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: move/integer conversion

Post by sje »

In regards to pair-wise sorting, a more Lispish way of doing things is to write a macro:

Code: Select all

;;; General purpose pair-wise sorting macro

(defmacro key-sort (my-keygen my-keycmp my-forms)
  `(mapcar
    #'cdr
    (sort
      (mapcar (lambda (my-form) (cons (,my-keygen my-form) my-form)) ,my-forms)
      ,my-keycmp
      :key 'car)))
And then instantiate this for different types and different comparisons:

Code: Select all

(defun sort-moves-by-nemo (my-moves)
  "Sort the given moves by integer sort key ordering."
  (key-sort calc-nemo-from-move #'< my-moves))

(defun sort-moves-by-san (my-moves)
  "Sort the given moves by SAN ordering."
  (key-sort san-string #'string< my-moves))
Alas, the above gives more credence to Bob's claim that Lisp is Write-Only.
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: ver.2 SAN move encoding

Post by sje »

In Common Lisp, the standard way of producing formatted output to a stream is the "format" function. It's roughly analogous to fprintf() in C/C++. However, the Lisp format routine includes much more functionality and so also more overhead. This isn't a concern in nearly all applications, but in a chess program it's useful to be able to output lots of moves on a stream in very little time and so using format is not the best way to go.

In light of the above, I have recoded the SAN move encoder function to avoid format and its pals. The revised routine is a bit cleaner and some common code has been factored into simple and separate routines.

Code: Select all

;;; Standard Algebraic Notation move encoding: fixed single character markers

(defun encode-san-broken (my-stream)
  "Encode a SAN broken move marker on a stream."
  (fmt-star my-stream))

(defun encode-san-capture (my-stream)
  "Encode a SAN capture marker on a stream."
  (put-char my-stream #\x))

(defun encode-san-check (my-stream)
  "Encode a SAN check marker on a stream."
  (fmt-plus my-stream))

(defun encode-san-checkmate (my-stream)
  "Encode a SAN checkmate marker on a stream."
  (fmt-octo my-stream))

(defun encode-san-promote (my-stream)
  "Encode a SAN promotion marker on a stream."
  (fmt-equal my-stream))


;;; Standard Algebraic Notation move encoding: pieces, files, ranks, and squares

(defun encode-san-piece (my-stream my-piece)
  "Encode a SAN piece letter on a stream."
  (put-char my-stream (svref acuc-piece-vec my-piece)))

(defun encode-san-piece-from-man (my-stream my-man)
  "Encode a SAN piece letter from a man on a stream."
  (encode-san-piece my-stream (svref mc-man-to-piece-vec my-man)))

(defun encode-san-file (my-stream my-file)
  "Encode a SAN file letter on a stream."
  (put-char my-stream (svref ac-file-vec my-file)))

(defun encode-san-file-from-square (my-stream my-sq)
  "Encode a SAN file letter from a square on a stream."
  (encode-san-file my-stream (map-sq-to-file my-sq)))

(defun encode-san-rank (my-stream my-rank)
  "Encode a SAN rank digit on a stream."
  (put-char my-stream (svref ac-rank-vec my-rank)))

(defun encode-san-rank-from-square (my-stream my-sq)
  "Encode a SAN rank digit from a square on a stream."
  (encode-san-rank my-stream (map-sq-to-rank my-sq)))

(defun encode-san-square (my-stream my-sq)
  "Encode a SAN square on a stream."
  (encode-san-file-from-square my-stream my-sq)
  (encode-san-rank-from-square my-stream my-sq))


;;; Standard Algebraic Notation move encoding: whole moves

(defun encode-san-aux (my-stream my-move)
  "Encode a non-null chess move into SAN to a stream."
  (let
    (
      (fr-sq  (move-fr-sq  my-move))
      (to-sq  (move-to-sq  my-move))
      (fr-man (move-fr-man my-move))
    )
    (cond
;;
;; Regular moves
;;
      ((is-move-regular? my-move)
        (if (is-man-pawn? fr-man)
          (when (is-move-simple-capture? my-move)
            (encode-san-file-from-square my-stream fr-sq)
            (encode-san-capture my-stream))
          (progn
            (encode-san-piece-from-man my-stream fr-man)
            (when (mf-set? my-move mf-andf) (encode-san-file-from-square my-stream fr-sq))
            (when (mf-set? my-move mf-andr) (encode-san-rank-from-square my-stream fr-sq))
            (when (is-move-simple-capture? my-move)
              (encode-san-capture my-stream))))
          (encode-san-square my-stream to-sq))
;;
;; En passant capture moves
;;
      ((is-move-en-passant? my-move)
        (encode-san-file-from-square my-stream fr-sq)
        (encode-san-capture my-stream)
        (encode-san-square my-stream to-sq))
;;
;; Castling moves
;;
      ((is-move-castling? my-move)
        (put-string my-stream (svref mc-msc-to-castling-san-vec (move-msc my-move))))
;;
;; Pawn promotion moves
;;
      ((is-move-promotion? my-move)
        (when (is-move-simple-capture? my-move)
          (encode-san-file-from-square my-stream fr-sq)
          (encode-san-capture my-stream))
        (encode-san-square my-stream to-sq)
        (encode-san-promote my-stream)
        (encode-san-piece my-stream (svref mc-msc-to-piece-vec (move-msc my-move))))
;;
;; Cond fault
;;
      (t (error "cond fault: encode-san-aux")))
;;
    (if (is-move-checkmate? my-move)
      (encode-san-checkmate my-stream)
      (when (is-move-check? my-move)
        (encode-san-check my-stream)))
    (when (is-move-illegal? my-move)
      (encode-san-broken my-stream))))

(defun encode-san (my-stream my-move)
  "Encode a chess move into SAN to a stream."
  (if (is-move-null? my-move)
    (put-string my-stream "<null>")
    (encode-san-aux my-stream my-move)))

(defun san-string (my-move)
  "Encode a move on a string."
  (let ((result nil) (stream (make-string-output-stream)))
    (encode-san stream my-move)
    (setf result (get-output-stream-string stream))
  result))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: ver.2 hash dictionary

Post by sje »

A hash dictionary in the new CIL Toolkit is implemented as a binary tree with each entry keyed by a hash code. The dictionary remembers all inserted values, and so grows over time as new entries are added. While it is allowed to overwrite existing entries, there is no provision for removing an entry. Access time is O(log N) where N is the entry count. The hashes are sufficiently random so that rebalancing is unneeded.

A toolkit hash dictionary can store any object that can have a calculated hash code: positions, moves, variations, games, etc.

The hash dictionary structure has been revised to include statistics.

Code: Select all

;;; Hash indexed dictionary: structures for unbalanced binary tree storage

(defstruct hashdict
  (count       0)    ; The count of entries
  (match-count 0)    ; Count of matches
  (probe-count 0)    ; Count of probes
  (store-count 0)    ; Count of stores
  (root        nil)) ; The root hash entry of the tree

(defstruct hashentry
  (key    nil)  ; Hash key
  (value  nil)  ; Stored value
  (link-l nil)  ; Hash entry subnode (left link)
  (link-r nil)) ; Hash entry subnode (right link)


;;; Hash indexed dictionary: probing

(defun hashdict-probe (my-hashdict my-key)
  "Return the matching hash dictionary entry, if any."
  (let ((result nil))
    (incf (hashdict-probe-count my-hashdict))
    (when (hashdict-root my-hashdict)
      (setf result (hashdict-probe-aux (hashdict-root my-hashdict) my-key))
      (when result
        (incf (hashdict-match-count my-hashdict))))
    result))

(defun hashdict-probe-aux (my-hashentry my-key)
  "Helper routine for hashdict-probe."
  (cond
    ((hash-lt? (hashentry-key my-hashentry) my-key)
      (if (hashentry-link-l my-hashentry)
        (hashdict-probe-aux (hashentry-link-l my-hashentry) my-key)))
    ((hash-gt? (hashentry-key my-hashentry) my-key)
      (if (hashentry-link-r my-hashentry)
        (hashdict-probe-aux (hashentry-link-r my-hashentry) my-key)))
    ((hash-eq? (hashentry-key my-hashentry) my-key)
      my-hashentry)
    (t (error "cond fault: hashdict-probe-aux"))))

(defun hashdict-value (my-hashdict my-key)
  "Return the matching hash dictionary entry value; else nil if not found."
  (let ((hashentry (hashdict-probe my-hashdict my-key)))
    (if hashentry
      (hashentry-value hashentry))))


;;; Hash indexed dictionary: insertion

(defun hashdict-insert (my-hashdict my-key my-value)
  "Insert/overwrite an entry in a hash dictionary."
  (incf (hashdict-store-count my-hashdict))
  (if (not (hashdict-root my-hashdict))
    (progn
      (setf
        (hashdict-root my-hashdict)
        (make-hashentry :key (clone-hash my-key) :value my-value))
      (incf (hashdict-count my-hashdict)))
    (hashdict-insert-aux my-hashdict (hashdict-root my-hashdict) my-key my-value)))

(defun hashdict-insert-aux (my-hashdict my-hashentry my-key my-value)
  "Helper routine for hashdict-insert."
  (cond
    ((hash-lt? (hashentry-key my-hashentry) my-key)
      (if (hashentry-link-l my-hashentry)
        (hashdict-insert-aux my-hashdict (hashentry-link-l my-hashentry) my-key my-value)
        (progn
          (setf
            (hashentry-link-l my-hashentry)
            (make-hashentry :key (clone-hash my-key) :value my-value))
          (incf (hashdict-count my-hashdict)))))
    ((hash-gt? (hashentry-key my-hashentry) my-key)
      (if (hashentry-link-r my-hashentry)
        (hashdict-insert-aux my-hashdict (hashentry-link-r my-hashentry) my-key my-value)
        (progn
          (setf
            (hashentry-link-r my-hashentry)
            (make-hashentry :key (clone-hash my-key) :value my-value))
          (incf (hashdict-count my-hashdict)))))
    ((hash-eq? (hashentry-key my-hashentry) my-key)
      (setf (hashentry-value my-hashentry) my-value))
    (t (error "cond fault: hashdict-insert-aux"))))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: ver.2 fixed length hash tables

Post by sje »

The new CIL Toolkit hash a fixed length hash table structure that is similar in spirit to a hash indexed transposition table in a traditional chess program. As with a toolkit's hash dictionary, a toolkit fixed length hash table can store any structure that can be associated with a hash code. Unlike a hash dictionary, a hash table has an access time is faster at O(1), its size is fixed, and its entries can be overwritten with differently keyed values.

The toolkit hash table operations have been revised to include statistics and a summary report formatter.

Code: Select all

;;; Hash indexed fixed length table: structure

(defstruct
  (hashflt
    (:print-function
      (lambda (my-hashflt my-stream my-level)
        (declare (ignore my-level))
        (encode-hashflt my-stream my-hashflt))))
  (logcount    nil)  ; The log base two count of hashed entry slots
  (count       nil)  ; Total fixed count of hashed entries
  (mask        nil)  ; Hash bit mask for calculating storage vector indices
  (match-count nil)  ; Count of matches
  (probe-count nil)  ; Count of probes
  (store-count nil)  ; Count of stores
  (usage-count nil)  ; Count of used hashed entry slots
  (stvec       nil)) ; Storage vector containing hashed entries (key/value dotted pairs)

(defun mk-hashflt (my-logcount)
  "Return a fixed length hash table."
  (make-hashflt
    :logcount my-logcount
    :count       (2^ my-logcount)
    :mask        (calc-hash-mask my-logcount)
    :match-count 0
    :probe-count 0
    :store-count 0
    :usage-count 0
    :stvec       (make-array (2^ my-logcount) :initial-element nil)))

(defun mk-hashflt-vec (my-logcount)
  "Return a vector indexed by color of fixed length hash tables."
  (let ((result (make-array color-rlimit)))
    (docolors (color)
      (setf (svref result color) (mk-hashflt my-logcount)))
    result))

(defun clear-hashflt (my-hashflt)
  "Clear the statistics and the storage vector of the given hash fixed length table."
  (setf (hashflt-match-count my-hashflt) 0)
  (setf (hashflt-probe-count my-hashflt) 0)
  (setf (hashflt-store-count my-hashflt) 0)
  (setf (hashflt-usage-count my-hashflt) 0)
  (let ((stvec (hashflt-stvec my-hashflt)))
    (dotimes (index (hashflt-count my-hashflt))
      (setf (svref stvec index) nil))))


;;; Hash indexed fixed length table: probing

(defun hashflt-probe (my-hashflt my-key)
  "Return the requested dotted pair entry, if any."
  (incf (hashflt-probe-count my-hashflt))
  (let*
    (
      (index (calc-hash-index my-key (hashflt-mask my-hashflt)))
      (pair  (svref (hashflt-stvec my-hashflt) index))
    )
    (when (and pair (hash-eq? (first pair) my-key))
      (incf (hashflt-match-count my-hashflt))
      pair)))

(defun hashflt-value (my-hashflt my-key)
  "Return the requested value, if any."
  (let ((pair (hashflt-probe my-hashflt my-key)))
    (when pair
      (cdr pair))))


;;; Hash indexed fixed length table: insertion

(defun hashflt-insert (my-hashflt my-key my-value)
  "Store the given value in the fixed length hash table."
  (incf (hashflt-store-count my-hashflt))
  (let*
    (
      (index (calc-hash-index my-key (hashflt-mask my-hashflt)))
      (pair  (svref (hashflt-stvec my-hashflt) index))
    )
  (unless pair
    (incf (hashflt-usage-count my-hashflt)))
  (setf (svref (hashflt-stvec my-hashflt) index) (cons (clone-hash my-key) my-value))))


;;; Hash indexed fixed length table: encoding

(defun encode-hashflt (my-stream my-hashflt)
  "Encode the statistics of the given fixed length hash table on a stream."
  (let*
    (
      (count       (hashflt-count       my-hashflt))
      (match-count (hashflt-match-count my-hashflt))
      (probe-count (hashflt-probe-count my-hashflt))
      (store-count (hashflt-store-count my-hashflt))
      (usage-count (hashflt-usage-count my-hashflt))
      (match-rate  (if (nonzero? probe-count) (float (/ match-count probe-count)) 0.0))
      (usage-rate  (float (/ usage-count count)))
    )
    (fmt-brack-l my-stream)
    (put-string my-stream "C:")
    (put-integer my-stream count)
    (blank my-stream)
    (put-string my-stream "P:")
    (put-integer my-stream probe-count)
    (blank my-stream)
    (put-string my-stream "M:")
    (put-integer my-stream match-count)
    (blank my-stream)
    (put-string my-stream "R:")
    (put-float my-stream match-rate)
    (blank my-stream)
    (put-string my-stream "S:")
    (put-integer my-stream store-count)
    (blank my-stream)
    (put-string my-stream "U:")
    (put-integer my-stream usage-count)
    (blank my-stream)
    (put-string my-stream "F:")
    (put-float my-stream usage-rate)
    (fmt-brack-r my-stream)))

(defun hashflt-string (my-hashflt)
  "Encode a fixed length hash table on a string."
  (let ((result nil) (stream (make-string-output-stream)))
    (encode-hashflt stream my-hashflt)
    (setf result (get-output-stream-string stream))
    (close stream)
  result))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

Re: CIL Toolkit: code snippets: ver.2 fixed length hash tabl

Post by sje »

The toolkit's emp-cwt routine enumerates movepaths (i.e.; perft) using a vector of fixed length hash tables, one per ply. Here's an example call to depth seven; notice how the tables fill up by ply:

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
Ply:0  HT:[C:262144 P:1 M:0 R:0.0 S:1 U:1 F:3.8146973E-6]
Ply:1  HT:[C:262144 P:20 M:0 R:0.0 S:20 U:20 F:7.6293945E-5]
Ply:2  HT:[C:262144 P:400 M:0 R:0.0 S:400 U:400 F:0.0015258789]
Ply:3  HT:[C:262144 P:8902 M:3510 R:0.39429343 S:5392 U:5315 F:0.020275116]
Ply:4  HT:[C:262144 P:119180 M:46328 R:0.38872293 S:72852 U:62904 F:0.23995972]
Ply:5  HT:[C:262144 P:1817156 M:657765 R:0.36197498 S:1159391 U:251029 F:0.95759964]
Ply:6  HT:[C:262144 P:28571160 M:9686608 R:0.33903447 S:18884552 U:262144 F:1.0]
Total path count for depth seven: 3195901860
Descriptive: three billion, one hundred and ninety-five million, nine hundred and one thousand, eight hundred and sixty
F/P: 608.86426 KHz / 1.6424023 usec
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: search termination status

Post by sje »

It's handy to be able to mark the search termination status with a meaningful indicator. Like Symbolic, the new CIL Toolkit has several possible search termination indicators including the necessary "unterminated" value.

As the toolkit and programs using the toolkit may have vastly different kinds of searches, new entries can be easily added. Of course, not every search may use the full set.

Code: Select all

;;; Search termination status

(defconstant sts-all-bad-but-1 (enum-init) "All moves but one are bad")
(defconstant sts-all-certain   (enum-next) "All moves have certain scores")
(defconstant sts-book-move     (enum-next) "Book move located")
(defconstant sts-certain-lose  (enum-next) "Certain lose located")
(defconstant sts-certain-mate  (enum-next) "Certain mate located")
(defconstant sts-interrupt     (enum-next) "Interrupted")
(defconstant sts-maximum-depth (enum-next) "Maximum depth limit")
(defconstant sts-no-moves      (enum-next) "No moves available")
(defconstant sts-param-fault   (enum-next) "Parameter fault")
(defconstant sts-program-error (enum-next) "Program error detected")
(defconstant sts-random-move   (enum-next) "Random move selected")
(defconstant sts-re-nodes      (enum-next) "Resource exhaustion: nodes")
(defconstant sts-re-plies      (enum-next) "Resource exhaustion: plies")
(defconstant sts-re-time       (enum-next) "Resource exhaustion: time")
(defconstant sts-single-move   (enum-next) "Only one move available")
(defconstant sts-unterminated  (enum-next) "Search is still active")

(defconstant sts-limit (enum-limit))

(defconstant as-sts-vec
  (make-array sts-limit
    :initial-contents
      (vector
        "All moves but one are bad"
        "All moves have certain scores"
        "Book move located"
        "Certain lose located"
        "Certain mate located"
        "Interrupted"
        "Maximum depth limit"
        "No moves available"
        "Parameter fault"
        "Program error detected"
        "Random move selected"
        "Resource exhaustion: nodes"
        "Resource exhaustion: plies"
        "Resource exhaustion: time"
        "Only one move available"
        "Search is still active")))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: search limit control

Post by sje »

A search can be limited in extent by providing limits at the start of the search that are checked as needed during the search.

Copying from Symbolic, the new CIL Toolkit has an SLC (Search Limit Control) structure to represent search limits. It currently has three components: a ply limit (can be used as an iteration limit), a node count limit, and a time limit (measured in milliseconds). If all of these are nil, then the search is not limited by the SLC. If only one is non nil, then the non nil component limits the search. If more than one component is non nil, then each non nil component value is checked and the search will terminate if any values are exceeded.

More components can be added: a plan limit, an overall quiescence threshold, etc. But the three initial components are enough to get started.

Code: Select all

;;; SLC: Search Limit Control structure

(defstruct
  (slc
    (:print-function
      (lambda (my-slc my-stream my-level)
        (declare (ignore my-level))
        (encode-slc my-stream my-slc))))
  (msec-limit nil)  ; Time limit as a number of milliseconds
  (node-limit nil)  ; Node limit as a number of nodes
  (sply-limit nil)) ; Search ply limit as a number giving maximum depth in ply

(defun mk-slc ()
  "Return a new SLC with reasonable default initial values."
  (make-slc
    :msec-limit 5000  ; Set time limit check to five seconds
    :node-limit nil   ; Mark node limit check inactive
    :sply-limit nil)) ; Mark search ply limit check inactive


;;; SLC encoding

(defun encode-slc (my-stream my-slc)
  "Encode the given SLC on the given stream."
  (fmt-brack-l my-stream)
  (put-string my-stream "NL:")
  (if (slc-node-limit my-slc)
    (put-integer my-stream (slc-node-limit my-slc))
    (put-nil my-stream))
  (blank my-stream)
  (put-string my-stream "PL:")
  (if (slc-sply-limit my-slc)
    (put-integer my-stream (slc-sply-limit my-slc))
    (put-nil my-stream))
  (blank my-stream)
  (put-string my-stream "TL:")
  (if (slc-msec-limit my-slc)
    (put-float my-stream (/ (slc-msec-limit my-slc) 1000.0))
    (put-nil my-stream))
  (fmt-brack-r my-stream))

(defun slc-string (my-slc)
  "Encode a SLC on a string."
  (let ((result nil) (stream (make-string-output-stream)))
    (encode-slc stream my-slc)
    (setf result (get-output-stream-string stream))
    (close stream)
  result))
The default SLC:

Code: Select all

> (mk-slc)
[NL:nil PL:nil TL:5.0]
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: search trace flags

Post by sje »

Who wants to wait for a search to complete before seeing any output? Certainly none of us instant gratification types. So a search needs to be traced and a variety of trace options should be available. Here's the starter set of trace flags for the new CIL Toolkit:

Code: Select all

;;; Search trace flags

(defconstant tf-cv (enum-init) "Trace current variation")
(defconstant tf-it (enum-next) "Trace iteration operations")
(defconstant tf-pv (enum-next) "Trace predicted variation")
(defconstant tf-pz (enum-next) "Trace ply zero operations")
(defconstant tf-tt (enum-next) "Trace transposition table summary")

(defconstant tf-limit (enum-limit))

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

(defun valid-tf? (my-tf) (valid-ev? my-tf tf-limit))

(defmacro dotfs ((my-tf-var) &body my-body)
  "Construct a per trace flag iteration loop."
  `(dotimes (,my-tf-var tf-limit) ,@my-body))

