commit 571161ff8491dcac1831042e927aaae8fa975365 Author: Case Duckworth Date: Wed May 19 22:37:09 2021 -0500 Initial commit diff --git a/README.md b/README.md new file mode 100644 index 0000000..3d41eb5 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# paip +### _Your Name _ + +This is a project to do ... something. + +## License + +Specify license here + diff --git a/package.lisp b/package.lisp new file mode 100644 index 0000000..7a395ad --- /dev/null +++ b/package.lisp @@ -0,0 +1,4 @@ +;;;; package.lisp + +(defpackage #:paip + (:use #:cl)) diff --git a/paip.asd b/paip.asd new file mode 100644 index 0000000..56407d4 --- /dev/null +++ b/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"))) diff --git a/paip.fasl b/paip.fasl new file mode 100644 index 0000000..6d6ae9e Binary files /dev/null and b/paip.fasl differ diff --git a/paip.lisp b/paip.lisp new file mode 100644 index 0000000..903df9e --- /dev/null +++ b/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))