;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-
;;; Code from Paradigms of Artificial Intelligence Programming
;;; Copyright (c) 1991 Peter Norvig
;;;; File intro.lisp: Miscellaneous functions from the introduction.
(defun last-name (name)
"Select the last name from a name represented as a list."
(first (last name)))
(defun first-name (name)
"Select the first name from a name represented as a list."
(first name))
(setf names '((John Q Public) (Malcolm X)
(Admiral Grace Murray Hopper) (Spot)
(Aristotle) (A A Milne) (Z Z Top)
(Sir Larry Olivier) (Miss Scarlet)))
;;; ==============================
(defparameter *titles*
'(Mr Mrs Miss Ms Sir Madam Dr Admiral Major General)
"A list of titles that can appear at the start of a name.")
;;; ==============================
(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 numbers-and-negations (input)
"Given a list, return only the numbers and their negations."
(mappend #'number-and-negation input))
(defun number-and-negation (x)
"If x is a number, return a list of x and -x."
(if (numberp x)
(list x (- x))
nil))
;;; ==============================
(defun mappend (fn the-list)
"Apply fn to each element of list and append the results."
(if (null the-list)
nil
(append (funcall fn (first the-list))
(mappend fn (rest the-list)))))
;;; ==============================
;;; ==============================
(defun atomprint (exp &optional (depth 0))
"Print each atom in exp, along with its depth of nesting."
(if (atom exp)
(format t "~&ATOM: ~a, DEPTH ~d" exp depth)
(dolist (element exp)
(atomprint element (+ depth 1)))))
;;; ==============================
(defun power (x n)
"Power raises x to the nth power. N must be an integer >= 0.
This executes in log n time, because of the check for even n."
(cond ((= n 0) 1)
((evenp n) (expt (power x (/ n 2)) 2))
(t (* x (power x (- n 1))))))
;;; ==============================
(defun count-atoms (exp)
"Return the total number of non-nil atoms in the expression."
(cond ((null exp) 0)
((atom exp) 1)
(t (+ (count-atoms (first exp))
(count-atoms (rest exp))))))
(defun count-all-atoms (exp &optional (if-null 1))
"Return the total number of atoms in the expression,
counting nil as an atom only in non-tail position."
(cond ((null exp) if-null)
((atom exp) 1)
(t (+ (count-all-atoms (first exp) 1)
(count-all-atoms (rest exp) 0)))))
;;; ==============================
(defun count-anywhere (item tree)
"Count the times item appears anywhere within tree."
(cond ((eql item tree) 1)
((atom tree) 0)
(t (+ (count-anywhere item (first tree))
(count-anywhere item (rest tree))))))
;;; ==============================
(defun dot-product (a b)
"Compute the mathematical dot product of two vectors."
(if (or (null a) (null b))
0
(+ (* (first a) (first b))
(dot-product (rest a) (rest b)))))
(defun dot-product (a b)
"Compute the mathematical dot product of two vectors."
(let ((sum 0))
(dotimes (i (length a))
(incf sum (* (elt a i) (elt b i))))
sum))
(defun dot-product (a b)
"Compute the mathematical dot product of two vectors."
(apply #'+ (mapcar #'* a b)))
;;; ==============================