Related
I want to create a function that rearranges the elements of a list.
For example the list [1,2,3] will produce:
[1,2,3]
[1,3,2]
[2,1,3]
[2,3,1]
[3,1,2]
[3,2,1]
The order isn't important.
If I write this list comprehension:
[[a,b,c] | a <- l, b <- l, c <- l, a /= b, a /= c, b /= c]
It works (where l is the desired list). Problem is I want to do this for an undefined number of list elements
Yes. The Data.List module has a permutations :: [a] -> [[a]] function to generate all permutations. This does not only work on three or more elements, but it does not use an Eq typeconstraint. If a list contains two items that are equal, then you can still consider it a different permutation when we swap the two.
We can furthermore implement such function ourself. We can first make a helper function that is given a list and returns a list of 2-tuples where the first item contains the value we "picked", and the second item a list of remaining elements:
pick :: [a] -> [(a, [a])]
pick [] = []
pick (x:xs) = (x, xs) : map prep (pick xs)
where prep (y, ys) = (y, x:ys)
For example:
Prelude> pick [1,4,2,5]
[(1,[4,2,5]),(4,[1,2,5]),(2,[1,4,5]),(5,[1,4,2])]
Next we can use recursion to each time pick an element, and recurse on the remaining elements:
perms :: [a] -> [[a]]
perms [] = [[]]
perms xs = [ p : ps | (p, ys) <- pick xs, ps <- perms ys ]
This then yields:
Prelude> perms [1,4,2,5]
[[1,4,2,5],[1,4,5,2],[1,2,4,5],[1,2,5,4],[1,5,4,2],[1,5,2,4],[4,1,2,5],[4,1,5,2],[4,2,1,5],[4,2,5,1],[4,5,1,2],[4,5,2,1],[2,1,4,5],[2,1,5,4],[2,4,1,5],[2,4,5,1],[2,5,1,4],[2,5,4,1],[5,1,4,2],[5,1,2,4],[5,4,1,2],[5,4,2,1],[5,2,1,4],[5,2,4,1]]
I need to create or know if there is a function in Haskell that allows you to add items from a list. So, for example:
cumulativeAmount :: [Integer] -> [Integer]
cumulativeAmount [1,2,5,8,8,0,4,2] = [1,3,8,16,24,24,28,30]
cumulativeAmount [1,4,7,0,5] = [1, 1+4, 1+4+7, 1+4+7+0, 1+4+7+0+5] = [1,5,12,12,17]
I tried to use the map and scanl function, but I didn't get what I wanted, because I added all the elements.
This is exactly the purpose of scanl1 :: (a -> a -> a) -> [a] -> [a]:
Prelude> scanl1 (+) [1,2,5,8,8,0,4,2]
[1,3,8,16,24,24,28,30]
scanl1 takes as input a function f :: a -> a -> a (here (+)), and a list of as. It constructs a list where the first item is the first item of the list. This is the first value of the accumulator. Then for every value, the accumulator is updated by calling f with the accumulator and the next value of the list, this item is then yielded.
So in case of scal1 (+) [1,2,5] the first item we emit is 1, we also set the accumulator to 1. The next item is 2, so we call (+) 1 2 (which is 3) and this is the result and the new accumulator, next we call (+) ((+) 1 2) 5 (which is 8), etc.
But I think it is better, as an exercise to use recursion. Like said before we use an accumulator. We can implement this by introducing an extra function where the accumulator is a function we pass through the recursive calls (and update). So in that case it looks like:
cumulativeAmount :: [Integer] -> [Integer]
cumulativeAmount [] = ...
cumulativeAmount (x:xs) = go x xs
where go x xs = ...
so here the first argument of go (x) is the accumulator. I leave it as an exercise to implement it with recursion.
What about using an accumulator:
cumulativeAmount :: (Num a) => [a] -> [a]
cumulativeAmount xs = go xs 0
where go [] acc = []
go (x:xs) acc = (acc+x) : go xs (acc+x)
Which works as follows:
*Main> cumulativeAmount [1,2,5,8,8,0,4,2]
[1,3,8,16,24,24,28,30]
The above code keeps a state variable acc to accumulate sums whenever a new number is encountered, and adds the new sum to the resulting list.
Now a good exercise would be to replace the above code with higher order functions.
Off the top of my head, you could solve this with a list comprehension, like so:
cumulativeAmount xs = [ sum $ take x xs | x <- [1..length xs] ]
i'm new in the haskell world and i'd like to know how to insert a value in each position of a list in haskell, and return a lists of sublists containing the value in each position. For example:
insert' :: a -> [a] -> [[a]]
insert' a [] = [[a]]
insert' a list = ??
To get something like:
insert' 7 [1,2,3] = [[7,1,2,3],[1,7,2,3],[1,2,7,3],[1,2,3,7]]
insert' :: a -> [a] -> [[a]]
insert' y [] = [[y]]
insert' y xss#(x:xs) = (y : xss) : map (x :) (insert' y xs)
While the empty list case comes natural, let's take a look at insert' y xss#(x:xs). We essentially have two cases we need to cover:
y appears in front of x. Then we can just use y : xss.
y appears somewhere after x. We therefore just insert it in the rest of our list and make sure that x is the first element with map (x:).
Although #delta's answer is definitely more elegant, here a solution with difference lists. If we insert an element x on every location of list ys = [y1,y2,...,yn], the first time we will insert it as head, so that means we can construct x : ys.
. For the second element of the resulting list, we want to construct a list [y1,x,y2,...,yn]. We can do this like y1 : x : y2s. The next lists will all have a structure y1 : ....
The question is: how can we write a recursive structure that keeps track of the fact that we want to put elements in the head. We can use a function for that: we start with a function id. If we now call id (x:ys) then we will of course generate the list (x:ys).
We can however, based on the id function, construct a new function id2 = \z -> id (y1:z). This function will thus put y1 in the head of the list and then add the list with which we call id2 as tail. Next we can construct id3 = \z -> id2 (y2:z). This will put y1 and y2 as first elements followed by the tail z.
So we can put this into the following recursive format:
insert' :: a -> [a] -> [[a]]
insert' x = go id
where go d [] = [d [x]]
go d ys#(yh:yt) = (d (x : ys)) : go (d . (yh :)) yt
So we redirect insert' to go where the initial difference list is simply the id function. Each time we check if we have reached the end of the given list. If that is the case, we return the basecase: we call [x] (as tail) on the difference list, and thus construct a list where we append x as last element.
In case we have not yet reached the last element, we will first emit d (x : ys): we prepend x to the list and provide this as argument to the difference list d. d will prepend y1 : y2 : ... : yk up to the point where we insert x. Furthermore we call recursively go (d . (yh :)) yt on the tail of the list: we thus construct a new difference list, wehere we insert (yh :) as tail of the list. We thus produce a new function with one argument: the tail after the yh element.
This function produces the expected results:
*Main> insert' 4 []
[[4]]
*Main> insert' 4 [1,2,5]
[[4,1,2,5],[1,4,2,5],[1,2,4,5],[1,2,5,4]]
*Main> insert' 7 [1,2,3]
[[7,1,2,3],[1,7,2,3],[1,2,7,3],[1,2,3,7]]
You may also do as follows;
import Data.List
spread :: a -> [a] -> [[a]]
spread x xs = zipWith (++) (inits xs) ((x:) <$> tails xs)
*Main> spread 7 [1,2,3]
[[7,1,2,3],[1,7,2,3],[1,2,7,3],[1,2,3,7]]
*Main> spread 7 []
[[7]]
So this is about three stages.
(x:) <$> tails xs is all about applying the (x:) function to all elements of tails xs function. So tails [1,2,3] would return [[1,2,3],[2,3],[3],[]] and we are to apply an fmap which is designated by <$> in the inline form. This is going to be the third argument of the zipWith function.
(inits xs) which would return [[],[1],[1,2],[1,2,3]], is going to be the second argument to zipWith.
zipWith (++) is obviously will zip two list of lists by concatenating the list elements.
So we may also express the same functionality with applicative function functors as follows;
spread :: a -> [a] -> [[a]]
spread x = zipWith (++) <$> inits <*> fmap (x:) . tails
In this case we fmap the zipWith (++) function with type [[a]] -> [[a]] -> [[a]] over inits and then apply it over to fmap (x:) . tails.
It could get more pointfree but becomes more complicated to read through (at least for me). In my opinion this is as best as it gets.
Given the code:
data Error a = Fail|Ok a
deriving (Eq, Ord, Show)
split :: Int -> [a] -> (Error ([a],[a]))
split 0 list = Ok ([], list)
split n list
| n < 0 = Fail
| n > length (list) = Fail
| otherwise = Ok (take n list, drop n list)
interleave :: [a] -> [a] -> [a]
interleave list [] = list
interleave [] list = list
interleave (x:xs) (y:ys) = x : y : interleave xs ys
shuffle :: [Int] -> [a] -> Error [a]
How I write the function shuffle which will take a list of Ints, and split another list based on those ints. Examples of the int list would be intList = [20,23,24,13] where shuffle will split a list after the 20th element, interleave, split after the 23rd element, interleave, and so on.
Okay, what you want is basically the following:
Given a list xs and indices [a1, a2, a3, ..], split xs at a1, interleave, split it at a2 and interleave, and so on...
Now that leaves us with two functions:
step :: Int -> [a] -> [a]
step index xs = ??? -- something with split and interleave
shuffle :: [a]
shuffle [] xs = xs
shuffle (i:indices) xs = let newList = step i xs
in ??? -- something with recursion
Try to write the rest of these functions on yourself.
step can easily be expressed as let (x1, x2) = split index xs in interleave x1 x2. Basically, the rest of shuffle can be written as shuffle indices newList.
I figured it out:
shuffle [] xs = Ok (xs)
shuffle (x:xs) list = case (split x list) of
Fail -> Fail
Ok (l1, l2) -> shuffle xs (interleave l1 l2)
I know from computability theory that it is possible to take the intersection of two infinite lists, but I can't find a way to express it in Haskell.
The traditional method fails as soon as the second list is infinite, because you spend all your time checking it for a non-matching element in the first list.
Example:
let ones = 1 : ones -- an unending list of 1s
intersect [0,1] ones
This never yields 1, as it never stops checking ones for the element 0.
A successful method needs to ensure that each element of each list will be visited in finite time.
Probably, this will be by iterating through both lists, and spending approximately equal time checking all previously-visited elements in each list against each other.
If possible, I'd like to also have a way to ignore duplicates in the lists, as it is occasionally necessary, but this is not a requirement.
Using the universe package's Cartesian product operator we can write this one-liner:
import Data.Universe.Helpers
isect :: Eq a => [a] -> [a] -> [a]
xs `isect` ys = [x | (x, y) <- xs +*+ ys, x == y]
-- or this, which may do marginally less allocation
xs `isect` ys = foldr ($) [] $ cartesianProduct
(\x y -> if x == y then (x:) else id)
xs ys
Try it in ghci:
> take 10 $ [0,2..] `isect` [0,3..]
[0,6,12,18,24,30,36,42,48,54]
This implementation will not produce any duplicates if the input lists don't have any; but if they do, you can tack on your favorite dup-remover either before or after calling isect. For example, with nub, you might write
> nub ([0,1] `isect` repeat 1)
[1
and then heat up your computer pretty good, since it can never be sure there might not be a 0 in that second list somewhere if it looks deep enough.
This approach is significantly faster than David Fletcher's, produces many fewer duplicates and produces new values much more quickly than Willem Van Onsem's, and doesn't assume the lists are sorted like freestyle's (but is consequently much slower on such lists than freestyle's).
An idea might be to use incrementing bounds. Let is first relax the problem a bit: yielding duplicated values is allowed. In that case you could use:
import Data.List (intersect)
intersectInfinite :: Eq a => [a] -> [a] -> [a]
intersectInfinite = intersectInfinite' 1
where intersectInfinite' n = intersect (take n xs) (take n ys) ++ intersectInfinite' (n+1)
In other words we claim that:
A∩B = A1∩B1 ∪ A2∩B2 ∪ ... ∪ ...
with A1 is a set containing the first i elements of A (yes there is no order in a set, but let's say there is somehow an order). If the set contains less elements then the full set is returned.
If c is in A (at index i) and in B (at index j), c will be emitted in segment (not index) max(i,j).
This will thus always generate an infinite list (with an infinite amount of duplicates) regardless whether the given lists are finite or not. The only exception is when you give it an empty list, in which case it will take forever. Nevertheless we here ensured that every element in the intersection will be emitted at least once.
Making the result finite (if the given lists are finite)
Now we can make our definition better. First we make a more advanced version of take, takeFinite (let's first give a straight-forward, but not very efficient defintion):
takeFinite :: Int -> [a] -> (Bool,[a])
takeFinite _ [] = (True,[])
takeFinite 0 _ = (False,[])
takeFinite n (x:xs) = let (b,t) = takeFinite (n-1) xs in (b,x:t)
Now we can iteratively deepen until both lists have reached the end:
intersectInfinite :: Eq a => [a] -> [a] -> [a]
intersectInfinite = intersectInfinite' 1
intersectInfinite' :: Eq a => Int -> [a] -> [a] -> [a]
intersectInfinite' n xs ys | fa && fb = intersect xs ys
| fa = intersect ys xs
| fb = intersect xs ys
| otherwise = intersect xfa xfb ++ intersectInfinite' (n+1) xs ys
where (fa,xfa) = takeFinite n xs
(fb,xfb) = takeFinite n ys
This will now terminate given both lists are finite, but still produces a lot of duplicates. There are definitely ways to resolve this issue more.
Here's one way. For each x we make a list of maybes which has
Just x only where x appeared in ys. Then we interleave all
these lists.
isect :: Eq a => [a] -> [a] -> [a]
isect xs ys = (catMaybes . foldr interleave [] . map matches) xs
where
matches x = [if x == y then Just x else Nothing | y <- ys]
interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs
Maybe it can be improved using some sort of fairer interleaving -
it's already pretty slow on the example below because (I think)
it's doing an exponential amount of work.
> take 10 (isect [0..] [0,2..])
[0,2,4,6,8,10,12,14,16,18]
If elements in the lists are ordered then you can easy to do that.
intersectOrd :: Ord a => [a] -> [a] -> [a]
intersectOrd [] _ = []
intersectOrd _ [] = []
intersectOrd (x:xs) (y:ys) = case x `compare` y of
EQ -> x : intersectOrd xs ys
LT -> intersectOrd xs (y:ys)
GT -> intersectOrd (x:xs) ys
Here's yet another alternative, leveraging Control.Monad.WeightedSearch
import Control.Monad (guard)
import Control.Applicative
import qualified Control.Monad.WeightedSearch as W
We first define a cost for digging inside the list. Accessing the tail costs 1 unit more. This will ensure a fair scheduling among the two infinite lists.
eachW :: [a] -> W.T Int a
eachW = foldr (\x w -> pure x <|> W.weight 1 w) empty
Then, we simply disregard infinite lists.
intersection :: [Int] -> [Int] -> [Int]
intersection xs ys = W.toList $ do
x <- eachW xs
y <- eachW ys
guard (x==y)
return y
Even better with MonadComprehensions on:
intersection2 :: [Int] -> [Int] -> [Int]
intersection2 xs ys = W.toList [ y | x <- eachW xs, y <- eachW ys, x==y ]
Solution
I ended up using the following implementation; a slight modification of the answer by David Fletcher:
isect :: Eq a => [a] -> [a] -> [a]
isect [] = const [] -- don't bother testing against an empty list
isect xs = catMaybes . diagonal . map matches
where matches y = [if x == y then Just x else Nothing | x <- xs]
This can be augmented with nub to filter out duplicates:
isectUniq :: Eq a => [a] -> [a] -> [a]
isectUniq xs = nub . isect xs
Explanation
Of the line isect xs = catMaybes . diagonal . map matches
(map matches) ys computes a list of lists of comparisons between elements of xs and ys, where the list indices specify the indices in ys and xs respectively: i.e (map matches) ys !! 3 !! 0 would represent the comparison of ys !! 3 with xs !! 0, which would be Nothing if those values differ. If those values are the same, it would be Just that value.
diagonals takes a list of lists and returns a list of lists where the nth output list contains an element each from the first n lists. Another way to conceptualise it is that (diagonals . map matches) ys !! n contains comparisons between elements whose indices in xs and ys sum to n.
diagonal is simply a flat version of diagonals (diagonal = concat diagonals)
Therefore (diagonal . map matches) ys is a list of comparisons between elements of xs and ys, where the elements are approximately sorted by the sum of the indices of the elements of ys and xs being compared; this means that early elements are compared to later elements with the same priority as middle elements being compared to each other.
(catMaybes . diagonal . map matches) ys is a list of only the elements which are in both lists, where the elements are approximately sorted by the sum of the indices of the two elements being compared.
Note
(diagonal . map (catMaybes . matches)) ys does not work: catMaybes . matches only yields when it finds a match, instead of also yielding Nothing on no match, so the interleaving does nothing to distribute the work.
To contrast, in the chosen solution, the interleaving of Nothing and Just values by diagonal means that the program divides its attention between 'searching' for multiple different elements, not waiting for one to succeed; whereas if the Nothing values are removed before interleaving, the program may spend too much time waiting for a fruitless 'search' for a given element to succeed.
Therefore, we would encounter the same problem as in the original question: while one element does not match any elements in the other list, the program will hang; whereas the chosen solution will only hang while no matches are found for any elements in either list.