Browse Source

adding string_to_term and a first version of exec

master
julia 3 years ago
parent
commit
d32caf3070
  1. 50
      ocaml/Resolution.ml
  2. 39
      ocaml/Unification.ml

50
ocaml/Resolution.ml

@ -123,6 +123,50 @@ let rec enat i =
let make_const_add n m = let make_const_add n m =
[[add Pos zero y y]; [add Neg x y z; add Pos (s x) y (s z)]; [add Neg (enat n) (enat m) r; r]] [[add Pos zero y y]; [add Neg x y z; add Pos (s x) y (s z)]; [add Neg (enat n) (enat m) r; r]]
let constellation = make_const_add 3 1 ;; 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 *)
let exec graph const =
let rec aux graph sol =
match graph with
| [] -> Some sol
| h::tail ->
let rec aux2 glink sol =
match glink, sol with
| [], _ -> aux tail sol
| ((i,j),(ri, rj))::t,(Some sola, solb) ->
aux2 t (solve [(substit (ray_to_term ri) sola,substit (ray_to_term rj) sola)] sola, (List.filter (fun a -> a <> ri) (List.nth const i))@solb )
| (_,(None,_)) -> None
in aux2 h sol
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 *)
let exec2 graph const =
let rec aux graph sol =
match graph with
| [] -> Some sol
| h::tail ->
let rec aux2 glink sol =
match glink, sol with
| [], _ -> aux tail sol
| ((i,j),(ri, rj))::t,(Some sola, solb) ->
aux2 t (let eq = ((ray_to_term ri),(ray_to_term rj))::sola in
if (solve eq []) = None then
failwith "marchpo"
else Some eq,
(List.filter (fun a -> a <> ri) (List.nth const i))@solb )
| (_,(None,_)) -> None
in aux2 h sol
in aux graph (Some [],[]) ;;
exec (dgraph constellation) constellation;;
exec2 (dgraph constellation) constellation;;

39
ocaml/Unification.ml

@ -9,22 +9,23 @@ type term = Var of id | Func of (id * term list)
type subst = id * term list type subst = id * term list
type equation = term * term type equation = term * term
(* Affiche un term *) (* convert a term to a string *)
let print_term t = let rec term_to_string t =
let rec aux t =
match t with match t with
| Var id -> id | Var id -> id
| Func(f, tl) -> f ^ "(" ^ | Func(f, tl) -> f ^ "(" ^
let rec aux2 vl = let rec aux2 vl =
match vl with match vl with
| [] -> "" | [] -> ""
| h::[] -> aux h | h::[] -> term_to_string h
| h::t -> (aux h) ^ "," ^ (aux2 t) | h::t -> (term_to_string h) ^ "," ^ (aux2 t)
in (aux2 tl) ^ ")" in (aux2 tl) ^ ")"
in print_string (aux t)
(* Fonction de comparaison entre deux termes sur l'ordre lexicographique *) let print_term t =
print_string (term_to_string t)
(* Compare to terms *)
let rec compare_term t1 t2 = let rec compare_term t1 t2 =
match t1, t2 with match t1, t2 with
@ -35,21 +36,21 @@ let rec compare_term t1 t2 =
else if comp < 0 then -1 else if comp < 0 then -1
else List.compare compare_term fs gs else List.compare compare_term fs gs
(* indom regarde si une variable est dans le domaine d'une substitution *) (* 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 regarde si une variable apparaît dans un 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 ajoute un suffixe à toutes les variables *) (* 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
@ -57,7 +58,7 @@ let rec extends_varname t ext =
| Func(f, tl) -> Func(f, List.map (fun a -> extends_varname a ext) tl) | Func(f, tl) -> Func(f, List.map (fun a -> extends_varname a ext) tl)
(* vars renvoie la liste de toutes les variables d'un 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
@ -68,11 +69,11 @@ let rec vars t =
Substitution Substitution
======================================== *) ======================================== *)
(* apply applique une substitution à une variable *) (* 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 applique une substitution sur un terme *) (* 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
@ -83,20 +84,20 @@ let rec substit trm sub =
Unification Unification
======================================== *) ======================================== *)
(* Résout une liste d'équations *) (* 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
| (Var(x), term)::t -> if Var(x) = term then Some (solve t sub) else Some (elim x term t sub) (* Si x = x c'est une équation inutile, on passe donc à la suite *) | (Var(x), term)::t -> if Var(x) = term then (solve t sub) else (elim x term t sub) (* If x = x it's a useless equation *)
| (term, Var(x))::t -> Some (elim x term t sub) (*Inutile de vérifier si term = Var(x) ici car c'est déjà vérifié à la ligne ci-dessus*) | (term, Var(x))::t -> (elim x term t sub) (*It's useless to check if term = Var(x) because it would be the same case as above *)
| (Func(f, fs), Func(g, gs))::t -> if f = g then Some (solve ((List.combine fs gs)@t) sub) else None (*si f et g ne sont pas égaux, on ne peut pas résoudre l'équation*) | (Func(f, fs), Func(g, gs))::t -> if f = g then (solve ((List.combine fs gs)@t) sub) else None (* If f and g are not equal, the equation can't be solved *)
and elim id term eq sub = and elim id term eq sub =
if eq = [] then Some sub if eq = [] then Some sub
else if occurs id term then None (* l'équation n'est pas soluble, car on aurait quelque chose de la forme x = f(x) *) else if occurs id term then None (* If that's the cas, we would have something like x = f(x) which can't be solved *)
else let sigma_xy = [(id, term)] in else let sigma_xy = [(id, term)] in
Some (solve (List.map (fun (a,b) -> (substit a sigma_xy, substit b sigma_xy)) eq) (sigma_xy@sub)) (* On substitue toutes les occurences d'id dans le système d'équation et on ajoute cette solution au système *) (solve (List.map (fun (a,b) -> (substit a sigma_xy, substit b sigma_xy)) eq) (sigma_xy@sub)) (* We apply the sigma_xy substitution and we add it to the solution list *)
(* ======================================== (* ========================================
Tests Tests

Loading…
Cancel
Save