1 {------------------------------------------------------------------------------
    2                                  EXPERT SYSTEM
    3 
    4 This prototype expert system program uses the modules `result.g', `table.g',
    5 `knowledge.g', `match.g' and `search.g'. The main program reads in the file
    6 `animals', treats the first line as the main goal to be solved, and converts
    7 the remaining lines into the table of definitions representing the permanent
    8 knowledge about the problem area. The program then solves the main goal and
    9 displays the questions and solutions to the user, using the answers to the
   10 questions to continue the search for solutions. Each answer should be `yes' or
   11 `no'. After each solution, the user is asked whether the solution is adequate
   12 or whether the search should be continued for alternative solutions.
   13 ------------------------------------------------------------------------------}
   14 
   15 module Main where
   16 import Result
   17 import Table
   18 import Knowledge
   19 import Match
   20 import Search
   21 import IO hiding( try ) -- try is defined by Search
   22 import System--1.3
   23 
   24 -- The `main' function reads in the data file before interacting with user.
   25 -- The `process' function takes the contents of the file and the input from the
   26 -- user and produces the output. It builds an initial goal and a definition
   27 -- table from the file contents, and an information table from the user's
   28 -- input, and calls the `solve' function. The list of questions and solutions
   29 -- from this call is stripped to remove duplicate questions, and displayed as
   30 -- output.  The questions are also extracted and used to help build the
   31 -- information table which contains question-and-answer pairs.
   32 
   33 main = do
   34     prog <- getProgName
   35     args <- getArgs
   36     case args of
   37       [filename] -> getData filename
   38       []         -> getData "animals"
   39       _          -> hPutStr stderr ("Usage: " ++ prog ++ " datafile\n")
   40 
   41 getData filename = do
   42     contents <- readFile filename
   43     interact (process contents)
   44 
   45 {- OLD 1.2:
   46 main rs =
   47    GetProgName : GetArgs :
   48    let (r0:r1:rrs) = rs in
   49    case r1 of
   50       StrList [filename] -> getData filename rrs
   51       StrList [] -> getData "animals" rrs
   52       StrList args -> case r0 of
   53          Str prog -> [AppendChan stderr ("Usage: " ++ prog ++ " datafile\n")]
   54          Failure _ -> []
   55 
   56 getData filename rs =
   57    ReadFile filename :
   58    let (r:rrs) = rs in
   59    case r of
   60       Failure ioerr -> [AppendChan stderr
   61          ("Unable to read file " ++ filename ++ "\n")]
   62       Str contents -> interact (process contents) rrs
   63 -}
   64 
   65 process contents input =
   66    "Solving: " ++ showPhrase problem ++ "\n" ++
   67    display results (vars problem) replies
   68    where
   69    problem = goal (words (head (lines contents)))
   70    defs = definitions (tail (lines contents))
   71    info = enterList newTable [(q,a) | (Question q, a) <- zip results replies]
   72    replies = [words l /= ["no"] | l <- lines input]
   73    db = (defs,info)
   74    newsoln = Soln newTable ['X' : show n | n<-[0..]]
   75    results = strip [] (solve db newsoln problem)
   76 
   77 -- The `strip' function takes the list of questions and solutions from the main
   78 -- call to `solve' and removes all but the first occurrence of each question,
   79 -- to make sure that the user is not asked the same question twice. The first
   80 -- argument is a list of the questions seen so far.
   81 
   82 strip qs [] = []
   83 strip qs (Question q : rs) =
   84    if elem q qs then strip qs rs else
   85    Question q : strip (q:qs) rs
   86 strip qs (soln:rs) = soln : strip qs rs
   87 
   88 -- The display function displays a list of questions and solutions as a
   89 -- character stream. It also takes the list of variable names in the original
   90 -- goal to interpret solution environments using `showVars', and the list of
   91 -- answers from the user to determine whether to continue displaying more
   92 -- solutions.
   93 
   94 display [] xs as = "No (more) solutions\n"
   95 display (Question q : rs) xs as =
   96    "Is it true that " ++ q ++ "?\n" ++ display rs xs (tail as)
   97 display (Soln env vs : rs) xs as =
   98    "Solution: " ++ sol ++ ". More?\n" ++ etc  where
   99    sol = showVars env xs
  100    etc = if as == [] || head as == False then "" else display rs xs (tail as)
  101 
  102 showVars env vs =
  103    foldr1 join (map showVar vs) where
  104    join x y = x ++ "; " ++ y
  105    showVar v = v ++ " = " ++ showPhrase (subst env (Var v))