(defconstant as-tf-vec
  (make-array tf-limit
    :initial-contents
      (vector "cv" "it" "pv" "pz" "tt")))


;;; Search trace flag bits

(defconstant tfbit-cv (2^ tf-cv))
(defconstant tfbit-it (2^ tf-it))
(defconstant tfbit-pv (2^ tf-pv))
(defconstant tfbit-pz (2^ tf-pz))
(defconstant tfbit-tt (2^ tf-tt))

(defun encode-tfbits (my-stream my-tfbits)
  "Encode set of trace flag bits on a stream with brackets."
  (let ((needspace nil))
    (fmt-brack-l my-stream)
    (dotfs (tf)
      (when (bit? tf my-tfbits)
        (when needspace
          (blank my-stream))
        (put-string my-stream (svref as-tf-vec tf))
        (setf needspace t)))
    (fmt-brack-r my-stream)))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: move popularity history

Post by sje »

Simple stuff used to help implement the move popularity history heuristic:

Code: Select all

;;; Popularity cap

(defconstant popularity-limit (2^ 20))


;;; Move popularity history

(defun mk-history ()
  "Return a vector suitable for a color's move popularity history."
  (make-array fsts-limit :initial-element 0))

(defun reset-history (my-history)
  "Reset a history."
  (dotimes (index fsts-limit)
    (setf (svref my-history index) 0)))


