View in color  View documentation  License 
Download script  History  Other scripts by: sunanda 
7Aug 6:12 UTC
[0.062] 22.828k
[0.062] 22.828k
nimengine.rrebol [
title: "Nim engine"
purpose: "Calculate the best move in a game of NIM"
author: "Sunanda"
date: 1sep2004
version: 0.0.0
file: %nimengine.r
Library: [
level: 'intermediate
platform: 'all
type: [game tool]
domain: [game]
testedunder: 'win
support: none
license: 'bsd
seealso: none
]
history: [
[0.0.0 1sep2004 "written"]
]
credits: {Analysis and terminology taken from
"The Mathematics of Games"
John D. Beasley
Oxford University Press, 1989
}
]
;; 
;; See documentation:
;; http://www.rebol.org/cgibin/cgiwrap/rebol/documentation.r?nimengine.r
;; 
nimengine: make object!
[
;; Game types:
;; ** Common: take last and lose
;; ** Straight: take last and win
res: none ;; make available to whole nimmove object
pilescopy: none ;; caller's original piles
playernames: none ;; name of the two players
testtrace: none ;; test driver output
gametypes: ["common" "lose if you take the last counter"
"straight" "win if you take the last counter"
]
;; =====
move: func [
;; =====
gametype [string!] "Common or Straight"
piles [block!] "1 or more piles"
/names namesblock [block!] ;; [this player + other player]
/local
cp ;; count of piles
temp
][
if 0 = length? piles [make error! "nimmove: need at least 1 pile"]
if not any [
gametype = "common"
gametype = "straight"
]
[make error! "nimmove: game type must be common or straight"]
if all [names 2 <> length? namesblock]
[make error! "nimmove: name refinement  2 names needed"]
either names
[playernames: copy namesblock]
[playernames: copy ["nimengine" "human"]]
res: make object!
[gametype: none
gameover?: false
winner?: none
move: none
piles: copy []
winning?: none
]
res/gametype: gametype
;; 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
;; checkforwin
res/piles: copy []
foreach p piles
[append res/piles maximum 0 tointeger 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/gameover?: true
res/winner?: either res/gametype = "common" [playernames/1] [playernames/2]
res/winning?: res/winner?
return res
]
;; 
;; check for common end game
;; 
if all[gametype = "common"
commonendgamereached?
]
[
makecommonendgamemove
checkforwin
return res
]
;; 
;; Handle all other cases
;; 
;; This is for all straight
;; games, and nonend game
;; common games
cp: findbalance piles
res/winning?: cp <> 0
either res/winning?
[makewinningmove cp]
[makerandommove]
checkforwin
return res
]
;; ==============
checkforwin: func [
;; ==============
/local
targetsize
][
if pair? res/move
[
targetsize: pick res/piles res/move/1
res/move/1: randomentry res/piles targetsize
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/gameover?: true
res/winner?: either res/gametype = "common"
[playernames/2]
[playernames/1]
res/winning?: res/winner?
]
return true
]
;; =============
randomentry: func [piles [block!] target [integer!]
;; =============
/local
targetpositions
][
;; 
;; 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
targetpositions: copy []
repeat n length? piles
[if piles/:n = target
[append targetpositions n]
]
return random/secure/only targetpositions
]
;; ============
findbalance: func [piles [block!]
;; ============
/local
bal
][
bal: 0
foreach p piles [bal: xor bal p]
return bal
]
;; =========================
commonendgamereached?: func [
;; =========================
/local
count
][
;; The end game is when either:
;; * all nonempty piles have 1 counter; or
;; * all nonempty 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]
]
;; ==========================
makecommonendgamemove: func [
;; ==========================
/local
pi
move
take
pilescount
][
;; ================================
;; Precisely one nonzero 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
pilescount: 0
foreach p res/piles
[if p <> 0
[pilescount: pilescount + 1]
]
if 0 = (pilescount // 2)
[
;; even piles: reduce the largest to zero
;; 
move: index? find res/piles maxelement res/piles
take: res/piles/:move
res/move: topair reduce [move take]
res/winning?: playernames/1
return true
]
;; Deal with odd number of piles
;; 
if 1 <> maxelement res/piles
[
res/winning?: playernames/1
move: index? find res/piles maxelement res/piles
take: res/piles/:move  1
res/move: topair reduce [move take]
return true
]
;; 
;; We're losing: and all
;; piles have one in them,
;; except the empty piles
;; 
res/winning?: playernames/2
take: 1
move: index? find res/piles take
res/move: topair reduce [move take]
return true
]
;; ==================
makewinningmove: func [cp [integer!]
;; ==================
/local
hun
targetpile
pilesreduced
move
take
hunrem
][
;; 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 hun to the bit value of the
;; highest unbalance number
targetpile: findhighestunbalancedpile cp res/piles
;; Now, ignore that pile
;; 
pilesreduced: copy res/piles
alter pilesreduced targetpile
;; Now find highest unbalanced of what remains
;; 
hunrem: findbalance pilesreduced pilesreduced
move: index? find res/piles targetpile
take: res/piles/:move  hunrem
res/winning?: playernames/1
res/move: topair reduce [move take]
return true
]
;; =============================
findhighestunbalancedpile: func [cp [integer!] piles [block!]
;; =============================
/local
hun
][
if cp = 0 [return 0]
hun: to integer! 2 ** (to integer! log2 cp)
foreach p sort/reverse copy piles
[
if 0 <> and hun p [return p]
]
return 0 ;; there isn't one
]
;; =================
makerandommove: 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: topair reduce [move take]
res/winning?: playernames/2
return true
]
;; ==========
maxelement: func [blk [block!]
;; ==========
][
;; maximimof is useless for our purposes
;; as it can return a block, eg:
;; maximumof [1 1 9 9 9]
;; returns [9 9 9]
return first maximumof blk
]
;; ===========
testdriver: func [
;; ===========
/local
gamesplayed
movesmade
piles
gametype
res
winning?
winnames
diffpiles
temp
;; 
;; Runs 1000s of games and
;; checks that the results
;; are right...or at least
;; credible.
;; 
][
winnames: ["human" "nimengine" "human"]
gamesplayed: 0
movesmade: 0
forever
[testtrace: copy []
gamesplayed: gamesplayed + 1
piles: copy []
loop 5 + random/secure 5 [append piles random/secure 20]
gametype: random/secure/only ["common" "straight"]
;; get who is supposed to be winning
;; 
res: move gametype piles
winning?: select winnames res/winning?
forever
[
movesmade: movesmade + 1
res: move gametype piles
append testtrace res
if not find winnames res/winning?
[print "bad winner name" halt]
if res/gameover? [break]
if res/winning? = winning?
[print ["didn't rotate winner names" mold res] halt]
;; exactly 1 pile should be different
;; 
diffpiles: copy []
diffall: 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 diffpiles temp]
append diffall temp
]
if 1 <> length? diffpiles
[print ["piles are wrong" mold piles "" mold res "" mold diffpiles mold diffall] halt]
if diffpiles/1 < 1
[print ["changed result is negative!!" mold piles "" mold res "" mold diffpiles mold diffall] halt]
piles: copy res/piles
winning?: copy res/winning?
] ;; forever
if 0 = (gamesplayed // 100)
[
print [now/precise "Played:" gamesplayed "Total moves:" movesmade "Average:" movesmade / gamesplayed]
]
] ;; forever
]
;; =========
playgame: func [
;; =========
/type gametype
/opponentstarts
/position startingposition [block!]
/local
piles
res
humanmove
][
if not type [gametype: "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 startingposition]
[loop 2 + random/secure 3 [append piles random/secure 8]]
loop 2 [print ""]
print [" game type:" gametype " ... " select gametypes gametype]
loop 2 [print ""]
print [" starting position:" mold piles]
if opponentstarts
[ res: move gametype piles
print [" nimengine:" res/move mold res/piles]
piles: res/piles
]
forever
[ until
[humanmove: ask "Your move? "
humanmove: load humanmove
either all [pair? humanmove
humanmove/1 > 0
humanmove/1 <= length? piles
humanmove/2 > 0
humanmove/2 <= pick piles humanmove/1
]
[true]
[print "Oops: not possible to do that. Please try again" false]
]
poke piles humanmove/1 (pick piles humanmove/1)  humanmove/2
print ["You moved:" mold piles]
print ""
print "Thinking"
wait (.01 * random/secure 50)
print ""
res: move gametype piles
print [" nimengine moves: " res/move]
print [" position now: " mold res/piles]
piles: res/piles
if res/gameover?
[print "Game over!!"
print ["Winner: " res/winner?]
break
]
] ;; forever
if not (trim/lines ask "playagain? (y for yes) ") = "y" [break]
] ;; foever
]
] ;; nimengine object Notes
