I have a datastructure for a tree with nodes that have either one or two childs. I can generate a random tree with a given maximum Depth. Now I want to generate these random three with a given maximum amount of nodes (/leafes). This is my structure:
import System.Random
data Tree a = Leaf
| NodeTwo (Tree a) (Tree a)
| NodeOne (Tree a)
deriving (Show)
create :: RandomGen g => Int -> Int -> Int -> Int -> g -> Tree a
create depth maxNodeOne maxNodeTwo maxLeaf g
| (depth == 0) = Leaf
| (x >= a && x < c && (maxNodeTwo /= 0))
= let (g1, g2) = split g in
NodeTwo (create (depth -1) maxNodeOne (maxNodeTwo-1)
maxLeaf g1) (create (depth -1) maxNodeOne
(maxNodeTwo-1) maxLeaf g2)
|(x >= c && x < 2*c && (maxNodeOne /= 0))
= NodeOne (create (depth -1)
(maxNodeOne -1) maxNodeTwo maxLeaf g')
| otherwise = Leaf
where (x, g') = next g
(a, b) = genRange g
c = (b - a) `div` 3
countFnk :: Tree a -> Int
countFnk (Leaf) = 0
countFnk (NodeOne a) = countFnk a
countFnk (NodeTwo a b) = 1 + countFnk a + countFnk b
countLam :: Tree a -> Int
countLam (Leaf) = 0
countLam (NodeOne a) = 1 + countLam a
countLam (NodeTwo a b) = countLam a + countLam b
countLeaf :: Tree a -> Int
countLeaf (Leaf) = 1
countLeaf (NodeOne a) = countLeaf a
countLeaf (NodeTwo a b) = countLeaf a + countLeaf b
This attempt fails ofcourse. I don't know how to decrement the counter(s) for the node(s) in the recursion. I also have functions which can get me the amount of nodes (/leafes) but I don't know how to use these functions in my create function since they need a finished tree to scan.
Thanks for your help.
The most obvious problem is in your NodeTwo case. You arrive at that point with a "budget" of NodeTwos and NodeOnes to spend. But you tell both branches of your new tree the same thing: "feel free to spend the whole total budget"! Of course if they both do that, you will wind up spending double your budget.
You need some way to negotiate a budget for each branch of the tree. There are a number of ways you could do this; for example, give one branch access to the whole budget, and give whatever is left to the second branch. Or you could decide before creating either branch how to divide the budget between them, and give each branch only a portion of your total budget.
Either of those two approaches probably introduce some bias in your randomness, which may or may not matter to you. You should think of a way to handle the budget accounting in a way that produces the kinds of random trees you want.
Once you've fixed this, you'll run into other problems: there are constraint sets for which it is impossible to build a tree fitting them! Most notably, if maxLeaf is zero, you can't create any kind of tree at all, since every tree has at least one leaf node somewhere. You'll have to be careful not to build any subtrees with too few leaves available to let them terminate.
Related
I'm trying to implement a Binomial Heap in Haskell, using the book "Purely Functional Data Structures" Chris Okasaki.
{- Implemetation of Binomial Heap-}
module BinomialHeap where
{- Definition of a Binomial Tree -}
data BTree a = Node Int a ([BTree a]) deriving Show
{- Definition of a Binomial Heap -}
data BHeap a = Heap [BTree a] deriving Show
empty :: BHeap a
empty = Heap []
{- Linking function tree -}
-- w/ larger root is
-- linked w/ tree w/ lower root -}
link :: Ord a => BTree a -> BTree a -> BTree a
link t1#(Node r x1 c1) t2#(Node _ x2 c2) =
if x1 < x2 then
Node (r+1) x1 (t2:c1)
else
Node (r+1) x2 (t1:c2)
root :: BTree a -> a
root (Node _ x _) = x
{- Gives the rank of the Binomial Tree-}
rank :: BTree a -> Int
rank (Node r _ _ ) = r
{- Insertion in the tree -}
-- Create a new singl. tree
-- Step through the existing trees in increasing order
-- until we find a missing rank
-- link tree of equal ranks
-- atm it's O(log n)
insTree :: Ord a => BTree a -> [BTree a] -> [BTree a]
insTree t [] = [t]
insTree t ts1#(t1':ts1') =
if rank t > rank t1' then
t:ts1
else
insTree (link t t1') ts1'
insert :: Ord a => BHeap a -> a -> BHeap a
insert (Heap ts) x = Heap $ insTree (Node 0 x []) ts
{- Merge of Heaps-}
-- We step through both list of tree in increasing order
-- link tree of equal root
merge :: Ord a => [BTree a] -> [BTree a] -> [BTree a]
merge [] ts = ts
merge ts [] = ts
merge ts1#(t1:ts1') ts2#(t2:ts2') =
if rank t1 < rank t2 then
t1:merge ts1' ts2
else if rank t2 < rank t1 then
t2:merge ts1 ts2'
else
insTree (link t1 t2) (merge ts1' ts2')
sampleHeap :: BHeap Int
sampleHeap = foldl insert empty [1, 2, 3]
The problem is that insertion gives me an output that isn't right :
Heap [Node 1 1 [Node 0 3 [],Node 0 2 []]]
The insertion primitive might not be correct. Okasaki says :
"To insert a new element into a heap, we first create a new singleton tree (rank 0). We then step through the existing trees in increasing order of rank until we find a missing rank, linking tree of equal rank as we go. Each link corresponds to a carry in binary arithmetic"
Can you help me find where there can be an error in the insertions primitives ?
Thank you.
From page 71 of Okasaki's paper (https://www.cs.cmu.edu/~rwh/theses/okasaki.pdf):
For reasons that will become clear later, we maintain the list of
trees representing a heap in increasing order of rank, but maintain
the list of trees representing the children of a node in decreasing
order of rank.
Let's look at your insTree function in light of this statement:
insTree :: Ord a => BTree a -> [BTree a] -> [BTree a]
insTree t [] = [t]
insTree t ts1#(t1':ts1') =
if rank t > rank t1' then
t:ts1
else
insTree (link t t1') ts1'
Pay attention to the case where the list of binomial trees isn't empty. The code there says if the rank of the tree being inserted is greater than the rank of next tree in the list, prepend the tree to the list. This violates the assumption that the list of trees representing a heap is organized in increasing order of rank. Reversing the sign from > to < in the comparison should fix the problem.
I have these structures:
data Tree = Leaf Points | Branch Points [Tree]
deriving(Eq,Show)
data Design = Design Tree Tree Int
deriving(Eq,Show)
data type Tree is a part of data type Design and Design holds two Trees:
type Points = [(Int,Int,Int,Int)]
design = Design mtree btree 180
I have to find all the possible paths:
numberPaths :: Design -> Int
and change the third Integer from Points and also 180 from design:
type Points = [(Int,Int,Int,Int)]
design = Design mtree btree 180
changeInt :: Design -> Design
Count paths
To find the number of paths in a tree, we recursively descend down the tree to count the number of subpaths for each node and then sum them up. So aside from having numberPaths as the interface, we also need another auxiliary function whose type signature is Tree -> Int. Let's call it descend.
descend :: Tree -> Int
We count Leaf as 1, and Branch as the sum of number of paths of its subtrees. So the descend becomes:
descend :: Tree -> Int
descend (Leaf _) = 1
descend (Branch _ subtress) = foldr (\tree sum -> sum + descend tree) 0 subtrees
The function numberPaths only need to call descend to count its two trees.
numberPaths :: Design -> Int
numberPaths (Design a b _) = descend a + descend b
Chang Int
The type signature of changeInt indicates that no Int value is introduced to change Design type. This, I think, does not make sense so I have taken the liberty of changing it into Int -> Design -> Design.
The implementation of changeInt follows a similar pattern. To change the tree we recursively walk down each level of the tree. We also introduce an auxiliary function changePoints.
changeTree :: Int -> Tree -> Tree
changeTree n (Leaf points) = Leaf $ changePoints n points
changeTree n (Branch points subtrees) = Branch points' subtrees'
where points' = changePoints n points
subtrees' = map (changeTree n) subtrees
changePoints :: Int -> Points -> Points
changePoints n points = map (\(x, y, _, z) -> (x, y, n, z)) points
The changeInt then only needs to call changeTree to finish the job.
changeInt :: Int -> Design -> Design
changeInt n (Design mtree btree _) = Design mtree' btree' n
where mtree' = changeTree n mtree
btree' = changeTree n btree
Apologies for my poor wording of the question. I've tried searching for an answer but not knowing what to search is making it very difficult to find one.
Here is a simple function which calculates the area of a triangle.
triangleArea :: Float -> Float -> Float -> Float
triangleArea a b c
| (a + b) <= c = error "Not a triangle!"
| (a + c) <= b = error "Not a triangle!"
| (b + c) <= a = error "Not a triangle!"
| otherwise = sqrt (s * (s - a) * (s - b) * (s - c))
where s = (a + b + c) / 2
Three lines of the function have been taken up for the purposes of error checking. I was wondering if these three lines could be condensed into one generic line.
I was wondering if something similar to the following would be possible
(arg1 + arg2) == arg3
where Haskell knows to check each possible combination of the three arguments.
I think #behzad.nouri's comment is the best. Sometimes doing a little math is the best way to program. Here's a somewhat overdone expansion on #melpomene's solution, which I thought would be fun to share. Let's write a function similar to permutations but that computes combinations:
import Control.Arrow (first, second)
-- choose n xs returns a list of tuples, the first component of each having
-- n elements and the second component having the rest, in all combinations
-- (ignoring order within the lists). N.B. this would be faster if implemented
-- using a DList.
choose :: Int -> [a] -> [([a],[a])]
choose 0 xs = [([], xs)]
choose _ [] = []
choose n (x:xs) =
map (first (x:)) (choose (n-1) xs) ++
map (second (x:)) (choose n xs)
So..
ghci> choose 2 [1,2,3]
[([1,2],[3]),([1,3],[2]),([2,3],[1])]
Now you can write
triangleArea a b c
| or [ x + y <= z | ([x,y], [z]) <- choose 2 [a,b,c] ] = error ...
This doesn't address the question of how to shorten your error checking code, but you may be able to limit how often you repeat it by defining some new types with invariants. This function needs error checking because you can't trust the user to supply Float triples that make a reasonable triangle, and if you continue to define functions this way then every triangle-related function you write would need similar error checks.
However, if you define a Triangle type, you can check your invariants only once, when a triangle is created, and then all other functions will be guaranteed to receive valid triangles:
module Triangle (Triangle(), mkTriangle, area) where
data Triangle a = Triangle a a a deriving Show
mkTriangle :: (Num a, Ord a) => a -> a -> a -> Either String (Triangle a)
mkTriangle a b c
| a + b <= c = wrong
| a + c <= b = wrong
| b + c <= a = wrong
| otherwise = Right $ Triangle a b c
where wrong = Left "Not a triangle!"
area :: Floating a => Triangle a -> a
area (Triangle a b c) = sqrt (s * (s - a) * (s - b) * (s - c))
where s = (a + b + c) / 2
Here we export the Triangle type, but not its constructor, so that the client must use mkTriangle instead, which can do the required error checking. Then area, and any other triangle functions you write, can omit the checks that they are receiving a valid triangle. This general pattern is called "smart constructors".
Here are two ideas.
Using existing tools, you can generate all the permutations of the arguments and check that they all satisfy a condition. Thus:
import Data.List
triangleArea a b c
| any (\[x, y, z] -> x + y <= z) (permutations [a,b,c])
= error "Not a triangle!"
| otherwise = {- ... -}
This doesn't require writing very much additional code; however, it will search some permutations you don't care about.
Use the usual trick for choosing an element from a list and the left-overs. The zippers function is one I use frequently:
zippers :: [a] -> [([a], a, [a])]
zippers = go [] where
go b [] = []
go b (v:e) = (b, v, e) : go (v:b) e
We can use it to build a function which chooses only appropriate triples of elements:
triples :: [a] -> [(a, a, a)]
triples xs = do
(b1, v1, e1) <- zippers xs
(b2, v2, e2) <- zippers e1
v3 <- b1 ++ b2 ++ e2
return (v1, v2, v3)
Now we can write our guard like in part (1), but it will only consider unique pairings for the addition.
triangleArea a b c
| any (\(x, y, z) -> x + y <= z) (triples [a,b,c])
= error "Not a triangle!"
| otherwise = {- ... -}
I'm trying to implement with Haskell an algorithm to manipulate mathematical expressions.
I have this data type :
data Exp = Var String | IVal Int | Add Exp Exp
This will be enough for my question.
Given a set of expression transformations, for example :
(Add a b) => (Add b a)
(Add (Add a b) c) => (Add a (Add b c))
And an expression, for example : x = (Add (Add x y) (Add z t)), I want to find all expressions in the neighborhood of x. Given that neighborhood of x is defined as: y in Neighborhood(x) if y can be reached from x within a single transformation.
I am new to Haskell. I am not even sure Haskell is the right tool for this job.
The final goal is to get a function : equivalent x which returns a set of all expressions that are equivalent to x. In other words, the set of all expressions that are in the closure of the neighborhood of x (given a set of transformations).
Right now, I have the following :
import Data.List(nub)
import Data.Set
data Exp = IVal Int
| Scalar String
| Add Exp Exp
deriving (Show, Eq, Ord)
commu (Add a b) = (Add b a)
commu x = x
assoc (Add (Add a b) c) = (Add a (Add b c))
assoc (Add a (Add b c)) = (Add (Add a b) c)
assoc x = x
neighbors x = [commu x, assoc x]
equiv :: [Exp] -> [Exp]
equiv closure
| closure == closureUntilNow = closure
| otherwise = equiv closureUntilNow
where closureUntilNow = nub $ closure ++ concat [neighbors x|x<-closure]
But It's probably slower than needed (nub is O(n^2)) and some terms are missing.
For example, if you have f = (x+y)+z, then, you will not get (x+z)+y, and some others.
Imports, etc. below. I'll be using the multiset package.
import Control.Monad
import Data.MultiSet as M
data Exp = Var String | IVal Int | Add Exp Exp deriving (Eq, Ord, Show, Read)
A bit of paper-and-pencil work shows the following fact: expressions e1 and e2 are in the congruence closure of your relation iff the multiset of leaves are equal. By leaves, I mean the Var and IVal values, e.g. the output of the following function:
leaves :: Exp -> MultiSet Exp
leaves (Add a b) = leaves a `union` leaves b
leaves e = singleton e
So this suggests a nice clean way to generate all the elements in a particular value's neighborhood (without attempting to generate any duplicates in the first place). First, generate the multiset of leaves; then nondeterministically choose a partition of the multiset and recurse. The code to generate partitions might look like this:
partitions :: Ord k => MultiSet k -> [(MultiSet k, MultiSet k)]
partitions = go . toOccurList where
go [] = [(empty, empty)]
go ((k, n):bag) = do
n' <- [0..n]
(left, right) <- go bag
return (insertMany k n' left, insertMany k (n-n') right)
Actually, we only want partitions where both the left and right part are non-empty. But we'll check that after we've generated them all; it's cheap, as there's only two that aren't like that per invocation of partitions. So now we can generate the whole neighborhood in one fell swoop:
neighborhood :: Exp -> [Exp]
neighborhood = go . leaves where
full = guard . not . M.null
go m
| size m == 1 = toList m
| otherwise = do
(leftBag, rightBag) <- partitions m
full leftBag
full rightBag
left <- go leftBag
right <- go rightBag
return (Add left right)
By the way, the reason you're not getting all the terms is because you're generating the reflexive, transitive closure but not the congruence closure: you need to apply your rewrite rules deep in the term, not just at the top level.
Assume I have a binary tree:
data Bst a = Empty | Node (Bst a) a (Bst a)
I have to write a function that searches for a value and returns the number of its children. If there is no node with this value, it returns -1. I was trying to write both BFS and DFS, and I failed with both.
Pattern matching is your friend. Your Bst can either be Empty or a Node, so at the toplevel, your search function will be
search Empty = ...
search (Node left x right) = ...
Can an Empty tree possibly contain the target value? With a Node the target value, if present, will be either the node value (x above), in the left subtree, in the right subtree—or perhaps some combination of these.
By “return[ing] the number of its children,” I assume you mean the total number of descendants of the Bst rooted at a Node whose value is the target, which is an interesting combination of problems. You will want another function, say numChildren, whose definition uses pattern matching as above. Considerations:
How many descendants does an Empty tree have?
In the Node case, x doesn’t count because you want descendants. If only you had a function to count the number of children in the left and right subtrees …
Here is a way to do this. Breath-first search can actually be a bit tricky to implement and this solution (findBFS) has aweful complexity (appending to the list is O(n)) but you'll get the gist.
First I have decided to split out the finding functions to return the tree where the node element matches. That simplifies splitting out the counting function. Also, it is easier to return the number of elements than the number of descendants and return -1 in case not found, so the numDesc functions rely on the numElements function.
data Tree a = Empty
| Node a (Tree a) (Tree a)
numElements :: Tree a -> Int
numElements Empty = 0
numElements (Node _ l r) = 1 + numElements l + numElements r
findDFS :: Eq a => a -> Tree a -> Tree a
findDFS _ Empty = Empty
findDFS x node#(Node y l r) | x == y = node
| otherwise = case findDFS x l of
node'#(Node _ _ _) -> node'
Empty -> findDFS x r
findBFS :: Eq a => a -> [Tree a] -> Tree a
findBFS x [] = Empty
findBFS x ((Empty):ts) = findBFS x ts
findBFS x (node#(Node y _ _):ts) | x == y = node
findBFS x ((Node _ l r):ts) = findBFS x (ts ++ [l,r])
numDescDFS :: Eq a => a -> Tree a -> Int
numDescDFS x t = numElements (findDFS x t) - 1
numDescBFS :: Eq a => a -> Tree a -> Int
numDescBFS x t = numElements (findBFS x [t]) - 1