(* ***** Eliza ***** *) (* This is a Mathematica version of Weizenbaum's famous (1966) ELIZA simulated conversation with a Rogerian psychotherapist. translated by Matthew Markert from a Prolog version To begin type "Eliza". The program works best when it is given one sentence at a time. To escape the clutches of eliza, type "goodbye". Note: A small incompatibility between $PreRead and notebook front ends (Windows, NeXT, or presumably Mac) causes an extra output prompt for every response. For this reason you may prefer not to use a notebook front end with this application. *) (* BreakIntoWords is a somewhat general utility used here to parse a sentence into a list of words. *) BreakIntoWords[phrase_String] := BreakIntoWords[phrase," "] BreakIntoWords[phrase_String,divider_String] := Block[{pairs}, pairs = Drop[Transpose[{#,RotateRight[#-2,-1]}],-1]&[ Union[Flatten[StringPosition[divider<>phrase<>divider,divider]]]]; Select[Map[StringTake[phrase,#]&,pairs],(#=!="")&] ] (* StringClip is an ad hoc solution to the problem of finding a sequnce of words, possibly capitalized, in an English sentence. It is not good code. *) StringClip[s_String,subs_String] := Block[{p}, p = StringPosition[s,subs]; If[Length[p]===0, p = StringPosition[ s, ToUpperCase[StringTake[subs,1]]<>StringDrop[subs,1] ] ]; If[Length[p]===0, s, p=p[[1]][[2]]; StringTake[s,{p+1,StringLength[s]}] ] ] (* Executing Eliza causes ElizaRead to take control of your Mathematica session. Type "goodbye" to get control back. *) Eliza := Block[{}, familyvalue = True; family = {"mother","father","sister","brother","parents"}; $PreRead = ElizaRead[("\""<>#<>"\"")]&; "Tell me your problem." ] (* ElizaRead only wants to help you ... *) ElizaRead[s_String] := Block[{s1,ls,qq}, qq = If[StringPosition[s,"?"]==={},False,True]; eq = If[StringPosition[s,"!"]==={},False,True]; s1 = StringReplace[ ToLowerCase[s], Map[(#->" ")&,Characters[",.?:{}!\""]]]; s1 = StringReplace[s1," "->" "]; ls = BreakIntoWords[s1]; "\""<>Which[ Length[ls] === 0, "I'm sorry. I didn't catch what you just said.", ls[[1]] === "goodbye", $PreRead=.;"Goodbye.", ls === {"tell","me","your","problem"}, "Tell me your problem.", MemberQ[ls,"always"], "Can you think of a specific example?", (Intersection[family,ls] =!= {}) && familyvalue, familyvalue = False; "Tell me more about your family.", MemberQ[ls,"depressed"], "I am sorry to hear that.", MemberQ[ls,"computer"] || MemberQ[ls,"computers"], "Are you afraid of computers?", MemberQ[ls,"my"], "Your"<>StringDrop[StringClip[s,"my"],-1], MatchQ[ls,{___,"you","are",___}] || MatchQ[ls,{___,"You","are",___}], StringDrop[ "What makes you think I am"<> StringClip[s,"you are"],-2]<>"?", qq, "Why do you ask that?", ls[[1]] === "yes", "You sound very positive.", ls[[1]] === "no", "You sound very negative.", Length[ls] === 1, "You are not very talkative.", (Length[ls] > 2) && (ls[[{1,2,3}]] === {"i","am","not"}), "Do you think coming here will help you to be"<> StringDrop[StringDrop[s,{1,9}],-1]<>"?", ls[[{1,2}]] === {"i","need"}, "What would it mean to you if you got "<> StringDrop[StringDrop[s,{1,8}],-1]<>"?", MemberQ[ls,"are"], "In what way?", Random[] < .2, "I do not follow you.", Random[] < .25, "I am not sure I understand.", Random[] < .33, "Tell me more.", Random[] < .5, "Go on.", True, "I see." ]<>"\"" ] /; StringLength[s] > 2 ElizaRead[s_String] := s