CIL Toolkit: code snippets: move generation

Discussion of chess software programming and technical issues.

Moderator: Ras

User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

Re: CIL Toolkit: code snippets: first version A/B search

Post by sje »

Given the mate-in-four position:
[d]r1b2rk1/pp1p1pp1/1b1p2B1/n1qQ2p1/8/5N2/P3RPPP/4R1K1 w - - 0 1

Sample search calls:

Code: Select all

> (setf s (stabs0-driver 1 "r1b2rk1/pp1p1pp1/1b1p2B1/n1qQ2p1/8/5N2/P3RPPP/4R1K1 w - - 0 1"))
[EX:-6.380 NC:6436 PV:(Be4)]

> (setf s (stabs0-driver 2 "r1b2rk1/pp1p1pp1/1b1p2B1/n1qQ2p1/8/5N2/P3RPPP/4R1K1 w - - 0 1"))
[EX:-4.713 NC:112981 PV:(Bxf7+ Rxf7 Re8+ Kh7 Qxf7 Qxf2+ Kh1)]

> (setf s (stabs0-driver 3 "r1b2rk1/pp1p1pp1/1b1p2B1/n1qQ2p1/8/5N2/P3RPPP/4R1K1 w - - 0 1"))
[EX:-4.713 NC:672563 PV:(Bxf7+ Rxf7 Re8+ Kh7 Qxf7 Qxf2+ Kh1)]

