193 lines
6.1 KiB
Common Lisp
193 lines
6.1 KiB
Common Lisp
;;;; paip.lisp
|
||
|
||
(in-package #:paip)
|
||
|
||
|
||
;;; Chapter 1
|
||
|
||
;; 1.1 define a version of `last-name' that handles "Rex Morgan MD," "Morton
|
||
;; Downey, Jr.," etc.
|
||
(defparameter *titles* '(MD Sr. Jr. Sir)
|
||
"Titles aren't part of names.")
|
||
|
||
(defun first-name (name)
|
||
"Select the first name from a NAME represented as a list."
|
||
(if (member (first name) *titles*)
|
||
(first-name (rest name))
|
||
(first name)))
|
||
|
||
(defun last-name (name)
|
||
"Select the last name from a NAME represented as a list."
|
||
(first-name (reverse name)))
|
||
|
||
;; 1.2 Write a function to exponentiate, or raise a number to an integer
|
||
;; power. For example: (power 3 2) = 3 ^ 2 = 9.
|
||
|
||
(defun power (n m)
|
||
"Raise N to an integer power M."
|
||
(cond
|
||
((= m 0) 1)
|
||
((= m 1) n)
|
||
(t (* n (power n (- m 1))))))
|
||
|
||
;; 1.3 Write a function that counts the number of atoms in an expression. For
|
||
;; example: (count-atoms '(a (b) c)) = 3. Notice that there is something of an
|
||
;; ambiguity in this: shoul (a nil c) count as 3 atoms, or as two, because it's
|
||
;; the equivalent to (a () c) ?
|
||
|
||
(defun count-atoms (expr)
|
||
"Count how many atoms are in EXPR, disregarding NIL."
|
||
(cond
|
||
((null expr) 0)
|
||
((atom expr) 1)
|
||
(t (+ (count-atoms (first expr))
|
||
(count-atoms (rest expr))))))
|
||
|
||
(defun count-all-atoms (expr &optional (if-null 1))
|
||
"Count all atoms in EXPR, including NILs only in non-tail position."
|
||
(cond
|
||
((null expr) if-null)
|
||
((atom expr) 1)
|
||
(t (+ (count-all-atoms (first expr) 1)
|
||
(count-all-atoms (rest expr) 0)))))
|
||
|
||
;; 1.4 Write a function that counts the number of times an expression occurs
|
||
;; anywhere in another expression. Example: (count-anywhere 'a '(a ((a) b) a))
|
||
;; => 3.
|
||
|
||
(defun count-anywhere (obj expr &optional (test #'eq))
|
||
"Count how many times an OBJ appears anywhere in an EXPR."
|
||
(cond
|
||
((null expr) 0)
|
||
((atom expr) (if (funcall test obj expr) 1 0))
|
||
(t (+ (count-anywhere obj (first expr) test)
|
||
(count-anywhere obj (rest expr) test)))))
|
||
|
||
;; Exercise 1.5 [m] Write a function to compute the dot product of two
|
||
;; sequences of numbers, represented as lists. The dot product is computed by
|
||
;; multiplying corresponding elements and then adding up the resulting
|
||
;; products. Example: (dot-product '(10 20) '(3 4)) = 10 × 3 + 20 × 4 = 110
|
||
|
||
(defun dot-product (list1 list2)
|
||
"Compute the dot product of LIST1 and LIST2"
|
||
(apply #'+ (mapcar #'* list1 list2)))
|
||
|
||
|
||
;;; Chapter 2
|
||
|
||
(defun mappend (fn list)
|
||
"Apply FN to each element of LIST and append the results."
|
||
(apply #'append (mapcar fn list)))
|
||
|
||
(defun one-of (set)
|
||
"Pick one element of SET, and make a list of it."
|
||
(list (random-elt set)))
|
||
|
||
(defun random-elt (choices)
|
||
"Choose a random element from list CHOICES."
|
||
(elt choices (random (length choices))))
|
||
|
||
(defparameter *simple-grammar*
|
||
'((sentence (noun-phrase verb-phrase))
|
||
(noun-phrase (Article Noun))
|
||
(verb-phrase (Verb noun-phrase))
|
||
(Article the a)
|
||
(Noun man ball woman table)
|
||
(Verb hit took saw liked))
|
||
"A grammar for a trivial subset of English.")
|
||
|
||
(defvar *grammar* *simple-grammar*
|
||
"The grammar used by `generate'.")
|
||
|
||
(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 rule))
|
||
|
||
(defun rewrites (category)
|
||
"Return a list of the possible rewrites for CATEGORY."
|
||
(rule-rhs (assoc category *grammar*)))
|
||
|
||
;; 2.1. Write a version of `generate' that uses `cond' but avoids calling
|
||
;; `rewrites' twice.
|
||
(defun generate (phrase)
|
||
"Generate a random LHS present in `*grammar*'."
|
||
(let ((rw-list (rewrites phrase)))
|
||
(cond ((listp phrase) (mappend #'generate phrase))
|
||
(rw-list (generate (random-elt rw-list)))
|
||
(t (list phrase)))))
|
||
|
||
;; 2.2. Write a version of `generate' that explicitly differentiates between
|
||
;; terminal symbols (those with no rewrite rules) and nonterminal symbols.
|
||
|
||
;; I'm gonna be honest, this one is tougher. I'm going to let it sit a minute.
|
||
;; (defun generate2 (phrase)
|
||
;; (let ((rw-list (rewrites phrase)))
|
||
;; (if rw-list
|
||
;; (let ((relt (random-elt rw-list)))
|
||
;; (if (listp relt)
|
||
;; (mappend #'generate2 phrase)
|
||
;; (generate2 relt)))
|
||
;; (list phrase))))
|
||
|
||
(defparameter *bigger-grammar*
|
||
'((sentence (noun-phrase verb-phrase))
|
||
(noun-phrase (Article Adj* Noun PP*) (Name) (Pronoun))
|
||
(verb-phrase (Verb noun-phrase PP*))
|
||
(PP* () (PP PP*))
|
||
(Adj* () (Adj Adj*))
|
||
(PP (Prep noun-phrase))
|
||
(Prep to in by with on)
|
||
(Adj big little blue green adiabatic)
|
||
(Article the a)
|
||
(Name Pat Kim Lee Terry Robin)
|
||
(Noun man ball woman table)
|
||
(Verb hit took saw liked)
|
||
(Pronoun he she it these those that)))
|
||
|
||
(setf *grammar* *bigger-grammar*)
|
||
|
||
(defun generate-tree (phrase)
|
||
"Generate a random 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 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)))))
|
||
|
||
(defun combine-all (xlist ylist)
|
||
"Return a list of lists formed by appending a YLIST to an XLIST.
|
||
|
||
E.g., (combine-all '((a) (b)) '((1) (2)))
|
||
=> ((A 1) (B 1) (A 2) (B 2))."
|
||
(cross-product #'append xlist ylist))
|
||
|
||
;; Exercise 2.4 [m] One way of describing combine-all is that it calculates the
|
||
;; cross-product of the function append on the argument lists. Write the
|
||
;; higher-order function cross-product, and define combine-all in terms of it.
|
||
;; The moral is to make your code as general as possible, because you never
|
||
;; know what you may want to do with it next.
|
||
;; NOTE[acd]: it's the CARTESIAN product.
|
||
|
||
(defun cross-product (fn as bs)
|
||
"Calculate the result of passing FN to the cross (or Cartesian) product of
|
||
lists of AS and BS."
|
||
(mappend #'(lambda (b)
|
||
(mapcar #'(lambda (a) (funcall fn a b)) as))
|
||
bs))
|
||
|
||
|
||
;;; Chapter 3
|