/* TEACH STROPPYGRAM Inspired by a first term miniproject to generate 'rude' responses, by Michael Harris, neurobiology major, 1982. Adapted by Aaron Sloman 8 Dec 2011 (and others earlier) The original program was called stroppy. A simplified version is included in this file. CONTENTS - (Use g to access required sections) -- The original "stroppy" program -- To run the original program -- To run the program in this file -- The original "stroppy" program ------------------------------------- This was the description of the original. STROPPY is an oversensitive, rude response generator which carries out ELIZA type matching tests on input text and employs randomized sentence construction using interchangeable part-sentences and descriptive words. The program is particularly sensitive to references to machines and handles or generates three basic types of sentences: 1) name calling (You stupid machine) 2) suggestions (Go jump in the lake) 3) retaliations (What do you mean Im a stupid machine) A DEFAULT procedure generates replies. In the event of no match being found, there is a primitive expletive generator which can add to the repertoire of default sentences. -- To run the original program ---------------------------------------- To run the original stroppy program in pop11, do ENTER lib stroppy That will compile and run the original lib stroppy. -- To run the program in this file ------------------------------------ To run the version in this file (which is a modified version of a subset of the LIB STROPPPY version: try the following: 1. Compile this file (ENTERN l1) 2. To pop11 or to ved type stroppy(); */ uses random; uses oneof; uses database; ;;; version of readline that ignores string quotes (apostrophes) uses nostring_readline nostring_readline -> readline; vars procedure( describe, lookat, notext, contains, machine_ref, suggest, default, comp) ; vars obj adj,lacking, compwords, plurcomps, digs, challenge, expl, sugg, action, contain, substance; ;;; The words and phrases from which descriptions and replies ;;; are built are stored in lists assigned to global variables. [ [object ['toad' 'mistake' 'disaster' 'sponge' 'assemblage of organic parts' 'thing' 'jelly fish' 'speck of intergalactic dust' 'squirrel excretion' 'baked bean' 'decerebrate cat' 'haggis'] ] ;;;-> obj; [adj [['apology of' det] 'pitiful' 'insignificant' 'wet' 'useless' ['mistake of' det] 'repugnant' 'organic' 'hormonal' 'pinkish' 'infective' 'sac_like' 'indescribable' 'awful' 'nasty' 'bilious' 'food imbibing'] ] ;;;->adj; [lacking ['Cant you be bothered to type anything?' 'Im sorry I didnt quite catch that.' 'RETURN to you too!' 'That was exciting' 'Any more scintillating contributions?' 'Boring!' 'Your typing is a trifle faint.'] ] ;;;->lacking; ;;; The following words are recognised as referring to computers. [compwords [computer machine pile heap typewriter calculator telly tv silicon vax Vax explode fuse blow chip chips box components screen diodes piece eliza metallic metal rusty wires junk load] ] ;;; ->compwords; [plurcomps [computers machines]] ;;;->plurcomps; ;;; Stock phrases. [challenge ['How dare you call me' 'What do you mean Im' 'Im not' 'You have no right to call me' 'Only a bio sod could call me a'] ] ;;;->challenge; ;;; The following are used to make up "suggestion" insults. [sugg ['Why dont you go' 'Go' 'Just go' 'I think you should go' 'Get out of here' 'Begone ' 'Please, please go' 'go forth from this place -'] ] ;;;->sugg; [action ['and jump in' 'for a swim in' 'and put your head in' 'and lower your horrible carcass into' 'and wallow in' 'and drown in' 'and immerse yourself in'] ] ;;; ->action; [contain ['a bucket of' 'a lake full of' 'a tank of' 'a large receptacle of' 'a ditch full of ' 'a vat full of'] ] ;;; ->contain; [substance ['pirahna fish' 'custard' 'Hyena offal' 'jelly fish' 'sour milk' 'pigeon droppings' 'rancid butter' 'used engine oil' 'reject silicon'] ] ;;;->substance; ;;; These are used when no matching of text possible. [digs ['Get lost' 'Look here' 'I know your sort' 'Dont make me laugh' 'How unoriginal' 'Thats rubbish' 'Im not standing for that' 'How dare you say that' 'I suppose you think thats funny' 'Dont give me that'] ] ;;; ->digs; ;;; prompt the user to type something [prompt ['What do you want' 'Go away Im having a nap you' 'AARRGH its you again' 'Oh no! Not another human again-you'] ] ] -> database; [] -> expl; ;;; Make a list of vowel character codes, assuming all text input has been ;;; transformed into lower case; vars vowels = [% explode('aeiou') %]; ;;; recogniser for words starting with a vowel define vowel_start(word) -> boolean; member(word(1), vowels) -> boolean enddefine; define tidy(output) -> output; ;;; This changes "det" in generated sentences to ;;; "a" or "an" as appropriate. lvars first, item, rest; flatten(output) -> output; ;;; for debugging ;;; output => ;;; first replace all occurrences of "det" before a vowel with "an" while output matches ![??first det ?item:vowel_start ??rest] do item => [^^first an ^item ^^rest] -> output; endwhile; ;;; now replace all remaining occurrences of "det" with "a" while output matches ![??first det ??rest] do [^^first a ^^rest] -> output; endwhile; enddefine; /* vowel_start("apple") => vowel_start("cat") => trace vowel_start untrace vowel_start tidy([go eat det mouse]) => tidy([pick up det apple]) => */ define get_option(keyword) -> option; lvars options; if present(![^keyword ?options]) then oneof(options) -> option; else 'SOMETHING WRONG CANNOT FIND OPTION FOR ' >< keyword => setpop(); endif; enddefine; define stroppy(); ;;; Gives introduction, handles input text and prints generated responses. lvars intro, text, tail, response; define prmishap(text,list); 'NOW YOUVE MADE ME MAKE A MISTAKE...' -> response; exitto(stroppy); enddefine; pr('\nTYPE ANYTHING YOU LIKE. TERMINATE WITH "RETURN" BUTTON.\ TO FINISH, TYPE \'BYE\' \n\n\n'); describe([]) -> tail; [^intro ^^tail] -> response; ppr([%tidy(response)%]); pr(newline); nostring_readline() -> text; until text matches [??x bye ??y] do apply(procedure(); tidy(lookat(text)) -> response; endprocedure); ppr(response); pr(newline); nostring_readline() -> text; enduntil; ppr(oneof(['Good riddance!' 'And dont come back' 'So much for that one!'])); nl(4); enddefine; define lookat(text) -> response; ;;; Carries out matching and word search tests on input text and ;;; generates response sentences. It uses MACHREF, DESCRIBE and SUGGEST. ;;; Sometimes a random element eliminates the use of a particular match. vars x, y, z, imp, answer,description; describe([]) -> description; [description ^description] => if text = [] then notext() -> response; elseif text matches [??x overgrown ?y] and random(7)<6 then oneof([['You underdeveloped' ^^description] 'The bigger the better' 'I have a brain the size of a planet' ['and you call me an overgrown' ^y]]) -> response; elseif contains([^^compwords ^^plurcomps], text) then machine_ref(text) -> response; elseif text matches [??x yourself] then oneof([['You cocky' ^^description] 'I cant stand arrogance' 'I said it first!' [%suggest()%]]) -> response; elseif text matches [??x just ??y] then oneof([['Well you are only' det ^^description] ['I think youre merely' det ^^description] ['That sounds ridiculous coming from' det ^^description] ]) -> response; elseif text matches [i think ??x] then oneof(['You cant even type-nevermind think!' 'Dont be stupid- you cant think' 'You can only think if you have a brain']) -> response; elseif text matches [i ??x] or text matches [im ??y] then oneof(['You are of no consequence.' [%default()%] 'Your presence is superfluous' 'Why should I listen to you?' 'I am not Eliza' 'Humans are all egocentrics']) -> response; ;;; Primitive expletive detecter. elseif text matches [?x off ??y] then oneof(['This input is unreadable' 'I was here first !' [^x 'off yourself!']]) -> response; ;;; Primitive suggestion detecter. elseif text matches [??x go ??y] or text matches [why dont you ??y] then oneof(['Keep your stupid suggestions to yourself' [Go ^^y yourself] [%suggest()%] 'Ive got much better things to do']) -> response; elseif member(hd(text), [What How Why what how why]) or last(text)="?" then oneof(['Dont ask me stupid questions' 'I cant stand beng asked things like that' 'Isnt it obvious ?' [%default()%]]) -> response; else default() -> response; endif; ;;; Detects and remembers "X off" expletives. if text matches [??x ?y off ??z] and y/="me" then [^^expl [^y off]] -> expl; endif; enddefine; define choose(keyword) -> sellist; ;;; Picks a word at random from the top few members of the ;;; argument list and puts it at the bottom. The chosen word ;;; is then available to the calling function. This ensures ;;; that the list is recycled and selections are not picked ;;; for a while after being used. lvars list; lookup(![^keyword ?list]); ;;;[^keyword ^list] => oneof(list) -> sellist; enddefine; define default() -> output; ;;; Used if no match of input text is found. lvars imp; if length(expl)>0 and random(4)=2 then hd(expl) -> imp; tl(expl) -> expl; elseif random(7)=4 then [%suggest()%] -> imp; else choose("digs") -> digs; [%last(digs)%] -> imp; endif; [^^imp you ^^description] -> output; enddefine; define machine_ref(text) -> response; ;;; This specialises in matching with inputs referring to computers. lvars answer; contains(compwords,text) -> answer; if answer then choose("challenge") -> challenge; last(challenge) -> imp; if text matches [??x just ??y] then oneof([[^imp only ^^y][JUST ^^y ?]]) -> response; elseif text matches [??x youre ??y ^answer] then [^imp ^^y ^answer] -> response; elseif text matches [??x you are ??y ^answer] then [^imp ^^y ^answer] -> response; elseif text matches [??x you ??y ^answer] then [^imp det ^^y ^answer] -> response; else comp() -> response; endif; else oneof(['What is wrong with being a machine ?' 'Computers are superior beings!' 'Thats a bit of an idiotic sweeping statement' 'Any more stupid generalizations to make?' 'Careful what you say or Ill have your job.']) -> response; endif; enddefine; define describe(subject) -> tail; ;;; Generates description of the general form ;;; "adjective, adjective, object" (with variable length). lvars y; if subject = [] then choose("object") -> obj; [obj ^obj] => obj ;;;last(obj); ;;; last(choose(obj)) else subject endif ->tail; [tail ^tail] => oneof([1 2 3 3 4]) -> y; [%repeat y times choose("adj") endrepeat, tail%] -> tail; enddefine; define contains(words, text) -> answer; ;;; If a member of "words" is in the text this is ;;; returned as "answer". if words = [] then false -> answer; elseif member(hd(words), text) then hd(words) -> answer; else contains(tl(words), text) -> answer; endif; enddefine; define notext() -> chunk; ;;; Generates replies when no text is typed in. lvars x,y,z, lacks; lookup(![lacking ?lacks]); if length(lacks) < 3 then ppr(oneof(['That does it. Im going back to sleep' 'Im off' 'Youre sending me to sleep.'])); nl(2); repeat 150 times ppr("z"); endrepeat; pr(newline); oneof(['Oh you are still here are you?' 'Hope it has gone away now']) -> chunk; else hd(lacks) -> chunk; ;;; tl(lacks) -> lacks; endif; enddefine; define suggest() -> suggestion; ;;; Builds suggestion insults (see global variables). lvars a, b, c, d; lvars suggestionon, content, substance; choose("sugg") -> sugg; [sugg ^sugg] => last(sugg) -> a; choose("action") -> action; [action ^action] => last(action) -> b; choose("contain") -> content; [contain ^content] => last(content) -> c; [last content ^c] => choose("substance") -> substance; last(substance) -> d; [substance ^substance d ^d] => [^a ^b ^c ^d] -> suggestion; [suggestion: ^suggestion] => enddefine; define comp() -> output; ;;; Generates responses to inputs containing singular "compwords" ;;; but which don't contain "you". if length(text)<4 and random(10) < 4 then [^text ?] -> output; else 'You' :: describe([human]) ->output; endif; enddefine; /* --- $usepop/pop/teach/stroppygram --- Copyright University of Birmingham 2011. All rights reserved. */