-- create a random tree.
randomTree :: Random r => IO (BinaryTree r)
randomTree =
-- randomly pick the left and right sides.
do leftIO <- pick(randomLeaf, randomBranch)
rightIO <- pick(randomLeaf, randomBranch)
-- "un-IO" the sides.
left <- leftIO
right <- rightIO
-- get a random value for the top of the branch/tree.
value <- randomIO
-- create branch and return.
return (Branch left value right)
where
-- return left or right at random.
pick (left, right) =
do useLeft <- randomRIO(True, False)
if useLeft then return left else return right
-- create a random leaf.
randomLeaf =
do value <- randomIO
let leaf = Leaf value
return leaf
-- setup an alias.
randomBranch = randomTree
This code actually works fine, but I'm wondering if there's a way to simplify the "leftIO/rightIO" stuff. Is there some sort of "double arrow" that will un-Monad twice, or is this verbosity unavoidable?
Name:
Anonymous2008-09-16 15:34
import Control.Monad
-- create a random tree.
randomTree :: Random r => IO (BinaryTree r)
randomTree =
-- randomly pick the left and right sides.
do [left, right] <- replicateM 2 $ liftM2 pick randomLeaf randomBranch
-- get a random value for the top of the branch/tree.
value <- randomIO
-- create branch and return.
return (Branch left value right)
where
-- return left or right at random.
pick left right = ([left, right] !!) =<< randomRIO (0, 1)
-- create a random leaf.
randomLeaf = fmap Leaf randomIO
-- setup an alias.
randomBranch = randomTree
Uhh... replace the following line: pick left right = ([left, right] !!) =<< randomRIO (0, 1)
with this one: pick left right = fmap ([left, right] !!) $ randomRIO (0, 1)
This is all untested, by the way.
Name:
Anonymous2008-09-16 15:45
>>3
Yeah, none of this seems to work, but thanks for the ideas.
Now replace this: liftM2 pick randomLeaf randomBranch
with this: join $ liftM2 pick randomLeaf randomBranch
Name:
Anonymous2008-09-16 15:51
>>1
Not that I know of (although I'm just learning Haskell). You might be able to get away with something fishy though, I have no idea if it would actually parse (let alone work) --
Not OP. I was considering to consider learning Haskell, but I was completely put off by this thread. I'm glad to see so many Anonymous trying to help, but if it takes several people and several iterations of Perl-like mess to write a simple tree algorithm, then I see the language is way too experimental, weird and unpractical. It's not without value — these curious abstractions and techniques are worth trying somewhere, and Haskell is the place. Once they prove good enough, more practical languages (where you actually get stuff done) like FIOC should steal them.
Name:
Anonymous2008-09-17 19:46
>>16
>but if it takes several people and several iterations of Perl-like mess to write a simple tree algorithm
>serveral iterations
It's called refactoring. There's really only three versions: OP, >>2 and >>10
>Perl-like mess
Excuse me? >>1 and >>10 don't look like Perl, though I admit they might scare off noobs. The final version is actually quite clean and nice.
>simple tree algorithm
It only looks simple because it's in Haskell. This "function" can generate random trees of integers, characters, bools, and even *other trees.* Further, if anyone defines a new type and makes it an instance of the Random class, this function could generate random trees of that type, too, with no code changes.
It also looks simple because it's recursive, which is not a problem in since Haskell compilers optimize recursion.
BinaryTree.hs
module BinaryTree where
import Control.Monad
import Random
data BinaryTree a = Leaf a
| Branch (BinaryTree a) a (BinaryTree a)
deriving (Eq, Show)
instance Random r => Random (BinaryTree r) where
-- create a random tree. I should probably re-write this somehow in
-- randomR/random, but that's hard, so let's go shopping.
randomIO = liftM3 Branch randomBranch randomIO randomBranch
where
randomBranch = randomRIO (0, 1) >>= ([liftM Leaf randomIO, randomIO] !!)
-- return a list of the elements of a tree from bottom-left.
elements :: BinaryTree a -> [a]
elements (Leaf a) = [a]
elements (Branch l a r) = elements l ++ [a] ++ elements r
-- get the maximum height of a tree.
height :: Integral i => BinaryTree a -> i
height (Leaf _) = 1
height (Branch l a r) = 1 + max (height l) (height r)
-- map a function onto a tree to produce a new tree.
treeMap :: (a -> b) -> BinaryTree a -> BinaryTree b
treeMap f (Leaf a) = Leaf (f a)
treeMap f (Branch l a r) = Branch (treeMap f l) (f a) (treeMap f r)
Main.hs
module Main where
import BinaryTree
import Random
main = do tree <- randomIO :: IO (BinaryTree (BinaryTree Integer)
putStrLn $ show tree
putStrLn $ show $ height tree
Name:
Anonymous2008-09-17 20:12
>>17
You should add a maximum height to the three, otherwise the chance that randomIO will terminate is very small.
I've seen messy Perl code in my lifetime. This code written in Haskell looks strange and I think it looks messy. Therefore, Haskell code is Perl-like code.
Great logic there, Edsger
Name:
Anonymous2008-09-17 21:01
>>18
It is possible that randomIO will not terminate, but it is unlikely. Though, one time I ran it and it kept going and eating my RAM, then my swap. Maybe it'd be good to add a maximum height, though.
Name:
Anonymous2008-09-17 21:43
It only looks simple
It is simple. You can cut out the middle man (type system) and make the random tree procedure take a random element procedure, so pretty much any language with funargs can do it with less bullshit (and usually less monad junk).
Puzzle: all operations in BinaryTree.hs can be written, IMHO bettr, as tree folds/unfolds. Do it.
Name:
Anonymous2008-09-17 23:41
>>21
But the type system allows for uniformity in creating (in this case) random values through the Random class, which is simpler than having "randomInteger", "randomBool", "randomDouble", "randomFoo", etc.
By tree folds, do you mean that I should right a fold function to work on the trees?
Name:
Anonymous2008-09-18 8:29
>>20
In randomBranch you have 0.5 chance of terminating and 0.5 chanche of calling randomIO recursively. randomIO calls randomBranch two times so on average one branch will terminate and the other continue. So it will run forever.
>>25
It can, but it might not; the possibility that it won't makes it fairly broken.
Name:
Anonymous2008-09-18 13:04
... which is part of it, but the reason some people need to go back to probabilities and statistics is because they are caught in the gambler's fallacy that "random" means "average" or "fair". Each flip of a coin has a 50% chance for that flip and has no relation to any previous flips.
>>27
I'm not saying >>23 isn't a complete idiot, I just wanted to make the point that even though it can terminate it's not necessarily a correct program. I think a slightly more sane implementation would wrap the tree generation somehow such that it gets produced on-demand, which would allow you to instantiate and traverse possibly infinite tree without raping the balls off your machine.
Name:
Anonymous2008-09-18 13:47
>>28
That's exactly what Haskell does, because it's non-strict (a.k.a lazy.)
Name:
Anonymous2008-09-18 14:13
HASKELL FUCK OFFFFFFFFFFF
Name:
Anonymous2008-09-18 14:41
WHY IS THIS SHIT USING IO INSIDE THE MOTHERFUCKING FUNCTIONS
Name:
Anonymous2008-09-18 15:07
>>31
BECAUSE randomIO REQUIRES USE OF THE IO MONAD, SHITHEAD.
Name:
Anonymous2008-09-18 15:12
>>32
FUCK YOU AND FUCK YOUR IO MONAD, YOU AREN"T SICP
Name:
Anonymous2008-09-18 15:41
>>25
It can terminate but the chance that that happens is very small. The problem is that each call to randomIO can call itself recursively two times. So it grows exponentially. If you have n branches the chance that all n branches terminate and thus the algorithm terminates is only 0.5n.
Name:
Anonymous2008-09-18 16:51
>>34
So... Is it common to have to argue a great deal about whether your Haskell programs terminate?
>>29
Sorry to disapoint you, but in this particular case the tree generation isn't lazy, because it's tied to the IO monad.
Name:
Anonymous2008-09-19 1:11
>>43
instance Random r => Random (BinaryTree r) where
randomR (a, b) g = let (useA, g1) = random g in
if useA then (a, g1) else (b, g1)
random g = let (leaf, g1) = random g in
if leaf
then let (value, g2) = random g1 in
(Leaf value, g2)
else let (left, g2) = random g1 in
let (right, g3) = random g2 in
let (value, g4) = random g3 in
(Branch left value right, g4)
There, no monads now. randomR doesn't really work like it's supposed to, but at least now there's no warnings.
Name:
Anonymous2008-09-19 10:17
>>44
I like monads.
import Control.Monad.State
import System.Random
import System
data BinaryTree a = Empty
| Node a (BinaryTree a) (BinaryTree a)
deriving Show
randomS :: (RandomGen s, Random a) => State s a
randomS = State random
randomRS :: (RandomGen s, Random a) => (a, a) -> State s a
randomRS = State . randomR
randomTree :: (RandomGen s, Random a) => State s (BinaryTree a)
randomTree = ([return Empty, randomNode] !!) =<< randomRS (0, 1)
randomNode :: (RandomGen s, Random a) => State s (BinaryTree a)
randomNode = liftM3 Node randomS randomTree randomTree
instance Random a => Random (BinaryTree a) where
--random = runState randomTree
random = runState randomNode
prune 0 _ = Empty
prune height tree
| height < 0 = error "prune: height must be non-negative"
| otherwise =
case tree of (Node v l r) -> Node v (ascend l) (ascend r)
Empty -> Empty
where ascend = prune (height - 1)
One of these days I need to set aside a week or so, hike out into the mountains with a copy of the Haskell documentation and just spend the week in quiet meditation reading and completing the exercises until I have some comprehension of this strange and wonderful language.
>>43,44
Despite the tree generation now being lazy, pruning a resulting tree still wouldn't guarantee termination upon printing. That's because each node's generation depends on state created by the generation of all nodes to its left. For pruning to do what's expected you have to split the random generator before each recursion in the tree generation.
import Control.Monad.State
import Control.Arrow
import System.Random
import System
data BinaryTree a = Empty
| Node a (BinaryTree a) (BinaryTree a)
deriving Show
randomRS :: (RandomGen g, Random a) => (a, a) -> State g a
randomRS bounds = State $ randomR bounds
splitS :: RandomGen g => State g a -> State g a
splitS fork = State $ first (evalState fork) . split
randomTreeS :: (RandomGen g, Random a, Eq a) => (a, a) -> State g (BinaryTree a)
randomTreeS bounds@(l, r)
| l == r = return Empty
| otherwise = do v <- randomRS bounds
splitS $ liftM2 (Node v) (randomTreeS (l, v))
(randomTreeS (v, r))
instance (Random a, Bounded a, Eq a) => Random (BinaryTree a) where
randomR = error "randomR: (BinaryTree a) does not implement this method"
random = runState $ randomTreeS (minBound, maxBound)
prune :: Integral i => i -> BinaryTree a -> BinaryTree a
prune 0 _ = Empty
prune height tree
| height < 0 = error "prune: height must be non-negative"
| otherwise =
case tree of Node v l r -> Node v (ascend l) (ascend r)
Empty -> Empty
where ascend = prune (height - 1)
main :: IO ()
main = print =<< liftM2 prune (fmap (read . head) getArgs)
(randomIO :: IO (BinaryTree Int))