engboris
/
large-star-collider
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

fixed dgraph

master
Julia 3 years ago
parent
d32caf3070
commit
72474711d1
2 changed files with 18 additions and 41 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 38
      ocaml/Resolution.ml
  2. 15
      ocaml/Unification.ml

38
ocaml/Resolution.ml
Unescape View File

@ -20,61 +20,45 @@ let guard c x = if c then return x else []
======================================== *) ======================================== *)
(* Convert a pol and an id to a string, adding + or - before the id *) (* Convert a pol and an id to a string, adding + or - before the id *)
let pol_to_string pol id = let pol_to_string pol id =
if pol = Pos then "+" ^ id if pol = Pos then "+" ^ id
else if pol = Neg then "-" ^ id else if pol = Neg then "-" ^ id
else id else id
(* Convert a ray (which is polarized) to a term *) (* Convert a ray (which is polarized) to a term *)
let rec ray_to_term r = let rec ray_to_term r =
match r with match r with
| Var id -> (Var(id) : term) | Var id -> (Var(id) : term)
| Func(id, pol, raylist) -> (Func(pol_to_string pol id, List.map ray_to_term raylist) : term) | Func(id, pol, raylist) -> (Func(pol_to_string pol id, List.map ray_to_term raylist) : term)
(* Invert polarization of a pol*) (* Invert polarization of a pol*)
let inv_pol pol = let inv_pol pol =
if pol = Pos then Neg if pol = Pos then Neg
else if pol = Neg then Pos else if pol = Neg then Pos
else pol else pol
(* Invert the polarization of a ray to allow an easier Unification writing *) (* Invert the polarization of a ray to allow an easier Unification writing *)
let rec inv_pol_ray ray = let rec inv_pol_ray ray =
match ray with match ray with
| Func(id, pol, raylist) -> Func(id, inv_pol pol, List.map inv_pol_ray raylist) | Func(id, pol, raylist) -> Func(id, inv_pol pol, List.map inv_pol_ray raylist)
| _ -> ray | _ -> ray
(* Checks if a ray is polarised *) (* Checks if a ray is polarised *)
let rec is_polarised r = let rec is_polarised r =
match r with match r with
| Var id -> false | Var id -> false
| Func(_, p, r) -> (p <> Npol) || (List.fold_left (fun acc b -> (is_polarised b) || acc) false r) | Func(_, p, r) -> (p <> Npol) || (List.fold_left (fun acc b -> (is_polarised b) || acc) false r)
(* Checks if two rays are dual, meaning that after inverting polarization of one ray, the two rays can be unified *) (* Checks if two rays are dual, meaning that after inverting polarization of one ray, the two rays can be unified *)
let dual_check r1 r2 = let dual_check r1 r2 =
if (is_polarised r1 && is_polarised r2) then if (is_polarised r1 && is_polarised r2) then
(solve [(extends_varname (ray_to_term (inv_pol_ray r1)) "0"), (extends_varname ((ray_to_term r2)) "1")] []) (solve [(extends_varname (ray_to_term (inv_pol_ray r1)) "0"), (extends_varname ((ray_to_term r2)) "1")] [])
else None else None
(* Create an index for a constellation *) (* Create an index for a constellation *)
let index_constellation const = let index_constellation const =
List.combine (List.init (List.length const) (fun a -> a)) const List.combine (List.init (List.length const) (fun a -> a)) const
(* Make a list of links between two stars using their indexes*)
let are_linked (i, il) (j, jl) =
List.fold_left (fun link_list ray ->
List.fold_left (fun rl rs ->
let uni = dual_check ray rs in
if Option.is_some uni then ((i,j),(ray,rs))::rl else rl
) [] jl ) [] il
(* ======================================== (* ========================================
Constellation graph Constellation graph
======================================== *) ======================================== *)
@ -84,10 +68,13 @@ let dgraph const =
let indexed_const = index_constellation const in let indexed_const = index_constellation const in
indexed_const >>= fun (i, il) -> indexed_const >>= fun (i, il) ->
indexed_const >>= fun (j, jl) -> indexed_const >>= fun (j, jl) ->
guard (j >= i) (are_linked (i, il) (j, jl)) il >>= fun r1 ->
jl >>= fun r2 ->
guard (j >= i) ( let uni = dual_check r1 r2 in
if Option.is_some uni then [((i,j),(r1,r2))]
else [])
(* Convert a link to a string to be printable *) (* Convert a link to a string to be printable *)
let link_to_string dg = let link_to_string dg =
let rec aux dgl = let rec aux dgl =
match dgl with match dgl with
@ -97,7 +84,6 @@ let link_to_string dg =
in aux dg ;; in aux dg ;;
(* Print a dgraph *) (* Print a dgraph *)
let print_dgraph dg = let print_dgraph dg =
let rec aux dgl = let rec aux dgl =
match dgl with match dgl with
@ -127,12 +113,7 @@ let constellation = make_const_add 1 3 ;;
print_dgraph (dgraph constellation) ;; print_dgraph (dgraph constellation) ;;
(* test constellation cyclique déterministe *)
(*let boucle = [[Func("c", Neg, [x]) ; Func("c", Pos, [x])]]
print_dgraph (dgraph boucle);; *)
(* exec graph *) (* exec graph *)
let exec graph const = let exec graph const =
let rec aux graph sol = let rec aux graph sol =
match graph with match graph with
@ -147,9 +128,8 @@ let exec graph const =
in aux2 h sol in aux2 h sol
in aux graph (Some [],[]) ;; in aux graph (Some [],[]) ;;
(* Exec where it just keeps the last equation and re-tries to solve it as a whole instead of applying the solution of the previous equation *) (* Exec where it just keeps the last equation and re-tries to solve it as a whole instead of applying the solution of the previous equation *)
let exec2 graph const =
let exec2 graph const =
let rec aux graph sol = let rec aux graph sol =
match graph with match graph with
| [] -> Some sol | [] -> Some sol
@ -170,3 +150,7 @@ let exec graph const =
exec (dgraph constellation) constellation;; exec (dgraph constellation) constellation;;
exec2 (dgraph constellation) constellation;; exec2 (dgraph constellation) constellation;;
(* test constellation cyclique déterministe *)
let boucle = [ [Func("c", Neg, [x]); x] ; [Func("c", Pos, [Func("f", Npol, [y])]) ; Func("c", Npol, [x]) ] ] ;;
print_dgraph (dgraph boucle);;

