Personal tools

Examples/Random list

From HaskellWiki

(Difference between revisions)
Jump to: navigation, search
(looks like someone used two different names for the same thing)
(add "unpick")
Line 1: Line 1:
 
[[Category:Code]]
 
[[Category:Code]]
  +
  +
== Create a random list ==
   
 
Generate a random list of numbers, without using the
 
Generate a random list of numbers, without using the
Line 15: Line 17:
 
randomlist :: Int -> StdGen -> [Int]
 
randomlist :: Int -> StdGen -> [Int]
 
randomlist n = take n . unfoldr (Just . random)
 
randomlist n = take n . unfoldr (Just . random)
  +
</haskell>
  +
  +
== Delete an element at random ==
  +
  +
<haskell>
  +
unpick and unpick' are by osfameron and are from http://osfameron.vox.com/library/post/more-random-fun.html (no explicit license)
  +
removeOne is by Chris Kuklewicz (BSD3 licence, 2007)
  +
  +
> import System.Random
  +
> import Control.Monad.State.Lazy
  +
> import Debug.Trace -- for removeOne' demonstration
  +
  +
The unpick function and its helper unpick' are strict in the entire
  +
list being operated on (forcing it all into memory at once). And IO
  +
[a] cannot lazily return any initial values.
  +
  +
> unpick :: [a] -> IO [a]
  +
> unpick [] = undefined
  +
> unpick [x] = do return []
  +
> unpick (x:xs) = do zs <- unpick' [] [x] xs 2
  +
> return (reverse zs)
  +
>
  +
> unpick' :: (Num p, Random p) => [t] -> [t] -> [t] -> p -> IO [t]
  +
> unpick' curr orig [] _
  +
> = do return curr
  +
> unpick' curr orig (next:rest) prob
  +
> = do r <- getStdRandom (randomR (1,prob))
  +
> let curr' = if r == 1 then orig else (next:curr)
  +
> unpick' curr' (next:orig) rest (prob+1)
  +
  +
To run in the IO Monad just use (getStdRandom . removeOne) :: [a] -> IO [a].
  +
  +
removeOne returns the output list lazily as soon as it has decided
  +
not to delete any element in a prefix of the input list.
  +
The resulting list is constructed efficiently, with no wasted
  +
intermediate list construction. removeOne allows any output it
  +
generates to be garbage collected, it holds no references to it.
  +
  +
"removeOne" is presented in curried form, without a binding for the
  +
RandomGen g. The StdGen is hidden inside a State
  +
monad. removeOne is designed for use with Strict.Lazy. It may not be
  +
optimal to use with Strict.Strict.
  +
  +
Like "tail" this function is partial and will produce an error if
  +
given the empty list.
  +
  +
> removeOne :: (RandomGen g) => [a] -> g -> ([a],g)
  +
> removeOne [] = error "Cannot removeOne from empty list"
  +
> removeOne whole@(_:xs) = runState (helper whole xs 0 1) where
  +
  +
The laziness is needed in helper to make "rest" a lazy thunk. The
  +
"start" list parameter to helper is a suffix of "whole" that has the
  +
current candidate for deletion as its head. "oldIndex" is the index
  +
of the current candidate for deletion in the "whole" list. "here" is a
  +
suffix of "whole" with the "index" element of whole as its head. The
  +
randomR decides if the head of "here" replaces the head of "start" as
  +
the candidate to remove. If it does replace the old candidate then
  +
a prefix of "start" of length "(index-oldIndex)" is immediately
  +
output, counted off by prependSome.
  +
  +
Assert "start" is never [].
  +
Assert 0 <= oldIndex < index.
  +
  +
> helper start [] oldIndex index = return (tail start)
  +
> helper start here@(_:ys) oldIndex index = do
  +
> r <- State (randomR (0,index))
  +
> if r==0 then do rest <- helper here ys index $! succ index
  +
> return (prependSome (index-oldIndex) start rest)
  +
> else helper start ys oldIndex $! succ index
  +
  +
I assert that "prependSome n xs ys == take n xs ++ ys" but slightly
  +
optimized (without depending on the compiler). Assert n >= length xs.
  +
  +
> prependSome :: Int -> [a] -> [a] -> [a]
  +
> prependSome 0 _ rest = rest
  +
> prependSome n (x:xs) rest = x : prependSome (pred n) xs rest
  +
