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

CIL Toolkit: code snippets: tracks and phases

Post by sje »

For the sample traditional A/B search, the new CIL toolkit organized node processing in terms of tracks and phases.

(Note: this material is at a very early stage of development.)

There are currently four tracks: base, evad, full, and gain. When a node is entered for the first time, one of the available tracks is chosen to direct the move generation and move ordering at that node.

Each track has a fixed sequence of processing phases. At a node, the phases are processed one at a time in order. It's like the track is a simple program and the phases are steps in that program.

Phases:

Code: Select all

;;; Depth first ply processing phases

(defconstant phase-exit        (enum-init) "No remaining moves; exit selection")
(defconstant phase-aps-history (enum-next) "Assign preliminary scores: history")
(defconstant phase-aps-gain    (enum-next) "Assign preliminary scores: expected gain")
(defconstant phase-gen-all     (enum-next) "Generate and post all moves")
(defconstant phase-gen-canon   (enum-next) "Generate and post all moves canonical")
(defconstant phase-gen-checks  (enum-next) "Generate and post checking moves")
(defconstant phase-gen-evasion (enum-next) "Generate and post evasion moves")
(defconstant phase-gen-gainers (enum-next) "Generate and post gainer moves")
(defconstant phase-gen-holders (enum-next) "Generate and post holder moves")
(defconstant phase-pick-best   (enum-next) "Pick the best move on the candidate list")
(defconstant phase-pick-first  (enum-next) "Pick the first move on the candidate list")
(defconstant phase-try-killer0 (enum-next) "Try killer 0 move")
(defconstant phase-try-killer1 (enum-next) "Try killer 1 move")
(defconstant phase-try-pv      (enum-next) "Try predicted variation move")
(defconstant phase-try-trans   (enum-next) "Try transposition table move")

(defconstant phase-limit (enum-limit))

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

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

(defmacro dophases ((my-phase-var) &body my-body)
  "Construct a per phase iteration loop."
  `(dotimes (,my-phase-var phase-limit) ,@my-body))

(defconstant as-phase-vec
  (make-array phase-limit
    :initial-contents
      (vector
        "exit"
        "aps-gain"
        "aps-history"
        "gen-all"
        "gen-canon"
        "gen-checks"
        "gen-evasion"
        "gen-gainers"
        "gen-holders"
        "pick-best"
        "pick-first"
        "try-killer0"
        "try-killer1"
        "try-pv"
        "try-trans")))
Tracks:

Code: Select all

;;; Depth first ply processing phase tracks

(defconstant track-base (enum-init) "Track at ply zero")
(defconstant track-evad (enum-next) "Track at check evasion search plies")
(defconstant track-full (enum-next) "Track at full scan search plies other than ply zero")
(defconstant track-gain (enum-next) "Track at capture search plies")

(defconstant track-limit (enum-limit))

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

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

(defmacro dotracks ((my-track-var) &body my-body)
  "Construct a per track iteration loop."
  `(dotimes (,my-track-var track-limit) ,@my-body))

(defconstant as-track-vec
  (make-array track-limit :initial-contents (vector "base" "evad" "full" "gain")))

(defconstant track-map-vec
  (make-array track-limit
    :initial-contents
      (vector
        (list                ; Base track
          phase-gen-canon
          phase-aps-gain
          phase-pick-best
          phase-exit)
        (list                ; Evad track
          phase-gen-evasion
          phase-aps-gain
          phase-pick-best
          phase-exit)
        (list                ; Full track
          phase-gen-all
          phase-aps-gain
          phase-pick-best
          phase-exit)
        (list                ; Gain track
          phase-gen-gainers
          phase-aps-gain
          phase-pick-best
          phase-exit))))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: the PIR (Ply Indexed Record)

Post by sje »

For a depth first traditional A/B search, the status of the move generation, move ordering. and other certain items has to be retained at each ply. There are several ways of handling this: local variables in a recursive node processing routine, a global variable indexed by ply, or a parameter passed from node to node that contains a vector of structures with each structure holding the current data for that ply.

In the new CIL Toolkit, the first two methods are discarded in favor of the parameter approach. The structure containing the ply data is called a PIR (Ply Indexed Record), and the values or all the current PIRs are organized into a vector that in turn is a component in a structure passed from node processor to node processor recursively.

Here's the PIR structure and a few routines:

Code: Select all

;;; PIR (Ply Indexed Record) structure

(defstruct
  (pir
    (:print-function
      (lambda (my-pir my-stream my-level)
        (declare (ignore my-level))
        (encode-pir my-stream my-pir))))
  (ply          nil)  ; Ply of this record, set once
  (phase        nil)  ; Current phase
  (phase-queue  nil)  ; Untried phases
  (cand-pairs   nil)  ; List of untried score/move dotted pairs
  (gen-moves    nil)  ; Result of last generaton operation
  (tt-move      nil)  ; Transposition table move
  (tt-score     nil)  ; Transposition table score
  (tt-tebits    nil)  ; Transposition table entry bits
  (killer0-move nil)  ; Most popular killer move
  (killer1-move nil)  ; Second most popular killer move
  (tried-moves  nil)  ; List of moves already tried
  (tried-fr-bb  nil)  ; Tried moves bitboard: from squares
  (tried-to-bb  nil)) ; Tried moves bitboard: to squares

