Initial commit

README.md

@@ -0,0 +1,9 @@
+# paip
+### _Your Name <your.name@example.com>_
+
+This is a project to do ... something.
+
+## License
+
+Specify license here
+

package.lisp

@@ -0,0 +1,4 @@
+;;;; package.lisp
+
+(defpackage #:paip
+  (:use #:cl))

paip.asd

@@ -0,0 +1,10 @@
+;;;; paip.asd
+
+(asdf:defsystem #:paip
+  :description "Me learning from the PAIP book"
+  :author "Case Duckworth"
+  :license  "WTFPL"
+  :version "0.0.1"
+  :serial t
+  :components ((:file "package")
+               (:file "paip")))

paip.lisp

@@ -0,0 +1,177 @@
+;;;; 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))."
+  (mappend #'(lambda (y)
+               (mapcar #'(lambda (x) (append x y)) xlist))
+           ylist))