;;; Move popularity history vector indexed by color

(defun mk-history-vec ()
  "Return a vector indexed by color for move popularity histories."
  (let ((result (make-array color-rlimit)))
    (docolors (color)
      (setf (svref result color) (mk-history)))
    result))

(defun reset-history-vec (my-history-vec)
  "Reset the histories of both colors in a history vector."
  (docolors (color)
    (reset-history (svref my-history-vec color))))

(defun reduce-history-vec (my-history-vec)
  "Divide each history popularity value by two."
  (docolors (color)
    (let ((history (svref my-history-vec color)))
      (dotimes (index fsts-limit)
        (setf (svref history index) (2/ (svref history index)))))))

(defun increment-history-popularity (my-move my-history-vec)
  "Increment the popularity of a move in a history vector."
  (let*
    (
      (index   (calc-fsts-index my-move))
      (color   (calc-mover-color my-move))
      (history (svref my-history-vec color))
    )
    (incf (svref history index))
    (when (= (svref history index) popularity-limit)
      (reduce-history-vec my-history-vec))))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

Re: CIL Toolkit: code snippets: move preliminary scoring

Post by sje »

Here's a simple, fast, and occasionally useful routine used to generate preliminary scores for move ordering:

Code: Select all

;;; Assign preliminary scores: expected gain

