[Haskell-beginners] nim programme
Peter Verswyvelen
bugfact at gmail.com
Sun Oct 25 15:09:28 EDT 2009
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
>>
>>
>
More information about the Beginners
mailing list