> prependSome _ [] _ = error "impossible error in removeOne.prependSome"
  +
  +
"removeOne'" is a tracing version for demonstration below:
  +
  +
> removeOne' :: (Show a,RandomGen g) => [a] -> g -> ([a],g)
  +
> removeOne' [] _ = error "Cannot removeOne from empty list"
  +
> removeOne' whole@(x:xs) g = runState (helper whole xs 0 1) g where
  +
> helper start [] oldIndex index = return (tail start)
  +
> helper start here@(_:ys) oldIndex index = do
  +
> r <- State (randomR (0,index))
  +
> if r==0 then do rest <- helper here ys index $! succ index
  +
> let rest' = trace "." rest
  +
> return (prependSome (index-oldIndex) start rest')
  +
> else do let ys' = trace "_" ys
  +
> helper start ys' oldIndex $! succ index
  +
  +
Use "removeOne'" to demonstrate when random decisions to drop
  +
elements are made. This also demonstrates that removeOne is lazy,
  +
returning elements as soon as the removal decision has moved on to a
  +
later element (the "." is output instead of "_").
  +
  +
The element after the last "." is the one actually removed,
  +
defaulting to the first element.
  +
  +
Since the probability of "." decreases, the average length of the
  +
run of output produced by appendSome increases as the list is
  +
processed.
  +
  +
*Main> getStdRandom (removeOne' [1..10])
  +
[1.
  +
_
  +
_
  +
,2,3,4.
  +
_
  +
_
  +
_
  +
_
  +
,5,6,7,8,9.
  +
]
  +
*Main> getStdRandom (removeOne' [1..10])
  +
_
  +
_
  +
[1,2,3.
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
,5,6,7,8,9,10]
  +
*Main> getStdRandom (removeOne' [1..10])
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
[2,3,4,5,6,7,8,9,10]
  +
*Main> getStdRandom (removeOne' [1..10])
  +
[1.
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
,3,4,5,6,7,8,9,10]
  +
*Main> getStdRandom (removeOne' [1..10])
  +
[1.
  +
,2.
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
_
  +
,4,5,6,7,8,9,10]
  +
*Main> getStdRandom (removeOne' [1..10])
  +
[1.
  +
_
  +
_
  +
_
  +
_
  +
,2,3,4,5,6.
  +
_
  +
_
  +
,7,8,9.
  +
]
  +
  +
If I use ":m + Data.List" then I can demonstrate how fair the removal is:
  +
  +
*Main Data.List> sequence (replicate 1000 $ getStdRandom (removeOne [1..4])) >>= return . map length . group . sort
  +
[241,255,239,265]
  +
  +
where a perfect balance would be [250,250,250,250]
 
</haskell>
 
</haskell>

Revision as of 01:27, 8 September 2007


1 Create a random list

Generate a random list of numbers, without using the System.Random.randoms method:

import System.Random
import Data.List
 
main = do
    seed  <- newStdGen
    let rs = randomlist 10 seed
    print rs
 
randomlist :: Int -> StdGen -> [Int]
randomlist n = take n . unfoldr (Just . random)

2 Delete an element at random

 unpick and unpick' are by osfameron and are from http://osfameron.vox.com/library/post/more-random-fun.html (no explicit license)
 removeOne is by Chris Kuklewicz (BSD3 licence, 2007)
 
> import System.Random
> import Control.Monad.State.Lazy
> import Debug.Trace -- for removeOne' demonstration
 
 The unpick function and its helper unpick' are strict in the entire
 list being operated on (forcing it all into memory at once).  And IO
 [a] cannot lazily return any initial values.
 
> unpick :: [a] -> IO [a]
> unpick []     = undefined
> unpick [x]    = do return []
> unpick (x:xs) = do zs <- unpick' [] [x] xs 2
>                    return (reverse zs)
> 
> unpick' :: (Num p, Random p) => [t] -> [t] -> [t] -> p -> IO [t]
> unpick' curr orig [] _
>     = do return curr
> unpick' curr orig (next:rest) prob
>     = do r <- getStdRandom (randomR (1,prob))
>          let curr' = if r == 1 then orig else (next:curr)
>          unpick' curr' (next:orig) rest (prob+1)
 
 To run in the IO Monad just use (getStdRandom . removeOne) :: [a] -> IO [a].
 
 removeOne returns the output list lazily as soon as it has decided
 not to delete any element in a prefix of the input list.
 The resulting list is constructed efficiently, with no wasted
 intermediate list construction.  removeOne allows any output it
 generates to be garbage collected, it holds no references to it.
 
 "removeOne" is presented in curried form, without a binding for the
 RandomGen g.  The StdGen is hidden inside a State
 monad. removeOne is designed for use with Strict.Lazy.  It may not be
 optimal to use with Strict.Strict.
 
 Like "tail" this function is partial and will produce an error if
 given the empty list.
 
> removeOne :: (RandomGen g) => [a] -> g -> ([a],g)
> removeOne [] = error "Cannot removeOne from empty list"
> removeOne whole@(_:xs) = runState (helper whole xs 0 1) where
 
 The laziness is needed in helper to make "rest" a lazy thunk.  The
 "start" list parameter to helper is a suffix of "whole" that has the
 current candidate for deletion as its head.  "oldIndex" is the index
 of the current candidate for deletion in the "whole" list. "here" is a
 suffix of "whole" with the "index" element of whole as its head.  The
 randomR decides if the head of "here" replaces the head of "start" as
 the candidate to remove.  If it does replace the old candidate then
 a prefix of "start" of length "(index-oldIndex)" is immediately
 output, counted off by prependSome.
 
 Assert "start" is never [].
 Assert 0 <= oldIndex < index.
 
>   helper start [] oldIndex index = return (tail start)
>   helper start here@(_:ys) oldIndex index = do
>     r <- State (randomR (0,index))
>     if r==0 then do rest <- helper here ys index $! succ index
>                     return (prependSome (index-oldIndex) start rest)
>             else helper start ys oldIndex $! succ index
 
 I assert that "prependSome n xs ys == take n xs ++ ys" but slightly
 optimized (without depending on the compiler).  Assert n >= length xs.
 
> prependSome :: Int -> [a] -> [a] -> [a]
> prependSome 0 _ rest = rest
> prependSome n (x:xs) rest = x : prependSome (pred n) xs rest
> prependSome _ [] _ = error "impossible error in removeOne.prependSome"
 
 "removeOne'" is a tracing version for demonstration below:
 
> removeOne' :: (Show a,RandomGen g) => [a] -> g -> ([a],g)
> removeOne' [] _ = error "Cannot removeOne from empty list"
> removeOne' whole@(x:xs) g = runState (helper whole xs 0 1) g where
>   helper start [] oldIndex index = return (tail start)
>   helper start here@(_:ys) oldIndex index = do
>     r <- State (randomR (0,index))
>     if r==0 then do rest <- helper here ys index $! succ index
>                     let rest' = trace "." rest
>                     return (prependSome (index-oldIndex) start rest')
>             else do let ys' = trace "_" ys
>                     helper start ys' oldIndex $! succ index
 
 Use "removeOne'" to demonstrate when random decisions to drop
 elements are made.  This also demonstrates that removeOne is lazy,
 returning elements as soon as the removal decision has moved on to a
 later element (the "." is output instead of "_").
 
 The element after the last "." is the one actually removed,
 defaulting to the first element.
 
 Since the probability of "." decreases, the average length of the
 run of output produced by appendSome increases as the list is
 processed.
 
*Main> getStdRandom (removeOne' [1..10])
[1.
_
_
,2,3,4.
_
_
_
_
,5,6,7,8,9.
]
*Main> getStdRandom (removeOne' [1..10])
_
_
[1,2,3.
_
_
_
_
_
_
,5,6,7,8,9,10]
*Main> getStdRandom (removeOne' [1..10])
_
_
_
_
_
_
_
_
_
[2,3,4,5,6,7,8,9,10]
*Main> getStdRandom (removeOne' [1..10])
[1.
_
_
_
_
_
_
_
_
,3,4,5,6,7,8,9,10]
*Main> getStdRandom (removeOne' [1..10])
[1.
,2.
_
_
_
_
_
_
_
,4,5,6,7,8,9,10]
*Main> getStdRandom (removeOne' [1..10])
[1.
_
_
_
_
,2,3,4,5,6.
_
_
,7,8,9.
]
 
If I use ":m + Data.List" then I can demonstrate how fair the removal is:
 
*Main Data.List> sequence (replicate 1000 $ getStdRandom (removeOne [1..4])) >>= return . map length . group . sort
[241,255,239,265]
 
where a perfect balance would be [250,250,250,250]