paip/paip.lisp

193 lines
6.1 KiB
Common Lisp
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;;; 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