(defun mk-pir (my-ply)
  "Return a new PIR with default values; done only during PSE construction."
  (make-pir
    :ply          my-ply
    :phase        nil
    :phase-queue  nil
    :cand-pairs   nil
    :gen-moves    nil
    :tt-move      nil
    :tt-score     nil
    :tt-tebits    0
    :killer0-move nil
    :killer1-move nil
    :tried-moves  nil
    :tried-fr-bb  (mk-bb)
    :tried-to-bb  (mk-bb)))

(defun prepare-pir (my-track my-pir)
  "Prepare a PIR for the start of operations at a new node."
  (setf (pir-phase       my-pir) (first (svref track-map-vec my-track)))
  (setf (pir-phase-queue my-pir) (rest  (svref track-map-vec my-track)))
  (setf (pir-cand-pairs  my-pir) nil)
  (setf (pir-gen-moves   my-pir) nil)
  (setf (pir-tt-move     my-pir) nil)
  (setf (pir-tt-score    my-pir) nil)
  (setf (pir-tt-tebits   my-pir) 0)
  (setf (pir-tried-moves my-pir) nil)
  (reset-bb (pir-tried-fr-bb my-pir))
  (reset-bb (pir-tried-to-bb my-pir)))

(defun encode-pir (my-stream my-pir)
  "Encode a PIR on a stream."
  (fmt-brack-l my-stream)
  (put-string my-stream "Ply:")
  (put-integer my-stream (pir-ply my-pir))
  (fmt-brack-r my-stream))

(defun mk-pir-vec (my-ply-limit)
  "Return a new PIR vector with the indicated length; done once per PSE construction."
  (let ((result (make-array my-ply-limit)))
    (dotimes (index my-ply-limit)
      (setf (svref result index) (mk-pir index)))
    result))

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

CIL Toolkit: code snippets: persistent search environment

Post by sje »

The PSE (Persistent Search Environment) structure is used to pass information from routine to routine during a search. It bundles together all of the information needed to handle a depth first search and so there is no need for any global variables. Naturally, it is thread safe as well.

Code: Select all

;;; PSE: Persistent Search Environment structure

(defstruct
  (pse
    (:print-function
      (lambda (my-pse my-stream my-level)
        (declare (ignore my-level))
        (encode-pse my-stream my-pse))))
  (base-pos    nil)  ; A clone of the base position at the start of the search
  (pv          nil)  ; Prior established predicted variation for this position
  (slc         nil)  ; The SLC (search limit control)
  (sts         nil)  ; Search termination status
  (tfbits      nil)  ; Trace flag bits
  (pir-vec     nil)  ; Ply Indexed Record vector
  (history-vec nil)  ; Move history popularity vector indexed by color
  (tt-eval-vec nil)  ; Transposition table vector indexed by color for positonal evaluations
  (tt-hint-vec nil)  ; Transposition table vector indexed by color for hint moves
  (tt-main-vec nil)  ; Transposition table vector indexed by color for score/move results
  (tt-pawn     nil)  ; Transposition table for pawn stucture evaluations
  (tt-tbas-vec nil)) ; Transposition table vector indexed by color for tablebase scores

(defun mk-pse ()
  "Return a new PSE with reasonable default initial values."
  (make-pse
    :base-pos    (create-initial-array-pos)
    :pv          nil
    :slc         (mk-slc)
    :sts         sts-unterminated
    :tfbits      tfbits-default
    :pir-vec     (mk-pir-vec max-ply-limit)
    :history-vec (mk-history-vec)
    :tt-eval-vec (mk-hashflt-vec 14)
    :tt-hint-vec (mk-hashflt-vec  8)
    :tt-main-vec (mk-hashflt-vec 16)
    :tt-pawn     (mk-hashflt     12)
    :tt-tbas-vec (mk-hashflt-vec 10)))


;;; PSE encoding

(defun encode-pse (my-stream my-pse)
  "Encode the given PSE on the given stream."
  (fmt-brack-l my-stream)
  (put-string my-stream "SLC:")
  (encode-slc my-stream (pse-slc my-pse))
  (blank my-stream)
  (put-string my-stream "STS:")
  (put-string my-stream (svref as-sts-vec (pse-sts my-pse)))
  (blank my-stream)
  (put-string my-stream "TF:")
  (encode-tfbits my-stream (pse-tfbits my-pse))
  (fmt-brack-r my-stream))

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

CIL Toolkit: code snippets: the next-move routine

Post by sje »

At a node in a depth first search. the program has to have a supplier of moves and these moves should be presented in a reasonable order.

(Note: this material is at a very early stage of development.)

In the new CIL Toolkit, this function is handled by the next-move routine:

Code: Select all

;;; Select the next move to be tried

(defun next-move (my-pse my-ply my-pos)
  "Supply the next move to be searched."
  (let*
    (
      (result  nil)
      (pir-vec (pse-pir-vec my-pse))
      (pir     (svref pir-vec my-ply))
    )
    (dowhile (and (not result) (/= (pir-phase pir) phase-exit))
      (cond
;;
        ((= (pir-phase pir) phase-aps-gain)
          (setf (pir-cand-pairs pir) (assign-prelim-gain (pir-gen-moves pir) my-pos))
          (setf (pir-gen-moves pir) nil)
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-aps-history)
          ; TBD
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-gen-all)
          (setf (pir-gen-moves pir) (generate my-pos))
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-gen-canon)
          (setf (pir-gen-moves pir) (generate-canon my-pos))
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-gen-checks)
          (setf (pir-gen-moves pir) (generate-checks my-pos))
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-gen-evasion)
          (setf (pir-gen-moves pir) (generate-evasion my-pos))
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-gen-gainers)
          (setf (pir-gen-moves pir) (generate-gainers my-pos))
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-gen-holders)
          (setf (pir-gen-moves pir) (generate-holders my-pos))
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-pick-best)
          (if (pir-cand-pairs pir)
            (progn
              (setf (pir-cand-pairs pir) (reorder-best-sm-pair (pir-cand-pairs pir)))
              (setf result (cdr (pop (pir-cand-pairs pir)))))
            (setf (pir-phase pir) (pop (pir-phase-queue pir)))))
