Eliza in ML
Fall 2000, David Matuszek, Villanova University

The following program is intended to be a sample ML program, not a full implementation of Eliza. I hope it will be helpful to you as you try to write in ML.

The program: (1) Does pronoun substitutions in replaceWords(sentence), using the substitutions defined in pronouns() (they aren't all pronouns), and (2) looks for patterns in try(words,rules), using the rules defined in rules(). If no pattern matches, the original sentence is just repeated.

A sentence comes in as a string, is converted to a list of characters, the characters are assembled into "words" (a list of strings), the words are manipulated, then the whole thing is converted back into a string for the final result.

Note that this is just a quick&dirty program, and could probably be cleaned up and simplified quite a bit; it's just the first thing that I got to (mostly) work. Sample output is at the bottom.

Trouble compiling this program? If ML complains that it doesn't know what Char.isAlpha is, you are probably trying to use MLWorks 2.0 instead of MLWorks 2.0 + Basis. Use the correct executable and you should be fine.


(* reload is just a convenience function that I wrote
   while debugging the function. *)

fun reload () = use "C:\\_ML\\eliza.sml";

(* Here is the list of pronoun substitutions. To simplify
   the program, it gets rid of any capital letters it sees. *)

fun pronouns () =
  [ ("I", "you"),
    ("me", "you"),  ("Me", "you"),
    ("my", "your"), ("My", "your"),
    ("am", "are"),  ("Am", "are")  ];

(* Here are some simple rules. The form of each rule is
   (   ([front], [back]),   ([new front], [new back])   )
   That is, if the sentence is "front something back," then
   the desired response is "new-front something new-back".  *)

fun rules () =
  [ ( (["you", "like"], ["?"]),
      (["Why", "do", "you", "like"], []) ),
    ( (["your"], []),
      (["Is", "the", "fact", "that", "your"], ["important", "to", "you?"]) ),
   ( ([], ["likes", "you"]),
     ([], ["sees", "the", "real", "you."]) )    ];

(* Given a list and a test, return a tuple containing two lists:
   the elements at the FRONT of the original list that satisfy
   the test, and a list of the remaining elements. *)

fun span test [] = ([], [])
|   span test (chars as ch::chs) =
      if test ch then
        let val (first, rest) = span test chs
        in (ch::first, rest)
        end
      else ([], chars);

(* Given a char list containing words, return the first word
   (as a char list) and the char list with the first word removed.
   If there are no remaining words, return ([], []).  *)

fun firstWord (chars) =
  let val (_, rest) = span (fn x => not (Char.isAlpha x)) chars
  in span Char.isAlpha rest
  end;

(* Given a string representing a sentence, return a list of
   strings, each string being one word. Punctuation is discarded. *)

fun breakIntoWords sentence =
  let
    fun break [] : string list = []
|     break sentence =
        let val (first, rest) = firstWord sentence
        in
          if first = [] then break rest
                        else (implode first) :: break rest
        end
  in
    break (explode sentence)
  end;

(* Given a list of words, use pronouns() to find suitable
   substitutions for some of the words. Once a word has been
   replaced, it cannnot be replaced again. *)

fun replaceWords (sentence) =
  let
    fun substitute (original, []) = original
|       substitute (original, ((old, new) :: pairs)) =
          if original = old then new
                            else substitute (original, pairs);
  in
    map (fn x => substitute (x, pronouns ())) sentence
  end;

(* Concatenate the words in a list, with blanks between. *)

fun reassemble [] = ""
|   reassemble (word::words) = word ^ " " ^ reassemble words;

(* Test if the first argument is an initial sublist of the
   second argument. *)

fun matchAtFront ([], _) = true
|   matchAtFront ((p1 :: p2), (w1 :: w2)) =
      if p1 = w1 then matchAtFront (p2, w2)
      else false;

(* Test if the first argument is a sublist of the second
   argument. Here, "sublist" really means "subsequence." *)

fun sublist (sub, list as (head::tail)) =
  if matchAtFront (sub, list) then true
  else sublist (sub, tail);

(* If front is an initial sublist of the sentence, and back
   is a final sublist of the sentence, return the part of
   the sentence in the center that wasn't matched. Otherwise
   just return []. *)

fun match (sentence, front, back) =
  if matchAtFront (front, sentence) andalso
     matchAtFront (rev back, rev sentence)
  then
    let val frontLen = length front;
        val backLen = length back;
        val midLen = (length sentence) - frontLen - backLen
    in  List.take ((List.drop (sentence, frontLen)), midLen)
    end
  else [];

(* Take a list of words and a list of rules, look for a rule
   that applies, and apply it. If no rule applies, return the
   original list of words. *)

fun try (words, []) = words
|   try (words, (rule::rules)) =
      let val ((oldFront, oldBack), (newFront, newBack)) = rule;
          val center = match (words, oldFront, oldBack)
      in
        if center = [] then try (words, rules)
        else newFront @ center @ newBack
      end;

(* Main routine. Accept a string, return a response. *)

fun say input =
  reassemble (try (replaceWords (breakIntoWords input), rules ()));

MLWorks> say "I like to read.";
val it : string = "Why do you like to read ? "
MLWorks> say "Nobody likes me.";
val it : string = "Nobody sees the real you. "
MLWorks> say "My mother wants me to get a job.";
val it : string = "Is the fact that your mother wants you to get a job important to you? "
MLWorks> say "Goodbye.";
val it : string = "Goodbye "