> (setf s (stabs0-driver 4 "r1b2rk1/pp1p1pp1/1b1p2B1/n1qQ2p1/8/5N2/P3RPPP/4R1K1 w - - 0 1"))
[EX:MateIn4 NC:2777564 PV:(Qxf7+ Rxf7 Re8+ Rf8 Rxf8+ Kxf8 Re8#)]
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

Re: CIL Toolkit: code snippets: first version A/B search

Post by sje »

Given the mate-in-three position:
[d]r1b1k2r/pp2bppp/8/3N2q1/2p5/8/PPP2PPP/R2QR1K1 w kq - 0 1

Code: Select all

> (setf s (stabs0-driver 1 "r1b1k2r/pp2bppp/8/3N2q1/2p5/8/PPP2PPP/R2QR1K1 w kq - 0 1"))
[EX:+1.422 NC:86 PV:(Nc7+ Kf8 Nxa8)]

> (setf s (stabs0-driver 2 "r1b1k2r/pp2bppp/8/3N2q1/2p5/8/PPP2PPP/R2QR1K1 w kq - 0 1"))
[EX:+1.422 NC:3181 PV:(Nc7+ Kf8 Nxa8)]

> (setf s (stabs0-driver 3 "r1b1k2r/pp2bppp/8/3N2q1/2p5/8/PPP2PPP/R2QR1K1 w kq - 0 1"))
[EX:MateIn3 NC:7362 PV:(Nc7+ Kf8 Qd8+ Bxd8 Re8#)]
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

Re: CIL Toolkit: code snippets: first version A/B search

Post by sje »

Given the mate-in-two position:
[d]2r1nr1k/pp1q1p1p/3bpp2/5P2/1P1Q4/P3P3/1B3P1P/R3K1R1 w Q - 0 1

Code: Select all

> (setf s (stabs0-driver 1 "2r1nr1k/pp1q1p1p/3bpp2/5P2/1P1Q4/P3P3/1B3P1P/R3K1R1 w Q - 0 1"))
[EX:MateIn2 NC:2454 PV:(Qxf6+ Ng7 Qxg7#)]
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

Re: CIL Toolkit: code snippets: first version A/B search

Post by sje »

One more, another mate-in-two:
[d]rnbqkbn1/ppppp3/7r/6pp/3P1p2/3BP1B1/PPP2PPP/RN1QK1NR w KQq - 0 1

Code: Select all

> (setf s (stabs0-driver 1 "rnbqkbn1/ppppp3/7r/6pp/3P1p2/3BP1B1/PPP2PPP/RN1QK1NR w KQq - 0 1"))
[EX:+1.016 NC:78 PV:(exf4)]

> (setf s (stabs0-driver 2 "rnbqkbn1/ppppp3/7r/6pp/3P1p2/3BP1B1/PPP2PPP/RN1QK1NR w KQq - 0 1"))
[EX:MateIn2 NC:68394 PV:(Qxh5+ Rg6 Qxg6#)]
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: PGN structure and encoding

Post by sje »

Here's the PGN structure and it's encoding routines. No parser yet, and only simple movetext is supported.

Code: Select all

;;; The standard PGN tag names (ordered; first seven required)

(defconstant pgntn-event    (enum-init) "Name of the event")
(defconstant pgntn-site     (enum-next) "Location of the event")
(defconstant pgntn-date     (enum-next) "Date of the game (YYYY.MM.DD)")
(defconstant pgntn-round    (enum-next) "Round number of the game")
(defconstant pgntn-white    (enum-next) "Name of White player")
(defconstant pgntn-black    (enum-next) "Name of Black player")
(defconstant pgntn-result   (enum-next) "Result of game (*, 1-0, 0-1, 1/2-1/2, 0-0)")
(defconstant pgntn-setup    (enum-next) "Position setup flag (0/1)")
(defconstant pgntn-fen      (enum-next) "Setup FEN string")
(defconstant pgntn-time     (enum-next) "Time of day (HH:MM:SS)")
(defconstant pgntn-utc      (enum-next) "Universal Coordinated Time (YYYY.MM.DD HH:MM:SS)")
(defconstant pgntn-whiteelo (enum-next) "White's ELO rating")
(defconstant pgntn-blackelo (enum-next) "Black's ELO rating")
(defconstant pgntn-opening  (enum-next) "Name of opening")
(defconstant pgntn-soc      (enum-next) "Standard Opening Code (DDDD)")
(defconstant pgntn-eco      (enum-next) "Encyclopedia of Chess Openings code (XDD)")
(defconstant pgntn-nic      (enum-next) "New in Chess code")
(defconstant pgntn-plycount (enum-next) "Number of ply in game")

(defconstant pgntn-limit  (enum-limit))
(defconstant pgntn-rlimit (1+ pgntn-result))

(defconstant pgntn-list (calc-index-list pgntn-limit))

(defmacro dopgntns ((my-pgntn-var) &body my-body)
  "Construct a per pgntn iteration loop."
  `(dotimes (,my-pgntn-var pgntn-rlimit) ,@my-body))

(defconstant as-pgntn-vec
  (make-array pgntn-limit
    :initial-contents
      (vector
        "Event"
        "Site"
        "Date"
        "Round"
        "White"
        "Black"
        "Result"
        "Setup"
        "FEN"
        "Time"
        "UTC"
        "WhiteElo"
        "BlackElo"
        "Opening"
        "SOC"
        "ECO"
        "NIC"
        "PlyCount")))


;;; Encoding

(defun encode-tagpair (my-stream my-pgntn my-value)
  "Encode a PGN tag pair on a stream."
  (fmt-brack-l my-stream)
  (if my-pgntn
    (put-value my-stream (svref as-pgntn-vec my-pgntn))
    (put-value my-stream nil))
  (blank my-stream)
  (fmt-quote my-stream)
  (put-value my-stream my-value)
  (fmt-quote my-stream)
  (fmt-brack-r my-stream))


;;; Vector of PGN tag pairs

(defun mk-tp-vec ()
  "Return a vector of PGN tag pair default values."
  (let ((result (make-array pgntn-limit :initial-element nil)))
    (setf (svref result pgntn-event ) "Unnamed event")
    (setf (svref result pgntn-site  ) "Unnamed site")
    (setf (svref result pgntn-date  ) "Unknown date")
    (setf (svref result pgntn-round ) "-")
    (setf (svref result pgntn-white ) "Unnamed player")
    (setf (svref result pgntn-black ) "Unnamed player")
    (setf (svref result pgntn-result) "*")
    result))

(defun clone-tp-vec (my-tp-vec)
  "Return a clone of a vector of PGN tag pair values."
  (copy-seq my-tp-vec))


;;; Encoding

(defun encode-tp-vec (my-stream my-tp-vec)
  "Encode a vector of PGN tag pair values on a stream."
  (dopgntns (pgntn)
    (when (svref my-tp-vec pgntn)
      (encode-tagpair my-stream pgntn (svref my-tp-vec pgntn)))
    (newline my-stream)))


;;; Portable Game Notation game structure

(defstruct
  (pgn
    (:print-function
      (lambda (my-pgn my-stream my-level)
        (declare (ignore my-level))
        (encode-pgn my-stream my-pgn))))
  (tp-vec nil)  ; Vector of all tag pair values
  (game   nil)) ; Moves and game result

(defun mk-pgn ()
  "Return an initialized PGN game structure."
  (make-pgn
    :tp-vec (mk-tp-vec)
    :game   (mk-game)))

(defun clone-pgn (my-pgn)
  "Return a clone of PGN game."
  (make-pgn
    :tp-vec (clone-tp-vec (pgn-tp-vec my-pgn))
    :game   (clone-game   (pgn-game   my-pgn))))


;;; Normalization

(defun normalize-pgn (my-pgn)
  "Normalize a PGN game in place."
  (let*
    (
      (tp-vec (pgn-tp-vec my-pgn))
      (game   (pgn-game   my-pgn))
      (pos    (game-current-pos game))
    )
    (if (is-initial-array-pos? pos)
      (progn
        (setf (svref tp-vec pgntn-setup) nil)
        (setf (svref tp-vec pgntn-fen) nil))
      (progn
        (setf (svref tp-vec pgntn-setup) "1")
        (setf (svref tp-vec pgntn-fen) (pos-string pos))))
    (setf (svref tp-vec pgntn-result) (svref as-gsr-vec (game-gsr game))))
  my-pgn)


;;; Encoding

(defun encode-pgn (my-stream my-pgn)
  "Encode a PGN game on a stream."
  (encode-tp-vec my-stream (pgn-tp-vec my-pgn))
  (newline my-stream)
  (encode-pos-history my-stream (game-current-pos (pgn-game my-pgn)))
  (blank my-stream)
  (put-value my-stream (svref as-gsr-vec (game-gsr (pgn-game my-pgn))))
  (newline my-stream))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: another movepath enumeration

Post by sje »

I've been testing the new CIL toolkit under several different Lisp environments for the usual reasons. One of these is CMU Common Lisp (a.k.a. cmucl). This Lisp offers a compiler that produces native (32 bit x86) code. So far, testing has shown that the code produced runs about 4.5 times faster than the same Lisp source running on the GNU Common Lisp (clisp) bytecode interpreter. In the tests, bath Lisps are also handling full type, range, and value checking on all operands and operations.

Here's a movepath enumeration to ply seven running under cmucl. Note that the toolkit keeps track of the count of unique positions; the count is very slightly high because of a very few positions where the en passant status is a little optimistic. (An en passant target square is specified but no legal en passant capture is possible.)

Code: Select all

* (time-emp-cwt pos0 7)
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
Depth: 0   Unique: 1
Depth: 1   Unique: 20
Depth: 2   Unique: 400
Depth: 3   Unique: 5362
Depth: 4   Unique: 72078
Depth: 5   Unique: 822518
Depth: 6   Unique: 9417683
Total path count for depth seven: 3195901860
Descriptive: three billion one hundred ninety-five million nine hundred one thousand eight hundred sixty
F/P: 817.56067 KHz / 1.2231507 usec

Code: Select all

;;; Count terminal nodes with transpositions (movepath enumeration)

(defun create-transtable-vec (my-ply-limit)
  (let ((result (make-array my-ply-limit)))
    (dotimes (ply my-ply-limit)
      (setf (svref result ply) (make-hashdict)))
    result))

(defun emp-cwt-aux (my-pos my-ply my-depth my-tt-vec)
  "Return a count of distinct movepaths using a transposition table vector."
  (let ((result nil) (trans-flag (< my-ply (array-total-size my-tt-vec))))
    (when trans-flag
      (setf result (hashdict-value (svref my-tt-vec my-ply) (pos-main-hash my-pos))))
    (unless result
      (cond
        ((zero? my-depth)
          (setf result 1))
        ((one? my-depth)
          (setf result (count-moves my-pos)))
        (t
          (setf result 0)
          (dolist (move (if (zero? my-ply) (generate-canon my-pos) (generate my-pos)))
            (execute-move move my-pos)
            (incf result (emp-cwt-aux my-pos (1+ my-ply) (1- my-depth) my-tt-vec))
            (retract-move my-pos))))
      (when trans-flag
        (hashdict-insert (svref my-tt-vec my-ply) (pos-main-hash my-pos) result)))
    (when (one? my-ply)
      (format t "~A ~D~%" (first (pos-move-stack my-pos)) result))
    result))

(defun emp-cwt (my-pos my-depth)
  "Count the distinct movepaths from the given position to the given ply depth."
  (let ((result nil) (tt-vec (create-transtable-vec my-depth)))
    (setf result (emp-cwt-aux my-pos 0 my-depth tt-vec))
    (dotimes (index my-depth)
      (format t "Depth: ~D   Unique: ~D~%" index (hashdict-count (svref tt-vec index))))
    (format t "Total path count for depth ~R: ~D~%" my-depth result)
    (format t "Descriptive: ~R~%" result)
    result))

(defun time-emp-cwt (my-pos my-depth)
  "Time a count nodes movepath enumeration using transposition tables."
  (let ((result nil) (tm0 nil) (tm1 nil) (seconds nil))
    (setf tm0 (get-internal-run-time))
    (setf result (emp-cwt my-pos my-depth))
    (setf tm1 (get-internal-run-time))
    (setf seconds (calc-time-delta tm0 tm1))
    (encode-fp t result seconds)
    (newline t)
    result))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: convenience macros

Post by sje »

One advantage of using Common Lisp is the macro facility that allow a user to customize and extend the basic functions of the language.

Also, one disadavantage of using Common Lisp is the macro facility that allow a user to customize and extend the basic functions of the language.

An instance of the nature of duality is that the opposite of a Great Truth is also a Great Truth. (Wolfgang Pauli)

The following Scheme-like macros in the new CIL Toolkit make the coding a bit easier for me. They might also help Schemers upgrade! :D

Do they make things clearer? You decide.

Code: Select all

;;; Handy predicate macros

(defmacro eq?  (my-form0 my-form1) `(eq ,my-form0 ,my-form1))
(defmacro neq? (my-form0 my-form1) `(not (eq ,my-form0 ,my-form1)))

(defmacro atom? (my-form) `(atom  ,my-form))
(defmacro list? (my-form) `(listp ,my-form))

(defmacro zero?    (my-integer) `(zerop ,my-integer))
(defmacro nonzero? (my-integer) `(not (zerop ,my-integer)))

(defmacro positive? (my-integer) `(plusp  ,my-integer))
(defmacro negative? (my-integer) `(minusp ,my-integer))

(defmacro nonpositive? (my-integer) `(not (plusp  ,my-integer)))
(defmacro nonnegative? (my-integer) `(not (minusp ,my-integer)))

(defmacro one? (my-integer) `(= ,my-integer 1))
(defmacro two? (my-integer) `(= ,my-integer 2))

(defmacro even? (my-integer) `(evenp ,my-integer))
(defmacro odd?  (my-integer) `(oddp  ,my-integer))

(defmacro null? (my-form) `(null ,my-form))
(defmacro end?  (my-form) `(endp ,my-form))

(defmacro numeric?  (my-form) `(numberp   ,my-form))
(defmacro rational? (my-form) `(rationalp ,my-form))
(defmacro integer?  (my-form) `(integerp  ,my-form))
(defmacro float?    (my-form) `(floatp    ,my-form))

(defmacro plural? (my-integer) `(> ,my-integer 1))

(defmacro bit? (my-bit-index my-integer) `(logbitp ,my-bit-index ,my-integer))


;;; Shifting macros

(defmacro 2* (my-integer) `(ash ,my-integer  1))
(defmacro 2/ (my-integer) `(ash ,my-integer -1))


;;; Single bit mask construction macro

(defmacro 2^ (my-bit-index) `(ash 1 ,my-bit-index))


;;; The dowhile and dountil indefinite iteration macros

(defmacro dowhile (my-form &body my-body)
  "Construct an indefinite iteration loop; positive sense."
  `(do () ((not ,my-form)) ,@my-body))

(defmacro dountil (my-form &body my-body)
  "Construct an indefinite iteration loop; negative sense."
  `(do () (,my-form) ,@my-body))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: calculating a move hash

Post by sje »

A hash can be generated for a move just as it can for a position. In some implementations, the hash for a position can be a simple combination of the hash of the prior position and the hash for the prior move. This is not exactly the case for the new CIL Toolkit, but it's fairly close.

The idea here is twofold:

1) A hash table can be used to hold best reply moves: given a move, return the best reply move seen so far.

2) A hash table can be used to hold variation response moves; given a variation, a hash of all the moves can be calculated and then stored as a key for indexing the most likely following move.

Code: Select all

;;; Hash calculation: move (used only for move hashing)

(defmacro fetch-msc-hash (my-msc) `(svref msc-hash-vec ,my-msc))

(defun calc-move-hash (my-move)
  "Calculate the a hash for the given move."
  (let ((result (mk-hash)))
    (unless (is-move-null? my-move)
      (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 (calc-mover-color my-move))
        )
        (hc-xor2d result (fetch-msc-hash msc))
        (cond
;;
;; Regular moves
;;
          ((is-msc-regular? msc)
            (when (is-man-nonvac? to-man)
              (hc-xor2d result (fetch-ms-hash to-man to-sq)))
            (hc-xor2d result (fetch-ms-hash fr-man fr-sq))
            (hc-xor2d result (fetch-ms-hash fr-man to-sq)))
;;
;; En passant capture moves
;;
          ((is-msc-en-passant? msc)
            (let
              (
                (victim-sq  (+ to-sq (svref pawn-retreat-delta-vec act-color)))
                (victim-man (synth-man (flip-color act-color) piece-pawn))
              )
              (hc-xor2d result (fetch-ms-hash victim-man victim-sq)))
            (hc-xor2d result (fetch-ms-hash fr-man fr-sq))
            (hc-xor2d result (fetch-ms-hash fr-man to-sq)))
;;
;; Castling moves
;;
          ((is-msc-castling? msc)
            (hc-xor2d result (fetch-ms-hash fr-man fr-sq))
            (hc-xor2d result (fetch-ms-hash fr-man to-sq))
            (let*
              (
                (castling   (aref mc-msc-color-to-castling-vec msc 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))
              )
              (hc-xor2d result (fetch-ms-hash rook-man rook-fr-sq))
              (hc-xor2d result (fetch-ms-hash rook-man rook-to-sq))))
;;
;; Pawn promotion moves
;;
          ((is-msc-promotion? msc)
            (when (is-man-nonvac? to-man)
              (hc-xor2d result (fetch-ms-hash to-man to-sq)))
            (hc-xor2d result (fetch-ms-hash fr-man fr-sq))
            (let ((prom-man (synth-man act-color (svref mc-msc-to-piece-vec msc))))
              (hc-xor2d result (fetch-ms-hash prom-man to-sq))))
;;
          (t (error "cond fault: calc-move-hash")))))
    result))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: calculating a game hash

Post by sje »

It can be useful to be able to calculate a hash for an entire game. A game hash is almost a requirement for the handling of duplicate game detection.

In the new CIL Toolkit, a game hash is calculated from combining a hash for the game score result ("1/2-1/2" "0-0" "*" "0-1" "1-0") and all the position hashes present in the game. To correctly discriminate among games that differ only due to transpositions, the cumulative hash is rotated one bit for each sequential position.

Code: Select all

;;; Game score results

(defconstant gsr-drawn          (enum-init) "Drawn result; half point to each color")
(defconstant gsr-double-forfeit (enum-next) "Double forfeit; no points to either color")
(defconstant gsr-unterminated   (enum-next) "Unterminated game; no points to either color")
(defconstant gsr-win-by-black   (enum-next) "Black won; one point to Black, no points to White")
(defconstant gsr-win-by-white   (enum-next) "White won; one point to White, no points to Black")

(defconstant gsr-limit (enum-limit))

(defmacro dogsrs ((my-gsr-var) &body my-body)
  "Construct a per symmetric game termination iteration loop."
  `(dotimes (,my-gsr-var gsr-limit) ,@my-body))

(defconstant as-gsr-vec
  (make-array gsr-limit :initial-contents (vector "1/2-1/2" "0-0" "*" "0-1" "1-0")))

Code: Select all

;;; Hash code constant table (5 of 5): game score result

(defun initialize-gsr-hash-vec ()
  "Build the game score result hash code vector."
  (let
    (
      (result       (make-array gsr-limit))
      (hash-ordinal (+ (* man-rlimit sq-limit) castling-limit file-limit msc-limit))
    )
    (dogsrs (gsr)
      (setf (svref result gsr) (calc-nth-hash-code hash-ordinal))
      (incf hash-ordinal))
  result))

(defconstant gsr-hash-vec (initialize-gsr-hash-vec))

Code: Select all

;;; Hash rotation

(defun rotate-hash-right (my-hash)
  "Return a hash rotated in place to the right by one bit position."
  (let
    (
      (b0 (odd? (svref my-hash 0)))
      (b1 (odd? (svref my-hash 1)))
      (b2 (odd? (svref my-hash 2)))
      (b3 (odd? (svref my-hash 3)))
    )
    (setf (svref my-hash 0) (2/ (svref my-hash 0)))
    (setf (svref my-hash 1) (2/ (svref my-hash 1)))
    (setf (svref my-hash 2) (2/ (svref my-hash 2)))
    (setf (svref my-hash 3) (2/ (svref my-hash 3)))
    (when b0 (incf (svref my-hash 3) 32768))
    (when b1 (incf (svref my-hash 0) 32768))
    (when b2 (incf (svref my-hash 1) 32768))
    (when b3 (incf (svref my-hash 2) 32768))
    my-hash))

Code: Select all

;;; Hash calculation: gsr (used only for game hashing)

(defmacro fetch-gsr-hash (my-gsr) `(svref gsr-hash-vec ,my-gsr))

Code: Select all

;;; Game hash calculation

(defun calc-game-hash (my-game)
  "Return the hash for the given game; only played moves and game status result used."
  (let
    (
      (result (clone-hash (fetch-gsr-hash (game-gsr my-game))))
      (pos    (game-current-pos my-game))
    )
    (hc-xor2d result (pos-main-hash pos))
    (dolist (hash (pos-main-hash-stack pos))
      (rotate-hash-right result)
      (hc-xor2d result hash))
    result))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: move/integer conversion

Post by sje »

In the new CIL Toolkit, a chess move is usually represented as an instance of the "move" structure:

Code: Select all

;;; Chess move

(defstruct
  (move
    (:print-function
      (lambda (my-move my-stream my-level)
        (declare (ignore my-level))
        (encode-move my-stream my-move))))
  (fr-sq  sq-a1)   ; The origin square of the moving man
  (to-sq  sq-a1)   ; The destination square of the moving man
  (fr-man man-v0)  ; The moving man
  (to-man man-v0)  ; The captured man if any; en passant is the exception
  (msc    msc-reg) ; The move special case processing indication
  (mfbits 0))      ; Move flag bits
While this representation is natural for Lisp and has many advantages, it's not a space saver suitable for transposition table storage. Also, there are times when two lists of moves with possibly different orderings need to be compared for set equality, and that can't be done quickly with the usual move representation.

So there is a need for an integer format move. It's called a NEMO (Numeric Equivalent Move Ordinal), and here's how the conversions work:

Code: Select all

;;; Numeric Equivalent Move Ordinal

(defun calc-nemo-from-move (my-move)
  "Calculate the nemo of a move."
  (logior
    (ash (move-fr-sq  my-move) 17)
    (ash (move-to-sq  my-move) 11)
    (ash (move-fr-man my-move)  7)
    (ash (move-to-man my-move)  3)
    (move-msc my-move)))  

(defun calc-move-from-nemo (my-nemo)
  "Calculate the move of a nemo."
  (make-move
    :fr-sq          (ash my-nemo -17)
    :to-sq  (logand (ash my-nemo -11) 63)
    :fr-man (logand (ash my-nemo  -7) 15)
    :to-man (logand (ash my-nemo  -3) 15)
    :msc    (logand      my-nemo       7)
    :mfbits 0))
Here's how to convert a list of moves to its NEMO version and also how to sort the NEMO version:

Code: Select all

;;; Sorting by NEMO

(defun make-move-sort-key-list (my-moves)
  "Return a list of move sorting keys for a move list."
  (mapcar #'calc-nemo-from-move my-moves))

(defun sort-move-sort-keys (my-sort-keys)
  "Return a sort of a list of move sorting keys."
  (sort my-sort-keys #'<))
Here are two similar routines; the first re-orders a list of moves by their NEMO values while the second re-orders a list of moves by their SAN ASCII values:

Code: Select all

(defun sort-moves-by-sort-key (my-moves)
  "Sort the given moves by integer sort key ordering."
  (let ((result nil) (pairs nil))
    (dolist (move my-moves)
      (push (list (calc-nemo-from-move move) move) pairs))
    (setf pairs (sort pairs #'> :key 'first))
    (dolist (pair pairs)
      (push (second pair) result))
    result))

(defun sort-moves-by-san (my-moves)
  "Sort the given moves by SAN ordering."
  (let ((result nil) (pairs nil))
    (dolist (move my-moves)
      (push (list (san-string move) move) pairs))
    (setf pairs (sort pairs #'string> :key 'first))
    (dolist (pair pairs)
      (push (second pair) result))
    result))