Apply "permutations" of a function over a list - list

Creating the permutations of a list or set is simple enough. I need to apply a function to each element of all subsets of all elements in a list, in the order in which they occur. For instance:
apply f [x,y] = { [x,y], [f x, y], [x, f y], [f x, f y] }
The code I have is a monstrous pipeline or expensive computations, and I'm not sure how to proceed, or if it's correct. I'm sure there must be a better way to accomplish this task - perhaps in the list monad - but I'm not sure. This is my code:
apply :: Ord a => (a -> Maybe a) -> [a] -> Set [a]
apply p xs = let box = take (length xs + 1) . map (take $ length xs) in
(Set.fromList . map (catMaybes . zipWith (flip ($)) xs) . concatMap permutations
. box . map (flip (++) (repeat Just)) . flip iterate []) ((:) p)
The general idea was:
(1) make the list
[[], [f], [f,f], [f,f,f], ... ]
(2) map (++ repeat Just) over the list to obtain
[[Just, Just, Just, Just, ... ],
[f , Just, Just, Just, ... ],
[f , f , Just, Just, ... ],
... ]
(3) find all permutations of each list in (2) shaved to the length of the input list
(4) apply the permuted lists to the original list, garnering all possible applications
of the function f to each (possibly empty) subset of the original list, preserving
the original order.
I'm sure there's a better way to do it, though. I just don't know it. This way is expensive, messy, and rather prone to error. The Justs are there because of the intended application.

To do this, you can leverage the fact that lists represent non-deterministic values when using applicatives and monads. It then becomes as simple as:
apply f = mapM (\x -> [x, f x])
It basically reads as follows: "Map each item in a list to itself and the result of applying f to it. Finally, return a list of all the possible combinations of these two values across the whole list."

If I understand your problem correctly, it's best not to describe it in terms of permutations. Rather, it's closer to generating powersets.
powerset (x:xs) = let pxs = powerset xs in pxs ++ map (x :) pxs
powerset [] = [[]]
Each time you add another member to the head of the list, the powerset doubles in size. The second half of the powerset is exactly like the first, but with x included.
For your problem, the choice is not whether to include or exclude x, but whether to apply or not apply f.
powersetapp f (x:xs) = let pxs = powersetapp f xs in map (x:) pxs ++ map (f x:) pxs
powersetapp f [] = [[]]
This does what your "apply" function does, modulo making a Set out of the result.

