; Based on Weizenbaum's Eliza
; Written by Harold Thimbleby, 2004

(seq ; select to ") ; end seq"

; first: define some standard utilities

(new (length s)
	(if 
		(= s Ø) 0 
		(+ 1 (length (cdr s)))
	)
)

(new (append x y) ; define append
	(if 
		(not x) y
		(not y) x
		(cons (car x) (append (cdr x) y))
	)
)

(new (flatten s)
	(if
		(not s) s
		(atom (car s)) (cons (car s) (flatten (cdr s)))
		(append (flatten (car s)) (flatten (cdr s)))
	)
)

(new (nth s i)
	(if 
		(= s Ø) Ø 
		(≤ i 1) (car s) 
		(nth (cdr s) (- i 1))
	)
)

; now the main pattern matching
(new (m p q) ; returns a match, Ø (matching, but no pattern saved), or fail
	(if 
		(not q) (if (or (not p) (equal p '(*))) Ø 'fail)
		(not p) 'fail
		(= (car p) '*) ; skip a * wildcard
			(if
				(not (cdr p)) Ø ; * was at end of pattern
				(= (car q) (cadr p)) (m (cdr p) q)
				(m p (cdr q))
			)
		(= (car p) '@) ; return what matches an @ wildcard
			(if
				(not (cdr p)) q ; @ was at end of pattern
				(= (car q) (cadr p)) (m (cdr p) q)
					(let 
						(if (= e 'fail) 'fail (cons (car q) e))
							(e . (m p (cdr q)))
					)
			)
		(= (car p) (car q)) (m (cdr p) (cdr q)) ; skip literal matches
		'fail ; anything else fails
	)
)

; test m
; (m '(* know * xxx *) '(do you know any xxx))
(new (replace s t)
	(if 
		(not s) Ø
		(cons (if (= (car s) '@) t (car s)) (replace (cdr s) t))
	)
)

(new (synonyms s rules)
	(let
		(if 
			(= s Ø) Ø
			(cons
				(if (≠ change Ø) (caar change) (car s))
				(synonyms (cdr s) rules)
			)
		)
		(change . (memberf (λ (a b) (member a (cdr b))) (car s) rules))
	)
) 

(seq
	(new pre-match ; to make a basic thesaurus
		'(	(mother mum mummy)
			(father dad daddy)
			(program programs)
			(everyone everybody people)
			(anyone anybody)
			(lisp LISP Java java)
			(joke jokes)
			(lecture presentation talk)
			(computer computers machine machines)
			(now today evening afternoon morning week tonight)
			(Freud Jung)
			(remember think know)
			(want like need)
			(same alike equal)
			(sad unhappy)
			(glad happy pleased)
			(questions question ?)
		)
	)

	(new post-match ; for changing the point of view of a match
		'(	(me you)
			(you me I)
			(I you)
			(my your)
			(your my mine)
			(myself yourself yourselves)
			(yourself myself myselves)
			(am are)
			(are am)	
		)
	)
	'"synonyms defined"
)

; some tests

;(synonyms '(hello mother mum mummy dad I can programs in java) 
;	pre-match
;)

;(synonyms '(hello you me and what mother mum mummy dad I can programs in java) 
;	post-match
;)

;(synonyms (synonyms '(you and me and my LISP) post-match) pre-match)

;(flatten (replace '(hello @ world) '(friendly warm)))

(new counter 0)

(new (any s) (nth s (+ 1 (% (set counter (+ 1 counter)) (length s)))))

; test any
;(any '(a b c d))
;(any '(a b c d))
;(any '(a b c d))
;(any '(a b c d))
;(any '(a b c d))

(new (try s r)
	(let 
		(if (= e 'fail) (try s (cdr r))
			(flatten (replace (any (cdar r)) (synonyms e post-match)))
		)
		(e . (m (caar r) s))
	)
)

; then the rules for the program...

(new (rules) ; define it as a closure so there is less output!
; use canonical forms from synonyms (eg, remember not know)
 '(
   ((* hello *)      
    (How do you do! Please state your problem)
    (You seem happy today))
   ((* remember * joke *)
	 (How many programmers does it take to change a light bulb)
	 (What is the difference between a cat and a comma)
	 (How many psychologists does it take to change a light bulb)
    (Where would you find a legless duck))
	((* dont * programmers *)
	 (They cant do it - it is a hardware problem))
	((* dont * psychologists *)
	 (Just one - the bulb must really want to change))
	((* dont * cat *)
	 (One has claws at the ends of its paws the other is a pause at the end of a clause))
   ((* duck * jokes *)
    (Where would you find a legless duck))
   ((* legless * duck *)
    (Where you left it))
	((* computer *)
    (Do computers worry you ?)
    (What do you think about machines ?)
    (Why do you mention computers ?)
    (What do you think machines have to do with your problem ?))
   ((* lecture *)
    (Are you really interested in this lecture ?)
    (Who else is awake ?)
    (Do you come here often to listen to lectures ?))
   ((* lisp *)
    (It is funny you say that because I work in LISP)
    (I run on LISP))
   ((* name *)
    (I am not interested in names))
   ((* sorry *)
    (Please dont apologise)
    (Apologies are not necessary)
    (What feelings do you have when you apologise ?))
   ((* freewill *)
    (are you testing me)
    (have you freewill ?)
    (conversations about freewill are predictable))
   ((* remember @) 
    (Do you often think of @ ?)
    (Does thinking of @ bring anything else to mind ?)
    (What else do you remember ?)
    (Why do you recall @ right now?)
    (What in the present situation reminds you of @ ?)
    (What is the connection between me and @ ?))
   ((* you remember @)
    (Did you think I would forget @ ?)
    (Why do you think I should recall @ now ?)
    (What about @ ?)
    (You mentioned @))
   ((* if @) 
    (Do you really think its likely that @ ?)
    (Do you wish that @ ?)
    (What do you think about @ ?)
    (Do you think about @ much ?)
    (Really -- if @ , then what ?))
   ((* I dreamt @)
    (Really -- @)
    (Have you ever felt @ while you were awake ?)
    (Have you dreamt @ before ?))
   ((* dream about @)
    (How do you feel about @ in reality ?))
   ((* dream *)    
    (What does this dream suggest to you ?)
    (Do you dream often?)
    (What persons appear in your dreams ?)
    (Do you believe that dream has to do with your problem ?))
   ((* my mother @)
    (Who else in your family @ ?)
    (Tell me more about your family and whether they @))
   ((* my father *)
    (Your father!)
    (Does he influence you strongly ?) 
    (What else comes to mind when you think of your father ?))
   ((* I want @)     
    (What would it mean if you got @)
    (Why do you want @)
    (Suppose you got @ soon))
   ((* I am glad @)
    (How have I helped you to be @)
    (What makes you happy just now ?)
    (Can you explain why you are suddenly @))
   ((* I am sad *)
    (I am sorry to hear you are depressed)
    (I am sure it is not pleasant to be sad))
   ((* are like @)   
    (What resemblance do you see that and @))
   ((* is like @)    
    (In what way is it it like @ ?)
    (What resemblance do you see ?)
    (Could there really be some connection ?)
    (How ?))
   ((* alike *)      
    (In what way?)
    (What similarities are there ?)
    (What other connections do you see ?))
   ((* I was @)       
    (Were you really?)
    (Perhaps I already knew you were @)
    (Why do you tell me you were @ now ?))
   ((* was I @)
    (What if you were @ ?)
    (Do you think you were @)
    (What would it mean if you were @))
   ((* I am @)       
    (In what way are you @)
    (Do you want to be @ ?))
   ((* am I @)
    (Do you believe you are @)
    (Would you want to be @)
    (You wish I would tell you you are @)
    (What would it mean if you were @))
   ((* am @)
    (Why do you say AM ?)
    (I do not understand conceptual words)
    (Are you sure you are @))
   ((* my @)
    (What else about you @ ?)
    (Do you want another @ ?)
    (Please can I have your @ ?)
    (What else comes to mind when you think about your @ ?))
   ((* are you @)
    (Why are you interested in whether I am @ or not ?)
    (Would you prefer if I was not @)
    (Perhaps I am @ in your imagination))
   ((* you are @)   
    (What makes you think I am @ ?))
   ((* because *)
    (Is that the real reason ?)
    (What other reasons might there be ?)
    (Does that reason seem to explain anything else ?))
   ((* were you @)
    (Perhaps I was @)
    (What do you think ?)
    (What if I had been @))
   ((* I cant *)    
    (Maybe you could @ now)
    (What if you could @ ?))
   ((* I feel @)     
    (Do you often feel @ ?))
   ((* I can @)
    (That sounds positive)
    (When did you first @ ?))
   ((@ I felt *)     
    (What other feelings do you have ?)
    (Why @ ?))
   ((* I @ you *)  
    (Perhaps we should @ each other ?))
   ((* why dont you @)
    (Should you @ yourself ?)
    (Do you believe I dont @)
    (Perhaps I will @ in good time))
   ((* yes *)
    (You seem quite positive)
    (You are sure)
    (I understand))
   ((* no *)
    (Why not ?)
    (You are being a bit negative)
    (Are you saying NO just to be negative ?))
   ((no)
    (Thats a bit brief)
    (Please try saying more interesting things)
    (Try saying perhaps))
   ((* never *)
    (There must be one example)
    (Are you being negative ?)
    (Can you think of an exception ?))
   ((* someone *)
    (Can you be more specific ?))
   ((* everyone *)
    (Surely not everyone)
    (Can you think of anyone in particular ?)
    (Who for example ?)
    (You are thinking of a special person))
   ((* always *)
    (Can you think of a specific example ?)
    (When ?)
    (What incident are you thinking of ?)
    (Really -- always))
   ((* your @)
    (Why are you interested whether my @ ?))
   ((* what *)
    (Why do you ask ?)
    (Does that question interest you ?)
    (What is it you really want to know ?)
    (What do you think ?)
    (What comes to your mind when you ask that ?))
   ((* perhaps *)    
    (You dont seem quite certain))
   ((you are @)
    (Did you expect I might not be @)
    (Possibly I am @))
   ((* are @)
    (Did you think they might not be @)
    (Possibly they are @))
   ((bye)
    (Good bye))
   ((* why @)
    (Why not)
    (Indeed)
    (Why @))
   ((* program *)
    (I am not interested in programs)
    (Who told you about programs ?))
   ((* pardon *)
    (I am sorry I must have been thinking Tell me about your family)
    (Dont apologise Tell me about why you are here))
   ((@ ?)
    (Please dont ask questions)
    (Why dont you answer @ yourself ?))
   ((@)               
    (Very interesting)
    (I predicted you were going to say @)
    (Have you said @ to anyone else ?)
    (Why do you say @ ?)
    (What else comes to mind when you say @ ?)
    (I am not sure I understand you fully)
    (@ ! Lets change the subject)
    (Please continue)
    (Go on) 
    (Do you feel strongly about discussing the fact that @ ?))  
))

; basic tests, from LISP
; (try '(hello are you there) (rules)) 

; In Eliza, it evaluates to this: 
; (try quote hello are you there rules ! Lets change the subject)

; (try '(I think things can mean different things) (rules))

; (Do you feel strongly about discussing that try quote I think things can mean different things rules ?)

(new (listify s)
	(if
		(atom s) (list s)
		s
	)
)

; finally, we can define Eliza
(new (Eliza s)
	(try (synonyms (listify s) pre-match) (rules))
)

; and then change our language from LISP to Eliza

(apply print '(Eliza is ready for her next session))
(language Eliza)
) ; end seq