P91 - Knight's tour

lisp

;;; Knight's Tour
;;; uses function jump n x y, which gives a list of
;;; valid positions from x y in an nxn board

(setf jumps '
      ((+1 +2)
       (-1 +2)
       (-1 -2)
       (+1 -2)
       (+2 +1)
       (-2 +1)
       (-2 -1)
       (+2 -1))
      )       

(defun jump (n pair)
  "Returns the list of valid positions a knight's jump away from
   (X, Y) in an NxN board."
  (filter n
	  (mapcar #'(lambda (x) (mapcar #'+ pair x)) jumps)
	  )
  )

(defun filter (n lista)
  (if (null lista)
      ()
    (if (inside n (car lista))
	(cons (car lista) (filter n (cdr lista)))
      (filter n (cdr lista))
      )
    )
  )

(defun inside (n pair)
  (and (>= (car pair) 1)
       (<= (car pair) n)
       (>= (second pair) 1)
       (<= (second pair) n)
       )
  )

;;; now main function; it is based on dfs (see p87.lisp)

(defun knight (n)
  (one-longer n (* n n) () 0 (all-squares n))
  )

(defun one-longer (n nsqr ptour len nts)
  (cond
   ;; no more to see: failed
   ((null nts)
    nil)
   ;; next to see already a member: disregard it
   ((member (car nts) ptour :test #'equal)
    (one-longer n nsqr ptour len (cdr nts)))
   ;; next to see not a member: if there is a tour with this prefix, return it, otherwise try cdr
   (t (let ((tour (tour-with-prefix n nsqr (cons (car nts) ptour) (1+ len))))
	(if tour
	    tour
	  (one-longer n nsqr ptour len (cdr nts))
	  )))
   )
  )

(defun tour-with-prefix (n nsqr ptour len)
  (if (= len nsqr)
      ptour
    (one-longer n nsqr ptour len (jump n (car ptour)))
    )
  )

(defun all-squares (n)
  (if (= n 1)
      (last-line 1 1)
    (append (all-squares (1- n))
	    (last-line n n)
	    (last-col n (1- n))
	    )
    )
  )

(defun last-line (n k)
  (if (= k 1)
      (list (list 1 n))
    (cons (list k n) (last-line n (1- k)))
    )
  )

(defun last-col (n k)
  (if (= k 1)
      (list (list n 1))
    (cons (list n k) (last-col n (1- k)))
    )
  )