Paul's and Heatsink's answers are good, but error out when you try to run them on infinite lists.
Here's a different method that works on both infinite and finite lists:
apply _ [] = [ [] ]
apply f (x:xs) = (x:ys):(x':ys):(double yss)
where x' = f x
(ys:yss) = apply f xs
double [] = []
double (ys:yss) = (x:ys):(x':ys):(double yss)
This works as expected - though you'll note it produces a different order to the permutations than Paul's and Heatsink's
ghci> -- on an infinite list
ghci> map (take 4) $ take 16 $ apply (+1) [0,0..]
[[0,0,0,0],[1,0,0,0],[0,1,0,0],[1,1,0,0],[0,0,1,0],...,[1,1,1,1]]
ghci> -- on a finite list
ghci> apply (+1) [0,0,0,0]
[[0,0,0,0],[1,0,0,0],[0,1,0,0],[1,1,0,0],[0,0,1,0],...,[1,1,1,1]]

Here is an alternative phrasing of rampion's infinite-input-handling solution:
-- sequence a list of nonempty lists
sequenceList :: [[a]] -> [[a]]
sequenceList [] = [[]]
sequenceList (m:ms) = do
xs <- nonempty (sequenceList ms)
x <- nonempty m
return (x:xs)
where
nonempty ~(x:xs) = x:xs
Then we can define apply in Paul's idiomatic style:
apply f = sequenceList . map (\x -> [x, f x])
Contrast sequenceList with the usual definition of sequence:
sequence :: (Monad m) => [m a] -> m [a]
sequence [] = [[]]
sequence (m:ms) = do
x <- m
xs <- sequence ms
return (x:xs)
The order of binding is reversed in sequenceList so that the variations of the first element are the "inner loop", i.e. we vary the head faster than the tail. Varying the end of an infinite list is a waste of time.
The other key change is nonempty, the promise that we won't bind an empty list. If any of the inputs were empty, or if the result of the recursive call to sequenceList were ever empty, then we would be forced to return an empty list. We can't tell in advance whether any of inputs is empty (because there are infinitely many of them to check), so the only way for this function to output anything at all is to promise that they won't be.
Anyway, this is fun subtle stuff. Don't stress about it on your first day :-)

Related

How to use foldr to add variables to each other in a list?

When given a list [x0, x1, x2, . . . , xn−1], the function
should return the list [y0, y1, y2, . . . , yn−1] where y0 = x0, y1 = x0 + x1, ...
So if you had [1,2,3] as input, you would get [1,3,6] as output
I don't completely understand foldr, so maybe if I could get some help in trying to figure out how to change that last line to get the right answer.
scan :: [Integer] -> [Integer]
scan [] = []
scan [x] = [x]
scan (x:xs) = x : foldr (/y -> y (+) x) 0 (scan xs)
My initial solution (that works) uses the map function.
scan :: [Integer] -> [Integer]
scan [] = []
scan [x] = [x]
scan (x:xs) = x : map (+x) (scan xs)
EDIT, I added this first section to better address your two implementations.
First, addressing your issue with your implementation using foldr, here are a few remarks:
Lambdas start with a backslash in Haskell, not a slash. That's because backslashes kind of look like the lambda greek letter (λ).
Functions named using only special characters, like +, are infix by default. If you use parens around them, it turns them into prefix functions:
$> (+) 1 5
$> 6
The function passed to foldr takes two argument, whereas you're only supplying one in your lambda. If you really want to ignore the second one, you can use a _ instead of binding it to a variable (\x _ -> x).
I think this you're going down a rabbit hole with this implementation. See the discussion below for my take on the right way to tackle this issue.
Note: It is possible to implement map using foldr (source), that's one way you could use foldr in your working (second) implementation.
Implementing this with foldr is not optimal, since it folds, as the name implies, from the right:
foldr1 (+) [1..5]
--is equivalent to:
(1+(2+(3+(4+5))))
As you can see, the summing operation is done starting from the tail of the list, which is not what you're looking for. To make this work, you would have to "cheat", and reverse your list twice, once before folding it and once after:
scan = tail . reverse . foldr step [0] . reverse where
step e acc#(a:_) = (e + a) : acc
You can make this better using a left fold, which folds from the left:
foldl1 (+) [1..5]
--is equivalent to:
((((1+2)+3)+4)+5)
This, however, still isn't ideal, because to keep the order of elements in your accumulator the same, you would have to use the ++ function, which amounts to quadratic time complexity in such a function. A compromise is to use the : function, but then you still have to reverse your accumulator list after the fold, which is only linear complexity:
scan' :: [Integer] -> [Integer]
scan' = tail . reverse . foldl step [0] where
step acc#(a:_) e = (e + a) : acc
This still isn't very good, since the reverse adds an extra computation. The ideal solution would therefore be to use scanl1, which, as a bonus, doesn't require you to give a starting value ([0] in the examples above):
scan'' :: [Integer] -> [Integer]
scan'' = scanl1 (+)
scanl1 is implemented in terms of scanl, which is defined roughly like this:
scanl f init list = init : (case list of
[] -> []
x:xs -> scanl f (f init x) xs)
You can therefore simply do:
$> scanl1 (+) [1..3]
$> [1,3,6]
As a final note, your scan function is unnecessarily specialized to Integer, as it only requires a Num constraint:
scan :: Num a => [a] -> [a]
This might even lead to an increase in performance, but that's where my abilities end, so I won't go any further :)

Haskell:: how to compare/extract/add each element between lists

I'm trying to get each element from list of lists.
For example, [1,2,3,4] [1,2,3,4]
I need to create a list which is [1+1, 2+2, 3+3, 4+4]
list can be anything. "abcd" "defg" => ["ad","be","cf","dg"]
The thing is that two list can have different length so I can't use zip.
That's one thing and the other thing is comparing.
I need to compare [1,2,3,4] with [1,2,3,4,5,6,7,8]. First list can be longer than the second list, second list might be longer than the first list.
So, if I compare [1,2,3,4] with [1,2,3,4,5,6,7,8], the result should be [5,6,7,8]. Whatever that first list doesn't have, but the second list has, need to be output.
I also CAN NOT USE ANY RECURSIVE FUNCTION. I can only import Data.Char
The thing is that two list can have different length so I can't use zip.
And what should the result be in this case?
CAN NOT USE ANY RECURSIVE FUNCTION
Then it's impossible. There is going to be recursion somewhere, either in the library functions you use (as in other answers), or in functions you write yourself. I suspect you are misunderstanding your task.
For your first question, you can use zipWith:
zipWith f [a1, a2, ...] [b1, b2, ...] == [f a1 b1, f a2 b2, ...]
like, as in your example,
Prelude> zipWith (+) [1 .. 4] [1 .. 4]
[2,4,6,8]
I'm not sure what you need to have in case of lists with different lengths. Standard zip and zipWith just ignore elements from the longer one which don't have a pair. You could leave them unchanged, and write your own analog of zipWith, but it would be something like zipWithRest :: (a -> a -> a) -> [a] -> [a] -> [a] which contradicts to the types of your second example with strings.
For the second, you can use list comprehensions:
Prelude> [e | e <- [1 .. 8], e `notElem` [1 .. 4]]
[5,6,7,8]
It would be O(nm) slow, though.
For your second question (if I'm reading it correctly), a simple filter or list comprehension would suffice:
uniques a b = filter (not . flip elem a) b
I believe you can solve this using a combination of concat and nub http://www.haskell.org/ghc/docs/6.12.1/html/libraries/base-4.2.0.0/Data-List.html#v%3anub which will remove all duplicates ...
nub (concat [[0,1,2,3], [1,2,3,4]])
you will need to remove unique elements from the first list before doing this. ie 0
(using the same functions)
Padding then zipping
You suggested in a comment the examples:
[1,2,3,4] [1,2,3] => [1+1, 2+2, 3+3, 4+0]
"abcd" "abc" => ["aa","bb","cc"," d"]
We can solve those sorts of problems by padding the list with a default value:
padZipWith :: a -> (a -> a -> b) -> [a] -> [a] -> [b]
padZipWith def op xs ys = zipWith op xs' ys' where
maxlen = max (length xs) (length ys)
xs' = take maxlen (xs ++ repeat def)
ys' = take maxlen (ys ++ repeat def)
so for example:
ghci> padZipWith 0 (+) [4,3] [10,100,1000,10000]
[14,103,1000,10000]
ghci> padZipWith ' ' (\x y -> [x,y]) "Hi" "Hello"
["HH","ie"," l"," l"," o"]
(You could rewrite padZipWith to have two separate defaults, one for each list, so you could allow the two lists to have different types, but that doesn't sound super useful.)
General going beyond the common length
For your first question about zipping beyond common length:
How about splitting your lists into an initial segment both have and a tail that only one of them has, using splitAt :: Int -> [a] -> ([a], [a]) from Data.List:
bits xs ys = (frontxs,frontys,backxs,backys) where
(frontxs,backxs) = splitAt (length ys) xs
(frontys,backys) = splitAt (length xs) ys
Example:
ghci> bits "Hello Mum" "Hi everyone else"
("Hello Mum","Hi everyo","","ne else")
You could use that various ways:
larger xs ys = let (frontxs,frontys,backxs,backys) = bits xs ys in
zipWith (\x y -> if x > y then x else y) frontxs frontys ++ backxs ++ backys
needlesslyComplicatedCmpLen xs ys = let (_,_,backxs,backys) = bits xs ys in
if null backxs && null backys then EQ
else if null backxs then LT else GT
-- better written as compare (length xs) (length ys)
so
ghci> larger "Hello Mum" "Hi everyone else"
"Hillveryone else"
ghci> needlesslyComplicatedCmpLen "Hello Mum" "Hi everyone else"
LT
but once you've got the hang of splitAt, take, takeWhile, drop etc, I doubt you'll need to write an auxiliary function like bits.

Need to partition a list into lists based on breaks in ascending order of elements (Haskell)

Say I have any list like this:
[4,5,6,7,1,2,3,4,5,6,1,2]
I need a Haskell function that will transform this list into a list of lists which are composed of the segments of the original list which form a series in ascending order. So the result should look like this:
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
Any suggestions?
You can do this by resorting to manual recursion, but I like to believe Haskell is a more evolved language. Let's see if we can develop a solution that uses existing recursion strategies. First some preliminaries.
{-# LANGUAGE NoMonomorphismRestriction #-}
-- because who wants to write type signatures, amirite?
import Data.List.Split -- from package split on Hackage
Step one is to observe that we want to split the list based on a criteria that looks at two elements of the list at once. So we'll need a new list with elements representing a "previous" and "next" value. There's a very standard trick for this:
previousAndNext xs = zip xs (drop 1 xs)
However, for our purposes, this won't quite work: this function always outputs a list that's shorter than the input, and we will always want a list of the same length as the input (and in particular we want some output even when the input is a list of length one). So we'll modify the standard trick just a bit with a "null terminator".
pan xs = zip xs (map Just (drop 1 xs) ++ [Nothing])
Now we're going to look through this list for places where the previous element is bigger than the next element (or the next element doesn't exist). Let's write a predicate that does that check.
bigger (x, y) = maybe False (x >) y
Now let's write the function that actually does the split. Our "delimiters" will be values that satisfy bigger; and we never want to throw them away, so let's keep them.
ascendingTuples = split . keepDelimsR $ whenElt bigger
The final step is just to throw together the bit that constructs the tuples, the bit that splits the tuples, and a last bit of munging to throw away the bits of the tuples we don't care about:
ascending = map (map fst) . ascendingTuples . pan
Let's try it out in ghci:
*Main> ascending [4,5,6,7,1,2,3,4,5,6,1,2]
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
*Main> ascending [7,6..1]
[[7],[6],[5],[4],[3],[2],[1]]
*Main> ascending []
[[]]
*Main> ascending [1]
[[1]]
P.S. In the current release of split, keepDelimsR is slightly stricter than it needs to be, and as a result ascending currently doesn't work with infinite lists. I've submitted a patch that makes it lazier, though.
ascend :: Ord a => [a] -> [[a]]
ascend xs = foldr f [] xs
where
f a [] = [[a]]
f a xs'#(y:ys) | a < head y = (a:y):ys
| otherwise = [a]:xs'
In ghci
*Main> ascend [4,5,6,7,1,2,3,4,5,6,1,2]
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
This problem is a natural fit for a paramorphism-based solution. Having (as defined in that post)
para :: (a -> [a] -> b -> b) -> b -> [a] -> b
foldr :: (a -> b -> b) -> b -> [a] -> b
para c n (x : xs) = c x xs (para c n xs)
foldr c n (x : xs) = c x (foldr c n xs)
para c n [] = n
foldr c n [] = n
we can write
partition_asc xs = para c [] xs where
c x (y:_) ~(a:b) | x<y = (x:a):b
c x _ r = [x]:r
Trivial, since the abstraction fits.
BTW they have two kinds of map in Common Lisp - mapcar
(processing elements of an input list one by one)
and maplist (processing "tails" of a list). With this idea we get
import Data.List (tails)
partition_asc2 xs = foldr c [] . init . tails $ xs where
c (x:y:_) ~(a:b) | x<y = (x:a):b
c (x:_) r = [x]:r
Lazy patterns in both versions make it work with infinite input lists
in a productive manner (as first shown in Daniel Fischer's answer).
update 2020-05-08: not so trivial after all. Both head . head . partition_asc $ [4] ++ undefined and the same for partition_asc2 fail with *** Exception: Prelude.undefined. The combining function g forces the next element y prematurely. It needs to be more carefully written to be productive right away before ever looking at the next element, as e.g. for the second version,
partition_asc2' xs = foldr c [] . init . tails $ xs where
c (x:ys) r#(~(a:b)) = (x:g):gs
where
(g,gs) | not (null ys)
&& x < head ys = (a,b)
| otherwise = ([],r)
(again, as first shown in Daniel's answer).
You can use a right fold to break up the list at down-steps:
foldr foo [] xs
where
foo x yss = (x:zs) : ws
where
(zs, ws) = case yss of
(ys#(y:_)) : rest
| x < y -> (ys,rest)
| otherwise -> ([],yss)
_ -> ([],[])
(It's a bit complicated in order to have the combining function lazy in the second argument, so that it works well for infinite lists too.)
One other way of approaching this task (which, in fact lays the fundamentals of a very efficient sorting algorithm) is using the Continuation Passing Style a.k.a CPS which, in this particular case applied to folding from right; foldr.
As is, this answer would only chunk up the ascending chunks however, it would be nice to chunk up the descending ones at the same time... preferably in reverse order all in O(n) which would leave us with only binary merging of the obtained chunks for a perfectly sorted output. Yet that's another answer for another question.
chunks :: Ord a => [a] -> [[a]]
chunks xs = foldr go return xs $ []
where
go :: Ord a => a -> ([a] -> [[a]]) -> ([a] -> [[a]])
go c f = \ps -> let (r:rs) = f [c]
in case ps of
[] -> r:rs
[p] -> if c > p then (p:r):rs else [p]:(r:rs)
*Main> chunks [4,5,6,7,1,2,3,4,5,6,1,2]
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
*Main> chunks [4,5,6,7,1,2,3,4,5,4,3,2,6,1,2]
[[4,5,6,7],[1,2,3,4,5],[4],[3],[2,6],[1,2]]
In the above code c stands for current and p is for previous and again, remember we are folding from right so previous, is actually the next item to process.

Using Haskell's map function to calculate the sum of a list

Haskell
addm::[Int]->Int
addm (x:xs) = sum(x:xs)
I was able to achieve to get a sum of a list using sum function but is it possible to get the sum of a list using map function? Also what the use of map function?
You can't really use map to sum up a list, because map treats each list element independently from the others. You can use map for example to increment each value in a list like in
map (+1) [1,2,3,4] -- gives [2,3,4,5]
Another way to implement your addm would be to use foldl:
addm' = foldl (+) 0
Here it is, the supposedly impossible definition of sum in terms of map:
sum' xs = let { ys = 0 : map (\(a,b) -> a + b) (zip xs ys) } in last ys
this actually shows how scanl can be implemented in terms of map (and zip and last), the above being equivalent to foldl (+) 0 xs === last $ scanl (+) 0 xs:
scanl' f z xs = let { ys = z : map (uncurry f) (zip ys xs) } in ys
I expect one can calculate many things with map, arranging for all kinds of information flow through zip.
edit: the above is just a zipWith in disguise of course (and zipWith is kind of a map2):
sum' xs = let { ys = 0 : zipWith (+) ys xs } in last ys
This seems to suggest that scanl is more versatile than foldl.
It is not possible to use map to reduce a list to its sum. That recursive pattern is a fold.
sum :: [Int] -> Int
sum = foldr (+) 0
As an aside, note that you can define map as a fold as well:
map :: (a -> b) -> ([a] -> [b])
map f = fold (\x xs -> f x : xs) []
This is because foldr is the canonical recursive function on lists.
References: A tutorial on the universality and expressiveness of fold, Graham Hutton, J. Functional Programming 9 (4): 355–372, July 1999.
After some insights I have to add another answer: You can't get the sum of a list with map, but you can get the sum with its monadic version mapM. All you need to do is to use a Writer monad (see LYAHFGG) over the Sum monoid (see LYAHFGG).
I wrote a specialized version, which is probably easier to understand:
data Adder a = Adder a Int
instance Monad Adder where
return x = Adder x 0
(Adder x s) >>= f = let Adder x' s' = f x
in Adder x' (s + s')
toAdder x = Adder x x
sum' xs = let Adder _ s = mapM toAdder xs in s
main = print $ sum' [1..100]
--5050
Adder is just a wrapper around some type which also keeps a "running sum." We can make Adder a monad, and here it does some work: When the operation >>= (a.k.a. "bind") is executed, it returns the new result and the value of the running sum of that result plus the original running sum. The toAdder function takes an Int and creates an Adder that holds that argument both as wrapped value and as running sum (actually we're not interested in the value, but only in the sum part). Then in sum' mapM can do its magic: While it works similar to map for the values embedded in the monad, it executes "monadic" functions like toAdder, and chains these calls (it uses sequence to do this). At this point, we get through the "backdoor" of our monad the interaction between list elements that the standard map is missing.
Map "maps" each element of your list to an element in your output:
let f(x) = x*x
map f [1,2,3]
This will return a list of the squares.
To sum all elements in a list, use fold:
foldl (+) 0 [1,2,3]
+ is the function you want to apply, and 0 is the initial value (0 for sum, 1 for product etc)
As the other answers point out, the "normal" way is to use one of the fold functions. However it is possible to write something pretty similar to a while loop in imperative languages:
sum' [] = 0
sum' xs = head $ until single loop xs where
single [_] = True
single _ = False
loop (x1 : x2 : xs) = (x1 + x2) : xs
It adds the first two elements of the list together until it ends up with a one-element list, and returns that value (using head).
I realize this question has been answered, but I wanted to add this thought...
listLen2 :: [a] -> Int
listLen2 = sum . map (const 1)
I believe it returns the constant 1 for each item in the list, and returns the sum!
Might not be the best coding practice, but it was an example my professor gave to us students that seems to relate to this question well.
map can never be the primary tool for summing the elements of a container, in much the same way that a screwdriver can never be the primary tool for watching a movie. But you can use a screwdriver to fix a movie projector. If you really want, you can write
import Data.Monoid
import Data.Foldable
mySum :: (Foldable f, Functor f, Num a)
=> f a -> a
mySum = getSum . fold . fmap Sum
Of course, this is silly. You can get a more general, and possibly more efficient, version:
mySum' :: (Foldable f, Num a) => f a -> a
mySum' = getSum . foldMap Sum
Or better, just use sum, because its actually made for the job.

How to takeWhile elements in a list wrapped in a monad

Got a little puzzle I was wondering if you could help me clarify.
Let's define a function that returns a list:
let f = replicate 3
What we want to do is map this function to an infinite list, concatenate the results, and then take only things that match a predicate.
takeWhile (< 3) $ concatMap f [1..]
Great! That returns [1,1,1,2,2,2], which is what I want.
Now, I want to do something similar, but the function f now wraps its results in a Monad. In my usecase, this is the IO monad, but this works for discussing my problem:
let f' x = Just $ replicate 3 x
To map and concat, I can use:
fmap concat $ mapM f' [1..5]
That returns: Just [1,1,1,2,2,2,3,3,3,4,4,4,5,5,5]
If I want to use takeWhile, this still works:
fmap (takeWhile (< 3) . concat) $ mapM f' [1..5]
Which returns: Just [1,1,1,2,2,2]. Great!
But, if I make the list over which I map an infinite list this does not do what I expected:
fmap (takeWhile (< 3) . concat) $ mapM f' [1..]
Seems like the takeWhile is never happening. Somehow, I'm not getting the lazy computation I was expecting. I’m a bit lost.
The problem isn't that fmap + takeWhile doesn't work with infinite lists wrapped in a monad. The problem is that mapM can't produce an infinite list (at least not in the Maybe monad).
Think about it: If f' returns Nothing for any item in the list, mapM has to return Nothing. However mapM can't know whether that will happen until it has called f' on all items in the list. So it needs to iterate through the whole list before it knows whether the result is Nothing or Just. Obviously that's a problem with infinite lists.
This should do the trick:
takeWhileM :: (Monad m) => (a -> Bool) -> [m a] -> m [a]
takeWhileM p [] = return []
takeWhileM p (m:ms) = do
x <- m
if p x
then liftM (x:) (takeWhileM p ms)
else return []
See sepp2k's answer for an explanation of why you are losing laziness. The Identity monad or the nonempty list monad, for example, wouldn't have this problem.
You can't mapM an infinite list of Maybes. mapM is map followed by sequence. Here is the definition of sequence:
sequence ms = foldr k (return []) ms
where
k m m' = do { x <- m; xs <- m'; return (x:xs) }
From this we see that sequence evaluates every monadic value in the list. Since it's an infinite list, this operation will not terminate.
EDIT:
luqui and Carl make a good point that this doesn't generalize to any monad. To see why it doesn't work for Maybe we need to look at the implementation of (>>=):
(>>=) m k = case m of
Just x -> k x
Nothing -> Nothing
The important point here is that we do a case on m. This makes the m strict because we have to evaluate it to figure out how to continue execution. Note that we're not casing on x here, so it remains lazy.