code/gsv.hs

   1 type Predicate = String
   2 data Ent = Alice | Bob | Carl deriving (Eq, Show)
   3 data World = W1 | W2 | Hungry | Full deriving (Eq, Show)
   4 type Variable = String
   5 data Term = Constant Ent | Var Variable deriving (Eq, Show)
   6 data Clause =   Pred Predicate Term
   7               | Eq Term Term
   8               | Conj Clause Clause
   9               | Neg Clause
  10               | Poss Clause
  11               | Ex String Clause
  12               deriving (Eq, Show)
  13 type Assignment = [(Variable, Ent)]
  14 type Poss = (World, Assignment)
  15 type Infostate = [Poss]
  16
  17 referent :: Poss -> Term -> Ent
  18 referent (w,g) (Constant c) = c
  19 referent (w,(v',a):g) (Var v) = if v == v' then a else referent (w,g) (Var v)
  20
  21 extension :: World -> Predicate -> Ent -> Bool
  22 extension _ "woman" Alice = True
  23 extension _ "man" Bob = True
  24 extension _ "man" Carl = True
  25 extension Hungry "hungry" Alice = True
  26 extension _ "enter" Bob = True
  27 extension _ "enter" Carl = True
  28 extension _ "sit" Alice = True
  29 extension _ "sit" Bob = True
  30 extension W1 "closet" Alice = True
  31 extension W1 "guilty" Bob = True
  32 extension W2 "closet" Carl = True
  33 extension W2 "guilty" Carl = True
  34 extension _ _ _ = False
  35
  36 update :: Infostate -> Clause -> Infostate
  37 update s (Pred p t) = [i | i@(w,g) <- s, extension w p (referent i t)]
  38 update s (Eq t1 t2) = [i | i <- s, referent i t1 == referent i t2]
  39 update s (Conj c1 c2) = update (update s c1) c2
  40 update s (Neg c) = [i | i <- s, length (update [i] c) == 0]
  41 update s (Poss c) = [i | i <- s, length (update s c) > 0]
  42 update s (Ex v c) =
  43   concat [update [(w, (v,a):g) | (w,g) <- s] c | a <- domain]
  44
  45 domain = [Alice, Bob, Carl]
  46
  47 test1 = update [(W1, [])] (Ex "x" (Pred "man" (Var "x")))
  48 test2 = update [(W1, [])] (Ex "x" (Pred "woman" (Var "x")))
  49 test3 = update [(W1, [])] (Ex "x" (Ex "y" (Conj (Pred "man" (Var "x"))
  50                                                 (Pred "man" (Var "y")))))
  51 test4 = update [(W1, [])] (Ex "x" (Ex "y" (Eq (Var "x") (Var "y"))))
  52 test5 = update [(Hungry,[]),(Full,[])] (Neg (Pred "hungry" (Constant Alice)))
  53
  54 test6 = update [(Hungry,[]),(Full,[])]
  55                (Conj (Neg (Pred "hungry" (Constant Alice)))
  56                      (Poss (Pred "hungry" (Constant Alice))))
  57
  58 test7 = update [(Hungry,[]),(Full,[])]
  59                (Conj (Poss (Pred "hungry" (Constant Alice)))
  60                      (Neg (Pred "hungry" (Constant Alice))))
  61
  62 test8 = update [(W1,[("x",Bob)])]
  63                (Conj (Ex "x" (Pred "enter" (Var "x")))
  64                      (Pred "sit" (Var "x")))
  65
  66 test9 = update [(W1,[("x",Bob)])]
  67                (Conj (Pred "sit" (Var "x"))
  68                      (Ex "x" (Pred "enter" (Var "x"))))
  69 test10 = update [(W1,[]),(W2,[])]
  70                 (Conj (Ex "x" (Pred "closet" (Var "x")))
  71                       (Poss (Pred "guilty" (Var "x"))))
  72
  73 test11 = update [(W1,[]),(W2,[])]
  74                 (Ex "x" (Conj (Pred "closet" (Var "x"))
  75                               (Poss (Pred "guilty" (Var "x")))))
  76
  77