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 *)