[Haskell-beginners] nim programme
Peter Verswyvelen
bugfact at gmail.com
Sun Oct 25 15:07:26 EDT 2009
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