Anonymous user
Knight's tour: Difference between revisions
→{{header|C++}}
SqrtNegInf (talk | contribs) m (→{{header|Sidef}}: Fix link: Perl 6 --> Raku) |
|||
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
</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}}==
| |||