Maximum tree depth in Haskell - haskell

I am given this type definition:
data Tree = Leaf Char | Branch2 Char Tree Tree | Branch3 Char Tree Tree Tree
How can I write a method that gives me the maximum path length of the tree (count the nodes in the path)?

You would want to write a recursive function to do this. For each Tree constructor, you'll need a different case in your function. To start with, you know that the depth of any Leaf is 1, so
maxDepth :: Tree -> Int
maxDepth (Leaf _) = 1
maxDepth (Branch2 c left right) = maximum [???]
maxDepth (Branch3 c left center right) = maximum [???]
I'll let you finish the rest of the function. You could do it a few different ways as well (such as using max instead of maximum).

with lazy corecursive breadth-first tree traversal:
treedepth tree = fst $ last queue
where
queue = (1,tree) : gen 1 queue
gen 0 p = []
gen len ((d,Leaf _ ) : p) = gen (len - 1) p
gen len ((d,Branch2 _ l r) : p) = (d+1,l) : (d+1,r) : gen (len + 1) p
gen len ((d,Branch3 _ l c r) : p) = (d+1,l) : (d+1,c) : (d+1,r) : gen (len + ??) p
changing it to the depth-first traversal will turn it into a regular recursion.

I'd probably write a tail-recursive solution by using continuation passing.
depth :: Tree -> Int
depth t = go t id
where
go (Leaf _) k = k 0
go (Branch2 _ l r) k = go l $ \dl -> go r $ \dr -> k (1 + max dl dr)
go (Branch3 _ l m r) k = go l $ \dl -> go m $ \dm -> go r $ \dr -> k (1 + max dl (max dm dr))

depth :: Tree -> Int
depth (Leaf _) = 1
depth (Branch2 c left right) = max((depth(left) + 1) (depth(right) + 1))
depth (Branch3 c left center right) = max(max((depth(left) + 1) (depth(right) + 1)) (depth(center) + 1))
Is that right? Sorry i'm not so good in recursive programming.

Related

Coordinates for clockwise outwards spiral

