home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / hugs101.zip / hugs101o.zip / Progs / HUGS / Demos / Expert / Search.hs < prev    next >
Text File  |  1995-02-14  |  4KB  |  90 lines
  1. {------------------------------------------------------------------------------
  2.                                    SEARCHING
  3.  
  4. The `solve' function is the logical inference mechanism which allows the expert
  5. system to search for solutions to goals, by making deductions from the stored
  6. definitions and from the answers to the questions which it asks the user. This
  7. is essentially the same as the inference mechanism which is built into logic
  8. programming languages, with two main differences.  The first is that the search
  9. algorithm has to be programmed explicitly, and the second is that interaction
  10. with the user cannot be handled as a side effect; questions are returned as
  11. part of the result, and answers are fed in as part of the argument.
  12. ------------------------------------------------------------------------------}
  13.  
  14. module Search where
  15. import Result
  16. import Table
  17. import Knowledge
  18. import Match
  19.  
  20. -- A call to `solve' returns a list of solutions and questions of type
  21. -- `Solution'. Each solution will be preceded by the questions to which `solve'
  22. -- needs answers in order to form that solution, and the answers to these
  23. -- questions are passed to `solve' in its database argument. A solution
  24. -- consists of an environment giving information about variables, and a list of
  25. -- variable names which are not mentioned in the environment and are therefore
  26. -- available for general use. In particular, the search procedure often calls
  27. -- for a copy of a goal to be made using fresh variables, and the `freshCopy'
  28. -- function performs this, returning a modified solution along with the copy.
  29.  
  30. data Solution = Soln Environment [String] | Question String
  31.  
  32. freshCopy (Soln env vs) p =
  33.    ((Soln env (drop n vs)), subst tab p) where
  34.    tab = updateList newTable (zip xs [Var v | v <- take n vs])
  35.    xs = vars p
  36.    n = length xs
  37.  
  38. -- The arguments to `solve' are: a database of stored definitions and
  39. -- information gained from answers to questions, a partial solution
  40. -- representing the information gained about variables so far in the search,
  41. -- and a goal to be satisfied. The first equation allows questions which are
  42. -- generated deep within the search to be passed up and out in the main
  43. -- solution stream. Compound goals are solved by solving the two subgoals and
  44. -- combining the solutions. In the case of `and', information gained in each
  45. -- solution to the first subgoal is used in solving the second. A simple goal
  46. -- (a relation) is solved either by consulting the stored definitions, or by
  47. -- asking the user a question, depending on the verb in that relation.
  48.  
  49. solve db (Question q) g = [Question q]
  50.  
  51. solve db soln (Term "or" [g1,g2]) =
  52.    solve db soln g1 ++ solve db soln g2
  53.  
  54. solve db soln (Term "and" [g1,g2]) =
  55.    concat [solve db res g2 | res <- solve db soln g1]
  56.  
  57. solve db soln g =
  58.    if not (null rs) then lookup db soln g rs else ask info soln g
  59.    where
  60.    (defs,info) = db
  61.    rs = relevant defs g
  62.  
  63. -- To `lookup' a simple goal using the list of rules `rs', a fresh copy of each
  64. -- rule is made (to avoid name clashes with variables about which information
  65. -- is already known), and `try' is used to see if the left hand side of the
  66. -- rule matches the goal. If it does, the goal on the right hand side of the
  67. -- rule is used to continue the search for solutions.
  68.  
  69. lookup db soln g rs =
  70.    concat [try db soln' g r' | (soln',r') <- copies] where
  71.    copies = [freshCopy soln r | r<-rs]
  72.  
  73. try db (Soln env vs) g (Term "if" [p,newg]) =
  74.    if fails m then [] else solve db (Soln (answer m) vs) newg
  75.    where
  76.    m = match env g p
  77.  
  78. -- If the solver must ask a question then that question is returned in the list
  79. -- of solutions. The answer is then looked up in the table `info' of
  80. -- questions-and-answers passed as an argument. If the answer is `yes', then
  81. -- the current partial solution is returned. This assumes that questions
  82. -- contain no variables, eg `the animal has stripes?'. Note that, as with other
  83. -- interactive i/o functions, `ask' must return the question before testing the
  84. -- answer.
  85.  
  86. ask info (Soln env vs) g =
  87.    Question (showPhrase (subst env g)) :
  88.    if ans then [Soln env vs] else [] where
  89.    ans = answer (find info (showPhrase (subst env g)))
  90.