ML

Unification Algorithm

by Clint Morgan


(* Clint Morgan 
   AI homework 1 -- Unification
   Spring 2004 *)


(* Expression to unify *)
datatype expr = Symbol of string
	      | Predicate of expr * expr list
	      | Var of string

(* Result from unification *)
datatype unification = Fail
		     | Bindings of (expr*string) list (* expr / var string *)

(* apply : Bindings * expr -> expr 
   apply a set of variable binding to an expression to get a new
   expression with the var bound *)
fun apply _ (Symbol s) = Symbol s
  | apply s (Predicate(e,es)) = Predicate((apply s e), map (apply s) es)
  | apply (Bindings bs) (Var s) = 
    case List.find (fn (e,vs) => vs = s) bs
     of SOME(e,v) => e
      | NONE => Var(s)

(* composition : unification * unification list -> unification 
   compose multiple unifications and remove duplicates 
*)
(* raised when the same Var is substituted for different exprs *)
exception  bindingMismatch 
fun composition (b, []) = b
  | composition (Bindings s1, Bindings(s2)::bs) =
    let
	val new_bds = List.foldl 
			  (fn ((b as (e,s)), acc) => 
			      if List.exists 
				     (fn (e2,x) 
					 => if s=x andalso e2 <> e
					    then raise bindingMismatch
					    else s=x) acc
				     then acc else b::acc) s1 s2
    in
	composition(Bindings(new_bds), bs)
	handle bindingMismatch => Fail
    end


(* occursCheck : string * expression -> bool 
   make sure that the variable string does not occur in the expression *)
fun occursCheck (s1, Var s2) = (s1 = s2)
  | occursCheck (s, Predicate(e, es)) =
    occursCheck (s,e) orelse List.exists (fn x => occursCheck (s,x)) es
  | occursCheck _ = false

(* unify : expr * expr -> unification 
   Unify two expressions, returning the binding. This algorithm is an
   implementation of the pseudo code in the text pg 71. *)
fun unify (Symbol x, Symbol y) = if (x = y) then Bindings([]) else Fail
  | unify (Var x, e) = if occursCheck(x,e) then Fail else Bindings([(e,x)])
  | unify (e, Var y) = if occursCheck(y,e) then Fail else Bindings([(e,y)]) 
  | unify (Predicate(x, xs), Predicate(y, ys)) =
    let
	val subs1 = unify(x,y)
    in
	if subs1 = Fail orelse (List.length xs) <> (List.length ys) then Fail
	else let
		val te1 = List.map (apply subs1) xs
		val te2 = List.map (apply subs1) ys
		val subs2 = ListPair.map unify (te1, te2)
	    in
		case List.find (fn x => x=Fail) subs2
		 of SOME(_) => Fail
		  | NONE => composition(subs1, subs2)
	    end
    end

(* So that my sexy ML code can be fairly compared to less attractive
lisp, I will parse lisp expressions to ML datatype *)

(* parse : string -> expr 

 Turn a scheme s-exper representing a predicate expression into a ML
 datatype expr. *)

exception cannotParse
fun stringToExpr s =
    let
	val t = String.translate (fn #")" => " ) "
				   | #"(" => " ( "
				   | x => Char.toString x) s
	val toks = String.tokens Char.isSpace t

	(* Get tokens until closing paren *)
	fun chompClosing 1 (")"::ts) = ([], ts)
	  | chompClosing n (")"::ts) = let val (e,rest) = chompClosing (n-1) ts
				       in (")"::e, rest) end
	  | chompClosing n ("("::ts) = let val (e,rest) = chompClosing (n+1) ts
				       in ("("::e,rest) end
	  | chompClosing n (t::ts) = 
	    let val (e,rest) = (chompClosing n ts)
	    in (t::e, rest) end

	(* string list -> (expr, string list) *)
	fun tokensToExpr [] = raise cannotParse
	  | tokensToExpr (t::ts) =
	    case String.sub(t,0) 
	     of #"(" =>
		let 
		    val ((x::xs), rest) = chompClosing 1 ts
		    val (e, _) = tokensToExpr([x])
		in
		    (Predicate(e, (tokensToExprs xs)),
		     rest)
		end
	    | x => if Char.isUpper x
		then ((Var t),ts) else ((Symbol t),ts)

	and tokensToExprs [] = []
	  | tokensToExprs ts = 
	    let
		val (e, rest) = tokensToExpr ts
	    in
		e :: (tokensToExprs rest)
	    end

	val (e, rest) = tokensToExpr toks
    in
	if rest <> nil then raise cannotParse else e
    end

(* Test cases:

Example from text:

Control.Print.printDepth := 10;
val e1 = stringToExpr "(parents X (father X) (mother bill))";
val e2 = stringToExpr "(parents bill (father bill) Y)";

unify(e1,e2);
val it =
  Bindings
    [(Predicate (Symbol "mother",[Symbol "bill"]),"Y"),(Symbol "bill","X")]
  : unification

Another example:

val e1 = stringToExpr "(eats X X)";
val e2 = stringToExpr "(eats cat dog)";
val e3 = stringToExpr "(eats cannibal cannibal)";

- unify (e1, e2);
val it = Fail : unification
- unify (e1, e3);
val it = Bindings [(Symbol "cannibal","X")] : unification

And for the grand finale:

val e1 = stringToExpr ("(Where (Did Guy Girl) Why WhatHappendToJack " ^
			      "WhatHappenedToJill)");
val e2 = stringToExpr ("(upThehill (went jack jill) (fetch water)" ^
		       "(jack felldown (and broke his crown))" ^
		       "(jill came tumbiling after))");
- unify(e1, e2);
val it =
  Bindings
    [(Predicate
        (Symbol "jill",[Symbol "came",Symbol "tumbiling",Symbol "after"]),
      "WhatHappenedToJill"),
     (Predicate
        (Symbol "jack",
         [Symbol "felldown",
          Predicate
            (Symbol "and",[Symbol "broke",Symbol "his",Symbol "crown"])]),
      "WhatHappendToJack"),
     (Predicate (Symbol "fetch",[Symbol "water"]),"Why"),
     (Symbol "went","Did"),(Symbol "jack","Guy"),(Symbol "jill","Girl"),
     (Symbol "upThehill","Where")] : unification				  

*)
  

Close Window