Knight's tour: Difference between revisions
Content added Content deleted
SqrtNegInf (talk | contribs) m (→{{header|Sidef}}: Fix link: Perl 6 --> Raku) |
|||
Line 1,708: | Line 1,708: | ||
1, 62, 3, 68, 65, 60,237, 70, 95, 58,245, 72, 93, 56,311, 74, 91, 54,355, 76, 89, 52,157, 78, 87, 50,147, 80, 85, 48,145 |
1, 62, 3, 68, 65, 60,237, 70, 95, 58,245, 72, 93, 56,311, 74, 91, 54,355, 76, 89, 52,157, 78, 87, 50,147, 80, 85, 48,145 |
||
</pre> |
</pre> |
||
=={{header|Common Lisp}}== |
|||
{{works with|clisp|2.49}} |
|||
This interactive program will ask for a starting case in algebraic notation and, also, whether a closed tour is desired. Each next move is selected according to Warnsdorff's rule; ties are broken at random. |
|||
The closed tour algorithm is quite crude: just find tours over and over until one happens to be closed by chance. |
|||
This code is quite verbose: I tried to make it easy for myself and for other to follow and understand. I'm not a Lisp expert, so I probably missed some idiomatic shortcuts I could have used to make it shorter. |
|||
For some reason, the interactive part does not work with sbcl, but it works fine wit clisp. |
|||
<lang lisp>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|||
;;; Solving the knight's tour. ;;; |
|||
;;; Warnsdorff's rule with random tie break. ;;; |
|||
;;; Optionally outputs a closed tour. ;;; |
|||
;;; Options from interactive prompt. ;;; |
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|||
(defparameter *side* 8) |
|||
(defun generate-chessboard (n) |
|||
(loop for i below n append |
|||
(loop for j below n collect (complex i j)))) |
|||
(defparameter *chessboard* |
|||
(generate-chessboard *side*)) |
|||
(defun complex->algebraic (n) |
|||
;; returns a string like "b2" |
|||
(concatenate 'string |
|||
;; 'a' is char #97: add it to the offset |
|||
(string (character (+ 97 (realpart n)))) |
|||
;; indices start at 0, but algebraic starts at 1 |
|||
(string (digit-char (+ 1 (imagpart n)))))) |
|||
(defun algebraic->complex (string) |
|||
;; takes a string like "e4" |
|||
(let ((row (char string 0)) |
|||
(col (char string 1))) |
|||
(complex (- (char-code row) 97) |
|||
(- (digit-char-p col) 1)))) |
|||
(defconstant *knight-directions* |
|||
(list |
|||
(complex 1 2) |
|||
(complex 2 1) |
|||
(complex 1 -2) |
|||
(complex 2 -1) |
|||
(complex -1 2) |
|||
(complex -2 1) |
|||
(complex -1 -2) |
|||
(complex -2 -1))) |
|||
(defun find-legal-moves (moves-list) |
|||
;; 2. the move must not be on a case already visited |
|||
(remove-if (lambda (m) (member m moves-list)) |
|||
;; 1. the move must be within the chessboard |
|||
(intersection |
|||
(mapcar (lambda (i) (+ (car moves-list) i)) *knight-directions*) |
|||
*chessboard*))) |
|||
;; Select between two moves by Warnsdorff's rule: |
|||
;; pick the one with the lowest index or else |
|||
;; randomly break the tie. |
|||
;; Takes a cons in the form (n . #C(x y)). |
|||
;; This will be the sorting rule for picking the next move. |
|||
(defun w-rule (a b) |
|||
(cond ((< (car a) (car b)) t) |
|||
((> (car a) (car b)) nil) |
|||
((= (car a) (car b)) |
|||
(zerop (random 2))))) |
|||
;; For every legal move in a given position, |
|||
;; look forward one move and return a cons |
|||
;; in the form (n . #C(x y)) where n is |
|||
;; how many next free moves follow the first move. |
|||
(defun return-weighted-moves (moves) |
|||
(let ((candidates (find-legal-moves moves))) |
|||
(loop for mv in candidates collect |
|||
(cons |
|||
(list-length (find-legal-moves (cons mv moves))) |
|||
mv)))) |
|||
;; Given a list of weighted moves (as above), |
|||
;; pick one according to the w-rule |
|||
(defun pick-among-weighted-moves (moves) |
|||
;; prune dead ends one move early |
|||
(let ((possible-moves |
|||
(remove-if (lambda(m) (zerop (car m))) moves))) |
|||
(cdar (sort possible-moves #'w-rule)))) |
|||
(defun make-move (moves-list) |
|||
(let ((next-move |
|||
(if (< (list-length moves-list) (1- (list-length *chessboard*))) |
|||
(pick-among-weighted-moves (return-weighted-moves moves-list)) |
|||
(car (find-legal-moves moves-list))))) |
|||
(cons next-move moves-list))) |
|||
(defun make-tour (moves-list) |
|||
;; takes a list of moves as an argument |
|||
(if (null (car moves-list)) ; last move not found: start over |
|||
(make-tour (last moves-list)) |
|||
(if (= (list-length moves-list) (list-length *chessboard*)) |
|||
moves-list |
|||
(make-tour (make-move moves-list))))) |
|||
(defun make-closed-tour (moves-list) |
|||
(let ((tour (make-tour moves-list))) |
|||
(if (tour-closed-p tour) |
|||
tour |
|||
(make-closed-tour moves-list)))) |
|||
(defun tour-closed-p (tour) |
|||
;; takes a full tour as an argument |
|||
(let ((start (car (last tour))) |
|||
(end (car tour))) |
|||
;; is the first position a legal move, when |
|||
;; viewed from the last move? |
|||
(if (member start (find-legal-moves (list end))) ; find-legal-moves takes a list |
|||
t nil))) |
|||
(defun print-tour-linear (tour) |
|||
;; takes a tour (moves list) with the last move first |
|||
;; and prints it nicely in algebraic notation |
|||
(let ((moves (mapcar #'complex->algebraic (reverse tour)))) |
|||
(format t "~{~A~^ -> ~}" moves))) |
|||
(defun tour->matrix (tour) |
|||
;; takes a tour and makes a row-by-row 2D matrix |
|||
;; from top to bottom (for further formatting & printing) |
|||
(flet ((index-tour (tour) ; 1st local function |
|||
(loop for i below (length tour) |
|||
;; starting from index 1, not 0, so add 1; |
|||
;; reverse because the last move is still in the car |
|||
collect (cons (nth i (reverse tour)) (1+ i)))) |
|||
(get-row (n tour) ; 2nd local function |
|||
;; in every row, the imaginary part (vertical offset) stays the same |
|||
(remove-if-not (lambda (e) (= n (imagpart (car e)))) tour))) |
|||
(let* ((indexed-tour (index-tour tour)) |
|||
(ordered-indexed-tour |
|||
;; make a list of ordered rows |
|||
(loop for i from (1- *side*) downto 0 collect |
|||
(sort (get-row i indexed-tour) |
|||
(lambda (a b) (< (realpart (car a)) (realpart (car b)))))))) |
|||
;; clean up, leaving only the indices |
|||
(mapcar (lambda (e) (mapcar #'cdr e)) ordered-indexed-tour)))) |
|||
(defun print-tour-matrix (tour) |
|||
(mapcar (lambda (row) |
|||
(format t "~{~3d~}~&" row)) (tour->matrix tour))) |
|||
;;; Handling options |
|||
(defstruct options |
|||
closed |
|||
start |
|||
grid) |
|||
(defparameter *opts* (make-options)) |
|||
;;; Interactive part |
|||
(defun prompt() |
|||
(format t "Starting case (leave blank for random)? ") |
|||
(let ((start (string (read-line)))) |
|||
(if (member start (mapcar #'complex->algebraic *chessboard*) :test #'equal) |
|||
(setf (options-start *opts*) start)) |
|||
(format t "Require a closed tour (yes or default to no)? ") |
|||
(let ((closed (read-line))) |
|||
(if (or (equal closed "y") (equal closed "yes")) |
|||
(setf (options-closed *opts*) t))))) |
|||
(defun main () |
|||
(let* ((start |
|||
(if (options-start *opts*) |
|||
(algebraic->complex (options-start *opts*)) |
|||
(complex (random *side*) (random *side*)))) |
|||
(closed (options-closed *opts*)) |
|||
(tour |
|||
(if closed |
|||
(make-closed-tour (list start)) |
|||
(make-tour (list start))))) |
|||
(fresh-line) |
|||
(if closed (princ "Closed ")) |
|||
(princ "Knight's tour") |
|||
(if (options-start *opts*) |
|||
(princ ":") |
|||
(princ " (starting on a random case):")) |
|||
(fresh-line) |
|||
(print-tour-linear tour) |
|||
(princ #\newline) |
|||
(princ #\newline) |
|||
(print-tour-matrix tour))) |
|||
;;; Good to go: invocation! |
|||
(prompt) |
|||
(main)</lang> |
|||
{{out}} |
|||
<pre>Starting case (leave blank for random)? a8 |
|||
Require a closed tour (yes or default to no)? y |
|||
Closed Knight's tour: |
|||
a8 -> c7 -> e8 -> g7 -> h5 -> g3 -> h1 -> f2 -> h3 -> g1 -> e2 -> c1 -> a2 -> b4 -> a6 -> b8 -> d7 -> f8 -> h7 -> g5 -> e6 -> d8 -> b7 -> a5 -> b3 -> a1 -> c2 -> e1 -> g2 -> f4 -> d3 -> c5 -> a4 -> b2 -> d1 -> c3 -> b1 -> a3 -> b5 -> a7 -> c6 -> d4 -> f3 -> h4 -> g6 -> h8 -> f7 -> e5 -> g4 -> h2 -> f1 -> d2 -> e4 -> f6 -> g8 -> h6 -> f5 -> e7 -> d5 -> e3 -> c4 -> d6 -> c8 -> b6 |
|||
1 16 63 22 3 18 55 46 |
|||
40 23 2 17 58 47 4 19 |
|||
15 64 41 62 21 54 45 56 |
|||
24 39 32 59 48 57 20 5 |
|||
33 14 61 42 53 30 49 44 |
|||
38 25 36 31 60 43 6 9 |
|||
13 34 27 52 11 8 29 50 |
|||
26 37 12 35 28 51 10 7</pre> |
|||
=={{header|Clojure}}== |
=={{header|Clojure}}== |