ANSI Common Lisp 第四章习题解

1. Define a function to take a square array (an array whose dimensions
are (n n)) and rotate it 90° clockwise:
> (quarter-turn #2A((a b) (c d)))
#2A((C A) (D B))

You'll need array-dimensions (page 361).

2. Read the description of reduce on page 368, then use it to define:
(a) c o p y - l i s t
(b) r e v e r s e (for lists)

;;; copy list using reduce(defun our-copy-list (xs)  (reduce #'cons xs   :initial-value nil  :from-end t));;;; test our-copy-list(out-copy-list '(1 2 3))(defun our-reverse (xs)  "reverse function using reduce"  (reduce #'(lambda (acc x)      (cons x acc))   xs  :initial-value nil))(our-reverse '(1 2 3))

3. Define a structure to represent a tree where each node contains some
data and has up to three children. Define
(a) a function to copy such a tree (so that no node in the copy is eql
to a node in the original)
(b) a function that takes an object and such a tree, and returns true if
the object is eql to the data field of one of the nodes

(defstruct node3  (left nil)   (mid nil)   (right nil)  (val nil))(defun node3-copy-tree (tr)  (or (null tr)      (make-node3        :left (node3-copy-tree (node3-left tr))       :right (node3-copy-tree (node3-right tr))       :mid (node3-copy-tree (node3-mid tr))       :val (node3-val tr))))(defparameter *dummy-node*  (make-node3    :left (make-node3 :val 1)   :mid (make-node3 :val 2)   :right (make-node3 :val 3)   :val 4))(defun node3-look (tr val)  (and (not (null tr))       (or (eql (node3-val tr) val)   (node3-look (node3-left tr) val)   (node3-look (node3-right tr) val)   (node3-look (node3-mid tr) val)))(node3-look *dummy-node* 5)(node3-copy-tree *dummy-node*)(defun map-node3 (fn tr0 tr1)  (cond    ((null tr0) '())   ((null tr1) '())   (t (append       (list (funcall fn tr0 tr1))       (list (map-node3 fn (node3-left tr0) (node3-left tr1))(map-node3 fn (node3-mid tr0) (node3-mid tr1))(map-node3 fn (node3-right tr0) (node3-right tr1)))))))(map-node3 #'(lambda (x y)       (cons (node3-val x)     (node3-val y)))   *dummy-node* (node3-copy-tree *dummy-node*))(map-node3 #'eql *dummy-node* (node3-copy-tree *dummy-node*))

;;;; 4. Define a function that takes a BST and returns a list of its ;;;; elements ordered from greatest to least.(defstruct BST   (left nil)  (right nil)  (val nil))(defun BST-insert (tr val)  (if (null tr)      (make-BST :val val)    (if (> val (BST-val tr))(make-BST :left (BST-left tr) :right (BST-insert (BST-right tr) val) :val (BST-val tr))      (make-BST       :left (BST-insert (BST-left tr) val)       :right (BST-right tr)       :val (BST-val tr)))))(defun BST-travel (fn tr)  (or (null tr)      (progn (BST-travel fn (BST-right tr))(funcall fn (BST-val tr))(BST-travel fn (BST-left tr)))))      (BST-travel  #'(lambda(el)      (format t "~A " el)) (BST-insert   (BST-insert    (BST-insert    (BST-insert nil 10)    5)   7)  4))

;; 5. Define bst-adjoin. This function should take the same arguments as;; bst-insert, but should only insert the object if there is nothing eql;; to it in the tree.(defun BST-isleaf (node)  (and (typep node 'BST)       (not (null node))       (null (BST-left node))       (null (BST-left node))))(BST-isleaf (make-BST))(defun BST-adjoin (tr val)  (if (null tr)      (make-BST :val val)    (if (and (BST-isleaf tr)     (eql val (BST-val tr)))(make-BST :val (BST-val tr))      (if (> val (BST-val tr))  (make-BST    :left (BST-left tr)   :right (BST-adjoin (BST-right tr) val)   :val (BST-val tr))(make-BST :left (BST-adjoin (BST-left tr) val) :right (BST-right tr) :val (BST-val tr))))))(BST-adjoin (BST-adjoin  (BST-adjoin   (BST-adjoin    (BST-adjoin NIL 5)    7)   4)  4) 6)

;;6. The contents of any hash table can be described by an assoc-list whose;;elements are (k . v), for each key-value pair in the hash table. Define;;a function that;;(a) takes an assoc-list and returns a corresponding hash table;;(b) takes a hash table and returns a corresponding assoc-list(defun hash-2-assoc (dict)  (let ((as '()))    (maphash #'(lambda (k v) (setf as (cons (cons k v) as)))     dict)    as))(defun assoc-2-hash (as)  (let ((hash (make-hash-table)))    (mapcar #'(lambda (pair)(setf (gethash (car pair) hash)       (cdr pair)))    as)    hash))(defun create-hash ()  (let ((hash (make-hash-table)))    (progn      (setf (gethash 'color hash) 'yellow)      (setf (gethash 'sex hash) 'male)      (setf (gethash 'name hash) 'cj)      hash)))(create-hash)(hash-2-assoc (create-hash))