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.
Related
I'm trying to add two lists together and keep the extra elements that are unused and add those into the new list e.g.
addLists [1,2,3] [1,3,5,7,9] = [2,5,8,7,9]
I have this so far:
addLists :: Num a => [a] -> [a] -> [a]
addLists xs ys = zipWith (+) xs ys
but unsure of how to get the extra elements into the new list.
and the next step is changing this to a higher order function that takes the combining function
as an argument:
longZip :: (a -> a -> a) -> [a] -> [a] -> [a]
zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] is implemented as [src]:
zipWith :: (a->b->c) -> [a]->[b]->[c]
zipWith f = go
where
go [] _ = []
go _ [] = []
go (x:xs) (y:ys) = f x y : go xs ys
It thus uses explicit recursion where go will check if the two lists are non-empty and in that case yield f x y, otherwise it stops and returns an empty list [].
You can implement a variant of zipWith which will continue, even if one of the lists is empty. THis will look like:
zipLongest :: (a -> a -> a) -> [a] -> [a] -> [a]
zipLongest f = go
where go [] ys = …
go xs [] = …
go (x:xs) (y:ys) = f x y : go xs ys
where you still need to fill in ….
You can do it with higher order functions as simple as
import Data.List (transpose)
addLists :: Num a => [a] -> [a] -> [a]
addLists xs ys = map sum . transpose $ [xs, ys]
because the length of transpose[xs, ys, ...] is the length of the longest list in its argument list, and sum :: (Foldable t, Num a) => t a -> a is already defined to sum the elements of a list (since lists are Foldable).
transpose is used here as a kind of a zip (but cutting on the longest instead of the shortest list), with [] being a default element for the lists addition ++, like 0 is a default element for the numbers addition +:
cutLongest [xs, ys] $
zipWith (++) (map pure xs ++ repeat []) (map pure ys ++ repeat [])
See also:
Zip with default value instead of dropping values?
You're looking for the semialign package. It gives you an operation like zipping, but that keeps going until both lists run out. It also generalizes to types other than lists, such as rose trees. In your case, you'd use it like this:
import Data.Semialign
import Data.These
addLists :: (Semialign f, Num a) => f a -> f a -> f a
addLists = alignWith (mergeThese (+))
longZip :: Semialign f => (a -> a -> a) -> f a -> f a -> f a
longZip = alignWith . mergeThese
The new type signatures are optional. If you want, you can keep using your old ones that restrict them to lists.
just recently I started to try out haskell.
It's fun trying out different exercises, but sometimes I get the feeling, that my found solutions are far from elegant: The following Code Snipplet will find the longest sub-sequence in a list, which will satisfy a given condition (for example uppercase letters etc.)
Could you help a noob to make everything shorter and more elegant - every advice is highly appreciated.
import Data.Char
longer :: [a] -> [a] -> [a]
longer x y = if length x > length y
then x
else y
longest :: [[a]]->[a]
longest = foldl longer []
nextSequence :: (a->Bool) -> [a] ->([a],[a])
nextSequence f x = span f (dropWhile (not . f) x)
longestSubsequence :: (a -> Bool) -> [a] -> [a]
longestSubsequence _ x | null x = []
longestSubsequence f x =
longest $ (\y -> [fst y , longestSubsequence f $ snd y]) (nextSequence f x)
testSequence :: String
testSequence = longestSubsequence Data.Char.isUpper
"hkerhklehrERJKJKJERKJejkrjekERHkhkerHERKLJHERJKHKJHERdjfkj"
At first, you can define your longest like this:
import Data.Function
import Data.List
longest :: [[a]] -> [a]
longest = maximumBy (compare `on` length)
And to get all subsequences that satisfy a given condition you can write a function like this:
import Data.List
getSatisfyingSubseqs :: (a -> Bool) -> [a] -> [[a]]
getSatisfyingSubseqs f = filter (f . head) . groupBy same
where same x y = f x == f y
Here we group elements where the condition yields the same result and filter only subsequences that satisfy the condition.
In the total:
longestSubsequence :: (a -> Bool) -> [a] -> [a]
longestSubsequence f = longest . getSatisfyingSubseqs f
UPDATE: And if you want to make it shorter, you can just throw out the auxiliary functions and write the whole at a time:
longestSubsequence :: (a -> Bool) -> [a] -> [a]
longestSubsequence f = maximumBy (compare `on` length) . filter (f . head) . groupBy same
where same x y = f x == f y
(Don't forget the imports)
You can run it there: https://repl.it/#Yuri12358/so-longestsequence
The span :: (a -> Bool) -> [a] -> ([a], [a]) function could be very handy here. Also note that f <$> (a,b) = (a,f b). Probably not very efficient due to the length checks but it should do the job.
lss :: (a -> Bool) -> [a] -> [a]
lss f [] = []
lss f ls#(x:xs) = if f x then longer (lss f <$> span f ls)
else lss f xs
where
longer ::([a],[a]) -> [a]
longer (xs,ys) = if length xs >= length ys then xs else ys
Your longer function uses length, which means it doesn't work if either input is infinite. However, it can be improved to work when at most one is infinite:
longer l1 l2 = go l1 l2
where
go [] _ = l2
go _ [] = l1
go (_:xs) (_:ys) = go xs ys
This is also a performance optimization. Before, if you had a 10-element list and a 10-million-element list, it would walk through all 10 million elements of the 10-million-element list before returning it. Here, it will return it as soon as it gets to the 11th element instead.
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 implemented a broken filter function using an anamorphism from recursion-schemes Hackage library:
import Data.Functor.Foldable
xfilter :: (a -> Bool) -> [a] -> [a]
xfilter f = ana $ project . phi f
phi :: (a -> Bool) -> [a] -> [a]
phi f (h : t) | not (f h) = t
phi f l = l
The function is not a faithful implementation of filter: xfilter odd [1..5] works, but xfilter odd [0,0] doesn't. I tried to implement "retries" by using explicit recursion in phi and then reimplemented that with a paramorphism, so I ended with ana . para:
xfilter :: (a -> Bool) -> [a] -> [a]
xfilter f = ana . para $ phi where
phi Nil = Nil
phi (Cons h (t, tt)) | f h = Cons h t
phi (Cons h (t, tt)) = tt
This is satisfactory, but I then tried to express retries explicitly in phi and perform them outside:
xfilter :: (a -> Bool) -> [a] -> [a]
xfilter f = ana $ project . retry (phi f)
phi :: (a -> Bool) -> [a] -> Either [a] [a]
phi f (h : t) | not (f h) = Left t
phi f l = Right l
retry f x = case f x of
Right x -> x
Left x -> retry f x
Right means 'produce a new element' and Left means 'retry with a new seed'.
The signature of phi started to look pretty similar to the first argument of apomorphism specialized for lists:
xxapo :: ([a] -> Prim [a] (Either [a] [a])) -> [a] -> [a]
xxapo = apo
([a] -> Either [a] [a] vs [a] -> Prim [a] [a] (Either [a] [a])
So I wonder is it possible to implement filtering using apomorphisms or other generalized unfolds, or ana . para is the best I can hope for?
I know I can use folds, but the question is specifically about unfolds.
In short: This can't be done. You always have to break down the input list somehow, which you can't accomplish by unfolding alone. You can see that in your code already. You have retry (phi f), which is equivalent to dropWhile (not . f), which recursively consumes an input list. In your case, the recursion is inside retry.
We can implement filter using ana, but the function passed to ana will have to be recursive, as in
filter1 :: (a -> Bool) -> [a] -> [a]
filter1 p = ana f
where
f [] = Nil
f (x : xs') | p x = Cons x xs'
| otherwise = f xs'
However, we can implement filtering using para without any further recursion:
filter2 :: (a -> Bool) -> [a] -> [a]
filter2 p = cata f
where
f Nil = []
f (Cons x r) | p x = x : r
| otherwise = r
(although this is not what you've been interested in).
So why it works with cata but not with ana?
Catamorphisms represent inductive recursion where each recursive step consumes at least one constructor. Since each steps takes only finite time, together this ensures that when consuming a (finite) data structure, the whole recursion always terminates.
Anamorphisms represent co-inductive recursion where each recursive step is guarded by a constructor. This means that although the result can be infinite, each part (a constructor) of the constructed data structure is produced in finite time.
Now how filter works: At each step it consumes one element of a list and sometimes it produces an output element (if it satisfies a given predicate).
So we see that we can implement filter as a catamorphism - we consume each element of a list in a finite time.
But we can't implement filter just as an anamorphism. We can never know when filter produces a new result. We can't describe the production of a next output element using just a finite number of operations. For example, let's take filter odd (replicate n 0 ++ [1]) - it takes O(n) steps to produce the first element 1. So there must be some kind of recursion that searches an input list until it finds a satisfying element.
xfilter :: (a -> Bool) -> [a] -> [a]
xfilter f xs = last $ apo phi ([xs], []) where
phi ([[]], ys) = Cons [] $ Left [ys]
phi ([h:t], ys) | f h = Cons [] $ Right ([t], h:ys)
phi ([h:t], ys) = Cons [] $ Right ([t], ys)
But last is a cata.
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