There are some piles of tokens, every turn can remove any number of token from a pile, the player loose if he remove the last token from the last pile.
Sunada wrote the following script that permits you to play against your PC:
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
license: 'bsd
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/documentation.r?script=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
How it works?
Well, you can find a very good documentation here: http://www.rebol.org/documentation.r?script=nim-engine.r
I'll just explain it shortly, launch nim-engine/play-game:
>> nim-engine/play-game
Enter moves as a pair!
eg 3x7 means take from pile 3. The number of counters taken is 7
game type: common ... lose if you take the last counter
starting position: [7 3 4 3 1]
Your move?
It shows the situation as a block, every item of the block is the number of tokens in the pile.
You have to give a pair! to indicate "pile X tokens" to remove.
This script is also a nim engine to create cool games with GUI, just launch it with /move refinement, and you'll obtain an object with the PC move:
>> a: nim-engine/move "common" [3 4 5]
>> ? a
A is an object of value:
game-type string! "common"
game-over? logic! false
winner? none! none
move pair! 1x2
piles block! length: 3
winning? string! "nim-engine"
This is the object explained:
| game-type |
|
| game-over? | true/false depending on whether more moves are possible |
| winner? | who won ("human" or "nim-engine") if the game is over |
| move | (assuming the game wasn't over when you made the call) the move nim-engine is making. A pair: 1x2 means taking 2 from pile 1 |
| piles | the updated position block |
| winning? | which player is winning |
Can you create a GUI for this game?
No comments:
Post a Comment