I have to design a function removeOrAdd :: a -> [a] -> [a]. My straightforward solution:
removeOrAdd :: Eq a => a -> [a] -> [a]
removeOrAdd x xs | x `elem` xs = [x' | x' <- xs, x' /= x]
| otherwise = x : xs
However, I have a feeling that I am doing something that has already been done by others. Is there any function in Haskell that already does it?
UPD: Let's see list as a Set we don't expect to have more than one x in a list, otherwise we remove all of them.
Is there any function in Haskell that already do it?
Not as far as I know no, and a search on Hoogle does not immediately lists such function. I think it is rather strange, since usually one aims to either add, or delete, but not both depending on a condition.
We can improve the above function, by making it more lazy (such that it works on infinite lists where x never occurs), as well as more efficient in the sense that we do not iterate twice over the list. We can use explicit recursion for this:
removeOrAdd :: Eq a => a -> [a] -> [a]
removeOrAdd x = go
where go [] = [x]
go (y:ys) | x == y = ys
| otherwise = y : go ys
We here thus iterate over the list, we keep iterating until we find an element y that is equal to x. If that is the case, we return ys, and we are done, since we removed that item. If not and we reach the end of the list with the recursion, we know x was not part of the list, and thus we return [x] to add that element. Here we thus add the elements at the end of the list.
If the list is sorted, we can insert it at the correct place:
removeOrAdd :: Ord a => a -> [a] -> [a]
removeOrAdd x = go
where go [] = [x]
go (y:ys) | x == y = ys
| y > x = x : y : ys
| otherwise = y : go ys
Here we thus keep the items in the correct order.
Related
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.
I have a list of values that I would like to take from while the value is increasing. I assume it would always take the head of the list and then compare it to the next value. The function will continue to take as long as this continues to increase. Upon reaching an list element that is less than or equal the pervious value the list is returned.
takeIncreasing :: (Ord a) => [a] -> [a]
takeIncreasing [1,2,3,4,3,5,6,7,8] -- Should return [1,2,3,4]
A fold could compare the last element of the accumulation with the next value and append if the condition is met, but would continue to the end of the list. I would like the function to stop taking at the first instance the constraint is not met.
This seems like an application of a monad but cannot determine if an existing monad accomplishes this.
A fold [...] would continue to the end of the list. I would like the function to stop taking at the first instance the constraint is not met.
A right fold can short circuit:
fun :: Ord a => [a] -> [a]
fun [] = []
fun (x:xs) = x: foldr go (const []) xs x
where go x f i = if i < x then x: f x else []
then,
\> fun [1,2,3,4,3,undefined]
[1,2,3,4]
or infinite size list:
\> fun $ [1,2,3,4,3] ++ [1..]
[1,2,3,4]
Right folds are magical, so you never even have to pattern match on the list.
twi xs = foldr go (const []) xs Nothing where
go x _ (Just prev)
| x < prev = []
go x r _ = x : r (Just x)
Or one that IMO has a bit less code complexity:
takeIncreasing :: Ord x => [x] -> [x]
takeIncreasing (x:x':xs) | x < x' = x : takeIncreasing (x':xs)
| otherwise = [x]
takeIncreasing xs = xs
This one is just a bit less clever than previous suggestions. I like un-clever code.
A solution without folds:
takeIncreasing :: Ord a => [a] -> [a]
takeIncreasing [] = []
takeIncreasing (x:xs) = (x :) . map snd . takeWhile (uncurry (<)) $ zip (x:xs) xs
I'm looking for a cleaner way to write a function that adds an element to a list if the list does not contain it. Or otherwise removes it if the list does contain it, I'm using an if clause now and the function is working.
But I'm trying to find a more haskell-ish way to right this.
This is my code:
removeElemOrAdd :: Eq a => a -> [a] -> [a]
removeElemOrAdd elem list = if (List.elem elem list)
then (filter(\x -> x /= elem) list)
else (elem:list)
Note: a small ambiguity in your question is what to do when x already occurs multiple times in the original list. I assumed this won't happen and in case it does, only the first occurrence is removed. Meaning that removeElemOrAdd 2 [4,2,5,2,7] will result in [4,5,2,7]. Furthermore it is unspecified where the item should be added. Because it has some advantages, I've opted to do this at the end of the list.
An implementation without using any library methods is the following:
removeElemOrAdd :: Eq a => a -> [a] -> [a]
removeElemOrAdd x (y:ys) | x == y = ys
| otherwise = y : removeElemOrAdd x ys
removeElemOrAdd x _ = [x]
Or a shorter version:
removeElemOrAdd :: Eq a => a -> [a] -> [a]
removeElemOrAdd x = reoa
where reoa (y:ys) | x == y = ys
| otherwise = y : reoa ys
reoa _ = [x]
or an equivalent implementation (see discussion below):
removeElemOrAdd :: Eq a => a -> [a] -> [a]
removeElemOrAdd x = reoa
where reoa (y:ys) | x == y = ys
| otherwise = y : reoa ys
reoa [] = [x]
The function works as follows: in case we are talking about a list with at least one item (y:ys), we compare x with y and if they are equal, we return ys: in that case we have removed the element and we are done.
Now in case the two are not equal, we return a list construction (:) with y in the head since we need to retain y and in the tail, we will do a recursive call removeElemOrAdd with x and ys. Indeed: it is possible that there is an x somewhere in the tail ys to remove, and furthermore we still need to add x to the list if it does not occur.
That clause will loop recursively through the list. From the moment it finds an y such that x == y it will remove that y. It is however possible that we reach the end of the list, and still have not found the element. In that case we will call the final clause. Here we know the list is empty (we could have written removeElemOrAdd x []) but to make the function definition syntactically total, I have opted to use an underscore. We can only reach this state if we have failed to find x in the list, so then we add it to the tail of the list by returning [x].
An advantage of this approach over using the if-then-else is that this does all tasks at once (checking, removing and adding) making it more efficient.
Another advantage is that this can run on an "infinite" list (like for instance the list of prime numbers). The list is evaluated lazily, so if you want to take the first three items, this function will only check the equality of the first three items.
I like the other approaches, but don't like that they behave differently than the specification. So here is an approach that:
Like the original, deletes all copies, if there are any, AND
like the original, inserts the new value at the beginning, if necessary, BUT
unlike the original, uses a clever trick based on the ideas of beautiful folding (and follow-up developments) to make only one pass through the data.
The basic idea is that we will have a single value which tracks both whether all values so far have been a mismatch as well as the resulting filtered list. The injectNE operation will perform this operation for a single element of the list, and we will then use foldMap to expand from one element to the whole input list.
import Data.Monoid
injectNE :: Eq a => a -> a -> (All, [a])
injectNE old new = (All ne, [new | ne]) where
ne = old /= new
removeElemOrAdd :: Eq a => a -> [a] -> [a]
removeElemOrAdd x xs = case foldMap (injectNE x) xs of
(All nex, noxs) -> [x | nex] ++ noxs
In the final pattern, you should read nex as "no element was equal to x", and noxs as "the list without any copies of x" (get it? "no xs"? ba-dum-tsh).
It is slightly unfortunate that the spec was written the way it was, though: in particular, one of the selling points of beautiful folding is that its resulting one-pass folds can be friendlier to the garbage collector. But the spec makes that quite hard, because we must traverse the entire input list before deciding what the first element of the result list should be. We can improve the friendliness to the garbage collector significantly by relaxing point (2) above (but leaving (1) and (3)); and moreover the difference is merely swapping the arguments to (++), a nicely semantic diff to see in your revision history:
-- <snipped identical code>
removeElemOrAdd x xs = case ... of
... -> noxs ++ [x | nex]
I'd use a fold to remove all copies:
removeOrAdd x xs = foldr go (bool [x] []) xs False where
go y r found
| y == x = r True
| otherwise = y : r found
To remove just one, a paramorphism seems to be in order:
removeOrAdd x = para go [x] where
go y ys r
| y == x = ys
| otherwise = y : r
This is homework that has been driving crazy for the last couple of days.
I got a list that I am applying a function to - pushing each element to the right if the element next to it is smaller then the previous one.
My function to pass over the list once and sort the head of the list:
sortEm lis#(x:y:xs) = if x > y then y: sortEm (x:xs) else lis
sortEm [x] = [x]
sortEm [] = []
myList (x:y:xs) = if x > y then sortEm lis else x:myList(y:xs)
myList [] = []
myList [x] = [x]
But my problem is that once that sortem has finished it returns either an empty list or a list containing one element, how would i design this the functional way?
I was thinking about foldl and some haskell magic to go along with that but currently I am stuck.
Thanks in advance
First of, your sortEm function name is misleading, it doesn't sort its argument list but inserts its head element into its tail. As it happens, there is an insert function already in Data.List module that inserts its first argument into the 2nd, so there's an equivalency
sortEm (x:xs) === Data.List.insert x xs
Now, inserting an item will only get you a sorted list back if you're inserting it into a list that is already sorted. Since empty list is sorted, that's what myList function does that you got in dave4420's answer. That is an "insertion" sort, progressively inserting elements of list into an auxiliary list, initially empty. And that's what the 2nd function does that you got in dave4420 answer:
insertionSort xs = foldr Data.List.insert [] xs
This does "apply sortem" i.e. inserts, "each element" only once. For a list [a,b,c,...,z] it's equivalent to
insert a (insert b (insert c (... (insert z []) ...)))
What you probably meant in your comment, i.e. comparing (and possibly swapping) two neighboring elements "only once", is known as bubble sort. Of course making only one pass through the list won't get it sorted, in a general case:
bubbleOnce xs = foldr g [] xs where
g x [] = [x]
g x xs#(y:ys) | x>y = y:x:ys -- swap x and y in the output
| otherwise = x:xs -- keep x before y in the output
Now, bubbleOnce [4,2,6,1,8] ==> [1,4,2,6,8]. The value that you expected, [2,4,1,6,8], would result from applying the folding function g in an opposite direction, from the left to the right. But that's much less natural to do here with Haskell lists:
bubbleOnce' [] = []
bubbleOnce' (x:xs) = let (z,h)=foldl g (x,id) xs in (h [z]) where
g (x,f) y | x>y = (x, f.(y:)) -- swap x and y in the output
| otherwise = (y, f.(x:)) -- keep x before y in the output
(edit:) see jimmyt's answer for the equivalent, but simple and nice version using straightforward recursion. It is also lazier (less strict) than both the fodlr and foldl versions here.
myList [] = []
myList (x : xs) = sortEm (x : myList xs)
(untested)
Or in terms of a fold:
myList = foldr cons []
where cons x xs = sortEm (x : xs)
(also untested)
-- if..then..else version
sortEM :: Ord a => [a] -> [a]
sortEM (x:y:xs) = if x < y
then x : sortEM (y:xs)
else y : sortEM (x:xs)
sortEM b = b
-- guard version
sortEM_G :: Ord a => [a] -> [a]
sortEM_G (x:y:xs)
| x < y = x : sortEM_G (y:xs)
| otherwise = y : sortEM_G (x:xs)
sortEM_G b = b
Trying to learn Haskell. I am trying to write a simple function to remove a number from a list without using built-in function (delete...I think). For the sake of simplicity, let's assume that the input parameter is an Integer and the list is an Integer list. Here is the code I have, Please tell me what's wrong with the following code
areTheySame :: Int -> Int-> [Int]
areTheySame x y | x == y = []
| otherwise = [y]
removeItem :: Int -> [Int] -> [Int]
removeItem x (y:ys) = areTheySame x y : removeItem x ys
The others are right that the problem is the : operator. I would say that your areTheySame function that returns a list is the wrong approach anyway, though. Rather than switch to the ++ operator, a better implementation of that function would be:
removeItem _ [] = []
removeItem x (y:ys) | x == y = removeItem x ys
| otherwise = y : removeItem x ys
As you can see, this is a pretty simple implementation. Also, consing like this is much less taxing for your program than appending a bunch of lists together. It has other benefits as well, such as working lazily.
The : operator doesn't do what you think it does:
(:) :: a -> [a] -> [a]
It takes an item of type a and adds it to the beginning of a list of type a. You're using it to join two lists of type a. For that, you need to use ++:
(++) :: [a] -> [a] -> [a]
Also, if you make a recursive function, it needs an ending condition. So try this:
removeItem _ [] = []
removeItem x (y:ys) = areTheySame x y ++ removeItem x ys
That way, when you get to the end of the list, the function will stop recursing.
You can also do this as a list-comprehension
delete :: Eq a => a -> [a] -> [a]
delete deleted xs = [ x | x <- xs, x /= deleted ]
I wrote a function in just one line of code:
remove element list = filter (\e -> e/=element) list
For example:
remove 5 [1..10]
[1,2,3,4,6,7,8,9,10]
remove 'b' ['a'..'f']
"acdef"
This is the minimal fix to make your example work:
removeItem :: Int -> [Int] -> [Int]
removeItem _ [] = []
removeItem x (y:ys) = areTheySame x y ++ removeItem x ys
First, you need to use ++ to concatenate lists, as the : operator used by you adds just one element to the beginning of a list (it can neither be used to add lists with one element nor to add empty lists). You first compare the head of the list (y) to the item you want to remove and correctly return the item or an empty list using areTheySame. Then you want to recursively continue using removeItem on the rest of the list (ys). The resulting list needs to be concatenated using ++.
Second, as Chris Lutz noted, you need an ending condition when you reach the end of the list. By adding this line, Haskell knows what to do with an empty list (that is, nothing, just return an empty list).
As Chuck said, you can simplify the code for this task by having removeItem not delegate the task of the comparison, but compare itself and throw away the element if it should be removed, otherwise keep it at the list head (using :). In any case, continue recursively with the rest of the list.
-- nothing can be removed from an empty list
-- ==> return empty list and stop recursion
removeItem _ [] = []
-- if the list is not empty, cut off the head in y and keep the rest in ys
-- if x==y, remove y and continue
removeItem x (y:ys) | x == y = removeItem x ys
-- otherwise, add y back and continue
| otherwise = y : removeItem x ys
For reference, you may be interested in seeing how it's done in delete from Data.List.
You could leave areTheySame as is, but you'd then need to use concatMap in removeItem to collapse the empty lists:
removeItem :: Int -> [Int] -> [Int]
removeItem x xs = concatMap (areTheySame x) xs
or equivalently
removeItem :: Int -> [Int] -> [Int]
removeItem x = concatMap (areTheySame x)
Note that the types of your functions could be more general:
areTheySame :: (Eq a) => a -> a -> [a]
removeItem :: (Eq a) => a -> [a] -> [a]
This allows removal of items from lists of any type for which == is defined, not just Int.
I believe all the solutions given so far work differently than Data.List.delete, which only deletes the first member.
deleteFromList x xs =
case break (==x) xs of
(_,[]) -> xs
(notsat,sat) -> notsat ++ tail sat
was my attempt to delete only the first member (haven't peaked at D.L yet).
It's unclear which behavior the top poster wants.