; (C) 2005 Markus Triska triska@gmx.at
; Public domain code.

;; >(print-board (solve))
;; 50 19 34  5 52  9 32  7
;; 35  4 51 20 33  6 53 10
;; 18 49 36 59 56 63  8 31
;;  3 60 21 62 37 58 11 54
;; 22 17 48 57 64 55 30 41
;; 45  2 61 38 47 42 27 12
;; 16 23 46 43 14 25 40 29
;;  1 44 15 24 39 28 13 26

(defun froms (pos)
  (let ((fs (mapcar (lambda (p)
		      `(,(+ (car pos) (car p)) ,(+ (cadr pos) (cadr p))))
		    (knight-moves))))
    (remove-if-not (lambda (p)
		     (every (lambda (n) (and (>= n 1) (<= n 8))) p)) fs)))


(defun knight-moves ()
  '((1 2) (2 1) (2 -1) (1 -2) (-1 -2) (-2 -1) (-2 1) (-1 2)))


(defun gen-choices ()
  (let ((ps nil))
    (loop for i from 8 downto 1 do
	  (loop for j from 8 downto 1 do
		(push `(,i ,j) ps)))
    (mapcar (lambda (p) `(,p . ,(froms p))) ps)))

(defun first-fail (c1 c2) (< (length (cdr c1)) (length (cdr c2))))

(defun moves (choices prev sofar)
  (if (null choices)
      (reverse sofar)
    (let* ((sorted (stable-sort choices #'first-fail))
	   (next (caar (member-if (lambda (c)
				    (member prev (cdr c) :test #'equal))
				  sorted)))
	   (rest (remove-if (lambda (x) (equal (car x) next)) sorted)))
      (if (null next)
	  nil				; heuristics failed
	(moves (remove-from-all prev rest) next `(,next ,@sofar))))))

(defun remove-from-all (pos cs)
  (mapcar (lambda (c) `(,(car c) . ,(remove pos (cdr c) :test #'equal))) cs))

(defun solve ()
  (let ((s '(1 1)))
    (moves (remove-if (lambda (c) (equal (car c) s)) (gen-choices)) s `(,s))))

(defun print-board (moves)
  (loop for y from 8 downto 1 do
	(loop for x from 1 to 8 do
	      (format t "~2D " (1+ (position `(,x ,y) moves :test #'equal))))
	(terpri)))