Personal tools

Examples/Random list

From HaskellWiki

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

Latest revision as of 21:09, 4 March 2011


[edit] 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)

[edit] 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]    = 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 _ [] _ = 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</hsak> a lazy thunk.  The
<hask>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
th element of whole as its head.
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
I will 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 Control.Monad
then I can demonstrate how fair the removal is:
*Main Data.List Control.Monad> replicateM 1000 (getStdRandom (removeOne [1..4])) >>= return . map length . group . sort
[241,255,239,265]
where a perfect balance would be
[250,250,250,250]