(defun assign-prelim-gain (my-moves my-pos)
  "Return a list of score/move pairs using expected gain."
  (let*
    (
      (result     nil)
      (act-color  (pos-act-color my-pos))
      (pas-color  (pos-pas-color my-pos))
      (act-atk-bb (svref (pos-atk-by-color-bb-vec my-pos) act-color))
      (pas-atk-bb (svref (pos-atk-by-color-bb-vec my-pos) pas-color))
    )
    (dolist (move my-moves)
      (let*
        (
          (score     0)
          (fr-sq     (move-fr-sq move))
          (to-sq     (move-to-sq move))
          (fr-score  (svref mc-man-to-score-vec (move-fr-man move)))
          (to-score  (svref mc-man-to-score-vec (move-to-man move)))
          (msc-score (svref mc-msc-to-score-vec (move-msc    move)))
        )
        (incf score (+ to-score msc-score))
        (when (sq-set? pas-atk-bb to-sq)
          (decf score (2/ fr-score)))
        (when (sq-set? pas-atk-bb fr-sq)
          (incf score (2/ fr-score)))
        (when (sq-set? act-atk-bb fr-sq)
          (decf score (2/ (2/ fr-score))))
        (push (cons score move) result)))
    result))

(defun reorder-best-sm-pair (my-pairs)
  "Move the best preliminary score/move pair to the front of a list; return updated list."
  (let ((cand-pair nil) (best-score nil))
    (dolist (pair my-pairs)
      (when (or (not best-score) (> (car pair) best-score))
        (setf best-score (car pair))
        (setf cand-pair pair)))
    (when cand-pair
      (setf my-pairs (cons cand-pair (delete cand-pair my-pairs :test #'eq :count 1)))))
  my-pairs)