;;
        ((= (pir-phase pir) phase-pick-first)
          (if (pir-cand-pairs pir)
            (setf result (cdr (pop (pir-cand-pairs pir))))
            (setf (pir-phase pir) (pop (pir-phase-queue pir)))))
;;
        ((= (pir-phase pir) phase-try-killer0)
          ; TBD
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-try-killer1)
          ; TBD
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-try-pv)
          ; TBD
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        ((= (pir-phase pir) phase-try-trans)
          ; TBD
          (setf (pir-phase pir) (pop (pir-phase-queue pir))))
;;
        (t (error "cond fault: next-move")))
;;
;; Ensure the proposed result move hasn't been tried already; if new, update try data
;;
      (when result
        (let*
          (
            (fr-sq (move-fr-sq result))
            (to-sq (move-to-sq result))
            (fr-bb (pir-tried-fr-bb pir))
            (to-bb (pir-tried-to-bb pir))
            (fr-bf (sq-set? fr-bb fr-sq))
            (to-bf (sq-set? to-bb to-sq))
            (tried (and to-bf fr-bf (find-move result (pir-tried-moves pir))))
          )
          (if tried
            (setf result nil)
            (progn
              (unless fr-bf (set-sq fr-bb fr-sq))
              (unless to-bf (set-sq to-bb to-sq))
              (push result (pir-tried-moves pir)))))))
    result))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: time routines

Post by sje »

Here is the early version of the time routines of the new CIL Toolkit. These form the basis for later related development of routines for chess clock realization and time allocation.

Code: Select all

;;; Time mark structure

(defstruct
  (timemark
    (:print-function
      (lambda (my-timemark my-stream my-level)
        (declare (ignore my-level))
        (encode-timemark my-stream my-timemark))))
    (year   nil)  ; Year                  [0-9999]
    (month  nil)  ; Month number          [1-12]
    (date   nil)  ; Day of month number   [1-31]
    (hour   nil)  ; Hour of day           [0-23]
    (minute nil)  ; Minute of hour        [0-59]
    (second nil)  ; Second of minute      [0-59]
    (msec   nil)) ; Millisecond of second [0-999]


;;; Time mark routines

(defun calc-timemark-from-tm-list (my-tm-list)
  "Return a new time mark calculated from a time mark list."
  (make-timemark
    :year   (sixth  my-tm-list)
    :month  (fifth  my-tm-list)
    :date   (fourth my-tm-list)
    :hour   (third  my-tm-list)
    :minute (second my-tm-list)
    :second (first  my-tm-list)
    :msec   0))

(defun calc-current-utc-timemark ()
  "Return a time mark with the current UTC time."
  (calc-timemark-from-tm-list
    (multiple-value-list (decode-universal-time (get-universal-time) 0))))

(defun calc-current-ltz-timemark ()
  "Return a time mark with the current local time zone time."
  (calc-timemark-from-tm-list
    (multiple-value-list (get-decoded-time))))


;;; Time mark encoding

(defun encode-timemark-date (my-stream my-timemark)
  "Encode the date of a timemark on the given stream."
  (format my-stream "~4,'0D" (timemark-year  my-timemark))
  (fmt-period my-stream)
  (format my-stream "~2,'0D" (timemark-month my-timemark))
  (fmt-period my-stream)
  (format my-stream "~2,'0D" (timemark-date  my-timemark))
  (values))

(defun encode-timemark-time (my-stream my-timemark)
  "Encode the time of a timemark on the given stream."
  (format my-stream "~2,'0D" (timemark-hour   my-timemark))
  (fmt-colon my-stream)
  (format my-stream "~2,'0D" (timemark-minute my-timemark))
  (fmt-colon my-stream)
  (format my-stream "~2,'0D" (timemark-second my-timemark))
  (values))

(defun encode-timemark (my-stream my-timemark)
  "Encode the date and time of a timemark on the given stream."
  (encode-timemark-date my-stream my-timemark)
  (blank my-stream)
  (encode-timemark-time my-stream my-timemark)
  (values))


;;; Timing

(defun calc-time-delta (my-ituc0 my-ituc1)
  "Return the time difference in float seconds between the first and second times."
  (float (/ (- my-ituc1 my-ituc0) internal-time-units-per-second)))

(defun calc-frequency (my-count my-seconds)
  "Return a frequency."
  (when (zero? my-seconds)
    (error "calc-frequency: zero seconds"))
  (float (/ my-count my-seconds)))

(defun calc-period (my-count my-seconds)
  "Return a period."
  (when (zero? my-count)
    (error "calc-period: zero count"))
  (float (/ my-seconds my-count)))


;;; Frequency and period

(defun encode-frequency (my-stream my-frequency)
  "Encode a frequency."
  (encode-si-value my-stream my-frequency "Hz")
  (values))

