Programming Praxis

Today’s solution is provided by Jos Koot:

; Given a chessboard, find a path of knight jumps visiting all squares of the
; board. A normal chessboard has 8 rows and 8 columns. Generalize the
; knight rider such as to acccept a square board of arbitrary size.
;
; When forming a path, for each element of the path found so far, the list of
; moves yet to be tried must be remembered (movelists).
;
; Make the path finder such as to return either a complete path or
; #f when no path is found. Keep trying other moves as long as no path is found.
; If from a given starting square no path is found, then try another starting
; square.

(define (knight-rider boardsize)
        
 (define max-index (sub1 boardsize))
 (define nr-of-fields (sqr boardsize))
 
 ; Rows and columns are repesented by numbers 0 up to but not including
 ; the boardsize. At top level procedure main is called as (main)
 ; Squares are represented as (row . col).
 ; Jumps are represented as (row-difference . col-difference)
 
 (define (main) ; Try all possible starting squares.
  (let loop ((row 0) (col 0))
   (and (< row boardsize) ; If all starting squares have been tried, return #f.
    (if (= col boardsize) (loop (add1 row) 0) ; Try starting squares in next row.
     (or (find-path row col) (loop row (add1 col)))))))
 
 (define (find-path row col)
  (let ((start (cons row col))) ; Squares are represented as (row . col).
   (occupy! start) ; Mark the starting square occupied.
   (let path-loop
    ((path (list start)) ; Notice that the path will be built in reversed order.
    (move-lists (list (get-sorted-moves start)))
    (n 1))
   ; n is the length of the path found so far.
   ; Move-lists has as many elements as the path.
   ; Each move-list shows which jumps yet to try if the last jump fails.
   (cond
    ((zero? n) #f) ; Return #f when no path is found from current start.
    ((= n nr-of-fields) (reverse path)) ; Path has been found.
    ((null? (car move-lists)) ; End of path has no more moves to try,
     (clear! (car path)) ; hence backtrack by removing the last jump.
     (path-loop (cdr path) (cdr move-lists) (sub1 n)))
    ((let ((field (caar move-lists))) ; Try the next move.
      (occupy! field)
      (let
       ((result
         (path-loop
          (cons field path) ; Add one move to the path.
          (cons
           (get-sorted-moves field) ; Why sorting? See get-sorted-moves.
           ; Below: remove the move just made from its move-list.
           (cons (cdar move-lists) (cdr move-lists)))
          (add1 n))))
       (or result (begin (clear! field) #f)))))
     (else ; Previous move did not work, hence try next move.
      (path-loop path (cons (cdar move-lists) (cdr move-lists)) n))))))
 
 (define jumps '((1 . 2) (-1 . 2) (1 . -2) (-1 . -2)
                 (2 . 1) (-2 . 1) (2 . -1) (-2 . -1)))
 
 ; Procedure add-jump computes the squares reached when making a jump from a
 ; given square. It returns #f if the jump cannot be made from the square.
 
 (define (add-jump field jump)
   (let
    ((x (+ (car field) (car jump)))
     (y (+ (cdr field) (cdr jump))))
    (and (<= 0 x max-index) (<= 0 y max-index) (cons x y))))
 
 ; Procedure get-moves returns all non occupied squares we can jump to
 ; from a given square.
 
 (define (get-moves field)
  (filter
   (lambda (move) (and move (board-ref move)))
   (map (lambda (jump) (add-jump field jump)) jumps)))
 
 ; Procedure get-sorted-moves provides the following heuristic:
 ; The feasible moves from the last square of the path
 ; (id est (car path)) are sorted such as to try those moves first
 ; that allow as few remaining moves as possible.
 ; This heuristic speeds up very much. It works well for boardsize &lt; 35.
 ; For some boardsizes greater than 34, the speedup may not work.
 
 (define (get-sorted-moves p)
  (sort
   (lambda (p q) (< (length (get-moves p)) (length (get-moves q))))
   (get-moves p)))
 
 ; The board is a boardsize x boardsize matrix.
 ; At all stages the board shows #f for occupied squares and #t for free squares.
 
 (define board (make-matrix boardsize boardsize #t))
 (define (occupy! field) (matrix-set! board (car field) (cdr field) #f))
 (define (clear! field) (matrix-set! board (car field) (cdr field) #t))
 (define (board-ref field) (matrix-ref board (car field) (cdr field)))
 
 (main))

On an 8-by-8 chessboard, we get this solution:

< (knight-rider 8)
((0 . 0) (1 . 2) (0 . 4) (1 . 6) (3 . 7) (5 . 6) (7 . 7) (6 . 5)
 (5 . 7) (7 . 6) (6 . 4) (7 . 2) (6 . 0) (4 . 1) (2 . 0) (0 . 1)
 (1 . 3) (0 . 5) (1 . 7) (2 . 5) (0 . 6) (2 . 7) (4 . 6) (6 . 7)
 (7 . 5) (6 . 3) (7 . 1) (5 . 0) (6 . 2) (7 . 0) (5 . 1) (3 . 0)
 (1 . 1) (0 . 3) (1 . 5) (0 . 7) (2 . 6) (4 . 7) (6 . 6) (7 . 4)
 (5 . 5) (3 . 6) (4 . 4) (3 . 2) (2 . 4) (4 . 5) (5 . 3) (3 . 4)
 (2 . 2) (1 . 0) (0 . 2) (1 . 4) (3 . 5) (4 . 3) (3 . 1) (2 . 3)
 (4 . 2) (5 . 4) (7 . 3) (6 . 1) (4 . 0) (5 . 2) (3 . 3) (2 . 1))

Jos used when, add1, sub1, sqr, sort, make-matrix, matrix-ref, matrix-set!, any? and filter from the Standard Prelude. You can run the program at http://programmingpraxis.codepad.org/XQEm0Kc6.

Pages: 1 2