;;; 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))) ) )