a golden oldie challenge: Eliza - comp.lang.lisp

Message from discussion a golden oldie challenge: Eliza

Mark Tarver

View profile

More options 22 Feb 2008, 11:59

Newsgroups: comp.lang.lisp, comp.lang.functional

From: Mark Tarver <dr.mtar...@ukonline.co.uk>

Date: Fri, 22 Feb 2008 03:59:02 -0800 (PST)

Local: Fri 22 Feb 2008 11:59

Subject: Re: a golden oldie challenge: Eliza

  Reply to author
  |
  Forward | Print | View thread
  | Show original
  | Report this message | Find messages by this author
  

On 22 Feb, 11:49, Mark Tarver <dr.mtar...@ukonline.co.uk> wrote:

> Having got 3936 LOC through a 4000 LOC implementation, I thought I'd
> do some recreational
> hacking and do an old old program I've not looked at for some time -
> Eliza. You all know Eliza well enough for me not to have to spell it
> out. The challenge is to implement or dig up an Eliza program (you
> don't have to write it yourself) in your favourite FPL. Note that the
> script that drives Eliza's responses should not be counted towards the
> LOC count. Some constraints.

> 1. The script itself should be changeable by any novice. That is to
> say that it should not
> be a pile of hard-wired code written in the native language of
> the program or require
> deep programming skills.

> 2. The program should receive keyboard input from the user -
> including the usual punctuation
> and any characters he wants to enter without crashing.

> During the Harrop Wars on comp.lang.lisp a lot of stuff was thrown
> around about the desirability of pattern matching. The challenge is
> interesting because it involves a style of pattern-matching called
> 'segment pattern matching' that is not hard-wired into most FPLs and
> I'd like to see how well different FPLs cope with something outside
> the standard.

> Oh last thing; don't get too uptight about this. It's only a bit of
> fun.

> Mark

Well here is my shot at it in Qi. Total LOC excluding script is 70
LOC. You should run it under Qi 9.2 (latest release) because the
system function 'read-chars-as-stringlist' had a bug that was patched
in that release. My script is very boring ;).

I looked for a Haskell/ML equivalent and found zilch. Norvig's PAIP
contains a Lisp version in two files (eliza and eliza1) that is about
150 LOC excluding comments and script.

Mark
___________________________________________________________
(set *script* [
[[X "like" Y] ["Why" "do" "you" "like" Y "?"]]
[[X "father" Y] ["Tell me about your father."]]
[[X] ["That's very interesting. Do go on."]]])

(define eliza
-> (do (output "hi~%?- ") (eliza-loop (user) (value *script*))))

(define eliza-loop
User Script -> (let Responses (map (/. S (pmatch User S)) Script)
Interesting (remove-if no-match? Responses)
ScriptError (if (empty? Interesting)
(error "script failure!")
_)
Choice (nth (+ (random (length Interesting)) 1)
Interesting)
Response (respond-with Choice)
Output (output "~{~A ~}~%~%?- " Response)
(eliza-loop (user) Script)))

(define respond-with
[[] R] -> R
[[[X V] | B] R] -> (respond-with [B (rep X R V)]))

(define no-match?
[#\Escape _] -> true
_ -> false)

(define user
-> (read-chars-as-stringlist (user-loop (read-char _)) whitespace?))

(define whitespace?
#\Space -> true
#\Tab -> true
#\, -> true
#\. -> true
_ -> false)

(define user-loop
#\Newline -> []
C -> [C | (user-loop (read-char _))])

(define remove-if
_ [] -> []
F [X | Y] -> (if (F X) (remove-if F Y) [X | (remove-if F Y)]))

(define pmatch
User [I R] -> [(pmatch-help I User []) R])

(define nilbind
X [] -> [[X []]]
X [[X V] | B] -> [[X V] | B]
X [Y | Z] -> [Y | (nilbind X Z)])

(define consbind
X W [] -> [[X [W]]]
X W [[X V] | B] -> [[X (append V [W])] | B]
X W [Y | B] -> [Y | (consbind X W B)])

(define rep
_ [] _ -> []
X [X | Y] V -> (append V (rep X Y V))
X [Y | Z] V -> [Y | (rep X Z V)])

(define value-in
X B -> (head (tail (assoc X B))))

Reply to author Forward