第拾壹章學習 Lisp 3rd Edition, Winston & Horn

PROPERTIES AND ARRAYS
---------------------------------
property lists and arrays

* A procedure that creates data is a constructor.
* A procedure that extracts data is a reader.
* A procedure that changes data is a writer.
-----------------------------------------------------------
Symbol     Parents Property    Children Property
patrick    (robert dorothy)    (sarah)
karen      (james eve)         (sarah)
-------------------------------------------------------------
(get <symbol <property name>)

* (get 'patrick 'parents)
(ROBERT DOROTHY)
-----------------------------------------------------------
(setf (get <symbol> <property name>) <property vaule>)

* (setf (get 'patrick 'parents) '(robert dorothy))
(ROBERT DOROTHY)
------------------------------------------------------------
(remprop <symbol> <property name>)

* (setf (get 'bag 'contents) '(bread butter))
(BREAD BUTTER)

* (get 'bag 'contents)
(BREAD BUTTER)

* (remprop 'bag 'contents)
T

* (get 'bag 'contents)
NIL

題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題

11-1: Assume that if a person's father is known, the father's
name is given as the value of the FATHER property.  Define GRANDFATHER,
a procedure that returns the name of a person's paternal grandfather, if
known, or NIL otherwise.
-------------------------------------------------------------------
11-2: Define ADAM, a procedure that returns the most distant male
ancestor of a person through the paternal line, working through the
FATHER property.  If no male ancestor is known, the procedure is to
return the name given as its argument.  For simplicity, assume that no
name is ever used twice.
--------------------------------------------------------------------
11-3: Define ANCESTORS, a procedure that returns a list consisting of
the person given as its argument together with all known ancestors of
the person.  It is to work through both the FATHER and MOTHER properties.
You may assume that related people do not have children together; that
is, there is never a way to get to any ancestor by two distinct paths.
----------------------------------------------------------------------
11-4: Suppose each city in a network of cities and highways is
represented by a symbol.  Further suppose that each city has a property
named NEIGHBORS.  The value of the NEIGHBORS property is a list of all
the other cities for which there is a direct highway connection.

Define CONNECT, a procedure that takes two cities as arguments and puts
each into a list which the value of the NEIGHBORS property of the other.
Write CONNECT such if a connection is already in place, CONNECT changes
nothing and returns NIL; otherwise CONNECT returns T.
------------------------------------------------------------------------
11-5: Suppose that the value of the position property is a list of two 
coordinates.  Assuming a flat earth, write DISTANCE, a procedure
that calculates the distance between two cities based on the values of
their POSITION properties.  Remember that SQRT calculates square roots.

-----------------------------------------------------------------------

* (setf part-bins (make-array '(4)))

* (setf checker-board (make-array '(8 8)))

* (setf part-bins (make-array 4))

* (setf part-bins (make-array 4 :initial-element 'e))
#(E E E E)

* (setf checker-board
        (make-array '(8 8)
                    :initial-contents
                    '(X B X B X B X B)
                     (B X B X B X B X)
                     (X B X B X B X B)
                     (B X B X B X B X)
                     (X E X E X E X E)
                     (W X W X W X W X)
                     (X W X W X W X W)
                     (W X W X W X W X))))
#2A((X B X B ...)
    (B X B X ...)
    (X B X B ...)
    (E X E X ...)
    ...)
-----------------------------------------------------------
* (aref part-bins 0)    ;Expression stored in place 0.
EMPTY

* (aref part-bins 3)    ;Expression stored in place 3.
EMPTY

* (aref checker-board 0 3)    ;Expression stored in place (0 3).
B

* (aref checker-board 3 0)    ;Expression stored in place (3 0).
E
---------------------------------------------------------------
(setf (aref part-bins 0) 'nails)    ;Store expression in place 0.
(Setf (aref part-bins 1) 'nuts)     ;Store expression in place 1.
(setf (aref part-bins 2) 'bolts)    ;Store expression in place 2.
(setf (aref part-bins 3) 'washers)  ;Store expression in place 3.
------------------------------------------------------------------
(defun count-bins-with-specified-part (part)
  (let ((result 0))
    (dotimes (n 4 result)
      (when (eq part (aref part-bins n))
        (setf result (+ result 1))))))

* (count-bins-with-specified-part 'washers)
1
-----------------------------------------------------------------
(defun count-elements-with specified-part (part array)
  (let ((result 0))
    (dotimes (n (array-demension array 0) result)
      (when (eq part (aref array n))
        (setf result (+ result 1))))))

題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題題

11-6: Write STATIC-VALUE, a procedure that counts the number of
white pieces minus the number of black pieces in the CHECKER-BOARD
array.  Assume ordinary pieces are represented by W and B and kings
are represented by W-KING and B-BING.  Also one king is worth two 
ordinary pieces.

解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解解

11-1:
(defun grandfather (x)
  (when (get x 'father)
    (get (get x 'father) 'father)))

The following, more efficient solution binds a LET parameter to the
value returned by GET:

(defun grandfather (x)
  (let ((father (get x 'father)))
    (when father
      (get father 'father))))
-------------------------------------------------------------------
11-2:
(defun adam (x)
  (if (get x 'father)
      (adam (get x 'father))
      x))
-----------------------------------------------------------------
11-3:
(defun ancestors (x)
  (when x
    (cons x (append (ancestors (get x 'father))
                    (ancestors (get x 'mother))))))
------------------------------------------------------------------
11-4:
(defun connect (a b)
  (let ((a-neighbors (get a 'neighbors))
        (b-neighbors (get b 'neighbors))
        (result nil))
    (unless (member b a-neighbors)
       (setf (get a 'neighbors) (cons b a-neighbors))
       (setf result t))
    (unless (member a b-neighbors)
       (setf (get b 'neighbors) (cons a b-neighbors))
       (setf result t))
    result))
-----------------------------------------------------------------
11-5:
(defun distance (city-1 city-2)
  (let ((p1 (get city-1 'position))
        (p2 (get city-2 'position)))
    (sqrt (+ (expt (- (first p1) (first p2)) 2)
             (expt (- (second p1) (second p2)) 2)))))
-----------------------------------------------------------------
11-6: The following solution works, but inefficiently, inasmuch 
as it looks at the white squares, which cannot hold pieces:

(defun static-value (board)
  (let ((result 0))
    (dotimes (m 8 result)
      (dotimes (n 8)
        (cond ((eq 'white (aref board m n))
               (setf result (+ 1 result)))
              ((eq 'black (aref board m n))
               (setf result (- result 1)))
              ((eq 'white-king (aref board m n))
               (setf result (+ result 2)))
              ((eq 'black-king (aref board m n))
               (setf result (- result 2))))))))

How could you improve the efficiency of the procedure?