[Haskell-cafe] Re: Generate 50 random coordinates

apfelmus at quantentunnel.de apfelmus at quantentunnel.de
Sat Dec 2 08:48:50 EST 2006


Huazhi (Hank) Gong wrote:
> Hello,all
> 
> My intention is to generate 50 random coordinates like (x,y).
> 
> myrand :: Int
> myrand = randomRIO(1::Int, 100)
> 
> rf=[(myrand, myrand) | a <- [1..50]]
> 
> My short program is like this. However, GHCI say that the return type of
> randomRIO is IO a while the function defined by me is Int. Since I only need
> a integral type as my cooridinate, could you tell me how to fix this?

Taral wrote:
> do
>    let myrand = randomRIO (1 :: Int, 100)
>    rf <- replicateM 50 (liftM2 (,) myrand myrand) 

Jason Dagit wrote:
> When we look at the type of randomRIO we see:
> randomRIO :: forall a. (Random a) => (a, a) -> IO a
> 
> You're giving it a tuple of Int, so we can substitute Int for 'a' in
> that type signature:
> myrand :: IO Int
> 
>>
>> rf=[(myrand, myrand) | a <- [1..50]]
> 
> Here you are creating a list of tuples.  We see from above that the
> type of the tuples would be (IO Int, IO Int), so rf :: [(IO Int, IO
> Int)].  This is because we have not run the IO action to generate the
> Int yet.
>
>> My short program is like this. However, GHCI say that the return type of
>> randomRIO is IO a while the function defined by me is Int. Since I only need
>> a integral type as my cooridinate, could you tell me how to fix this?
> 
> Your type signature tries to make a claim that myrand has type Int,
> but the compiler will disagree because of that pesky IO type. 

Dons wrote:
> Try initialising your random generator in 'main' , creating a list of
> infinite randoms, take the number you need, then feed that to the
> functions that need the list:
> 
>     import System.Random
>     import Text.Printf
>     import Data.Word
> 
>     main = do
>         g <- newStdGen          -- intialise a random generator
>         let (a,b) = split g     -- create two separate generators
>             as = randoms a      -- one infinite list of randoms
>             bs = randoms b      -- another
>             rs = zip as bs      -- an infite list of pairs
>         dump (take 50 rs)       -- take 50, and consume them


-- The IO --

Who rides so late through the bits and the bytes?
It's Haskell with his child Hank;
He has the boy type safe in his arm,
He holds him pure, he holds him warm.

"My son, what makes you hide your face in fear?" -
Father, don't you see the IO?
The IO with randomRIO? -
"My son, it's a wisp of the outside world." -

"You dear child, do come along with me!
Such lovely replicateMs I'll do with you;
Many colorful liftM2s are to be done,
My Taral does have many a golden suggestions!"

My father, my father, and do you not hear
What the IO promises me so softly? -
"Be quiet, stay quiet, my child;
I know he won't treat you good." -

"Don't you come along with me, my fine boy?
My Jason shall do explain to you so nicely.
My Jason will do tutor you to understand 'return',
And he'll do help you and do show you and do guide you to >>=."

My father, my father, and do you not read over there
IO's minions in that dark post? -
"My son, my son, I see it most definitely:
It's the imperative paradigm looking so grey."

"I do love you; I'm charmed by your beautiful mind;
And if you're not willing, then I'll do use imperative force!"
My father, my father, now he's grabbing hold of me!
IO has done, IO did do me harm! -

Haskell shudders, he rides swiftly,
He holds in his arms the moaning child.
He reaches Dons' stronghold with effort and urgency.
With the following code, the child will not fall:

   import System.Random

   randPairs :: (RandomGen g, Random a) => (a,a) -> g -> [(a,a)]
   randPairs range gen = zip as bs
     where  (a,b) = split gen      -- create two separate generators
            as = randomRs range a  -- one infinite list of randoms
            bs = randomRs range b  -- another

   seed   = 13561956 :: Int
   mygen  = mkStdGen seed

   coords :: [(Int,Int)]
   coords = take 50 $              -- 50 random coordinates derived
        randPairs (1,100) mygen    -- from the random seed above





Regards,
apfelmus

PS: As you may have guessed, any similarity with living people is either
randomRIO or accidental ... I hope that you accept my apologies for the
latter.



More information about the Haskell-Cafe mailing list