[Haskell-cafe] Strange random choice algorithm

[Daniel Fischer]

Am Samstag 30 Januar 2010 20:59:08 schrieb michael rice:
> I'm not sure where I got this PICK function from, and don't understand
> why it's written as it is, so I wanted to test it for randomness. It
> seems random enough. But if I understand the algorithm correctly,
> instead of selecting one of the elements from the list, it eliminates
> all the elements but one and that's the value it returns.

Yep.

> Seems like a
> roundabout way of doing it. Comments?

Indeed.

>
> Also, is there a more direct way of printing an array?

Sure,

printing immutable arrays:

print arr ~> array (lo,hi) [(lo,arr!lo), ... , (hi,arr!hi)]
print (assocs arr) ~> [(lo,arr!lo), ... , (hi,arr!hi)]
print (elems arr) ~> [(arr!lo), ... , (arr!hi)]

printing IO[U]Arrays:

do immArr <- freeze arr
   print (immArr :: [U]Array ix el)

do ass <- getAssocs arr
   print ass

(getAssocs arr >>= print)

do els <- getElems arr
   print els

(getElems arr >>= print)

or, to get output like below:

getElems arr >>= mapM_ print

Printing ST[U]Arrays would need an unsafeIOToST, but reasonably, you 
wouldn't want to print them before you've left ST.

>
> Output below.
>
> Michael
>
> =================
>
> import System.Random
> import Data.Array.IO
>
> pick :: [a] -> IO a
> pick []     = undefined
> pick [x]    = do return x
> pick (x:xs) = pick' x xs (2 :: Int)
>
> pick' :: (Num p, Random p) => t -> [t] -> p -> IO t
> pick' curr []          _    = do return curr
> pick' curr (next:rest) prob
>   = do r <- getStdRandom (randomR (1,prob))
>        let curr' = if r == 1 then next else curr
>        pick' curr' rest (prob+1)
>
> main = do arr <- newArray (1,9) 0 :: IO (IOArray Int Int)
>           doLoop arr [1,2,3,4,5,6,7,8,9] 0
>          
> doLoop arr z k = do p <- pick z
>                     a <- readArray arr p
>                     writeArray arr p (a+1)
>                     if k > 10000
>                       then do
>                         v <- readArray arr 1
>                         print v
>                         v <- readArray arr 2
>                         print v
>                         v <- readArray arr 3
>                         print v
>                         v <- readArray arr 4
>                         print v
>                         v <- readArray arr 5
>                         print v
>                         v <- readArray arr 6
>                         print v
>                         v <- readArray arr 7
>                         print v
>                         v <- readArray arr 8
>                         print v
>                         v <- readArray arr 9
>                         print v
>                       else do
>                         doLoop arr z (k+1)
>
> ===============
>
> [michael at localhost ~]$ runhaskell array1.hs
> 1110
> 1117
> 1080
> 1169
> 1112
> 1119
> 1137
> 1084
> 1074
> [michael at localhost ~]$