Symbolic: Sample code / Transposition repository

Discussion of chess software programming and technical issues.

Moderators: bob, hgm, Harvey Williamson

Forum rules
This textbox is used to restore diagrams posted with the [d] tag before the upgrade.
Post Reply
User avatar
sje
Posts: 4675
Joined: Mon Mar 13, 2006 6:43 pm

Symbolic: Sample code / Transposition repository

Post by sje » Wed Apr 11, 2007 12:56 am

Code: Select all

;;;;; Symbolic: A cognitive chessplaying program by S. J. Edwards
;;
;; Copyright (C) 2007 by S. J. Edwards / All rights reserved.
;;
;; Distribution is prohibited except when explicitly permitted by the author.
;; There is no warranty, implied or otherwise.  Use at your own risk.


;; The transposition data repository is a pair (one per color) of binary
;; trees with one position per transposition node.  The anchors for the tree
;; pair are in the two element global vector TheSearchTransRootVec.  Each
;; transposition node is an a-list and contains the position main hash, the
;; search tree node where the position first appeared, a list of all other
;; search tree nodes that have the same position, and links to the left and
;; right transposition subtrees.
;;
;; Each search tree node has a TransRec attribute that points into one of
;; two transposition record trees.


;; Factory
;;

(defun MakeTransRec (MyNode)
  "Return a new transposition record for the given search node."
  (let ((Result (MakeAL 'TransRec)))
    (nassocq    MainHash  Result  (PcMainHash (FetchPV MyNode)))
    (nassocq    Node      Result  MyNode)
    (svn-assocq AltNodes  Result)
    (svn-assocq LinkLT    Result)
    (svn-assocq LinkGT    Result)
    Result))


;; Location (may or may not be present)
;;

(defun LocateTransRecAux (MyTransRec MyMainHash)
  "Try to locate a transposition record; return nil if not found."
  (let ((Result nil))
    (when MyTransRec
      (let ((TRMainHash (vassocq MainHash MyTransRec)))
        (cond
          ((HashOpLT MyMainHash TRMainHash)
            (setf Result
              (LocateTransRecAux (vassocq LinkLT MyTransRec) MyMainHash)))
          ((HashOpGT MyMainHash TRMainHash)
            (setf Result
              (LocateTransRecAux (vassocq LinkGT MyTransRec) MyMainHash)))
          ((HashOpEQ MyMainHash TRMainHash)
            (setf Result MyTransRec))
          (t (error "LocateTransRecAux")))))
    Result))


(defun LocateTransRecByNode (MyNode)
  "Try to locate a transposition record by search node."
  (let*
    (
      (Result nil)
      (PV (FetchPV MyNode))
      (RootTransRec (vref TheSearchTransRootVec (PcActColor PV)))
    )
    (when RootTransRec
      (setf Result (LocateTransRecAux RootTransRec (PcMainHash PV))))
    Result))


;; Insertion (only for non located nodes)
;;

(defun InsertTransRecAux (MyParentNode MyTransRec)
  "Insert a new transposition record (only for non located node)."
  (let
    (
      (PNMainHash (vassocq MainHash MyParentNode))
      (TRMainHash (vassocq MainHash MyTransRec))
    )
    (assert (HashOpNE PNMainHash TRMainHash) "InsertTransRecAux")
    (if (HashOpLT TRMainHash PNMainHash)
      (let ((LinkLT (vassocq LinkLT MyParentNode)))
        (if LinkLT
          (InsertTransRecAux LinkLT MyTransRec)
          (nassocq LinkLT MyParentNode MyTransRec)))
      (let ((LinkGT (vassocq LinkGT MyParentNode)))
        (if LinkGT
          (InsertTransRecAux LinkGT MyTransRec)
          (nassocq LinkGT MyParentNode MyTransRec))))))


(defun InsertTransRecByNode (MyNode)
  "Make and insert a new transposition record (only for non located node)."
  (let*
    (
      (Result (MakeTransRec MyNode))
      (PV (FetchPV MyNode))
      (ActColor (PcActColor PV))
      (ParentTransRec (vref TheSearchTransRootVec ActColor))
    )
    (if ParentTransRec
      (InsertTransRecAux ParentTransRec Result)
      (setf (vref TheSearchTransRootVec ActColor) Result))
    Result))


;; Application (called for each new search node)
;;

(defun ApplyTransByNode (MyNode)
  "Return transposition record for a node with side effects."
  (let ((Result (LocateTransRecByNode MyNode)))
    (if (null? Result)
      (setf Result (InsertTransRecByNode MyNode))
      (when (neq? MyNode (vassocq Node Result))
        (alv-pushq AltNodes Result MyNode)))
    Result))


;; Counting utilities
;;

(defun CalcTransCountsByTransRec (MyTransRec)
  "Return a list (unique alternate) of counts for a transposition record."
  (let
    (
      (Result nil)
      (UniqueCount 1)
      (AlternateCount (length (vassocq AltNodes MyTransRec)))
      (LinkLT (vassocq LinkLT MyTransRec))
      (LinkGT (vassocq LinkGT MyTransRec))
    )
    (when LinkLT
      (let ((ResultLT (CalcTransCountsByTransRec LinkLT)))
        (incf UniqueCount (first ResultLT))
        (incf AlternateCount (second ResultLT))))
    (when LinkGT
      (let ((ResultGT (CalcTransCountsByTransRec LinkGT)))
        (incf UniqueCount (first ResultGT))
        (incf AlternateCount (second ResultGT))))
    (setf Result (list UniqueCount AlternateCount))
    Result))


(defun CalcTransCountsByColor (MyColor)
  "Return a list (unique alternate) of counts for a color."
  (let ((Result nil) (RootTransRec (vref TheSearchTransRootVec MyColor)))
    (if (null? RootTransRec)
      (setf Result (list 0 0))
      (setf Result (CalcTransCountsByTransRec RootTransRec)))
    Result))


(defun CalcTransCounts ()
  "Return a list (unique alternate) of counts."
  (let ((Result nil) (UniqueCount 0) (AlternateCount 0))
    (DoColors (ActColor)
      (let ((ColorResult (CalcTransCountsByColor ActColor)))
        (incf UniqueCount (first ColorResult))
        (incf AlternateCount (second ColorResult))))
    (setf Result (list UniqueCount AlternateCount))
    Result))


;; Diagnostic reports
;;

(defun DumpTransDataByColor (MyStream MyColor)
  "Dump transposition data by color to the given stream."
  (let*
    (
      (Result (CalcTransCountsByColor MyColor))
      (UniqueCount (first Result))
      (AlternateCount (second Result))
      (TotalCount (+ UniqueCount AlternateCount))
    )
    (format MyStream "Transpositions for %u: " MyColor)
    (format MyStream "  unique: %u" UniqueCount)
    (format MyStream "  alternate: %u" AlternateCount)
    (format MyStream "  total: %u" TotalCount)
    (newline MyStream)
    Result))


(defun DumpTransData (MyStream)
  "Dump transposition data to the given stream."
  (let ((ColorResult nil) (UniqueCount 0) (AlternateCount 0))
    (DoColors (ActColor)
      (setf ColorResult (DumpTransDataByColor MyStream ActColor))
      (incf UniqueCount (first ColorResult))
      (incf AlternateCount (second ColorResult)))
    (format MyStream "Both colors: ")
    (format MyStream "  unique: %u" UniqueCount)
    (format MyStream "  alternate: %u" AlternateCount)
    (format MyStream "  total: %u" (+ UniqueCount AlternateCount))
    (newline MyStream)
    (list UniqueCount AlternateCount)))

smcracraft
Posts: 671
Joined: Wed Mar 08, 2006 7:08 pm
Location: Orange County California
Full name: Stuart Cracraft
Contact:

Re: Symbolic: Sample code / Transposition repository

Post by smcracraft » Wed Apr 11, 2007 1:51 am

Great - that's what I was hoping to see. Now for the questions.

Processor(s) you run on and your chess processing speed (define
it as you wish.)

Also, what kind of rating?

Cheers,

Stuart

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

Re: Symbolic: Sample code / Transposition repository

Post by sje » Wed Apr 11, 2007 2:10 am

At the moment it's using about 3 ms of the 200 ms per node average budget. There is no rating yet, although I hope to have the cognitive version running on FICS before the end of he month. It will probably be around 800 elo at first.

smcracraft
Posts: 671
Joined: Wed Mar 08, 2006 7:08 pm
Location: Orange County California
Full name: Stuart Cracraft
Contact:

Re: Symbolic: Sample code / Transposition repository

Post by smcracraft » Wed Apr 11, 2007 12:07 pm

Steven,

Does it automatically learn?

If so, what is the algorithm?

Stuart

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

Re: Symbolic: Sample code / Transposition repository

Post by sje » Wed Apr 11, 2007 4:22 pm

Program assisted learning is unlikely to be implemented soon, although it is in the plans. More important at this stage is to get a base version of the cognitive searcher up on a server; this will help tests the fundamental mechanics of the program and also serve to set a low-water benchmark.

smcracraft
Posts: 671
Joined: Wed Mar 08, 2006 7:08 pm
Location: Orange County California
Full name: Stuart Cracraft
Contact:

Re: Symbolic: Sample code / Transposition repository

Post by smcracraft » Fri Apr 13, 2007 1:06 pm

Steven,

What will be your first strength-enhancing features?

--Stuart

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

Re: Symbolic: Sample code / Transposition repository

Post by sje » Fri Apr 13, 2007 1:35 pm

Daily calisthenics. :lol:

Post Reply