mac@uvacs.UUCP (01/12/84)
.TH BLITHER nil UVa .SH NAME blither - generate locally coherent text .SH SYNOPSIS .B blither [ \-match .I matchdist ] [ \-length .I replymax ] [ \-sequence ] [ \-db ] .SH DESCRIPTION .PP Fifth-generation software has made it possible to generate new knowledge from old. .PP The program .I blither copies sentences from standard input to standard output, scrambling them by splicing different sentences together at common subsequences. This is very similar to the random text generation described in .I "Scientific American" Computer Recreations of November 1983. In this case, however, the units are words instead of characters. The .I \-match argument can be used to set the required length of common subsequences. .PP Program parameters are: .TP .B \-match changes the order of coherence of the sentences. The default .I matchdist=1. .TP .B \-length changes the maximum length of generated sentences. When a word is repeated in a sentence (e.g. Quack! Quack!) the sentence generator can get stuck in a loop. This maximum gets it out. Default .I replymax=20. .TP .B \-sequence makes each sentence output start from the corresponding input sentence. Otherwise the output sentence is chosen from the set of previous input. This option speeds up the program on large texts. .TP .B \-db intersperses garbage collector statistics & other nonsense. .SH EXAMPLES deroff th | blither -match 3 | nroff -me | page .SH BUGS "I'm better now! Quack! Quack! Quack! Quack! Quack! Quack! Quack!..." .PP Understanding of punctuation is weak. .PP Random number generator is not seeded. .SH AUTHORS .nf Tim Stryker Jeff Dalton Alex Colvin
mac@uvacs.UUCP (01/12/84)
;
; Blither a` la Tim Stryker
; programmed by Jeff Dalton '78
; copyright (c) 1977 by the trustees of Dharma College
; adapted for Franz by alex colvin 1983
; This program was originally written to engage the user in a dialogue.
; It was converted for UN*X to use as a text filter, e.g.
; deroff th | mumble -match 3 | nroff -me | page
; Some of the code is idiomatic DTSS Lisp, some is just strange. It
; shouldn't be taken as a guide to Lisp programming.
; $Compile: liszt -r -o %F %f
; functionq[f] == a cheap funarg, since we don't need closures
;
(def functionq (macro (l) (cons 'quote (cdr l))))
(declare
(special sentences ; list of known sentences
replymax ; bound on reply length (avoid Quack ! Quack ! ...)
matchdist ; coherence factor
sequence ; controls replies
$gcprint ; system GC trace flag
))
; worker[] == main driver
;
(def worker
(lambda ()
(readargs)
(talk)
))
; readargs[] == scan argv and set parameters
(def readargs
(lambda ()
(prog (n a)
(setq n 0)
a (setq n (add1 n))
(cond ((equal n (argv)) (return)))
(setq a (argv n))
(cond ((eq a '-match)
(setq matchdist (makenum (argv (setq n (add1 n))))) )
((eq a '-length)
(setq replymax (makenum (argv (setq n (add1 n))))) )
((eq a '-sequence)
(setq sequence t) )
((eq a '-db)
(setq $gcprint t) )
)
(go a) )))
; makenum[x] == convert a symbol x to a number
(def makenum (lambda (x) (readlist (explodec x))))
; talk[] == function to conduct the conversation
(declare
(special letter ; peek character
eof ; eof flag
))
(def talk
(lambda ()
(prog (letter answer)
(setq letter (readc))
a: (setq answer (readanswer))
(cond ((eq (car answer) eof)
(return) )
(t
(setq sentences (cons answer sentences ))
(analyze answer)
(printsentence (replyto answer))
))
(go a:)
)))
;
; sentence i/o functions
(declare
(special nl ; newline
spa ; space
tab ; tab
))
(setq nl (ascii 10))
(setq spa (ascii 32))
(setq tab (ascii 9))
(setq eof nil) ; value of (readc) on eof
; readword[] == returns the next word
; leaving the first character after the word in 'letter'
(def readword
(lambda ()
(prog (word)
sp: (cond ((get letter 'whitespace)
(setq letter (readc))
(go sp:)))
(setq word (cons letter nil))
(cond ((get letter 'break)
(setq letter (readc))
(return (car word))))
eat: (setq letter (readc))
(cond
((get letter 'break)
(return (implode (nreverse word)))))
(setq word (cons letter word))
(go eat:))))
; readanswer[] == read a sentence from the terminal
(def readanswer
(lambda ()
(prog (word sentence)
a: (setq word (readword))
(setq sentence (cons word sentence ))
(cond ((get word 'endsentence) (return (nreverse sentence)) ))
(go a:)
)))
; character classes
(def defclass
(lambda (class chars)
(map (functionq (lambda (x) (putprop (car x) t class)))
chars)))
; word breaks
(defclass 'break
(list nl tab spa eof
'\? '\( '\) '\[ '\] '\@ '\, '\! '\. '\: '\; '\"))
; white space characters
(defclass 'whitespace
(list nl tab spa))
; end of sentence characters
(defclass 'endsentence
(list eof '\? '\. '\!))
; printsentence [sentence] == prints the sentence in a readable form to the port
(def printsentence
(lambda (sentence)
(prog ()
a (cond (sentence (princ (car sentence))
(cond ((not (get (cadr sentence) 'break))
(princ spa)))
(setq sentence (cdr sentence))
(go a) ))
(terpri)
)))
;
; sentence recombination
; analyze[sentence] == associate each word in the sentence with the rest
; of the sentence
;
(def analyze
(lambda (sentence)
(map (functionq (lambda (words) (associate (car words) words) ))
sentence)
))
; use 'follows property
(def associate
(lambda (word follow)
(putprop word
(cons follow (get word 'follows))
'follows )))
;; functions to construct a reply
(def replyto
(lambda (sentence)
(extendreply replymax (initialreply sentence)) ))
; select a response to start with
; if the seqquence flag is set then the last input is used,
; otherwise some random input
;
(def initialreply
(lambda (sentence)
(cond (sequence sentence)
(t (randomth sentences) )) ))
; extendreply[max;words] == extends the words for at most max
;
(def extendreply
(lambda (max words)
(cond ((zerop max) '(|...|))
((null words) nil)
(t
(cons (car words)
(extendreply (sub1 max) (extension (cdr words)))
)) )) )
; extension[a] == splice on a new extension to reply a after match
(def extension
(lambda (a)
(splicen matchdist
a
(randomth (extend matchdist
a
(get (car a) 'follows)
)) ) ) )
; splicen[n;a;b] == appends b after the first n elements of a
;
(def splicen
(lambda (n a b)
(cond ((zerop n) b)
((null a) b)
(t (cons (car a) (splicen (sub1 n) (cdr a) b) )))))
; extend[dist;words;exts] == select those exts that match words for dist
; and return what follows the matching part.
;
(def extend
(lambda (dist words exts)
(cond ((zerop dist) exts)
(t (extend (sub1 dist)
(cdr words)
(restrict (car words) exts)
))
)))
; restrict[word;exts] == returns the cdr[ext] for each ext s.t. car[ext]=word
;
(def restrict
(lambda (word exts)
(mapcon (functionq
(lambda (exts)
(cond ((eq (caar exts) word) (list (cdar exts)))
(t nil)
)))
exts
)))
; useful little functions
; randomth [l] -- returns a random member of the list l
(def randomth
(lambda (l)
(cond ((null (cdr l)) (car l)) ; singleton
(t (nth (random (sub1 (length l)))
l
)) ) ) )
; begin
(setq sentences nil)
(setq replymax 20) ; maximum number of "words" in a reply
(setq matchdist 1) ; distince sentences must match
(setq sequence nil) ; scramble sentences
(setq gcdisable nil) ; !!! EVADE LOAD "FEATURE"
(worker)
(exit)