(defun encode-period (my-stream my-period)
  "Encode a period."
  (encode-si-value my-stream my-period "sec")
  (values))

(defun encode-fp (my-stream my-count my-seconds)
  "Encode a frequnecy/period string on a stream."
  (put-string my-stream "F/P: ")
  (encode-frequency my-stream (calc-frequency my-count my-seconds))
  (put-string my-stream " / ")
  (encode-period my-stream (calc-period my-count my-seconds))
  (values))
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 7:43 pm

CIL Toolkit: code snippets: the clock face object type

Post by sje »

A clock face object is used for representing the calculated components (days, hours, minutes, seconds, and milliseconds) of a timer value. It is not the same as a time mark; a time mark is used to represent a point in calendar time. A timer value is a value, expressed in milliseconds, of a simple count-down or count-up timer.

Does this sound confusing? Well, the nomenclature is a little mixed up because what we call a chess clock is not a clock at all, but rather a pair of count-down timers. So we have to define a clock face (really, a timer face) to help see in ASCII text the value of a timer. Then we can define a timer object, and after that we can eventually get around to defining a typical chess clock.

The clock face in the new CIL Toolkit:

Code: Select all

;;; Clock face structure

(defstruct
  (clockface
    (:print-function
      (lambda (my-clockface my-stream my-level)
        (declare (ignore my-level))
        (encode-clockface my-stream my-clockface))))
    (days    nil)  ; Day count             [0-999]
    (hours   nil)  ; Hour of day           [0-23]
    (minutes nil)  ; Minute of hour        [0-59]
    (seconds nil)  ; Second of minute      [0-59]
    (msecs   nil)) ; Millisecond of second [0-999]

(defun mk-clockface ()
  "Return a zeroed clock face."
  (make-clockface
    :days    0
    :hours   0
    :minutes 0
    :seconds 0
    :msecs   0))

(defun calc-clockface (my-msec)
  "Return a new clock face initialized with the given millisecond count."
  (let ((result (make-clockface)) (residue my-msec))
    (setf (clockface-days result) (truncate (/ residue 86400000)))
    (decf residue (* 86400000 (clockface-days result)))
    (setf (clockface-hours result) (truncate (/ residue 3600000)))
    (decf residue (* 3600000 (clockface-hours result)))
    (setf (clockface-minutes result) (truncate (/ residue 60000)))
    (decf residue (* 60000 (clockface-minutes result)))
    (setf (clockface-seconds result) (truncate (/ residue 1000)))
    (decf residue (* 1000 (clockface-seconds result)))
    (setf (clockface-msecs result) residue)
    result))


;;; Clock face encoding "DDD:HH:MM:SS.mmm"

(defun encode-clockface (my-stream my-clockface)
  "Encode a clock face on the given stream."
  (format my-stream "~3,'0D" (clockface-days    my-clockface))
  (fmt-colon my-stream)
  (format my-stream "~2,'0D" (clockface-hours   my-clockface))
  (fmt-colon my-stream)
  (format my-stream "~2,'0D" (clockface-minutes my-clockface))
  (fmt-colon my-stream)
  (format my-stream "~2,'0D" (clockface-seconds my-clockface))
  (fmt-period my-stream)
  (format my-stream "~3,'0D" (clockface-msecs   my-clockface))
  (values))

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

CIL Toolkit: code snippets: the simple timer object

Post by sje »

Now that we've got a clock face object to show the value of a timer, we have to come up with a simple timer class.

Simple timers come in two flavors: ones that count up, and ones that count down. A simple timer can be either activated or deactivated. To accurately reflect the operation of a real physical timer, a simple timer must be updated prior to any reference including when the timer's value is output to a stream.

A simple timer only understands about milliseconds; a clock face object is needed to split the measured time into easily readable components.

First, a few helper routines:

Code: Select all

;;; System implementation time unit conversion

(defun calc-msec-from-situ (my-situ)
  "Convert to milliseconds from system implementation time units."
  (* 1000 (/ my-situ internal-time-units-per-second)))

(defun calc-situ-from-msec (my-msec)
  "Convert to system implementation time units from milliseconds."
  (* internal-time-units-per-second (/ my-msec 1000)))


;;; Current base milliseconds from the current real system implementation time unit counter

(defun calc-cb-msec ()
  "Return an integer representing the current base milliseconds count."
  (values (truncate (calc-msec-from-situ (get-internal-real-time)))))
And now the simple timer:

Code: Select all

;;; Simple timer

(defstruct
  (simpletimer
    (:print-function
      (lambda (my-simpletimer my-stream my-level)
        (declare (ignore my-level))
        (encode-simpletimer my-stream my-simpletimer))))
  (up-flag      nil)  ; Count up flag
  (cr-flag      nil)  ; Currently running flag
  (current-msec nil)  ; Current value in milliseconds
  (updated-msec nil)) ; Time of last update in milliseconds (system implementation baseline)

(defun mk-count-up-simpletimer (my-msec)
  "Return a new count-up simple timer."
  (make-simpletimer
    :up-flag      t
    :cr-flag      nil
    :current-msec my-msec
    :updated-msec (calc-cb-msec)))

(defun mk-count-down-simpletimer (my-msec)
  "Return a new count-down simple timer."
  (make-simpletimer
    :up-flag      nil
    :cr-flag      nil
    :current-msec my-msec
    :updated-msec (calc-cb-msec)))


;;; Updating a simple timer