I'm trying to make what I think is called an Ulam spiral using Haskell.
It needs to go outwards in a clockwise rotation:
6 - 7 - 8 - 9
| |
5 0 - 1 10
| | |
4 - 3 - 2 11
|
..15- 14- 13- 12
For each step I'm trying to create coordinates, the function would be given a number and return spiral coordinates to the length of input number eg:
mkSpiral 9
> [(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
(-1, 1) - (0, 1) - (1, 1)
|
(-1, 0) (0, 0) - (1, 0)
| |
(-1,-1) - (0,-1) - (1,-1)
I've seen Looping in a spiral solution, but this goes counter-clockwise and it's inputs need to the size of the matrix.
I also found this code which does what I need but it seems to go counterclock-wise, stepping up rather than stepping right then clockwise :(
type Spiral = Int
type Coordinate = (Int, Int)
-- number of squares on each side of the spiral
sideSquares :: Spiral -> Int
sideSquares sp = (sp * 2) - 1
-- the coordinates for all squares in the given spiral
coordinatesForSpiral :: Spiral -> [Coordinate]
coordinatesForSpiral 1 = [(0, 0)]
coordinatesForSpiral sp = [(0, 0)] ++ right ++ top ++ left ++ bottom
where fixed = sp - 1
sides = sideSquares sp - 1
right = [(x, y) | x <- [fixed], y <- take sides [-1*(fixed-1)..]]
top = [(x, y) | x <- reverse (take sides [-1*fixed..]), y <- [fixed]]
left = [(x, y) | x <- [-1*fixed], y <- reverse(take sides [-1*fixed..])]
bottom = [(x, y) | x <- take sides [-1*fixed+1..], y <- [-1*fixed]]
-- an endless list of coordinates (the complete spiral)
mkSpiral :: Int -> [Coordinate]
mkSpiral x = take x endlessSpiral
endlessSpiral :: [Coordinate]
endlessSpiral = endlessSpiral' 1
endlessSpiral' start = coordinatesForSpiral start ++ endlessSpiral' (start + 1)
After much experimentation I can't seem to change the rotation or starting step direction, could someone point me in the right way or a solution that doesn't use list comprehension as I find them tricky to decode?
Let us first take a look at how the directions of a spiral are looking:
R D L L U U R R R D D D L L L L U U U U ....
We can split this in sequences like:
n times n+1 times
_^_ __^__
/ \ / \
R … R D … D L L … L U U … U
\_ _/ \__ __/
v v
n times n+1 times
We can repeat that, each time incrementing n by two, like:
data Dir = R | D | L | U
spiralSeq :: Int -> [Dir]
spiralSeq n = rn R ++ rn D ++ rn1 L ++ rn1 U
where rn = replicate n
rn1 = replicate (n + 1)
spiral :: [Dir]
spiral = concatMap spiralSeq [1, 3..]
Now we can use Dir here to calculate the next coordinate, like:
move :: (Int, Int) -> Dir -> (Int, Int)
move (x, y) = go
where go R = (x+1, y)
go D = (x, y-1)
go L = (x-1, y)
go U = (x, y+1)
We can use scanl :: (a -> b -> a) -> a -> [b] -> [a] to generate the points, like:
spiralPos :: [(Int, Int)]
spiralPos = scanl move (0,0) spiral
This will yield an infinite list of coordinates for the clockwise spiral. We can use take :: Int -> [a] -> [a] to take the first k items:
Prelude> take 9 spiralPos
[(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
The idea with the following solution is that instead of trying to generate the coordinates directly, we’ll look at the directions from one point to the next. If you do that, you’ll notice that starting from the first point, we go 1× right, 1× down, 2× left, 2× up, 3× right, 3× down, 4× left… These can then be seperated into the direction and the number of times repeated:
direction: > v < ^ > v < …
# reps: 1 1 2 2 3 3 4 …
And this actually gives us two really straightforward patterns! The directions just rotate > to v to < to ^ to >, while the # of reps goes up by 1 every 2 times. Once we’ve made two infinite lists with these patterns, they can be combined together to get an overall list of directions >v<<^^>>>vvv<<<<…, which can then be iterated over to get the coordinate values.
Now, I’ve always thought that just giving someone a bunch of code as the solution is not the best way to learn, so I would highly encourage you to try implementing the above idea yourself before looking at my solution below.
Welcome back (if you did try to implement it yourself). Now: onto my own solution. First I define a Stream data type for an infinite stream:
data Stream a = Stream a (Stream a) deriving (Show)
Strictly speaking, I don’t need streams for this; Haskell’s predefined lists are perfectly adequate for this task. But I happen to like streams, and they make some of the pattern matching a bit easier (because I don’t have to deal with the empty list).
Next, I define a type for directions, as well as a function specifying how they interact with points:
-- Note: I can’t use plain Left and Right
-- since they conflict with constructors
-- of the ‘Either’ data type
data Dir = LeftDir | RightDir | Up | Down deriving (Show)
type Point = (Int, Int)
move :: Dir -> Point -> Point
move LeftDir (x,y) = (x-1,y)
move RightDir (x,y) = (x+1, y)
move Up (x,y) = (x,y+1)
move Down (x,y) = (x,y-1)
Now I go on to the problem itself. I’ll define two streams — one for the directions, and one for the number of repetitions of each direction:
dirStream :: Stream Dir
dirStream = Stream RightDir $ Stream Down $ Stream LeftDir $ Stream Up dirVals
numRepsStream :: Stream Int
numRepsStream = go 1
where
go n = Stream n $ Stream n $ go (n+1)
At this point we’ll need a function for replicating each element of a stream a specific number of times:
replicateS :: Stream Int -> Stream a -> Stream a
replicateS (Stream n ns) (Stream a as) = conss (replicate n a) $ replicateS ns as
where
-- add more than one element to the beginning of a stream
conss :: [a] -> Stream a -> Stream a
conss [] s = s
conss (x:xs) s = Stream x $ appends xs s
This gives replicateS dirStream numRepsStream for the stream of directions. Now we just need a function to convert those directions to coordinates, and we’ve solved the problem:
integrate :: Stream Dir -> Stream Point
integrate = go (0,0)
where
go p (Stream d ds) = Stream p (go (move d p) ds)
spiral :: Stream Point
spiral = integrate $ replicateS numRepsStream dirStream
Unfortunately, it’s somewhat inconvenient to print an infinite stream, so the following function is useful for debugging and printing purposes:
takeS :: Int -> Stream a -> [a]
takeS 0 _ = []; takeS n (Stream x xs) = x : (takeS (n-1) xs)

Update a tree based on index Haskell

I have trees of the form:
data Tree a = Leaf | Node (Tree a) a (Tree a)
I created a function to look up the value of a node in a tree based on an in-order, left-to-right traversal.
getElem :: Tree a -> Int -> Maybe a
getElem Leaf _ = Nothing
getElem (Node l x r) n
| s == n = Just x
| n < s = getElem l n
| otherwise = getElem r (n - s - 1)
where
s = size l
I now want to write a method to be able to update a tree. It should be able to take in a tree, an index and a value and update the node at that index with the value. So far I have:
update :: Tree a -> Int -> a -> Tree a
update Leaf _ _ = Leaf
update (Node l x r) index c
| s == index = (Node l c r)
| index < s = update l index c
| otherwise = update r (index - s - 1) c
where
s = size l
This function is able to add but it obviously returns just the added node itself. I want to be able to return the entire tree post the 'update' with the new node or return the tree as is if the index is out of bounds.
Could anybody give me some idea how to proceed with this?
Edit 1:
Okay, I understand that I am basically discarding the remainder of my tree when recursing here. So:
update :: Tree a -> Int -> a -> Tree a
update Leaf _ _ = Leaf
update (Node l x r) index c
| s == index = (Node l c r)
| index < s = update (Node l2 x r) index c
| otherwise = update (Node l x r2) (index - s - 1) c
where
s = size l
l2 = l
r2 = r
Edit 2(Silly me!):
update :: Tree a -> Int -> a -> Tree a
update Leaf _ _ = Leaf
update (Node l x r) index c
| s == index = (Node l c r)
| index < s = (Node (upd l index c) x r)
| otherwise = (Node l x (upd r (index - s - 1) c))
where
s = size l
It took me a bit to wrap my head around it. Thank you for the comments!
Since in Haskell all data is immutable, you can not "update" a tree, you construct a new tree. That tree might however have references to subtrees of the old tree. You thus do not per se construct a completely new tree.
You managed to create an "updated" node, so now the only thing that is missing, is to use the "updated" subtree in a new tree. In that tree, you can use the "old" value together with the other subtree to construct a new one, like:
update :: Tree a -> Int -> a -> Tree a
update Leaf _ _ = Leaf
update (Node l x r) index c
| s == index = Node l c r
| index < s = Node (update l index c) x r
| otherwise = Node l x (update r (index - s - 1) c)
where s = size l
You might also need to change the Leaf case if you "count" a leaf as a node.
Trees with indices are not very common. It might also - in order to boost performance - be better to keep track of the number of items in the left subchild (or both), since then we can just pick the left or right subchild without counting the children. By keeping track of the number, for a complete tree, then updating the tree is an O(log n) operation, not an O(n) operation.

Finding out number of even paths from root in a tree

I'm trying to get a function that counts all paths from the root to a leaf that has an even number of nodes ( counting the root and the leaf)
My tree looks like this:
data Tree = Leaf Int | Node Int Tree Tree
all i got so far is a function that counts ALL nodes in a tree, which is easy enough:
countNodes (Leaf _) = 1
countNodes (Node _ x y) = 1+ countNodes x + countNodes y
Now i saw a bunch of questions that deal with trees but i felt like no answer helped me much, so I'm just gonna ask myself. How do i make a part of a function stop when a leaf is reached? I know this has to do with my problem to think with recursions.
What I tried to do was to to make list of all paths from the root, but i always end up with a function that gets all elements in the tree and puts them together somehow.
I'm missing something simple, please help. (or link me an answer that does exactly what i want)
I think the easiest way would be to make a data type that can describe a path through a tree:
data Path = L Path | R Path | End deriving (Eq, Show)
This type is basically a list but with two prepend constructors to tell you either go Left or go Right. This conveniently lets you look up items by path, or you can write a function that gives you a list of all paths in the tree.
-- Note that this can fail: lookupNode (Leaf 1) (L End) == Nothing
lookupNode :: Tree -> Path -> Maybe Tree
allPaths :: Tree -> [Path]
If you can write the allPaths function, then you can write the function you want on top of it. To start, just begin by listing the base cases:
allPaths (Leaf _) = [End]
allPaths (Node _ left right) = _
To fill in the hole _, think about what it means to list all the paths starting at a Node and recursing down left. You would need to have a L at the beginning of all of those paths, so you can put the following in there
allPaths (Node _ left right) = (map L $ allPaths left)
Similarly, you would need to handle the right tree:
allPaths (Node _ left right) =
(map L $ allPaths left) ++
(map R $ allPaths right)
So now:
> let tree =
Node 1
(Node 2 -- L _
(Leaf 3) -- L (L End)
(Node 4 -- L (R _)
(Leaf 5) -- L (R (L End))
(Leaf 6) -- L (R (R End))
)
)
(Leaf 7) -- R End
> allPaths tree
[L (L End),L (R (L End)), L (R (R End)),R End]
Now, to find the Leafs with an even number of nodes above them, first write a function that calculates a path length:
pathLength :: Path -> Int
pathLength End = 0
pathLength (L rest) = 1 + pathlength rest
pathLength (R rest) = 1 + pathLength rest
evenNodeCountPaths :: Tree -> [Path]
evenNodeCountPaths tree = filter (even . pathLength) $ allPaths tree
Note: It is possible to do this with
data Dir = L | R | End
type Path = [Dir]
But that can lead to invalid paths like [End, End, L, R, End], which just doesn't make any sense. I chose to go for the list-like data Path for this reason. You have to write your own pathLength function, but this formulation makes it impossible to have invalid paths.
Probably it's easier to compute both the number of even and the number of odd paths.
evenAndOdd (Leaf _) = (0, 1)
evenAndOdd (Node _ l r) = let
(el, ol) = evenAndOdd l
(er, or) = evenAndOdd r
in (ol+or, el+er)
If you really must, you can then define a function in terms of this to count just the even paths.
evenOnly = fst . evenAndOdd

Haskell ways to the 3n+1 challenge

Here is a simple programming problem from SPOJ: http://www.spoj.com/problems/PROBTRES/.
Basically, you are asked to output the biggest Collatz cycle for numbers between i and j. (Collatz cycle of a number $n$ is the number of steps to eventually get from $n$ to 1.)
I have been looking for a Haskell way to solve the problem with comparative performance than that of Java or C++ (so as to fits in the allowed run-time limit). Although a simple Java solution that memoizes the cycle length of any already computed cycles will work. I haven't been successful at applying the idea to obtain a Haskell solution.
I have tried the Data.Function.Memoize, as well as home-brewed log time memoization technique using the idea from this post: Memoization in Haskell?. Unfortunately, memoization actually makes the computation of cycle(n) even slower. I believe the slow down comes from the overhead of haskell way. (I tried running with the compiled binary code, instead of interpreting.)
I also suspect that simply iterating numbers from i to j can be costly ($i,j\le10^6$). So I even tried precompute everything for the range query, using idea from http://blog.openendings.net/2013/10/range-trees-and-profiling-in-haskell.html. However, this still gives "Time Limit Exceeding" error.
Can you help to inform a neat competitive Haskell program for this?
Thanks!
>>> using the approach bellow, I could submit an accepted answer to SPOJ. You may check the entire code from here.
The problem has bounds 0 < n < 1,000,000. Pre-calculate all of them and store them inside an array; then freeze the array. The array can be used as its own cache / memoization space.
The problem would then reduce to a range query problem over an array, which can be done very efficiently using trees.
With the code bellow I can get Collatz of 1..1,000,000 in a fraction of a second:
$ time echo 1000000 | ./collatz
525
real 0m0.177s
user 0m0.173s
sys 0m0.003s
Note that collatz function below, uses mutable STUArray internally, but itself is a pure function:
import Control.Monad.ST (ST)
import Control.Monad (mapM_)
import Control.Applicative ((<$>))
import Data.Array.Unboxed (UArray, elems)
import Data.Array.ST (STUArray, readArray, writeArray, runSTUArray, newArray)
collatz :: Int -> UArray Int Int
collatz size = out
where
next i = if odd i then 3 * i + 1 else i `div` 2
loop :: STUArray s Int Int -> Int -> ST s Int
loop arr k
| size < k = succ <$> loop arr (next k)
| otherwise = do
out <- readArray arr k
if out /= 0 then return out
else do
out <- succ <$> loop arr (next k)
writeArray arr k out
return out
out = runSTUArray $ do
arr <- newArray (1, size) 0
writeArray arr 1 1
mapM_ (loop arr) [2..size]
return arr
main = do
size <- read <$> getLine
print . maximum . elems $ collatz size
In order to perform range queries on this array, you may build a balanced tree as simple as below:
type Range = (Int, Int)
data Tree = Leaf Int | Node Tree Tree Range Int
build_tree :: Int -> Tree
build_tree size = loop 1 cnt
where
ctz = collatz size
cnt = head . dropWhile (< size) $ iterate (*2) 1
(Leaf a) +: (Leaf b) = max a b
(Node _ _ _ a) +: (Node _ _ _ b) = max a b
loop lo hi
| lo == hi = Leaf $ if size < lo then minBound else ctz ! lo
| otherwise = Node left right (lo, hi) (left +: right)
where
i = (lo + hi) `div` 2
left = loop lo i
right = loop (i + 1) hi
query_tree :: Tree -> Int -> Int -> Int
query_tree (Leaf x) _ _ = x
query_tree (Node l r (lo, hi) x) i j
| i <= lo && hi <= j = x
| mid < i = query_tree r i j
| j < 1 + mid = query_tree l i j
| otherwise = max (query_tree l i j) (query_tree r i j)
where mid = (lo + hi) `div` 2
Here is the same as in the other answer, but with an immutable recursively defined array (and it also leaks slightly (can someone say why?) and so two times slower):
import Data.Array
upper = 10^6
step :: Integer -> Int
step i = 1 + colAt (if odd i then 3 * i + 1 else i `div` 2)
colAt :: Integer -> Int
colAt i | i > upper = step i
colAt i = col!i
col :: Array Integer Int
col = array (1, upper) $ (1, 1) : [(i, step i) | i <- [2..upper]]
main = print $ maximum $ elems col

Haskell: Get path from every leaf node to root in a Bin tree structure

I've got work to do, but i dunno how to do it.
I have Bin tree
1
/ \
2 3
/ \ / \
4 5 6 7
And I need to find the way from root to Node with the coord [i, j].
For example: (2, 2) -> [1, 3, 6]
fromRoot :: Int -> Int -> Tree a -> [a]
I wrote some function for Index and BinTree, but how to make main function i dont know.
data Tree a = Node (Tree a) a (Tree a)
index :: Tree a -> Int -> Int -> a
index (Node _ x _ ) 0 _ = x
index (Node l x r) i j | ((border i)<j) = index r (i-1) (j-(border i)-1)
| otherwise = index l (i-1) j
border :: Int -> Int
border 0 = 0
border 1 = 0
border l = 2*(border (l-1))+1
myBuild :: Int -> Tree Int
myBuild n = (Node (myBuild (n*2)) n (myBuild (n*2+1)))
Since this is homework I won't give a complete solution, but some hints:
how do you represent an empty tree with your Tree type?
how do you represent the example tree (or any other finite tree)?
Considering the main function: you don't necessarily need one, a good way to start is running
ghci your_source_file.hs
You can then evaluate parts of your program, e.g.:
fromRoot 2 3 t1 -- if you have a t1 is a tree
Apart from that you could write a main function like this:
test_tree = ... -- you need to fill in the dots (see questions above)
main :: IO ()
main = do print (fromRoot 2 2 test_tree)
If you need to find some documentation, use http://haskell.org/hoogle/

Resources