rebol [
        title: "Nim engine"
      purpose: "Calculate the best move in a game of NIM"
       author: "Sunanda"
         date:  1-sep-2004
      version:  0.0.0
         file:  %nim-engine.r
 Library: [
           level: 'intermediate
        platform: 'all
            type: [game tool]
          domain: [game]
    tested-under: 'win
         support: none
         license: 'bsd
        see-also: none
        ]

       history: [
                  [0.0.0 1-sep-2004 "written"]
                ]
       credits: {Analysis and terminology taken from
                 "The Mathematics of Games"
                 John D. Beasley
                 Oxford University Press, 1989
                }
 ]

;; --------------------------------------------------------------------------
;; See documentation:
;;  http://www.rebol.org/cgi-bin/cgiwrap/rebol/documentation.r?nim-engine.r
;; --------------------------------------------------------------------------


nim-engine: make object!
[

;; Game types:
;; **  Common:  take last and lose
;; ** Straight: take last and win

 res: none            ;; make available to whole nim-move object
 piles-copy: none     ;; caller's original piles
 player-names: none   ;; name of the two players

 test-trace: none   ;; test driver output

 game-types: ["common"   "lose if you take the last counter"
              "straight" "win if you take the last counter"
             ]

;; =====
   move: func [
;; =====
              game-type [string!]   "Common or Straight"
              piles [block!]        "1 or more piles"
              /names names-block [block!] ;; [this player + other player]
  /local
   cp          ;; count of piles
   temp
][
 if 0 = length? piles [make error! "nim-move: need at least 1 pile"]

 if not any [
             game-type = "common"
             game-type = "straight"
            ]
            [make error! "nim-move: game type must be common or straight"]

 if all [names 2 <> length? names-block]
         [make error! "nim-move: name refinement -- 2 names needed"]

 either names
    [player-names: copy names-block]
    [player-names: copy ["nim-engine" "human"]]

 res: make object!
     [game-type: none
      game-over?: false
      winner?: none
      move: none
      piles: copy []
      winning?: none
     ]


 res/game-type: game-type




;; Make the piles make sense
;; -------------------------
;; * Set any negative ones to
;;   zero
;; * Make sure they are all
;; * integers (reduce [2 ** 5]
;;   would be a decimal, and
;;   that breaks the find in
;;   check-for-win

 res/piles: copy []
 foreach p piles
    [append res/piles maximum 0 to-integer p]




 ;; ------------------------------------------------
 ;; Check for game over already (all piles are zero)
 ;; ------------------------------------------------

 if all [res/piles/1 = 0
         (skip res/piles 1) = copy/part res/piles -1 + length? res/piles
        ]
        [
         res/game-over?: true
         res/winner?: either res/game-type = "common" [player-names/1] [player-names/2]
         res/winning?: res/winner?
         return res
        ]



;; ------------------------
;; check for common end game
;; -------------------------


  if all[game-type = "common"
         common-end-game-reached?
        ]
       [
        make-common-end-game-move
        check-for-win
        return res
       ]



;; ----------------------
;; Handle all other cases
;; ----------------------
;; This is for all straight
;; games, and non-end game
;; common games


 cp: find-balance piles

 res/winning?: cp <> 0

 either res/winning?
   [make-winning-move cp]
   [make-random-move]
 check-for-win
 return res
]





;; ==============
   check-for-win: func [
;; ==============
   /local
    target-size
][

 if pair? res/move
    [
     target-size: pick res/piles res/move/1
     res/move/1: random-entry res/piles target-size
     poke res/piles res/move/1 (pick res/piles res/move/1) - res/move/2
    ]



;; Check for game over
;; -------------------

 if all [res/piles/1 = 0
         (skip res/piles 1) = copy/part res/piles -1 + length? res/piles
        ]
        [
         res/game-over?: true
         res/winner?:  either  res/game-type = "common"
              [player-names/2]
              [player-names/1]
         res/winning?: res/winner?
        ]
 return true

]


;; =============
   random-entry: func [piles [block!]  target [integer!]
;; =============
    /local
     target-positions

][
;; -------------------------
;; We've got a set of piles,
;; eg:
;; [1 3 0 0 11 3 7 5 9]
;; and a target, eg:
;; 6
;;
;; We now want to return the
;; index of a pile with at
;; least 6 counters in it --
;; eg
;; 5 or 7 or 9
;; in the example

 target-positions: copy []
 repeat n length? piles
     [if piles/:n = target
        [append target-positions n]
     ]
 return random/secure/only target-positions

]


;; ============
   find-balance: func [piles [block!]
;; ============
   /local
    bal
][
 bal: 0
 foreach p piles [bal: xor bal p]
 return bal
]





;; =========================
   common-end-game-reached?: func [
;; =========================
   /local
    count
][
 ;; The end game is when either:
 ;; * all non-empty piles have 1 counter; or
 ;; * all non-empty piles but 1 have 1 counter.
 ;; eg:
 ;; [1 0 0 1 1 1 0 0 ]  ;; all have 1 counter
 ;; [1 1 0  1 0 0 88]   ;; all but 1 have one counter


 count: 0
 foreach p res/piles
  [
   if p > 1 [count: count + 1]
  ]

 return any [count = 0 count = 1]

]



;; ==========================
   make-common-end-game-move: func [
;; ==========================
    /local
     pi
     move
     take
     piles-count
][

;; ================================
;; Precisely one non-zero pile has
;; one or more counters.
;; And it is a common game
;; ================================
;;
;; We have a win if:
;; a) we can reduce the piles to an
;;    odd number, all with 1 in them

piles-count: 0
foreach p res/piles
     [if p <> 0
       [piles-count: piles-count + 1]
     ]

if  0 = (piles-count // 2)
 [
  ;; even piles: reduce the largest to zero
  ;; --------------------------------------

  move: index? find res/piles max-element res/piles
  take: res/piles/:move
  res/move: to-pair reduce [move take]

  res/winning?: player-names/1
  return true
  ]



;; Deal with odd number of piles
;; ------------------------------

if 1 <> max-element res/piles
 [
  res/winning?: player-names/1
  move: index? find res/piles max-element res/piles
  take: res/piles/:move - 1

  res/move: to-pair reduce [move take]
  return true
 ]


;; -----------------------
;; We're losing: and all
;; piles have one in them,
;; except the empty piles
;; -----------------------

 res/winning?: player-names/2
 take: 1
 move: index? find res/piles take
 res/move: to-pair reduce [move take]

 return true
]



;; ==================
   make-winning-move: func [cp [integer!]
;; ==================
   /local
    h-un
    target-pile
    piles-reduced
    move
    take
    h-un-rem
][
  ;; cp contains the binary of the highest unbalanced
  ;; pile contents, eg
  ;; cp: 12  =  8 + 4
  ;; therefore the 8s and the 4s are unbalanced --
  ;; perhaps the original piles were:
  ;; [17 24 8 12 8 4]  = [16+1 16+8 8 8+4 4+1]

  ;; set h-un to the bit value of the
  ;; highest unbalance number


 target-pile: find-highest-unbalanced-pile cp res/piles


;; Now, ignore that pile
;; ---------------------

  piles-reduced: copy res/piles
  alter piles-reduced target-pile


;; Now find highest unbalanced of what remains
;; -------------------------------------------

 h-un-rem: find-balance piles-reduced piles-reduced


 move: index? find res/piles target-pile
 take: res/piles/:move - h-un-rem

 res/winning?: player-names/1
 res/move: to-pair reduce [move take]

 return true

]




;; =============================
   find-highest-unbalanced-pile: func [cp [integer!] piles [block!]
;; =============================
   /local
    h-un
][

 if cp = 0 [return 0]
 h-un: to integer! 2 ** (to integer! log-2 cp)

 foreach p sort/reverse copy piles
   [
    if 0 <> and h-un p [return p]
   ]

 return 0  ;; there isn't one
]




;; =================
   make-random-move: func [
;; =================
   /local
    move
    take
][
;; -------------------------------------------
;; We're losing, so do something impressive:
;; Ideally, do not remove a pile completely --
;; that simplifies the game too much.
;;
;; And remember to ignore the empty piles
;; -------------------------------------------


;; attempt to find a random pile with 2 or more counters
;; -----------------------------------------------------

 take: 0
 foreach p random/secure copy res/piles
    [if p > 1 [take: p break]]

 if take = 0  [take: 1]    ;; have to play a one

 move: index? find res/piles take ;; find the first pile of that size

 If take > 3 [take: take - 1]  ;; avoid taking them all
 take: random/secure take

 res/move: to-pair reduce [move take]
 res/winning?: player-names/2

 return true

]



;; ==========
   max-element: func [blk [block!]
;; ==========
][

;; maximim-of is useless for our purposes
;; as it can return a block, eg:
;; maximum-of [1 1 9 9 9]
;; returns [9 9 9]

 return first maximum-of blk

]


;; ===========
   test-driver: func [
;; ===========
   /local
    games-played
    moves-made
    piles
    game-type
    res
    winning?
    win-names
    diff-piles
    temp
;;  -------------------------
;;  Runs 1000s of games and
;;  checks that the results
;;  are right...or at least
;;  credible.
;;  ------------------------
][


 win-names: ["human" "nim-engine" "human"]
 games-played: 0
 moves-made: 0

forever
 [test-trace: copy []
  games-played: games-played + 1

  piles: copy []
  loop 5 + random/secure 5 [append piles random/secure 20]
  game-type: random/secure/only ["common" "straight"]

 ;; get who is supposed to be winning
 ;; ---------------------------------

   res: move game-type piles

   winning?: select win-names res/winning?


 forever
    [
     moves-made: moves-made + 1

     res: move game-type piles
     append test-trace res

     if not find win-names res/winning?
         [print "bad winner name" halt]

     if res/game-over? [break]

     if res/winning? = winning?
         [print ["didn't rotate winner names" mold res] halt]


     ;; exactly 1 pile should be different
     ;; ----------------------------------
     diff-piles: copy []
     diff-all: copy []
     if (length? piles) <> length? res/piles
          [print "bad pile length" halt]
     repeat n length? piles
           [
           if res/piles/:n < 0
              [print ["result is negative!!" mold res] halt]
            if (temp: piles/:n - res/piles/:n ) <> 0
                [append diff-piles temp]
            append diff-all temp
           ]
     if 1 <> length? diff-piles
          [print ["piles are wrong" mold piles "--" mold res "--" mold diff-piles mold diff-all] halt]
     if diff-piles/1 < 1
          [print ["changed result is negative!!" mold piles "-" mold res "--" mold diff-piles mold diff-all] halt]

     piles: copy res/piles
     winning?: copy res/winning?

    ] ;; forever
 if 0 = (games-played // 100)
   [
 print [now/precise "Played:" games-played  "Total moves:" moves-made "Average:" moves-made / games-played]
   ]
] ;; forever

]




;; =========
   play-game: func [
;; =========
     /type game-type
     /opponent-starts
     /position starting-position [block!]
     /local
      piles
      res
      human-move
][

 if not type [game-type: "common"]


 print "Enter moves as a pair!"
 print "eg 3x7 means take from pile 3. The number of counters taken is 7"
 forever [
 piles: copy []
 either position
        [piles: copy starting-position]
        [loop 2 + random/secure 3  [append piles random/secure 8]]
 loop 2 [print ""]
 print [" game type:" game-type " ... " select game-types game-type]
 loop 2 [print ""]
 print [" starting position:" mold piles]
 if opponent-starts
   [ res: move game-type piles
     print ["  nim-engine:" res/move mold res/piles]
     piles: res/piles
   ]
 forever
  [ until
      [human-move: ask "Your move? "
       human-move: load human-move
       either all [pair? human-move

            human-move/1 > 0
            human-move/1 <= length? piles
            human-move/2 > 0
            human-move/2 <= pick piles human-move/1
           ]
          [true]
          [print "----Oops: not possible to do that. Please try again----" false]

      ]
  poke piles human-move/1 (pick piles human-move/1) - human-move/2
  print ["You moved:" mold piles]
  print ""
  print "-----------------Thinking------------"
  wait (.01 * random/secure 50)
  print ""
  res: move game-type piles
  print ["  nim-engine moves: " res/move]
  print ["    position now: " mold res/piles]
  piles: res/piles
  if res/game-over?
     [print "Game over!!"
      print ["Winner: " res/winner?]
      break
      ]

  ] ;; forever
 if not (trim/lines ask "play-again? (y for yes) ") = "y" [break]
 ] ;; foever
]



] ;; nim-engine object