(defun update-simpletimer (my-simpletimer)
  "Update a simple timer."
  (let ((new-cb-msec (calc-cb-msec)) (old-cb-msec (simpletimer-updated-msec my-simpletimer)))
    (setf (simpletimer-updated-msec my-simpletimer) new-cb-msec)
    (when (simpletimer-cr-flag my-simpletimer)
      (let ((delta-msec (- new-cb-msec old-cb-msec)))
        (if (simpletimer-up-flag my-simpletimer)
          (incf (simpletimer-current-msec my-simpletimer) delta-msec)
          (if (>= (simpletimer-current-msec my-simpletimer) delta-msec)
            (decf (simpletimer-current-msec my-simpletimer) delta-msec)
            (setf (simpletimer-current-msec my-simpletimer) 0))))))
  my-simpletimer)


;;; Simple timer activation/deactivation

(defun activate-simpletimer (my-simpletimer)
  "Turn on the given simple timer."
  (update-simpletimer my-simpletimer)
  (setf (simpletimer-cr-flag my-simpletimer) t)
  my-simpletimer)

(defun deactivate-simpletimer (my-simpletimer)
  "Turn off the given simple timer."
  (update-simpletimer my-simpletimer)
  (setf (simpletimer-cr-flag my-simpletimer) nil)
  my-simpletimer)


;;; Simple timer encoding

(defun encode-simpletimer (my-stream my-simpletimer)
  "Encode a simple timer on the given stream."
  (update-simpletimer my-simpletimer)
  (let ((clockface (calc-clockface (simpletimer-current-msec my-simpletimer))))
    (encode-clockface my-stream clockface))
  (values))

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

CIL Toolkit: code snippets: the chess clock object

Post by sje »

Now that we've got the timer and clock face issues resolved, we can take a look at the chess clock structure. A couple of more routines are needed for supporting take back; these will be implemented later. Otherwise, it's complete.

Code: Select all

;;; Chess clock structure

(defstruct
  (chessclock
    (:print-function
      (lambda (my-chessclock my-stream my-level)
        (declare (ignore my-level))
        (encode-chessclock my-stream my-chessclock))))
  (afc    nil)  ; The AFC (active color/full move number combination)
  (st-vec nil)) ; Array indexed by color of count-down simple timers.

(defun mk-chessclock (my-msec)
  "Return a new chessclock with its count down timers set at the given time value."
  (let ((result (make-chessclock)))
    (setf (chessclock-afc    result) (mk-afc))
    (setf (chessclock-st-vec result) (make-array color-rlimit))
    (docolors (color)
      (setf (svref (chessclock-st-vec result) color) (mk-simpletimer my-msec nil)))
    result))

(defun mk-blitz-cc ()
  "Return a five minute chess clock."
  (mk-chessclock (* 5 60 1000)))


;;; Chess clock accessors

(defun cc-act-color (my-chessclock)
  "Return the chess clock active color; timer may be stopped."
  (afc-act-color (chessclock-afc my-chessclock)))

(defun cc-fmvn (my-chessclock)
  "Return the chess clock full move number; timer may be stopped."
  (afc-fmvn (chessclock-afc my-chessclock)))


;;; Chess clock predicates

(defun is-cc-running? (my-chessclock)
  "Return t if the given chess clock is running."
  (or
    (is-st-running? (svref (chessclock-st-vec my-chessclock) color-white))
    (is-st-running? (svref (chessclock-st-vec my-chessclock) color-black))))

(defun is-cc-stopped? (my-chessclock)
  "Return t if the given chess clock is stopped."
  (and
    (is-st-stopped? (svref (chessclock-st-vec my-chessclock) color-white))
    (is-st-stopped? (svref (chessclock-st-vec my-chessclock) color-black))))

(defun is-cc-flagged? (my-chessclock)
  "Return t if the given chess clock has a flag drop."
  (update-chessclock my-chessclock)
  (or
    (is-st-zero? (svref (chessclock-st-vec my-chessclock) color-white))
    (is-st-zero? (svref (chessclock-st-vec my-chessclock) color-black))))


;;; Chess clock actions

(defun start-chessclock (my-chessclock)
  "Start the given chess clock."
  (update-chessclock my-chessclock)
  (when (is-cc-stopped? my-chessclock)
    (activate-simpletimer
      (svref (chessclock-st-vec my-chessclock) (cc-act-color my-chessclock))))
  my-chessclock)

(defun stop-chessclock (my-chessclock)
  "Stop the given chess clock."
  (update-chessclock my-chessclock)
  (when (is-cc-running? my-chessclock)
    (deactivate-simpletimer
      (svref (chessclock-st-vec my-chessclock) (cc-act-color my-chessclock))))
  my-chessclock)

(defun play-chessclock (my-chessclock)
  "Update the chess clock status after playing a move."
  (stop-chessclock my-chessclock)
  (incf-afc (chessclock-afc my-chessclock))
  (start-chessclock my-chessclock))


;;; Chess clock updating

(defun update-chessclock (my-chessclock)
  "Update the timers in the given chess clock."
  (docolors (color)
    (update-simpletimer (svref (chessclock-st-vec my-chessclock) color)))
  my-chessclock)


;;; Chess clock encoding "DDD:HH:MM:SS.mmm ?? DDD:HH:MM:SS.mmm"