15
ocaml/Unification.ml
Unescape View File

@ -10,7 +10,6 @@ type subst = id * term list
type equation = term * term type equation = term * term
(* convert a term to a string *) (* convert a term to a string *)
let rec term_to_string t = let rec term_to_string t =
match t with match t with
| Var id -> id | Var id -> id
@ -25,8 +24,7 @@ let rec term_to_string t =
let print_term t = let print_term t =
print_string (term_to_string t) print_string (term_to_string t)
(* Compare to terms *) (* Compare two terms *)
let rec compare_term t1 t2 = let rec compare_term t1 t2 =
match t1, t2 with match t1, t2 with
| Var(id1), Var(id2) -> String.compare id1 id2 | Var(id1), Var(id2) -> String.compare id1 id2
@ -37,21 +35,19 @@ let rec compare_term t1 t2 =
else List.compare compare_term fs gs else List.compare compare_term fs gs
(* Look if there's a var to be substituted in the term in the substitution environment *) (* Look if there's a var to be substituted in the term in the substitution environment *)
let rec indom t sl = let rec indom t sl =
match t with match t with
| Var id -> List.exists (fun (a,_) -> a = id ) sl | Var id -> List.exists (fun (a,_) -> a = id ) sl
| Func(_, tl) -> List.exists (fun a -> indom a sl) tl | Func(_, tl) -> List.exists (fun a -> indom a sl) tl
(* occurs checks if given var is in term *) (* occurs checks if given var is in term *)
let rec occurs id t = let rec occurs id t =
match t with match t with
| Var i -> i = id | Var i -> i = id
| Func(_, tl) -> List.exists (fun a -> occurs id a) tl | Func(_, tl) -> List.exists (fun a -> occurs id a) tl
(* extends_varname adds suffix to all var names of a term *)
(* extends_varname adds suffix to all var names of a term *)
let rec extends_varname t ext = let rec extends_varname t ext =
match t with match t with
| Var id -> Var(id ^ ext) | Var id -> Var(id ^ ext)
@ -59,7 +55,6 @@ let rec extends_varname t ext =
(* vars gives a list of all vars in a term *) (* vars gives a list of all vars in a term *)
let rec vars t = let rec vars t =
match t with match t with
| Var id -> [id] | Var id -> [id]
@ -70,11 +65,9 @@ let rec vars t =
======================================== *) ======================================== *)
(* apply applies a substitution to a var *) (* apply applies a substitution to a var *)
let apply id sub = let (_,s) = try List.find (fun (a,_) -> a = id ) sub with Not_found -> (id,Var(id)) in s let apply id sub = let (_,s) = try List.find (fun (a,_) -> a = id ) sub with Not_found -> (id,Var(id)) in s
(* subst applies all possible substition from an environment to a term *) (* subst applies all possible substition from an environment to a term *)
let rec substit trm sub = let rec substit trm sub =
match trm with match trm with
| Var id -> apply id sub | Var id -> apply id sub
@ -85,7 +78,6 @@ let rec substit trm sub =
======================================== *) ======================================== *)
(* Solves an equation list by returning solution list *) (* Solves an equation list by returning solution list *)
let rec solve eq sub = let rec solve eq sub =
match eq with match eq with
| [] -> Some sub | [] -> Some sub
@ -102,7 +94,7 @@ and elim id term eq sub =
(* ======================================== (* ========================================
Tests Tests
======================================== *) ======================================== *)
(*
let x = Var("x") let x = Var("x")
let v = Var("v") let v = Var("v")
let z = Var("z") let z = Var("z")
@ -141,3 +133,4 @@ let adeline = Var("Adeline")
let terme3 = Func("f",[ melina ; sieg; Func("g",[Func("h",[hyetta]); adeline])]) ;; let terme3 = Func("f",[ melina ; sieg; Func("g",[Func("h",[hyetta]); adeline])]) ;;
solve [(terme,terme3)] [] ;; solve [(terme,terme3)] [] ;;
*)
Write Preview
Loading…
Cancel
Save