(defun random-elt (choices) "Choose an element from a list at random." (elt choices (random (length choices)))) (defun one-of (set) "Pick one element of set, and make a list of it." (list (random-elt set))) (defun mappend (fn list) "Append the results of calling fn on each element of list. Like mapcon, but uses append instead of nconc." (apply #'append (mapcar fn list))) (defun combine-all (xlist ylist) "Return a list of lists formed by appending a y to an x. E.g., (combine-all '((a) (b)) '((1) (2))) -> ((A 1) (B 1) (A 2) (B 2))." (mappend #'(lambda (y) (mapcar #'(lambda (x) (append x y)) xlist)) ylist)) (defun rule-lhs (rule) "The left hand side of a rule." (first rule)) (defun rule-rhs (rule) "The right hand side of a rule." (rest (rest rule))) (defun rewrites (category) "Return a list of the possible rewrites for this category." (rule-rhs (assoc category *grammar*))) (defun generate (phrase) "Generate a random sentence or phrase" (cond ((listp phrase) (mappend #'generate phrase)) ((rewrites phrase) (generate (random-elt (rewrites phrase)))) (t (list phrase)))) (defun generate-tree (phrase) "Generate a random sentence or phrase, with a complete parse tree." (cond ((listp phrase) (mapcar #'generate-tree phrase)) ((rewrites phrase) (cons phrase (generate-tree (random-elt (rewrites phrase))))) (t (list phrase)))) (defun generate-all (phrase) "Generate a list of all possible expansions of this phrase." (cond ((null phrase) (list nil)) ((listp phrase) (combine-all (generate-all (first phrase)) (generate-all (rest phrase)))) ((rewrites phrase) (mappend #'generate-all (rewrites phrase))) (t (list (list phrase)))))