(defun encode-chessclock (my-stream my-chessclock)
  "Encode a chess clock on the given stream."
  (let
    (
      (white-cc (svref (chessclock-st-vec my-chessclock) color-white))
      (black-cc (svref (chessclock-st-vec my-chessclock) color-black))
    )
    (encode-simpletimer my-stream white-cc)
    (cond
      ((is-st-running? white-cc) (put-string my-stream " <- "))
      ((is-st-running? black-cc) (put-string my-stream " -> "))
      (t                         (put-string my-stream " <> ")))
    (encode-simpletimer my-stream black-cc)
    (blank my-stream)
    (fmt-brack-l my-stream)
    (put-string my-stream (svref asuc-color-vec (cc-act-color my-chessclock)))
    (fmt-slash my-stream)
    (put-integer my-stream (cc-fmvn my-chessclock))
    (fmt-brack-r my-stream))
  (values))

(defun chessclock-string (my-chessclock)
  "Encode a clock face on a string."
  (let ((result nil) (stream (make-string-output-stream)))
    (encode-chessclock stream my-chessclock)
    (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 chess clock

Post by sje »

I've changed the chess clock structure to allow for correct updating after unplaying a move; the saved prior values of the timers are correctly restored as are the prior active color and full move number. All prior time values are saved on an internal stack, so it's possible to unplay the clock back to the beginning of a game.

The chess clock formatted encoding now includes fallen flag indicators along with the name of the active side and move number.

Finally, a couple of routines have been added that allow loading time, color, and move number data into an existing chess clock.

It is possible to add time control information into a chess clock including multiple period controls. This addition could also cover increment style controls. This will have to wait until more important toolkit features are implemented.

Code: Select all

;;; Chess clock structure

(defstruct
  (chessclock
    (:print-function
      (lambda (my-chessclock my-stream my-level)
        (declare (ignore my-level))
        (encode-chessclock my-stream my-chessclock))))
  (afc     nil)  ; The AFC (active color/full move number combination)
  (p-stack nil)  ; Pushdown stack of white/black millisecond dotted pairs
  (st-vec  nil)) ; Array indexed by color of count-down simple timers

(defun mk-chessclock (my-msec)
  "Return a new chessclock with its count down timers set at the given time value."
  (let ((result (make-chessclock)))
    (setf (chessclock-afc     result) (mk-afc))
    (setf (chessclock-p-stack result) nil)
    (setf (chessclock-st-vec  result) (make-array color-rlimit))
    (docolors (color)
      (setf (svref (chessclock-st-vec result) color) (mk-simpletimer my-msec nil)))
    result))

(defun mk-lightning-cc ()
  "Return a one minute chess clock."
  (mk-chessclock (* 1 60 1000)))

(defun mk-blitz-cc ()
  "Return a five minute chess clock."
  (mk-chessclock (* 5 60 1000)))

(defun mk-lunch-hour-cc ()
  "Return a lunch hour chess clock."
  (mk-chessclock (* 30 60 1000)))


;;; Chess clock accessors

(defun cc-act-color (my-chessclock)
  "Return the chess clock active color; timer may be stopped."
  (afc-act-color (chessclock-afc my-chessclock)))

(defun cc-fmvn (my-chessclock)
  "Return the chess clock full move number; timer may be stopped."
  (afc-fmvn (chessclock-afc my-chessclock)))

(defmacro cc-st-color (my-color my-chessclock)
  `(svref (chessclock-st-vec ,my-chessclock) ,my-color))

(defmacro cc-st-white (my-chessclock) `(cc-st-color color-white ,my-chessclock))
(defmacro cc-st-black (my-chessclock) `(cc-st-color color-black ,my-chessclock))


;;; Chess clock predicates

(defun is-cc-running? (my-chessclock)
  "Return t if the given chess clock is running."
  (or
    (is-st-running? (cc-st-white my-chessclock))
    (is-st-running? (cc-st-black my-chessclock))))

(defun is-cc-stopped? (my-chessclock)
  "Return t if the given chess clock is stopped."
  (and
    (is-st-stopped? (cc-st-white my-chessclock))
    (is-st-stopped? (cc-st-black my-chessclock))))

(defun is-cc-color-flagged? (my-color my-chessclock)
  "Return t if the given chess clock has a flag drop for the indicated color."
  (update-chessclock my-chessclock)
  (is-st-zero? (cc-st-color my-color my-chessclock)))

(defun is-cc-flagged? (my-chessclock)
  "Return t if the given chess clock has a flag drop."
  (or
    (is-cc-color-flagged? color-white my-chessclock)
    (is-cc-color-flagged? color-black my-chessclock)))


;;; Chess clock updating

(defun update-chessclock (my-chessclock)
  "Update the timers in the given chess clock."
  (docolors (color)
    (update-simpletimer (cc-st-color color my-chessclock)))
  my-chessclock)


;;; Chess clock actions

(defun start-chessclock (my-chessclock)
  "Start the given chess clock."
  (update-chessclock my-chessclock)
  (when (is-cc-stopped? my-chessclock)
    (activate-simpletimer (cc-st-color (cc-act-color my-chessclock) my-chessclock)))
  my-chessclock)

(defun stop-chessclock (my-chessclock)
  "Stop the given chess clock."
  (update-chessclock my-chessclock)
  (when (is-cc-running? my-chessclock)
    (deactivate-simpletimer (cc-st-color (cc-act-color my-chessclock) my-chessclock)))
  my-chessclock)

(defun play-chessclock (my-chessclock)
  "Update the chess clock status after playing a move."
  (stop-chessclock my-chessclock)
  (push
    (cons
      (simpletimer-current-msec (cc-st-white my-chessclock))
      (simpletimer-current-msec (cc-st-black my-chessclock)))
    (chessclock-p-stack my-chessclock))
  (incf-afc (chessclock-afc my-chessclock))
  (start-chessclock my-chessclock))

(defun unplay-chessclock (my-chessclock)
  "Update the chess clock status after unplaying a move."
  (unless (chessclock-p-stack my-chessclock)
    (error "unplay-chessclock: no restoration available"))
  (stop-chessclock my-chessclock)
  (decf-afc (chessclock-afc my-chessclock))
  (let ((pair (pop (chessclock-p-stack my-chessclock))))
    (setf (simpletimer-current-msec (cc-st-white my-chessclock)) (car pair))
    (setf (simpletimer-current-msec (cc-st-black my-chessclock)) (cdr pair)))
  (start-chessclock my-chessclock))


;;; Chess clock loading

(defun load-chessclock-msec (my-white-msec my-black-msec my-chessclock)
  "Load the chessclock timers with the given millisecond values."
  (let ((stop-flag (is-cc-stopped? my-chessclock)))
    (unless stop-flag
      (stop-chessclock my-chessclock))
    (update-chessclock my-chessclock)
    (setf (simpletimer-current-msec (cc-st-white my-chessclock)) my-white-msec)
    (setf (simpletimer-current-msec (cc-st-black my-chessclock)) my-black-msec)
    (update-chessclock my-chessclock)
    (unless stop-flag
      (start-chessclock my-chessclock)))
  my-chessclock)

(defun load-chessclock-afc (my-act-color my-fmvn my-chessclock)
  "Load the chessclock AFC with the given active color and full move number."
  (let ((stop-flag (is-cc-stopped? my-chessclock)))
    (unless stop-flag
      (stop-chessclock my-chessclock))
    (update-chessclock my-chessclock)
    (setf (afc-act-color (chessclock-afc my-chessclock)) my-act-color)
    (setf (afc-fmvn      (chessclock-afc my-chessclock)) my-fmvn)
    (update-chessclock my-chessclock)
    (unless stop-flag
      (start-chessclock my-chessclock)))
  my-chessclock)


;;; Chess clock encoding "DDD:HH:MM:SS.mmm ?? DDD:HH:MM:SS.mmm"

(defun encode-chessclock (my-stream my-chessclock)
  "Encode a chess clock on the given stream."
  (let
    (
      (white-cc (cc-st-white my-chessclock))
      (black-cc (cc-st-black my-chessclock))
    )
    (encode-simpletimer my-stream white-cc)
    (cond
      ((is-st-running? white-cc) (put-string my-stream " <- "))
      ((is-st-running? black-cc) (put-string my-stream " -> "))
      (t                         (put-string my-stream " <> ")))
    (encode-simpletimer my-stream black-cc)
    (blank my-stream)
    (fmt-paren-l my-stream)
    (put-string my-stream (svref asuc-color-vec (cc-act-color my-chessclock)))
    (fmt-slash my-stream)
    (put-integer my-stream (cc-fmvn my-chessclock))
    (fmt-paren-r my-stream)
    (docolors (color)
      (when (is-cc-color-flagged? color my-chessclock)
        (blank my-stream)
        (fmt-paren-l my-stream)
        (put-string my-stream (svref asuc-color-vec color))
        (blank my-stream)
        (put-string my-stream "flagged")
        (fmt-paren-r my-stream))))
  (values))

(defun chessclock-string (my-chessclock)
  "Encode a chess clock on a string."
  (let ((result nil) (stream (make-string-output-stream)))
    (encode-chessclock stream my-chessclock)
    (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 positional scoring

Post by sje »

I've expanded the framework for positional scoring. No new factors are added to the skeletal evaluation, but the framework has been changed to more easily incorporate added terms. Also, the routines take a PSE (Persistent Search Environment) parameter in order to access transposition tables for various stored score components.

Code: Select all

;;; Pawn advancement weights

(defun initialize-pawn-advancement-vec ()
  "Provide the constant value of the pawn advancement vector."
  (let ((result (make-array (list color-rlimit sq-limit) :initial-element 0)))
    (docolors (color)
      (dosqs (sq)
        (let ((rank (map-sq-to-rank sq)) (r-delta nil))
          (if (= color color-white)
            (setf r-delta (- rank rank-2))
            (setf r-delta (- rank-7 rank)))
          (setf (aref result color sq) (* (square-numeric r-delta) 8)))))
    result))

(defconstant pawn-advancement-vec (initialize-pawn-advancement-vec))


;;; Knight mobility weights

(defun initialize-knight-mobility-vec ()
  "Provide the constant value of the knight mobility vector."
  (let ((result (make-array sq-limit :initial-element 0)))
    (dosqs (sq)
      (setf (svref result sq) (* (bb-card (svref crook-attack-bb-vec sq)) 4)))
    result))

(defconstant knight-mobility-vec (initialize-knight-mobility-vec))


;;; Positional factors scoring: pawns

(defun calc-pfs-white-pawn (my-sq my-pos)
  "Calculate the positional factors score for a white pawn."
  (declare (ignore my-pos))
  (let ((result 0))
    (incf result (aref pawn-advancement-vec color-white my-sq))
    result))

(defun calc-pfs-black-pawn (my-sq my-pos)
  "Calculate the positional factors score for a black pawn."
  (declare (ignore my-pos))
  (let ((result 0))
    (incf result (aref pawn-advancement-vec color-black my-sq))
    result))


;;; Positional factors scoring: knights

(defun calc-pfs-white-knight (my-sq my-pos)
  "Calculate the positional factors score for a white knight."
  (declare (ignore my-pos))
  (let ((result 0))
    (incf result (svref knight-mobility-vec my-sq))
    result))

(defun calc-pfs-black-knight (my-sq my-pos)
  "Calculate the positional factors score for a black knight."
  (declare (ignore my-pos))
  (let ((result 0))
    (incf result (svref knight-mobility-vec my-sq))
    result))


;;; Positional factors scoring: bishops

(defun calc-pfs-white-bishop (my-sq my-pos)
  "Calculate the positional factors score for a white bishop."
  (let ((result 0))
    (incf result (* (bb-card (svref (pos-atk-fr-sq-bb-vec my-pos) my-sq)) 3))
    result))

(defun calc-pfs-black-bishop (my-sq my-pos)
  "Calculate the positional factors score for a black bishop."
  (let ((result 0))
    (incf result (* (bb-card (svref (pos-atk-fr-sq-bb-vec my-pos) my-sq)) 3))
    result))


;;; Positional factors scoring: rooks

(defun calc-pfs-white-rook (my-sq my-pos)
  "Calculate the positional factors score for a white rook."
  (let ((result 0))
    (incf result (* (bb-card (svref (pos-atk-fr-sq-bb-vec my-pos) my-sq)) 2))
    result))

(defun calc-pfs-black-rook (my-sq my-pos)
  "Calculate the positional factors score for a black rook."
  (let ((result 0))
    (incf result (* (bb-card (svref (pos-atk-fr-sq-bb-vec my-pos) my-sq)) 2))
    result))


;;; Positional factors scoring: queens

(defun calc-pfs-white-queen (my-sq my-pos)
  "Calculate the positional factors score for a white queen."
  (let ((result 0))
    (incf result (* (bb-card (svref (pos-atk-fr-sq-bb-vec my-pos) my-sq)) 1))
    result))

(defun calc-pfs-black-queen (my-sq my-pos)
  "Calculate the positional factors score for a black queen."
  (let ((result 0))
    (incf result (* (bb-card (svref (pos-atk-fr-sq-bb-vec my-pos) my-sq)) 1))
    result))


;;; Positional factors scoring: kings

(defun calc-pfs-white-king (my-sq my-pos)
  "Calculate the positional factors score for a white king."
  (declare (ignore my-sq my-pos))
  (let ((result 0))
    result))

(defun calc-pfs-black-king (my-sq my-pos)
  "Calculate the positional factors score for a black king."
  (declare (ignore my-sq my-pos))
  (let ((result 0))
    result))


;;; Positional factors scoring by color

(defun calc-pfs-white (my-pse my-pos)
  "Return a positional factors score for white."
  (declare (ignore my-pse))
  (let ((result 0) (loc-man-bb-vec (pos-loc-man-bb-vec my-pos)))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-wp))))
      (loop-bb (bb sq) (incf result (calc-pfs-white-pawn   sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-wp))))
      (loop-bb (bb sq) (incf result (calc-pfs-white-knight sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-wn))))
      (loop-bb (bb sq) (incf result (calc-pfs-white-bishop sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-wb))))
      (loop-bb (bb sq) (incf result (calc-pfs-white-rook   sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-wr))))
      (loop-bb (bb sq) (incf result (calc-pfs-white-queen  sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-wk))))
      (loop-bb (bb sq) (incf result (calc-pfs-white-king   sq my-pos))))
    result))

(defun calc-pfs-black (my-pse my-pos)
  "Return a positional factors score for black."
  (declare (ignore my-pse))
  (let ((result 0) (loc-man-bb-vec (pos-loc-man-bb-vec my-pos)))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-bp))))
      (loop-bb (bb sq) (incf result (calc-pfs-black-pawn   sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-bp))))
      (loop-bb (bb sq) (incf result (calc-pfs-black-knight sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-bn))))
      (loop-bb (bb sq) (incf result (calc-pfs-black-bishop sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-bb))))
      (loop-bb (bb sq) (incf result (calc-pfs-black-rook   sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-br))))
      (loop-bb (bb sq) (incf result (calc-pfs-black-queen  sq my-pos))))
    (let ((bb (clone-bb (svref loc-man-bb-vec man-bk))))
      (loop-bb (bb sq) (incf result (calc-pfs-black-king   sq my-pos))))
    result))


;;; Positional factors scoring summary

(defun calc-positional-factors-score (my-pse my-pos)
  "Return a positional factors score based on the active color."
  (let
    (
      (result 0)
      (w-pfs  (calc-pfs-white my-pse my-pos))
      (b-pfs  (calc-pfs-black my-pse my-pos))
    )
    (if (= (pos-act-color my-pos) color-white)
      (progn (incf result w-pfs) (decf result b-pfs))
      (progn (incf result b-pfs) (decf result w-pfs)))
    result))


;;; Material scoring

(defun calc-material-score (my-pos)
  "Return the current raw material score based on the active color."
  (- (pos-act-material my-pos) (pos-pas-material my-pos)))


;;; Summary

(defun calc-total-score (my-pse my-pos)
  "Return a total score for the active color."
  (let ((result even-score))
    (incf result (calc-positional-factors-score my-pse my-pos))
    (incf result (calc-material-score my-pos))
    result))