failing like never before

Knight’s Tour in Lisp

For those of you unfamilar with the Knight's tour, here's a brief overview of the problem. The Knight's Tour invovles placing a knight on a chessboard and then having the knight move to each and every square on the chessboard once and only once. There are a suprisingly huge number of possible paths that a single Knight can take on a standard chessboard so of course, a blind, exhaustive search is generally out of the question. 

The program I have written below explores the Open Knight's Tour, where the knight simply has to reach each and every square once and only once (the Closed Tour would add the additional requirement that the knight end on the square he started on). I will admit that my Lisp code isn't exactly the best or the most efficient, but it works fairly deccent. My method of solving the tour, uses backtracking (which is very similar to Depth First Search) and a herustic known as Minimum Remaining Value. This herustic is sometimes known as Warnsdorff's algorithm when used in the Knight's Tour. Warnsdorff's algorithm selects as the knight's next move, the square that would present the fewest possible moves following the move to that square. Essentially, the herustic is trying to eliminate dead end's earlier on. And so here's my code (most of which is comments, [Hey, it was written for a class]):

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FIND-KNIGHTS-TOUR2                                                      ;;; 
;;; using minimum remaining value herustics (aka most constrained variable) ;;;
;;;                                                                         ;;; 
;;; on my laptop, this implementation can find a solution to                ;;;
;;; 100x100 board, starting from (1 1) in under three minutes               ;;;
;;; and can solve 50x50 in about 16 seconds on SEAS                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; you can run the knights tour with:
; (find-knights-tour ([rows in board] [cols in board] [row_pos] [col_pos])

(setq steps 0)
(setq visited-list ()) 


; generate a list of all possible moves for knight
; given that current position of knight is (row col)
; note that this function will generate "wrong" move values, like
; moving off the board or moving to an old spot.
;
; function get_values(number:x number:y):((num num) (num num) )
(defun get_values (row col)
  (list 
    ; there are at most eight possible move values 
    (list (+ row 2) (+ col 1))
    (list (+ row 2) (- col 1))
    (list (+ row 1) (+ col 2))
    (list (+ row 1) (- col 2))

    (list (- row 2) (+ col 1))
    (list (- row 2) (- col 1))
    (list (- row 1) (+ col 2))
    (list (- row 1) (- col 2))) )

; val is a list of possible move values for a knight variable
;   and should be generated by get_values function
; m_row is max number of rows in the board
; m_col is max number of columns in the board
;
; test_valid_values will return a list containing only the valid
; values allowed, removing those values that have already been
; visited and are not on the board
;
; function test_valid_values( 
;       ((num num) (num num) ):vals
;       number:m_row
;       number:m_col):((num num) (num num) )
(defun test_valid_values (vals m_row m_col)
  (let 
    ; grab the first value out of the vals list
    ((v (car vals)))
  (cond
    ((null vals) ()) 
    ; test for out of bound values, or already traversed
    ; if value is out of bound, remove it (cdr vals) 
    ((or (> (car v)  m_row) (<= (car v)  0) 
         (> (cadr v) m_col) (<= (cadr v) 0)
         (list_member v visited-list))
            (test_valid_values (cdr vals) m_row m_col))
    ; value is valid, add to our "valid" list
    (t (cons (car vals) 
             (test_valid_values (cdr vals) m_row m_col))))) )


; check if "l" is a member of "visited"
; return 't' if so, 'nil' otherwise
;
; function list_member( 
;       (number number):l
;       ((num num) (num num) ):visited) :t/nil
(defun list_member (l visited)
  (cond
    ((null visited) nil)
    ((equal (car visited) l) t)
    (t (list_member l (cdr visited)))) )


;minimum remaining value herustic, or the most constrained variable
;instead of just returning randomnly arranged list of possible moves from
;   current location (as in above without herustics) arrange possible moves
;   in the list so that the move that will offer the least number of moves in
;   the next iteration comes first, with the move that offers the most of 
;   moves coming last in the list
;   
;function min_remaining_val(number:m_row number:m_col): 
;       ((number number) (number number) )
(defun min_remaining_val (m_row m_col)
  (let
    ; get valid values
    ((vals (test_valid_values 
        (get_values 
        (car (car (last visited-list))) (cadr (car (last visited-list)))) 
             m_row m_col)))
    ; then call call mrv_helper to attach assign a value to each move
    ; mrv_sort to arrange moves 
    (mrv_sort (mrv_helper vals m_row m_col))
))

; determines number of possible moves allowed if we move to a position in
; the vals list
;
; function mrv_helper(
;   ((num num) (num num) ):vals
;   number:m_row
;   number:m_col) :
;   ((num (num num)) (num (num num)) )
(defun mrv_helper (vals m_row m_col)
  (let 
    ((len 
       ; calculate the number of possible moves from a position in the 
       ; "vals" list
       (length 
         (test_valid_values 
           (get_values (car (car vals)) (cadr (car vals))) 
         m_row m_col))))
    (cond 
      ; if no more moves in "vals", just return it and done
      ((null (cdr vals)) (list (cons len (list (car vals)))))
      ; else add move and length value to list and keep recursing
      (t (cons (cons len (list (car vals))) 
                 (mrv_helper (cdr vals) m_row m_col))))) )

;finds the move with the minimum value in the list "vals"
;i.e. if "vals" is ( (1 (2 4)) (2 (5 2)) (4 (3 2)) )
;   then min_vals would return (1 (2 4)) because its move value is "1"
;
;function min_val(
;   ((num (num num)) (num (num num)) ):vals) :
;       (num (num num))
(defun min_val (vals)
  (cond
    ; base case, return the only move in "vals"
    ((null (cdr vals)) (car vals))
    (t
      (let
        ; calculate the min_val in the rest of the list
        ; store it in "p"
        ((p (min_val (cdr vals))))
        (cond
          ; if the current minimum value is less then previous
          ; min val, then use current min val
          ((<= (car (car vals)) (car p)) (car vals))
          ; else use previous min val
          (t p))))) )

; remove from list 'l' the element that matches 'r'
; this is because we are not allowed to use "remove" function
;
;function remove_list(list:r list:l):list
(defun remove_list (r l)
  (cond
    ; if equal, then done
    ((equal r (car l)) (cdr l))
    ; reached the end and couldn't find a match
    ((null (cdr l)) l)
    ; else keep recursing
    (t (cons (car l) (remove_list r (cdr l))))) ) 

; sort the moves in "vals" list based on their move length values
; and then strips out their "length values
;
; i.e., if "vals" is ((3 (2 3)) (2 (1 2)) (5 (3 4)) (1 (2 1)) (2 (2 2)))
;then mrv_sort returns:
;   ((2 1) (1 2) (2 2) (2 3) (3 4) )

;function mrv_sort(
;   ((num (num num)) (num (num num))  ):vals) :
;   ((num num) (num num) )
(defun mrv_sort (vals)
  (cond
    ; base case, return the last move in "vals"
    ((null (cdr vals)) (cdr (car vals)))
    (t 
      (let
        ;else keep sorting, using min_val function 
        ;v is the min val in "vals"
        ((v (min_val vals)))
        (append (cdr v) (mrv_sort (remove_list v vals)))))) )


; recurse down the search tree, expand out the children for last
; visited spot
;
; m_row is number of rows in board
; m_col is number of cols in board
;
; function recurse_down(number:m_row number:m_col):t/nil
(defun recurse_down (m_row m_col)
  ; get the valid values, store as val
  (let
    ((vals (min_remaining_val m_row m_col)))
    (cond
      ; no valid values, backtrack 
      ; note, that we test for sucessful completion before this 
      ((null vals) nil)
      ; else recurse across
      (t (recurse_across vals m_row m_col)))) ) 

; this function is exactly the same as recurse_across except
; that it calls recurse_down instead of recurse_down
;
;vals is valid moves, having the form:
;     ((number number) (num num) etc.)
; m_row is number of rows in board
; m_col is number of cols in board
;
; function recurse_across(
;       ((num num) (num num) ):vals
;       number:m_row
;       number:m_col) : t/nil
(defun recurse_across (vals m_row m_col)
  (cond
    ; no more valid moves, backtrack
    ((null vals) nil)
    (t 
      (cond
      ; if number of steps taken equals number of squares on board
      ; then we're done
      ((equal (+ steps 1) (* m_row m_col)) 
        ; increment number of steps, add new visited square
        (setq steps (+ steps 1)) 
        (setq visited-list (append visited-list (list (car vals)))) 
        ; return t 
        t)
      (t
        ; else continue moving until end
        ; increment steps and add to visited-list 
        (setq steps (+ steps 1)) 
        (setq visited-list (append visited-list (list (car vals)))) 
        (cond 
          ; recurse down, return t if recurse_down found solution
          ((recurse_down m_row m_col) t)
          (t 
            ; if recurse_down did not find solution, backtrack, removing
            ; moves from visited-list and from "steps" as we backtrack
            ; and then recurse_across
            (setq steps (- steps 1))
            (setq visited-list (reverse (cdr (reverse visited-list))))
            (recurse_across (cdr vals) m_row m_col))))))) ) 

;find the knights tour given board size of (m_row m_col) and 
;starting position (row col)
;use herustics
;
;function find-knights-tour(number:m_row number:m_col number:row number:col) :
;       ((number number) (number number) )
(defun find-knights-tour (m_row m_col row col)
  ; set the global variables
  (setq visited-list (list (list row col)))
  (setq steps 1)
  ; start searching...
  (cond
    ((recurse_down m_row m_col) visited-list)
    (t nil)) )