puzzle.lisp

; John McCarthy. Puzzle Solving Program in LISP. Memo 20, Artificial Intelligence Project
; http://www.bitsavers.org/pdf/mit/ai/aim/AIM-020.pdf
; 1960

; Common Lisp translation: Rainer Joswig, 2016, [email protected]
; basically the code is unchanged, but using s-expression syntax in Common Lisp

(defparameter pzl
  '((a1  (a2 a5)              7.5)
    (a2  (a1 a5 a9 a3)        3.5)
    (a3  (a2 a6)              7.0)
    (a4  (a5 a9 a8)           2.0)
    (a5  (a1 a4 a2)           3.0)
    (a6  (a3 a9 a7)           6.0)
    (a7  (a6 a9 a10)          6.5)
    (a8  (a4 a9)              5.5)
    (a9  (a8 a4 a2 a6 a7 a10) 8.0)
    (a10 (a7 a9 H)            1.0))
  "the graph as a list of (vertex accessible-vertices value)")

(defun legals (p)
  "the list of squares to which it is legal to move in a position p"
  (less (car (ass2 (car p) pzl))
        p))

(defun less (m n)
  "a list of those elements of m not members of n"
  (cond ((null m) nil)
        ((occur (car m) n)
         (less (cdr m) n))
        (t (cons (car m)
                 (less (cdr m) n)))))

(defun ass2 (x m)
  "the cdr of the first element of m, where the car is x"
  (cond ((eq (caar m) x)
         (cdar m))
        (t (ass2 x (cdr m)))))

(defun occur (x n)
  "predicate that asserts that x is a member of n"
  (and (not (null n))
       (or (eq x (car n))
           (occur x (cdr n)))))

(defun best (p m s)
  "find the best path. subpath P, possible moves M and best path S."
  (cond ((null m) s)
        (t (best p
                 (cdr m)
                 ((lambda (n)
                    (cond ((eq (car n) 'h)
                           (cond ((better p s) p)
                                 (t s)))
                          (t (best n (legals n) s))))
                  (cons (car m) p))))))

(defun better (p1 p2)
  "is p1 better than p2?"
  (minusp (+ (addup p2) (- (addup p1)))))

(defun addup (p)
  "add the values of a path"
  (cond ((null p) 0.0)
        (t (+ (value (car p))
              (addup (cdr p))))))

(defun value (sq)
  "what's the value of a vertex?"
  (cadr (ass2 sq pzl)))


(defun solve ()
  (best '(a1)
        '(a2 a5)
        '(a1)))

; CL-USER 64 > (solve)
; (A10 A7 A6 A3 A2 A9 A8 A4 A5 A1)



#|

; this is a block comment in Common Lisp

; The (mostly) original Lisp code from John McCarthy, 1960, but with indentation

; Notation is the old MLISP notation
;
;  MLISP uses s-expressions only for data, not for code
;
;  * uppercase symbols are quoted data
;  * a negative number has a MINUS as its car
;  * cond is notated with [... -> ...; ...]


: The data for the graph, variable pzl

pzl := ((A1,(A2,A5),7.5),(A2,(A1,A5,A9,A3),3.5),(A3,(A2,A6),7.0),(A4,(A5,
        A9,A8),2.0),(A5,(A1,A4,A2),3.0),(A6,(A3,A9,A7),6.0),(A7,(A6,A9,A10),
        6.5),(A8,(A4,A9),5.5),(A9,(A8,A4,A2,A6,A7,A10),8.0),(A10,(A7,A9,H),1.0))

legals[p] = less[car[ass2[car[p];
                          pzl]];
                 p]

less[m;n] = [null[m] -> NIL;
             occur[car[m];n] -> less[cdr[m];n];
             T -> cons[car[m];
                       less[cdr[m];
                            n]]]

ass2[x;m] = [eq[caar[m];x] -> cadr[m];
             T -> ass2[x;cdr[m]]]

occur[x;m] = ~null[n] and [eq[x;car[n]] or occur[x;cdr[n]]]

best[p;m;s] = [null[m] -> s;
               T -> best[p;
                         cdr[m];
                         lambda[[n];
                                [eq[car[n];H] -> [better[p;s] -> p;
                                                  T -> s];
                                 T -> best[n;legals[n];s]]]
                               [cons[car[m]p]]]]

better[p1;p2] = eq[MINUS;
                   car[sum[addup[p2];
                           list[MINUS;addup[p1]]]]]

addup[p] = [null[p] -> 0.0;
            T -> sum[value[car[p]];
                     addup[cdr[p]]]]

value[sq] = cadr[ass2[sq;pzl]]


; example

best[(A1);(A2,A5);(A1)]

|#