Discussion of chess software programming and technical issues.
Moderator: Ras
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 12:39 am
These are the high level routines for move generation:
Code: Select all
;;; Move generation: full set of legal moves
(defun generate (my-pos)
"Return a complete list of moves for the given position."
(let ((result nil))
(if (is-act-king-in-check? my-pos)
(setf result (generate-check-evasion my-pos))
(setf result (generate-not-in-check my-pos)))
result))
;;; Move generation: full set of marked legal moves
(defun generate-marked (my-pos)
"Return a complete list of moves for the given position, fully marked."
(mark-san-flags (generate my-pos) my-pos))
;;; Move generation: sorted full set of marked legal moves
(defun generate-canonical (my-pos)
"Return a complete list of moves for the given position, fully marked and sorted by SAN."
(sort-moves-by-san (generate-marked my-pos)))
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 12:42 am
This is the main routine for generating moves for a position where the king is not in check:
Code: Select all
;;; Move generation: full set of legal moves when not in check
(defun generate-not-in-check (my-pos)
"Return a complete list of moves for the given position with the king not in check."
(let*
(
(result nil)
(act-color (pos-act-color my-pos))
(pas-color (pos-pas-color my-pos))
(act-king-sq (svref (pos-king-sq-vec my-pos) act-color))
(act-loc-bb (svref (pos-loc-color-bb-vec my-pos) act-color))
(pas-loc-bb (svref (pos-loc-color-bb-vec my-pos) pas-color))
(ep-sq (pos-ep-sq my-pos))
(target-bb (bit-not act-loc-bb))
(pinned-bb (svref (pos-pinned-bb-vec my-pos) act-color))
(frozen-bb (svref (pos-frozen-bb-vec my-pos) act-color))
(rstrct-bb (bit-andc2 pinned-bb frozen-bb))
(fr-sq-bb (bit-andc2 act-loc-bb frozen-bb))
(board-vec (pos-board-vec my-pos))
(atk-fr-sq-bb-vec (pos-atk-fr-sq-bb-vec my-pos))
)
(do ((fr-sq (next-sq fr-sq-bb) (next1-sq fr-sq-bb fr-sq))) ((not fr-sq))
(let*
(
(fr-man (svref board-vec fr-sq))
(fr-piece (svref mc-man-to-piece-vec fr-man))
(atk-fr-sq-bb (svref atk-fr-sq-bb-vec fr-sq))
)
(cond
;;
;; Pawn moves
;;
((= fr-piece piece-pawn)
(let*
(
(fr-rank (map-sq-to-rank fr-sq))
(fr-file (map-sq-to-file fr-sq))
(rstrct-flag (sq-set? rstrct-bb fr-sq))
(rstrct-dir (when rstrct-flag (aref intersquare-dir-vec act-king-sq fr-sq)))
(r2-flag nil)
(r7-flag nil)
(adv-delta nil)
(q-capt-sq nil)
(k-capt-sq nil)
)
(if (= act-color color-white)
(progn
(when (= fr-rank rank-2) (setf r2-flag t))
(when (= fr-rank rank-7) (setf r7-flag t))
(setf adv-delta delta-n)
(when (and (> fr-file file-a) (or (not rstrct-flag) (= rstrct-dir dir-nw)))
(setf q-capt-sq (+ fr-sq delta-nw))
(when (sq-reset? pas-loc-bb q-capt-sq)
(setf q-capt-sq nil)))
(when (and (< fr-file file-h) (or (not rstrct-flag) (= rstrct-dir dir-ne)))
(setf k-capt-sq (+ fr-sq delta-ne))
(when (sq-reset? pas-loc-bb k-capt-sq)
(setf k-capt-sq nil))))
(progn
(when (= fr-rank rank-7) (setf r2-flag t))
(when (= fr-rank rank-2) (setf r7-flag t))
(setf adv-delta delta-s)
(when (and (> fr-file file-a) (or (not rstrct-flag) (= rstrct-dir dir-sw)))
(setf q-capt-sq (+ fr-sq delta-sw))
(when (sq-reset? pas-loc-bb q-capt-sq)
(setf q-capt-sq nil)))
(when (and (< fr-file file-h) (or (not rstrct-flag) (= rstrct-dir dir-se)))
(setf k-capt-sq (+ fr-sq delta-se))
(when (sq-reset? pas-loc-bb k-capt-sq)
(setf k-capt-sq nil)))))
(when
(or
(not rstrct-flag)
(= bidir-n (svref mc-sweep-dir-to-bidir-vec rstrct-dir)))
(let ((to-sq (+ fr-sq adv-delta)))
(when (is-man-vacant? (svref board-vec to-sq))
(if r7-flag
(dolist (msc msc-reverse-promotion-list)
(push (mm-prom fr-sq to-sq fr-man msc) result))
(progn
(push (mm-simp fr-sq to-sq fr-man) result)
(when (and r2-flag (is-man-vacant? (svref board-vec (+ to-sq adv-delta))))
(push (mm-simp fr-sq (+ to-sq adv-delta) fr-man) result)))))))
(dolist (to-sq (list q-capt-sq k-capt-sq))
(when to-sq
(let ((to-man (svref board-vec to-sq)))
(if r7-flag
(dolist (msc msc-reverse-promotion-list)
(push (mm-prcp fr-sq to-sq fr-man to-man msc) result))
(push (mm-capt fr-sq to-sq fr-man to-man) result)))))
(when (and ep-sq (find ep-sq (aref pawn-sqs-vec act-color fr-sq)))
(let ((epcp-move (mm-epcp fr-man fr-sq ep-sq)))
(when (is-move-playable? epcp-move my-pos)
(push epcp-move result))))))
;;
;; Knight moves
;;
((= fr-piece piece-knight)
(let ((to-sq-bb (bit-and atk-fr-sq-bb target-bb)))
(do ((to-sq (next-sq to-sq-bb) (next1-sq to-sq-bb to-sq))) ((not to-sq))
(push (mm-capt fr-sq to-sq fr-man (svref board-vec to-sq)) result))))
;;
;; Sweeper moves
;;
((is-piece-sweeper? fr-piece)
(let ((to-sq-bb (bit-and atk-fr-sq-bb target-bb)))
(when (sq-set? rstrct-bb fr-sq)
(bit-and
to-sq-bb
(aref open-ray-bb-vec act-king-sq (aref intersquare-dir-vec act-king-sq fr-sq))
t))
(do ((to-sq (next-sq to-sq-bb) (next1-sq to-sq-bb to-sq))) ((not to-sq))
(push (mm-capt fr-sq to-sq fr-man (svref board-vec to-sq)) result))))
;;
;; King moves
;;
((= fr-piece piece-king)
(let*
(
(pas-atk-bb (svref (pos-atk-by-color-bb-vec my-pos) pas-color))
(to-sq-bb (bit-andc2 (bit-and atk-fr-sq-bb target-bb) pas-atk-bb))
)
(do ((to-sq (next-sq to-sq-bb) (next1-sq to-sq-bb to-sq))) ((not to-sq))
(push (mm-capt fr-sq to-sq fr-man (svref board-vec to-sq)) result)))
(let ((castbits (pos-castbits my-pos)))
(when castbits
(when (plusp (logand castbits (svref mc-color-to-castbits-vec act-color)))
(dolist (castling (svref mc-color-to-castlings-vec act-color))
(when (can-castle-flank-color? castling my-pos)
(push (clone-move (svref castling-move-vec castling)) result)))))))
;;
(t
(error "cond fault: generate-not-in-check")))))
result))
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 12:44 am
This is the main routine for generating moves for a position where the king is in check:
Code: Select all
;;; Move generation: full set of legal moves when in check
(defun generate-check-evasion (my-pos)
"Return a complete list of moves for the given position with the king in check."
(let*
(
(result nil)
(loc-color-bb-vec (pos-loc-color-bb-vec my-pos))
(board-vec (pos-board-vec my-pos))
(act-color (pos-act-color my-pos))
(pas-color (pos-pas-color my-pos))
(act-loc-bb (svref loc-color-bb-vec act-color))
(pas-loc-bb (svref loc-color-bb-vec pas-color))
(act-king-sq (svref (pos-king-sq-vec my-pos) act-color))
(act-king-man (synth-man act-color piece-king))
(act-pawn-man (synth-man act-color piece-pawn))
(act-pawn-bb (svref (pos-loc-man-bb-vec my-pos) act-pawn-man))
(act-second-rank (if (= color-white act-color) rank-2 rank-7))
(act-seventh-rank (if (= color-white act-color) rank-7 rank-2))
(adv-delta (if (= color-white act-color) delta-n delta-s))
(atk-to-bb (svref (pos-atk-to-sq-bb-vec my-pos) act-king-sq))
(atkr-bb (bit-and atk-to-bb pas-loc-bb))
(single-atkr-flag (= (card atkr-bb) 1))
(atkr-sq (if single-atkr-flag (first-sq atkr-bb)))
(atkr-man (if single-atkr-flag (svref board-vec atkr-sq)))
(interpose-test (and single-atkr-flag (svref mc-man-to-sweeper-vec atkr-man)))
(interpose-bb (if interpose-test (aref intersquare-bb-vec act-king-sq atkr-sq)))
(interpose-flag (and interpose-test (not (bb-reset? interpose-bb))))
(loc-sweep-bb (pos-loc-sweep-bb my-pos))
(pinned-bb (svref (pos-pinned-bb-vec my-pos) act-color))
(ep-sq (pos-ep-sq my-pos))
)
;;
;; Capture a single attacker by other than the king
;;
(when single-atkr-flag
(let ((cand-bb (bit-and act-loc-bb (svref (pos-atk-to-sq-bb-vec my-pos) atkr-sq))))
(reset-sq cand-bb act-king-sq)
(bit-andc2 cand-bb pinned-bb t)
(do ((cand-sq (next-sq cand-bb) (next1-sq cand-bb cand-sq))) ((not cand-sq))
(let ((cand-man (svref board-vec cand-sq)))
(if (and (= cand-man act-pawn-man) (= (map-sq-to-rank cand-sq) act-seventh-rank))
(dolist (msc msc-reverse-promotion-list)
(push (mm-prcp cand-sq atkr-sq cand-man atkr-man msc) result))
(push (mm-capt cand-sq atkr-sq cand-man atkr-man) result))))))
;;
;; King moves including captures
;;
(let
(
(zapr-bb (clone-bb atkr-bb))
(flight-bb (clone-bb (svref (pos-atk-fr-sq-bb-vec my-pos) act-king-sq)))
)
(bit-andc2 flight-bb act-loc-bb t)
(bit-andc2 flight-bb (svref (pos-atk-by-color-bb-vec my-pos) pas-color) t)
(do ((zapr-sq (next-sq zapr-bb) (next1-sq zapr-bb zapr-sq))) ((not zapr-sq))
(when (sq-set? loc-sweep-bb zapr-sq)
(let*
(
(zapr-dir (aref intersquare-dir-vec zapr-sq act-king-sq))
(flight-sq (aref step-sq-vec act-king-sq zapr-dir))
)
(when flight-sq
(reset-sq flight-bb flight-sq)))))
(do ((to-sq (next-sq flight-bb) (next1-sq flight-bb to-sq))) ((not to-sq))
(push (mm-capt act-king-sq to-sq act-king-man (svref board-vec to-sq)) result)))
;;
;; Interposition for a single sweep attacker by a non-pawn
;;
(when interpose-flag
(let ((cand-bb (clone-bb act-loc-bb)))
(reset-sq cand-bb act-king-sq)
(bit-andc2 cand-bb act-pawn-bb t)
(bit-andc2 cand-bb pinned-bb t)
(do ((cand-sq (next-sq cand-bb) (next1-sq cand-bb cand-sq))) ((not cand-sq))
(let ((to-bb (bit-and interpose-bb (svref (pos-atk-fr-sq-bb-vec my-pos) cand-sq))))
(do ((to-sq (next-sq to-bb) (next1-sq to-bb to-sq))) ((not to-sq))
(push (mm-simp cand-sq to-sq (svref board-vec cand-sq)) result))))))
;;
;; Interposition for a single sweep attacker by a pawn single square advance
;;
(when interpose-flag
(let ((cand-bb (clone-bb act-pawn-bb)))
(bit-andc2 cand-bb pinned-bb t)
(do ((cand-sq (next-sq cand-bb) (next1-sq cand-bb cand-sq))) ((not cand-sq))
(let ((to-sq (+ cand-sq adv-delta)))
(when (sq-set? interpose-bb to-sq)
(if (= (map-sq-to-rank cand-sq) act-seventh-rank)
(dolist (msc msc-reverse-promotion-list)
(push (mm-prom cand-sq to-sq act-pawn-man msc) result))
(push (mm-simp cand-sq to-sq act-pawn-man) result)))))))
;;
;; Interposition for a single sweep attacker by a pawn double square advance
;;
(when interpose-flag
(let ((cand-bb (clone-bb act-pawn-bb)))
(bit-andc2 cand-bb pinned-bb t)
(do ((cand-sq (next-sq cand-bb) (next1-sq cand-bb cand-sq))) ((not cand-sq))
(when (= (map-sq-to-rank cand-sq) act-second-rank)
(let ((to-sq (+ cand-sq adv-delta)))
(when (is-man-vacant? (svref board-vec to-sq))
(incf to-sq adv-delta)
(when (sq-set? interpose-bb to-sq)
(push (mm-simp cand-sq to-sq act-pawn-man) result))))))))
;;
;; En passant captures
;;
(when ep-sq
(let ((cand-bb (bit-and act-pawn-bb (svref (pos-atk-to-sq-bb-vec my-pos) ep-sq))))
(do ((cand-sq (next-sq cand-bb) (next1-sq cand-bb cand-sq))) ((not cand-sq))
(let ((epcp-move (mm-epcp act-pawn-man cand-sq ep-sq)))
(when (is-move-playable? epcp-move my-pos)
(push epcp-move result))))))
;;
result))
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 12:56 am
Code: Select all
;;; Move execution
(defun execute-move (my-move my-pos)
"Execute the given move on the given position."
(let*
(
(not-null-flag (not (is-move-null? my-move)))
(fr-sq (move-fr-sq my-move))
(to-sq (move-to-sq my-move))
(fr-man (move-fr-man my-move))
(to-man (move-to-man my-move))
(msc (move-msc my-move))
(act-color (pos-act-color my-pos))
(pas-color (pos-pas-color my-pos))
(castbits (pos-castbits my-pos))
(ep-sq (pos-ep-sq my-pos))
(king-sq-vec (pos-king-sq-vec my-pos))
(board-vec (pos-board-vec my-pos))
(fr-piece (svref mc-man-to-piece-vec fr-man))
)
(when not-null-flag
(cond
;;
;; Regular moves
;;
((is-msc-regular? msc)
(when (is-man-nonvac? to-man)
(hash-man-sq-pos to-man to-sq my-pos)
(del-man-pos to-man to-sq my-pos))
(hash-man-sq-sq-pos fr-man fr-sq to-sq my-pos)
(move-man-pos fr-man fr-sq to-sq my-pos))
;;
;; En passant capture moves
;;
((is-msc-en-passant? msc)
(let
(
(victim-sq (+ to-sq (if (= color-white act-color) delta-s delta-n)))
(victim-man (synth-man pas-color piece-pawn))
)
(hash-man-sq-pos victim-man victim-sq my-pos)
(del-man-pos victim-man victim-sq my-pos))
(hash-man-sq-sq-pos fr-man fr-sq to-sq my-pos)
(move-man-pos fr-man fr-sq to-sq my-pos))
;;
;; Castling moves
;;
((is-msc-castling? msc)
(hash-man-sq-sq-pos fr-man fr-sq to-sq my-pos)
(move-man-pos fr-man fr-sq to-sq my-pos)
(let*
(
(flank (svref mc-msc-to-flank-vec msc))
(castling (aref mc-flank-color-to-castling-vec flank act-color))
(rook-fr-sq (svref castling-rook-home-sq-vec castling))
(rook-to-sq (svref castling-rook-cstl-sq-vec castling))
(rook-man (synth-man act-color piece-rook))
)
(hash-man-sq-sq-pos rook-man rook-fr-sq rook-to-sq my-pos)
(move-man-pos rook-man rook-fr-sq rook-to-sq my-pos)))
;;
;; Pawn promotion moves
;;
((is-msc-promotion? msc)
(when (is-man-nonvac? to-man)
(hash-man-sq-pos to-man to-sq my-pos)
(del-man-pos to-man to-sq my-pos))
(hash-man-sq-pos fr-man fr-sq my-pos)
(del-man-pos fr-man fr-sq my-pos)
(let ((prom-man (synth-man act-color (svref mc-msc-to-piece-vec msc))))
(hash-man-sq-pos prom-man to-sq my-pos)
(add-man-pos prom-man to-sq my-pos)))
;;
(t
(error "cond fault: execute-move"))))
;;
;; Environment update: active/passive colors
;;
(setf (pos-act-color my-pos) pas-color)
(setf (pos-pas-color my-pos) act-color)
;;
;; Environment update: castling availability bits
;;
(when (and not-null-flag (plusp castbits))
(let*
(
(pres-fr-castbits (svref castbits-preservation-vec fr-sq))
(pres-to-castbits (svref castbits-preservation-vec to-sq))
(updt-castbits (logand castbits (logand pres-fr-castbits pres-to-castbits)))
)
(when (/= castbits updt-castbits)
(let ((drop-castbits (logandc2 castbits updt-castbits)))
(dotimes (castling castling-limit)
(when (logbitp castling drop-castbits)
(bit-xor (pos-main-hash my-pos) (fetch-castling-hash castling) t))))
(setf (pos-castbits my-pos) updt-castbits))))
;;
;; Environment update: en passant capture square
;;
(when ep-sq
(bit-xor (pos-main-hash my-pos) (fetch-ep-sq-hash ep-sq) t)
(setf (pos-ep-sq my-pos) nil))
(when (and (= fr-piece piece-pawn) (= (abs (- to-sq fr-sq)) abs-double-adv-delta))
(setf ep-sq (calc-ep-sq-board-vec act-color to-sq board-vec))
(when ep-sq
(bit-xor (pos-main-hash my-pos) (fetch-ep-sq-hash ep-sq) t)
(setf (pos-ep-sq my-pos) ep-sq)))
;;
;; Environment update: half move clock
;;
(if (and not-null-flag (or (is-move-capture? my-move) (= fr-piece piece-pawn)))
(setf (pos-hmvc my-pos) 0)
(incf (pos-hmvc my-pos)))
;;
;; Environment update: full move number
;;
(when (= color-black act-color)
(incf (pos-fmvn my-pos)))
;;
;; Environment update: king square vector
;;
(when (= fr-piece piece-king)
(setf (svref king-sq-vec act-color) to-sq))
;;
;; Environment update: pinned and frozen bitboard vectors
;;
(when not-null-flag
(setf (pos-pinned-bb-vec my-pos)
(calc-pinned-bb-vec king-sq-vec board-vec))
(setf (pos-frozen-bb-vec my-pos)
(calc-frozen-bb-vec king-sq-vec (pos-pinned-bb-vec my-pos) board-vec))))
;;
my-move)
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 12:57 am
Code: Select all
;;; Move retraction
(defun retract-move (my-move my-pos)
"Retract the given move on the given position."
(let
(
(fr-sq (move-fr-sq my-move))
(to-sq (move-to-sq my-move))
(fr-man (move-fr-man my-move))
(to-man (move-to-man my-move))
(msc (move-msc my-move))
(act-color (pos-act-color my-pos))
)
(when (not (is-move-null? my-move))
(cond
;;
;; Regular moves
;;
((is-msc-regular? msc)
(move-man-pos fr-man to-sq fr-sq my-pos)
(when (is-man-nonvac? to-man)
(add-man-pos to-man to-sq my-pos)))
;;
;; En passant capture moves
;;
((is-msc-en-passant? msc)
(move-man-pos fr-man to-sq fr-sq my-pos)
(add-man-pos
(synth-man (flip-color act-color) piece-pawn)
(+ to-sq (if (= color-white act-color) delta-s delta-n))
my-pos))
;;
;; Castling moves
;;
((is-msc-castling? msc)
(let*
(
(flank (svref mc-msc-to-flank-vec msc))
(castling (aref mc-flank-color-to-castling-vec flank act-color))
)
(move-man-pos
(synth-man act-color piece-rook)
(svref castling-rook-cstl-sq-vec castling)
(svref castling-rook-home-sq-vec castling)
my-pos))
(move-man-pos fr-man to-sq fr-sq my-pos))
;;
;; Pawn promotion moves
;;
((is-msc-promotion? msc)
(del-man-pos (synth-man act-color (svref mc-msc-to-piece-vec msc)) to-sq my-pos)
(add-man-pos fr-man fr-sq my-pos)
(when (is-man-nonvac? to-man)
(add-man-pos to-man to-sq my-pos)))
;;
(t
(error "cond fault: retract-move")))))
my-move)
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 1:04 am
Movepath enumeration; used for testing and benchmark generation:
Code: Select all
;;; All node visiting movepath enumeration routines
(defun enumerate-movepaths-aux (my-pos my-cv my-ply my-depth)
"Return a count of distinct movepaths."
(let ((result nil))
(cond
((= my-depth 0)
(when (is-pas-king-in-check? my-pos)
(encode-moves t (reverse my-cv))
(terpri)
(error "F**k up: passive king in check."))
(setf result 1))
(t
(setf result 0)
(dolist (move (if (zerop my-ply) (generate-canonical my-pos) (generate my-pos)))
(let ((env-stack nil))
(push (clone-posenv (pos-posenv my-pos)) env-stack)
(execute-move move my-pos)
(incf result
(enumerate-movepaths-aux my-pos (cons move my-cv) (1+ my-ply) (1- my-depth)))
(setf (pos-posenv my-pos) (pop env-stack))
(retract-move move my-pos)))))
(when (= my-ply 1)
(encode-moves t (reverse my-cv))
(format t " ~a~%" result))
result))
(defun enumerate-movepaths (my-pos my-depth)
"Count the distinct movepaths from the given position to the given ply depth."
(enumerate-movepaths-aux my-pos nil 0 my-depth))
And some sample output:
Code: Select all
> (enumerate-movepaths pos0 5)
(Na3) 198572
(Nc3) 234656
(Nf3) 233491
(Nh3) 198502
(a3) 181046
(a4) 217832
(b3) 215255
(b4) 216145
(c3) 222861
(c4) 240082
(d3) 328511
(d4) 361790
(e3) 402988
(e4) 405385
(f3) 178889
(f4) 198473
(g3) 217210
(g4) 214048
(h3) 181044
(h4) 218829
4865609
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 7:48 pm
Note that only slight changes are needed to the non-transposition version because of the intrinsic support of hash tables in Common Lisp.
Code: Select all
;;; Count terminal nodes with transpositions (movepath enumeration)
(defconstant trans-ply-limit 5)
(defun initialize-trans-vec ()
(let ((result (make-array trans-ply-limit)))
(dotimes (index trans-ply-limit)
(setf (svref result index) (make-hash-table :test 'equalp)))
result))
(defvar trans-vec (initialize-trans-vec))
(defun cwt-movepaths-aux (my-pos my-rcv my-ply my-depth)
"Return a count of distinct movepaths."
(let ((result nil))
(when (< my-ply trans-ply-limit)
(setf result (gethash (pos-main-hash my-pos) (svref trans-vec my-ply))))
(when (not result)
(cond
((zerop my-depth)
(setf result 1))
((= my-depth 1)
(setf result (count-moves my-pos)))
(t
(setf result 0)
(dolist (move (if (zerop my-ply) (generate-canonical my-pos) (generate my-pos)))
(let ((env-stack nil))
(push (clone-posenv (pos-posenv my-pos)) env-stack)
(execute-move move my-pos)
(incf result
(cwt-movepaths-aux my-pos (cons move my-rcv) (1+ my-ply) (1- my-depth)))
(setf (pos-posenv my-pos) (pop env-stack))
(retract-move move my-pos)))))
(when (< my-ply trans-ply-limit)
(setf (gethash (pos-main-hash my-pos) (svref trans-vec my-ply)) result)))
(when (= my-ply 1)
(encode-move t (first my-rcv))
(format t " ~D~%" result))
result))
(defun cwt-movepaths (my-pos my-depth)
"Count the distinct movepaths from the given position to the given ply depth."
(let ((result nil))
(dotimes (index trans-ply-limit)
(clrhash (svref trans-vec index)))
(setf result (cwt-movepaths-aux my-pos nil 0 my-depth))
(format t "Total path count for depth ~R: ~D ~R~%" my-depth result result)
result))
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Wed Aug 20, 2008 8:19 pm
Sample output of the above running on a bytecode virtual machine hosted on a 2.66 GHz Xeon:
Code: Select all
> (time (cwt-movepaths pos0 6))
Na3 4856835
Nc3 5708064
Nf3 5723523
Nh3 4877234
a3 4463267
a4 5363555
b3 5310358
b4 5293555
c3 5417640
c4 5866666
d3 8073082
d4 8879566
e3 9726018
e4 9771632
f3 4404141
f4 4890429
g3 5346260
g4 5239875
h3 4463070
h4 5385554
Total path count for depth six: 119060324 one hundred and nineteen million, sixty thousand, three hundred and twenty-four
Real time: 700.2554 sec.
Run time: 699.9713 sec.
Space: 2090553000 Bytes
GC: 1071, GC time: 17.40664 sec.
119060324
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Thu Aug 21, 2008 5:34 am
The previous output was generated with clisp; here's the same calculation with the CMU Common Lisp (cmucl) compiler:
Code: Select all
* (time (cwt-movepaths pos0 6))
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:
Na3 4856835
Nc3 5708064
Nf3 5723523
Nh3 4877234
a3 4463267
a4 5363555
b3 5310358
b4 5293555
c3 5417640
c4 5866666
d3 8073082
d4 8879566
e3 9726018
e4 9771632
f3 4404141
f4 4890429
g3 5346260
g4 5239875
h3 4463070
h4 5385554
Total path count for depth six: 119060324 one hundred nineteen million sixty thousand three hundred twenty-four
; Evaluation took:
; 348.36 seconds of real time
; 342.12543 seconds of user run time
; 6.173796 seconds of system run time
; 926,625,141,176 CPU cycles
; [Run times include 9.99 seconds GC run time]
; 0 page faults and
; 4,396,146,280 bytes consed.
;
And a warning: Don't use GNU Common Lisp (gcl). Both the interpreter and compiler are buggy and haven't seen a release in nearly four years.
sje
Posts: 4675Joined: Mon Mar 13, 2006 7:43 pm
Post by sje Thu Aug 21, 2008 5:54 am
Same as above, but one ply deeper:
Code: Select all
* (time (cwt-movepaths pos0 7))
; Compiling LAMBDA NIL:
; Compiling Top-Level Form:
Na3 120142144
Nc3 148527161
Nf3 147678554
Nh3 120669525
a3 106743106
a4 137077337
b3 133233975
b4 134087476
c3 144074944
c4 157756443
d3 227598692
d4 269605599
e3 306138410
e4 309478263
f3 102021008
f4 119614841
g3 135987651
g4 130293018
h3 106678423
h4 138495290
Total path count for depth seven: 3195901860 three billion one hundred ninety-five million nine hundred one thousand eight hundred sixty
; Evaluation took:
; 8367.09 seconds of real time
; 8171.145 seconds of user run time
; 171.57585 seconds of system run time
; 22,255,953,448,896 CPU cycles
; [Run times include 277.81 seconds GC run time]
; 0 page faults and
; 106,603,705,336 bytes consed.
;
3195901860
