Consider the following type:
data LTree a = Leaf a | Fork (LTree a) (LTree a)
Now consider the following function that lists the leaves of a tree, together with its depth
tolistdepth :: LTree a -> [(a,Int)]
tolistdepth (Leaf x) = [(x,0)]
tolistdepth (Fork e d) = map (\(x,n) -> (x,n+1)) (tolistdepth e ++ tolistdepth d)
I need help defining the following function
build :: [(a, Int)] -> LTree a
that calculates the inverse of the first function so that
build (tolistdepth a) = a
I don't even know where to start :)
I have managed to do the following:
build :: [(a, Int)] -> LTree a
build xs = let ys= map (\(x, n) -> (Leaf x, n)) xs
in SOMETHING iterateUntil SOMETHING (buildAssist ys)
buildAssist :: [(LTree a, Int)] -> [(LTree a, Int)]
buildAssist [] = []
buildAssist [x] = [x]
buildAssist (x#(t1, n1):y#(t2, n2):xs) = if n1 == n2 then ((Fork t1 t2), n1 - 1):buildAssist xs
else x:(buildAssist (y:xs))
This way, I think I have dealt with when to fork.
Now, how do I use buildAssist in my original function (if buildAssist is of any use of course)?
I believe I have figured it out.
Please let me know if this works:
build :: [(a,Int)] -> LTree a
build l = fst (buildaccum 0 l)
buildaccum :: Int -> [(a,Int)] -> (LTree a, [(a,Int)])
buildaccum n l#((a,b):t) |n==b = (Leaf a,t)
|n<b = (Fork e d, l2)
where (e,l1) = buildaccum (n+1) l
(d,l2) = buildaccum (n+2) l1
I'll give you a hint which demonstrates a helpful technique when parsing lists.
What really is at work here is a function like this:
build' :: [(a,Int)] -> (LTree a, [(a,Int)])
That is, build' returns a LTree a and the rest of the input list it has not yet consumed.
In this form the definition of build' goes something like this:
build' [] = error "oops - bad input list"
build' ((a,n):xs) =
if we are at a leaf node, return (LTree a, xs)
if we decide we need to fork, then return (Fork e f,zs)
where
(e,ys) = build' ((a,n):xs) -- parse the left branch
(f,zs) = build' ys -- parse the right branch
Note this is just pseudo-code, and there are important details missing which I am leaving as an exercise.
The interesting part is how the remaining input list is determined in the Fork case.
ys is the remaining input after parsing the left branch, and this is fed as input to build' to get the right branch, and the remaining input of that call to build' (zs) is returned as the remaining input from the original build' call.
Update:
To iterate a function f with starting value x until a certain condition p, follow this formula:
iterateUntil p f x = if p x then x else iterateUntil p f (f x)
Related
So I've been doing this program which receives a function f, a number a and a list b and it should return a list [a, f(a,b), f(f(a,b),b, ..] iterating through the list b and using recursion. Do you guys know how I can optimize my code?
calculate :: (a -> b -> a) -> a -> [b] -> [a]
help :: (a -> b -> a) -> a -> [b] -> [a]
help f a (x:xs) = (f a x) : (calculate f (f a x) xs)
help f a [] = []
calculate f a b = a : (help f a b)
calculate f a b = tail . concatMap (replicate 2) . scanl f a $ b.
The replicate bit is probably in error. If so, then simply calculate = scanl.
This translates the code, as the "[a, f(a,b), f(f(a,b),b, ..]" from the text contradicts it (and it contradicts the text itself, which talks of "iterating through the list b").
I'm having trouble writing this function that takes a predicate and a list of integers, then eliminates the last occurrence of the integer that satisfies the predicate in the list. I was able to take out the first occurrence of the predicate in the list with my function below:
fun :: (Int -> Bool) -> [Int] -> [Int]
fun check (s:ss)
|check s = ss
|otherwise = s : fun check ss
What I need help on is how I should modify this function to take out the last occurrence of the integer, instead of the first. For example, fun (<2) [3,4,1,5,0,-3,9] would return [3,4,1,5,0,9].
(I couldn't use where due to some indentation problems)
removeLast :: (a -> Bool) -> [a] -> [a]
removeLast p xs =
let
go c [] = tail (c [])
go c (x:xs)
| p x = c (go (x:) xs)
| otherwise = go (c . (x:)) xs
in case break p xs of
(ok, []) -> ok
(ok, x:xs) -> ok ++ go (x:) xs
go collects elements for which the predicate doesn't hold in a difference list and prepends this list to the result once a new satisfying the predicate element is found. Pattern matching on break p xs ensures that difference lists always start with an element that satisfies the predicate and we can drop it if it's the last.
Works with infinite lists:
main = do
print $ removeLast (< 2) [3,4,1,5,0,-3,9] -- [3,4,1,5,0,9]
print $ removeLast (== 2) [1,3] -- [1,3]
print $ take 10 $ removeLast (< 2) (cycle [1,3]) -- [1,3,1,3,1,3,1,3,1,3]
Here is an obfuscated version:
removeLast :: (a -> Bool) -> [a] -> [a]
removeLast p xs = case break p xs of
(ok, []) -> ok
(ok, x:xs) -> ok ++ foldr step (tail . ($[])) xs (x:) where
step x r c = if p x then c (r (x:)) else r (c . (x:))
If you want to have fun with it, try this version.
removeLast :: (a -> Bool) -> [a] -> [a]
removeLast p = fst . foldr go ([], False) where
go x ~(r, more)
| p x = (if more then x : r else r, True)
| otherwise = (x : r, more)
This seems to be almost as lazy as it can be, and it gets to the point pretty quickly. It could produce the list spine more lazily with some effort, but it produces list elements maximally lazily.
After some more thought, I realize that there is some tension between different aspects of laziness in this case. Consider
removeLast p (x : xs)
There are two ways we can try to find out whether to produce a [] or (:) constructor.
We can check xs; if xs is not [], then we can produce (:).
We can check p x. If p x is False, then we can produce (:).
These are the only ways to do it, and their strictness is not comparable. The only "maximally lazy" approach would be to use parallelism to try it both ways, which is not the most practical approach.
How about this:
fun :: (Num a) => (a -> Bool) -> [a] -> [a]
fun check (s:ss)
|check s = ss
|otherwise = s : fun check ss
Then, apply your fun function like this:
reverse $ fun (\ x -> x `mod` 3 == 0) (reverse [1..10])
HTH
I have this data structure for a tree:
data Tree a = NodeT a (Tree a) ( Tree a) | EmptyT
I need to create a function that returns a list of lists where each element of the list represents a level of the tree. For instance, from this:
1
/ \
2 3
/ \ / \
4 5 6 7
to this: [[1],[2,3],[4,5,6,7]]
The function must have the following form:
f :: Tree a -> [[a]]
How to do it using recursion?
anyone?
Thanks
Answer
levels :: Tree a -> [[a]]
levels t = levels' t []
levels' :: Tree a -> [[a]] -> [[a]]
levels' EmptyT rest = rest
levels' (NodeT a l r) [] = [a] : levels' l (levels r)
levels' (NodeT a l r) (x : xs) = (a : x) : levels' l (levels' r xs)
A slightly more complicated, but lazier, implementation of levels':
levels' EmptyT rest = rest
levels' (NodeT a l r) rest = (a : front) : levels' l (levels' r back)
where
(front, back) = case rest of
[] -> ([], [])
(x : xs) -> (x, xs)
Fans of folds will note that these are structured as catamorphisms:
cata :: (a -> b -> b -> b) -> b -> Tree a -> b
cata n e = go
where
go EmptyT = e
go (NodeT a l r) = n a (go l) (go r)
levels t = cata br id t []
where
br a l r rest = (a : front) : l (r back)
where
(front, back) = case rest of
[] -> ([], [])
(x : xs) -> (x, xs)
As chi points out, there seems to be some connection between this general approach and the result of using Jakub Daniel's solution with difference lists as intermediate forms. This could look something like
import Data.Monoid
levels :: Tree a -> [[a]]
levels = map (flip appEndo []) . (cata br [])
where
br :: a -> [Endo [a]] -> [Endo [a]] -> [Endo [a]]
br a l r = Endo (a :) : merge l r
merge :: Monoid a => [a] -> [a] -> [a]
merge [] ys = ys
merge (x : xs) ys = (x <> y) : merge xs ys'
where
(y,ys') =
case ys of
[] -> (mempty, [])
p : ps -> (p, ps)
I'm not entirely sure just how this compares with the more direct approaches.
Discussion
Kostiantyn Rybnikov's answer cites Okasaki's Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design, an excellent paper that highlights many functional programmers' "blind spots" and offers good arguments for making abstract data types easy enough to use that they won't be missed. However, the problem that paper describes is significantly more complex than this one; not so much machinery is required here. Also, the paper notes that level-oriented solutions are actually slightly faster than queue-based ones in ML; I'd expect to see a larger difference in a lazy language like Haskell.
Jakub Daniel's answer attempts a level-oriented solution, but unfortunately has an efficiency problem. It builds each level by repeatedly appending one list to another, and those lists may all be of equal length. Thus in the worst case, if I am calculating this correctly, it takes O(n log n) to process a tree with n elements.
The approach I chose is level-oriented, but avoids the pain of concatenation by passing each left subtree the levels of its right sibling and cousins. Each node/leaf of the tree is processed exactly once. That processing involves O(1) work: pattern matching on that node/leaf, and, if it is a node, pattern matching on the list derived from the right sibling and cousins. Thus the total time is O(n) to process a tree with n elements.
You recursively compute the levels and always merge lists from two subtrees point-wise (thus all the slices in the same depth get merged together).
f :: Tree a -> [[a]]
f EmptyT = []
f (NodeT a t1 t2) = [a] : merge (f t1) (f t2)
merge :: [[a]] -> [[a]] -> [[a]]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys) = (x ++ y) : merge xs ys
If the tree were complete (all the paths from the root to a list are of the same length) then you could use zipWith (++) as merge.
Slightly more complicated solution, than the one which was accepted, but I think mine might be better in terms of memory consumption (it's a bit late, so please check yourself).
Intuition goes from a wonderful paper of Chris Okasaki "Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design". You can get general intuition on breadth-first tree traversals of trees in functional languages in detail.
I did somewhat ugly addition to add the "list of lists" splitting, there might be a better way:
module Main where
data Tree a = NodeT a (Tree a) (Tree a) | EmptyT
-- 1
-- / \
-- 2 3
-- / \ / \
-- 4 5 6 7
f :: Tree a -> [[a]]
f t = joinBack (f' [(t, True)])
type UpLevel = Bool
f' :: [(Tree a, UpLevel)] -> [(a, UpLevel)]
f' [] = []
f' ((EmptyT, _) : ts) = f' ts
f' ((NodeT a t1 t2, up) : ts) = (a, up) : f' (ts ++ [(t1, up)] ++ [(t2, False)])
joinBack :: [(a, UpLevel)] -> [[a]]
joinBack = go []
where
go acc [] = [reverse acc]
go acc ((x, False) : xs) = go (x : acc) xs
go acc ((x, True) : xs) = reverse acc : go [] ((x, False):xs)
main :: IO ()
main = do
let tree = NodeT 1 (NodeT 2 (NodeT 4 EmptyT EmptyT) (NodeT 5 EmptyT EmptyT))
(NodeT 3 (NodeT 6 EmptyT EmptyT) (NodeT 7 EmptyT EmptyT))
:: Tree Int
print (tail (f tree))
I need an operation which iterates over a list and produces a new list, where the new list elements depend on all elements previously seen. To do this I would like to pass an accumulator/state from iteration to iteration.
Think for example of a list of tuples, where the components of a tuple can be "undefined". An undefined value shall assume the latest value of the same component earlier in the list, if any. So at any stage I will have a state of defined components, which I need to pass to the next iteration.
So with a list of type [l] and an accumulator/state of type a there will be a function of type
f :: a -> l -> (a,l)
i.e it spits out a new list element and a new accumulator.
Is there a function which allows simply applying f to a list? I looked at fold, scan and unfold, but none of them seem to do the trick.
Edit: While the state monad looks promising, I can only see how I would get the final state, but I fail to see how I would get the new list elements.
There are some standard functions you can use to do what you ask.
It sounds very much like you want mapAccum, so you just need to import Data.List and decide which way round you're accumulating. (I suspect you want mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y]).)
mapAccumL
import Data.List
data Instruction = NoChange | Reset | MoveBy Int
tell :: Int -> Instruction -> (Int,String) -- toy accumulating function
tell n NoChange = (n,"")
tell n Reset = (0,"Reset to zero")
tell n (MoveBy i) = (n+i,"Add "++show i++" to get "++ show (n+i))
which would give
ghci> mapAccumL tell 10 [MoveBy 5, MoveBy 3, NoChange, Reset, MoveBy 7]
(7,["Add 5 to get 15","Add 3 to get 18","","Reset to zero","Add 7 to get 7"])
scanL
But maybe you don't need to use the full power of mapAccum because sometimes the accumulator is what you want in the new list, so scanl :: (a -> b -> a) -> a -> [b] -> [a] will do the trick
act :: Int -> Instruction -> Int
act n NoChange = n
act n Reset = 0
act n (MoveBy i) = n+i
like this:
ghci> scanl act 10 [MoveBy 5, MoveBy 3, NoChange, Reset, MoveBy 7]
[10,15,18,18,0,7]
Definition for mapAccum
Anyway, here's how mapAccumL and mapAccumR are described in Data.List:
mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumL _ state [] = (state, [])
mapAccumL f state (x:xs) = (finalstate,y:ys)
where (nextstate, y ) = f state x
(finalstate,ys) = mapAccumL f nextstate xs
The mapAccumL function behaves like a combination of map and foldl; it applies a function to each element of a list, passing an accumulating parameter from left to right, and returning a final value of this accumulator together with the new list.
mapAccumR :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
mapAccumR _ state [] = (state, [])
mapAccumR f state (x:xs) = (finalstate, y:ys)
where (finalstate,y ) = f nextstate x
(nextstate, ys) = mapAccumR f state xs
The mapAccumR function behaves like a combination of map and foldr; it applies a function to each element of a list, passing an accumulating parameter from right to left, and returning a final value of this accumulator together with the new list.
You want mapM in conjunction with the State monad where your accumulator a will be the State. First, to see why you need State, just take your type signature and flip the order of arguments and results:
import Data.Tuple
f :: a -> l -> (a, l)
uncurry f :: (a, l) -> (a, l)
swap . uncurry f . swap :: (l, a) -> (l, a)
curry (swap . uncurry f . swap) :: l -> a -> (l, a)
Or you could just define f to already have the arguments and results in the right order, whichever you prefer. I will call this swapped function f':
f' :: l -> a -> (l, a)
Now lets add an extra set of parentheses around the right half of the type signature of f':
f' :: l -> (a -> (l, a))
That part grouped in parentheses is a State computation where the state is a and the result is l. So I will go ahead and convert it to the State type using the state function from Control.Monad.Trans.State:
state :: (a -> (l, a)) -> State a l
So the converted f' would look like this:
f'' :: l -> State a l
f'' = state . f'
However, the function you really want in the end is something of type:
final :: [l] -> a -> ([l], a)
-- which is really just:
state . final :: [l] -> State a [l]
So that means that I need some function that takes a l -> State a l and converts it to a [l] -> State a [l]. This is precisely what mapM does, except that mapM works for any Monad, not just State:
mapM :: (Monad m) => (a -> m b) -> ([a] -> m [b])
Notice how if we replace m with State a, and set a and b to l, then it has exactly the right type:
mapM :: (l -> State a l) -> ([l] -> State a [l])
f''' :: [l] -> State a [l]
f''' = mapM f''
Now we can unwrap the State using runState to get back a list-threading function of the appropriate type:
final :: [l] -> a -> ([l], a)
final = runState . f'''
So if we combine all those steps into one we get:
final = runState . mapM (state . f')
... where f' is your function written to swap the order of arguments and results. If you choose not to modify your original function then the solution is slightly more verbose:
final = runState . mapM (state . uncurry (swap . curry f . swap))
Without the specifics of what you are actually trying to achieve, getting to an answer is a bit difficult. But it seems to be that if your f had the type:
f :: (a, [l]) -> l -> (a,l)
Then you could define a function, f':
f' :: (a, [l]) -> l -> (a,l)
f' acc#(y, xs) x = (z, x':xs)
where
(z, x') = f acc
Which can then be used in a fold.
foldr f' (e, []) xs
The new signature of f allows it to have access to all preceding elements in the list, and f' adds the new element from the call to f to the list.
I'm trying to write a function that takes a predicate f and a list and returns a list consisting of all items that satisfy f with preserved order. The trick is to do this using only higher order functions (HoF), no recursion, no comprehensions, and of course no filter.
You can express filter in terms of foldr:
filter p = foldr (\x xs-> if p x then x:xs else xs) []
I think you can use map this way:
filter' :: (a -> Bool) -> [a] -> [a]
filter' p xs = concat (map (\x -> if (p x) then [x] else []) xs)
You see? Convert the list in a list of lists, where if the element you want doesn't pass p, it turns to an empty list
filter' (> 1) [1 , 2, 3 ] would be: concat [ [], [2], [3]] = [2,3]
In prelude there is concatMap that makes the code simplier :P
the code should look like:
filter' :: (a -> Bool) -> [a] -> [a]
filter' p xs = concatMap (\x -> if (p x) then [x] else []) xs
using foldr, as suggested by sclv, can be done with something like this:
filter'' :: (a -> Bool) -> [a] -> [a]
filter'' p xs = foldr (\x y -> if p x then (x:y) else y) [] xs
You're obviously doing this to learn, so let me show you something cool. First up, to refresh our minds, the type of filter is:
filter :: (a -> Bool) -> [a] -> [a]
The interesting part of this is the last bit [a] -> [a]. It breaks down one list and it builds up a new list.
Recursive patterns are so common in Haskell (and other functional languages) that people have come up with names for some of these patterns. The simplest are the catamorphism and it's dual the anamorphism. I'll show you how this relates to your immediate problem at the end.
Fixed points
Prerequisite knowledge FTW!
What is the type of Nothing? Firing up GHCI, it says Nothing :: Maybe a and I wouldn't disagree. What about Just Nothing? Using GHCI again, it says Just Nothing :: Maybe (Maybe a) which is also perfectly valid, but what about the value that this a Nothing embedded within an arbitrary number, or even an infinite number, of Justs. ie, what is the type of this value:
foo = Just foo
Haskell doesn't actually allow such a definition, but with a slight tweak we can make such a type:
data Fix a = In { out :: a (Fix a) }
just :: Fix Maybe -> Fix Maybe
just = In . Just
nothing :: Fix Maybe
nothing = In Nothing
foo :: Fix Maybe
foo = just foo
Wooh, close enough! Using the same type, we can create arbitrarily nested nothings:
bar :: Fix Maybe
bar = just (just (just (just nothing)))
Aside: Peano arithmetic anyone?
fromInt :: Int -> Fix Maybe
fromInt 0 = nothing
fromInt n = just $ fromInt (n - 1)
toInt :: Fix Maybe -> Int
toInt (In Nothing) = 0
toInt (In (Just x)) = 1 + toInt x
This Fix Maybe type is a bit boring. Here's a type whose fixed-point is a list:
data L a r = Nil | Cons a r
type List a = Fix (L a)
This data type is going to be instrumental in demonstrating some recursion patterns.
Useful Fact: The r in Cons a r is called a recursion site
Catamorphism
A catamorphism is an operation that breaks a structure down. The catamorphism for lists is better known as a fold. Now the type of a catamorphism can be expressed like so:
cata :: (T a -> a) -> Fix T -> a
Which can be written equivalently as:
cata :: (T a -> a) -> (Fix T -> a)
Or in English as:
You give me a function that reduces a data type to a value and I'll give you a function that reduces it's fixed point to a value.
Actually, I lied, the type is really:
cata :: Functor T => (T a -> a) -> Fix T -> a
But the principle is the same. Notice, T is only parameterized over the type of the recursion sites, so the Functor part is really saying "Give me a way of manipulating all the recursion sites".
Then cata can be defined as:
cata f = f . fmap (cata f) . out
This is quite dense, let me elaborate. It's a three step process:
First, We're given a Fix t, which is a difficult type to play with, we can make it easier by applying out (from the definition of Fix) giving us a t (Fix t).
Next we want to convert the t (Fix t) into a t a, which we can do, via wishful thinking, using fmap (cata f); we're assuming we'll be able to construct cata.
Lastly, we have a t a and we want an a, so we just use f.
Earlier I said that the catamorphism for a list is called fold, but cata doesn't look much like a fold at the moment. Let's define a fold function in terms of cata.
Recapping, the list type is:
data L a r = Nil | Cons a r
type List a = Fix (L a)
This needs to be a functor to be useful, which is straight forward:
instance Functor (L a) where
fmap _ Nil = Nil
fmap f (Cons a r) = Cons a (f r)
So specializing cata we get:
cata :: (L x a -> a) -> List x -> a
We're practically there:
construct :: (a -> b -> b) -> b -> L a b -> b
construct _ x (In Nil) = x
construct f _ (In (Cons e n)) = f e n
fold :: (a -> b -> b) -> b -> List a -> b
fold f m = cata (construct f m)
OK, catamorphisms break data structures down one layer at a time.
Anamorphisms
Anamorphisms over lists are unfolds. Unfolds are less commonly known than there fold duals, they have a type like:
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
As you can see anamorphisms build up data structures. Here's the more general type:
ana :: Functor a => (a -> t a) -> a -> Fix t
This should immediately look quite familiar. The definition is also reminiscent of the catamorphism.
ana f = In . fmap (ana f) . f
It's just the same thing reversed. Constructing unfold from ana is even simpler than constructing fold from cata. Notice the structural similarity between Maybe (a, b) and L a b.
convert :: Maybe (a, b) -> L a b
convert Nothing = Nil
convert (Just (a, b)) = Cons a b
unfold :: (b -> Maybe (a, b)) -> b -> List a
unfold f = ana (convert . f)
Putting theory into practice
filter is an interesting function in that it can be constructed from a catamorphism or from an anamorphism. The other answers to this question (to date) have also used catamorphisms, but I'll define it both ways:
filter p = foldr (\x xs -> if p x then x:xs else xs) []
filter p =
unfoldr (f p)
where
f _ [] =
Nothing
f p (x:xs) =
if p x then
Just (x, xs)
else
f p xs
Yes, yes, I know I used a recursive definition in the unfold version, but forgive me, I taught you lots of theory and anyway filter isn't recursive.
I'd suggest you look at foldr.
Well, are ifs and empty list allowed?
filter = (\f -> (>>= (\x -> if (f x) then return x else [])))
For a list of Integers
filter2::(Int->Bool)->[Int]->[Int]
filter2 f []=[]
filter2 f (hd:tl) = if f hd then hd:filter2 f tl
else filter2 f tl
I couldn't resist answering this question in another way, this time with no recursion at all.
-- This is a type hack to allow the y combinator to be represented
newtype Mu a = Roll { unroll :: Mu a -> a }
-- This is the y combinator
fix f = (\x -> f ((unroll x) x))(Roll (\x -> f ((unroll x) x)))
filter :: (a -> Bool) -> [a] -> [a]
filter =
fix filter'
where
-- This is essentially a recursive definition of filter
-- except instead of calling itself, it calls f, a function that's passed in
filter' _ _ [] = []
filter' f p (x:xs) =
if p x then
(x:f p xs)
else
f p xs