[Haskell-beginners] nim programme

Kyle Murphy orclev at gmail.com
Sun Oct 25 17:24:07 EDT 2009


This is a good example of Haskell trying to be smart and causing
confusion. Remember that the compiler needs a type for everything and
if you don't provide one it will try to guess. The best way to avoid
this issue is to start writing a function by first figuring out its
type signature and then writing the function.

You need some way to track game state. There's two (at least) ways to
do that. One way is using a monad which we'll ignore for now. The
second way is by defining some sort of state type and explicitly
passing it in and out of your functions. This could look like:

data State = State { turn :: Int, piles :: [Int] } deriving (Show, Eq)

runOn :: (a -> a) -> Int -> [a] -> [a]
runOn g i xs = runOn' g (splitAt i xs)
    where runOn' g (h,  t) = h ++ ((g (head t)) : (drop 1 t))

removeStone :: State -> Int -> Int -> State
removeStone s i num = State ((turn s)+1) (runOn (\x -> x - num) i (piles s))

Note that there's a potential failure condition here if you provide an
index off the end of the pile array (because of the use of head
without a guard).
removeStone would be used like so:

Main> removeStone (State 4 [5,6,7]) 0 2
State { turn = 5, piles = [3,6,7]}
Main> removeStone (State 5 [3,6,7]) 1 3
State { turn = 6, piles = [3,3,7]}

Using a Monad to do this is very similar, but instead of manual
passing the State around, you store the State inside of the enclosing
Monad and the various functions fetch and store the state from the
Monad.
Also bear in mind that once again you're not modifying a List in any
of these functions, that's impossible, rather you are making a *new*
list using pieces of the old list.

On Sunday, October 25, 2009, Peter Verswyvelen <bugfact at gmail.com> wrote:
> Btw, it's often a good idea to introduce type signatures:
>
> nim :: IO [Int]
>
> then you don't need to provide type signatures either, and don't have
> to disable the monomo restriction
>
> On Sun, Oct 25, 2009 at 8:07 PM, Peter Verswyvelen <bugfact at gmail.com> wrote:
>> Hi John,
>>
>> regarding the first problem, just provide the type of your range explicitly:
>>
>> nim = do
>>  let range = (1,10) :: (Int,Int)
>>  x <- getStdRandom $ randomR range
>>  y <- getStdRandom $ randomR range
>>  z <- getStdRandom $ randomR range
>>  return [x,y,z]
>>
>> This is because the annoying monomorphism restriction, which will most
>> likely be reduced in the next version of Haskell.
>>
>> You can also disable this restriction:
>>
>> {-# LANGUAGE NoMonomorphismRestriction #-}
>>
>> import System.Random
>>
>> nim = do
>>  let range = (1,10) -- no explicit type annotation needed anymore
>>  x <- getStdRandom $ randomR range
>>  y <- getStdRandom $ randomR range
>>  z <- getStdRandom $ randomR range
>>  return [x,y,z]
>>
>> Cheers,
>> Peter
>>
>> On Sun, Oct 25, 2009 at 7:57 PM, John Moore <john.moore54 at gmail.com> wrote:
>>> Hi All,
>>>         I'm attempting to write a program for the game nim.(The game of Nim
>>> is played with two players and several piles of stones. On each move a
>>> player removes as many stones as they would like but form only one pile. The
>>> player who takes the last stone wins) It not as simple as I first thought.
>>> Here is my basic starting points. Any comments would be greatly appreciated.
>>> I not well versed in Haskell yet so simple(basic) Haskell rather than well
>>> written haskell if you understand what I mean. Complicated monads are way
>>> out of my league.
>>>
>>>
>>> 1) I first get the program to give me three random piles by doing
>>>     nim = do
>>>   x <- getStdRandom $ randomR (1,10)
>>>   y <- getStdRandom $ randomR (1,10)
>>>   z <- getStdRandom $ randomR (1,10)
>>>   return [x,y,z]
>>>  Cant get this to work!
>>> 2) Now I need to get the program to ask for a number and which pile to
>>> remove the number  from. This is tricky I thought about asking to find the
>>> elementAt
>>> elementAt :: [a] -> Int -> a
>>> elementAt list i = list !! (i-1) put this in a variable
>>> then asking the palyer how many to take away.
>>>  and then subtracting the number from and then putting it back into the list
>>> but this seem impossible.
>>> Then the second player would do the same.
>>> 3) Finally we would end up with a case statement like
>>> f x = in case of x
>>> [0,0,1]-> You win
>>> [0,1,0]-> You win
>>> [0,0,1]-> You win
>>> [_,_,_]-> keep playing.
>>>
>>> Lets know what you think please, getting confused.
>>>
>>> John
>>> _______________________________________________
>>> Beginners mailing list
>>> Beginners at haskell.org
>>> http://www.haskell.org/mailman/listinfo/beginners
>>>
>>>
>>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>


More information about the Beginners mailing list