I'm trying to write a function that deletes the second occurrence of an element in a list.
Currently, I've written a function that removes the first element:
removeFirst _ [] = []
removeFirst a (x:xs) | a == x = xs
| otherwise = x : removeFirst a xs
as a starting point. However,I'm not sure this function can be accomplished with list comprehension. Is there a way to implement this using map?
EDIT: Now I have added a removeSecond function which calls the first
deleteSecond :: Eq a => a -> [a] -> [a]
deleteSecond _ [] = []
deleteSecond a (x:xs) | x==a = removeFirst a xs
| otherwise = x:removeSecond a xs
However now the list that is returned removes the first AND second occurrence of an element.
Well, assuming you've got removeFirst - how about searching for the first occurence, and then using removeFirst on the remaining list?
removeSecond :: Eq a => a -> [a] -> [a]
removeSecond _ [] = []
removeSecond a (x:xs) | x==a = x:removeFirst a xs
| otherwise = x:removeSecond a xs
You could also implement this as a fold.
removeNth :: Eq a => Int -> a -> [a] -> [a]
removeNth n a = concatMap snd . scanl go (0,[])
where go (m,_) b | a /= b = (m, [b])
| n /= m = (m+1, [b])
| otherwise = (m+1, [])
and in action:
λ removeNth 0 1 [1,2,3,1]
[2,3,1]
λ removeNth 1 1 [1,2,3,1]
[1,2,3]
I used scanl rather than foldl or foldr so it could both pass state left-to-right and work on infinite lists:
λ take 11 . removeNth 3 'a' $ cycle "abc"
"abcabcabcbc"
Here is an instinctive implementation using functions provided by List:
import List (elemIndices);
removeSecond x xs = case elemIndices x xs of
(_:i:_) -> (take i xs) ++ (drop (i+1) xs)
_ -> xs
removeNth n x xs = let indies = elemIndices x xs
in if length indies < n
then xs
else let idx = indies !! (n-1)
in (take idx xs) ++ (drop (idx+1) xs)
Note: This one cannot handle infinite list, and its performance may not be good for very large list.
Related
As a programming exercise I'm trying to build a function in Haskell where given a list it splits the list whenever an element is repeated. [1,2,3,3,4,5] would split into [[1,2,3],[3,4,5]] for example. My first idea was to split the list into a list of lists with single elements, where [1,2,3,3,4,5] would become [[1],[2],[3],[3],[4],[5]] and then merge lists only when the elements being compared are not equal, but implementing this has been a headache for me as I'm very new to Haskell and recursion has always given me trouble. I think something is wrong with the function I'm using to combine the lists, it will only ever return a list where all the elements that were broken apart are combined, where [1,2,3,3,4,5] becomes [[1],[2],[3],[3],[4],[5]] but my split_help function will transform this into [[1,2,3,3,4,5]] instead of [[1,2,3],[3,4,5]]
I've pasted my incomplete code below, it doesn't work right now but it should give the general idea of what I'm trying to accomplish. Any feedback on general Haskell code etiquette would also be welcome.
split_breaker breaks the list into a list of list and split_help is what I'm trying to use to combine unequal elements.
split_help x y
| x /= y = x ++ y
| otherwise = []
split_breaker :: Eq a => [a] -> [[a]]
split_breaker [] = []
split_breaker [x] = [[x]]
split_breaker (x:xs) = [x]:split_breaker xs
split_at_duplicate :: Eq a => [a] -> [[a]]
split_at_duplicate [x] = [[x]]
split_at_duplicate (x:xs) = foldl1 (split_help) (split_breaker [xs])
Do you want to work it something like this?
splitAtDup [1,2,3,3,3,4,4,5,5,5,5,6]
[[1,2,3],[3],[3,4],[4,5],[5],[5],[5,6]]
Am I right?
Then do it simple:
splitAtDup :: Eq a => [a] -> [[a]]
splitAtDup (x : y : xs) | x == y = [x] : splitAtDup (y : xs)
splitAtDup (x : xs) =
case splitAtDup xs of
x' : xs' -> (x : x') : xs'
_ -> [[x]]
splitAtDup [] = []
Here's a maximally lazy approach:
splitWhen :: (a -> a -> Bool) -> [a] -> [[a]]
splitWhen f = foldr go [[]] where
go x acc = (x:xs):xss where
xs:xss = case acc of
(z:_):_ | f x z -> []:acc
_ -> acc
splitAtDup :: Eq a => [a] -> [[a]]
splitAtDup = splitWhen (==)
To verify the laziness, try this:
take 2 $ take 4 <$> splitAtDup (1:2:3:3:4:5:6:undefined)
It can be fully evaluated to normal form as [[1,2,3],[3,4,5,6]].
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
Is there a Haskell function that takes a list and returns a list of duplicates/redundant elements in that list?
I'm aware of the the nub and nubBy functions, but they remove the duplicates; I would like to keep the dupes and collects them in a list.
The simplest way to do this, which is extremely inefficient, is to use nub and \\:
import Data.List (nub, (\\))
getDups :: Eq a => [a] -> [a]
getDups xs = xs \\ nub xs
If you can live with an Ord constraint, everything gets much nicer:
import Data.Set (member, empty, insert)
getDups :: Ord a => [a] -> [a]
getDups xs = foldr go (const []) xs empty
where
go x cont seen
| member x seen = x : r seen
| otherwise = r (insert x seen)
I wrote these functions which seems to work well.
The first one return the list of duplicates element in a list with a basic equlity test (==)
duplicate :: Eq a => [a] -> [a]
duplicate [] = []
duplicate (x:xs)
| null pres = duplicate abs
| otherwise = x:pres++duplicate abs
where (pres,abs) = partition (x ==) xs
The second one make the same job by providing a equality test function (like nubBy)
duplicateBy :: (a -> a -> Bool) -> [a] -> [a]
duplicateBy eq [] = []
duplicateBy eq (x:xs)
| null pres = duplicateBy eq abs
| otherwise = x:pres++duplicateBy eq abs
where (pres,abs) = partition (eq x) xs
Is there a Haskell function that takes a list and returns a list of duplicates/redundant elements in that list?
You can write such a function yourself easily enough. Use a helper function that takes two list arguments, the first one of which being the list whose dupes are sought; walk along that list and accumulate the dupes in the second argument; finally, return the latter when the first argument is the empty list.
dupes l = dupes' l []
where
dupes' [] ls = ls
dupes' (x:xs) ls
| not (x `elem` ls) && x `elem` xs = dupes' xs (x:ls)
| otherwise = dupes' xs ls
Test:
λ> dupes [1,2,3,3,2,2,3,4]
[3,2]
Be aware that the asymptotic time complexity is as bad as that of nub, though: O(n^2). If you want better asymptotics, you'll need an Ord class constraint.
If you are happy with an Ord constraint you can use group from Data.List:
getDups :: Ord a => [a] -> [a]
getDups = concatMap (drop 1) . group . sort
One more question about most elegant and simple implementation of element combinations in F#.
It should return all combinations of input elements (either List or Sequence).
First argument is number of elements in a combination.
For example:
comb 2 [1;2;2;3];;
[[1;2]; [1;2]; [1;3]; [2;2]; [2;3]; [2;3]]
One less concise and more faster solution than ssp:
let rec comb n l =
match n, l with
| 0, _ -> [[]]
| _, [] -> []
| k, (x::xs) -> List.map ((#) [x]) (comb (k-1) xs) # comb k xs
let rec comb n l =
match (n,l) with
| (0,_) -> [[]]
| (_,[]) -> []
| (n,x::xs) ->
let useX = List.map (fun l -> x::l) (comb (n-1) xs)
let noX = comb n xs
useX # noX
There is more consise version of KVB's answer:
let rec comb n l =
match (n,l) with
| (0,_) -> [[]]
| (_,[]) -> []
| (n,x::xs) ->
List.flatten [(List.map (fun l -> x::l) (comb (n-1) xs)); (comb n xs)]
The accepted answer is gorgeous and quickly understandable if you are familiar with tree recursion. Since elegance was sought, opening this long dormant thread seems somewhat unnecessary.
However, a simpler solution was asked for. Iterative algorithms sometimes seem simpler to me. Furthermore, performance was mentioned as an indicator of quality, and iterative processes are sometimes faster than recursive ones.
The following code is tail recursive and generates an iterative process. It requires a third of the amount of time to compute combinations of size 12 from a list of 24 elements.
let combinations size aList =
let rec pairHeadAndTail acc bList =
match bList with
| [] -> acc
| x::xs -> pairHeadAndTail (List.Cons ((x,xs),acc)) xs
let remainderAfter = aList |> pairHeadAndTail [] |> Map.ofList
let rec comboIter n acc =
match n with
| 0 -> acc
| _ ->
acc
|> List.fold (fun acc alreadyChosenElems ->
match alreadyChosenElems with
| [] -> aList //Nothing chosen yet, therefore everything remains.
| lastChoice::_ -> remainderAfter.[lastChoice]
|> List.fold (fun acc elem ->
List.Cons (List.Cons (elem,alreadyChosenElems),acc)
) acc
) []
|> comboIter (n-1)
comboIter size [[]]
The idea that permits an iterative process is to pre-compute a map of the last chosen element to a list of the remaining available elements. This map is stored in remainderAfter.
The code is not concise, nor does it conform to lyrical meter and rhyme.
A naive implementation using sequence expression. Personally I often feel sequence expressions are easier to follow than other more dense functions.
let combinations (k : int) (xs : 'a list) : ('a list) seq =
let rec loop (k : int) (xs : 'a list) : ('a list) seq = seq {
match xs with
| [] -> ()
| xs when k = 1 -> for x in xs do yield [x]
| x::xs ->
let k' = k - 1
for ys in loop k' xs do
yield x :: ys
yield! loop k xs }
loop k xs
|> Seq.filter (List.length >> (=)k)
Method taken from Discrete Mathematics and Its Applications.
The result returns an ordered list of combinations stored in arrays.
And the index is 1-based.
let permutationA (currentSeq: int []) (n:int) (r:int): Unit =
let mutable i = r
while currentSeq.[i - 1] = n - r + i do
i <- (i - 1)
currentSeq.[i - 1] <- currentSeq.[i - 1] + 1
for j = i + 1 to r do
currentSeq.[j - 1] <- currentSeq.[i - 1] + j - i
()
let permutationNum (n:int) (r:int): int [] list =
if n >= r then
let endSeq = [|(n-r+1) .. n|]
let currentSeq: int [] = [|1 .. r|]
let mutable resultSet: int [] list = [Array.copy currentSeq];
while currentSeq <> endSeq do
permutationA currentSeq n r
resultSet <- (Array.copy currentSeq) :: resultSet
resultSet
else
[]
This solution is simple and helper function costs constant memory.
My solution is less concise, less effective (altho, no direct recursion used) but it trully returns all combinations (currently only pairs, need to extend filterOut so it can return a tuple of two lists, will do little later).
let comb lst =
let combHelper el lst =
lst |> List.map (fun lstEl -> el::[lstEl])
let filterOut el lst =
lst |> List.filter (fun lstEl -> lstEl <> el)
lst |> List.map (fun lstEl -> combHelper lstEl (filterOut lstEl lst)) |> List.concat
comb [1;2;3;4] will return:
[[1; 2]; [1; 3]; [1; 4]; [2; 1]; [2; 3]; [2; 4]; [3; 1]; [3; 2]; [3; 4]; [4; 1]; [4; 2]; [4; 3]]
Ok, just tail combinations little different approach (without using of library function)
let rec comb n lst =
let rec findChoices = function
| h::t -> (h,t) :: [ for (x,l) in findChoices t -> (x,l) ]
| [] -> []
[ if n=0 then yield [] else
for (e,r) in findChoices lst do
for o in comb (n-1) r do yield e::o ]
I'm new in haskell and I'm looking for some standard functions to work with lists by indexes.
My exact problem is that i want to remove 3 elements after every 5. If its not clear enough here is illustration:
OOOOOXXXOOOOOXXX...
I know how to write huge function with many parameters, but is there any clever way to do this?
Two completely different approaches
You can use List.splitAt together with drop:
import Data.List (splitAt)
f :: [a] -> [a]
f [] = []
f xs = let (h, t) = splitAt 5 xs in h ++ f (drop 3 t)
Now f [1..12] yields [1,2,3,4,5,9,10,11,12]. Note that this function can be expressed more elegantly using uncurry and Control.Arrow.second:
import Data.List (splitAt)
import Control.Arrow (second)
f :: [a] -> [a]
f [] = []
f xs = uncurry (++) $ second (f . drop 3) $ splitAt 5 xs
Since we're using Control.Arrow anyway, we can opt to drop splitAt and instead call in the help of Control.Arrow.(&&&), combined with take:
import Control.Arrow ((&&&))
f :: [a] -> [a]
f [] = []
f xs = uncurry (++) $ (take 5 &&& (f . drop 8)) xs
But now it's clear that an even shorter solution is the following:
f :: [a] -> [a]
f [] = []
f xs = take 5 xs ++ (f . drop 8) xs
As Chris Lutz notes, this solution can then be generalized as follows:
nofm :: Int -> Int -> [a] -> [a]
nofm _ _ [] = []
nofm n m xs = take n xs ++ (nofm n m . drop m) xs
Now nofm 5 8 yields the required function. Note that a solution with splitAt may still be more efficient!
Apply some mathematics using map, snd, filter, mod and zip:
f :: [a] -> [a]
f = map snd . filter (\(i, _) -> i `mod` 8 < (5 :: Int)) . zip [0..]
The idea here is that we pair each element in the list with its index, a natural number i. We then remove those elements for which i % 8 > 4. The general version of this solution is:
nofm :: Int -> Int -> [a] -> [a]
nofm n m = map snd . filter (\(i, _) -> i `mod` m < n) . zip [0..]
Here is my take:
deleteAt idx xs = lft ++ rgt
where (lft, (_:rgt)) = splitAt idx xs
You can count your elements easily:
strip' (x:xs) n | n == 7 = strip' xs 0
| n >= 5 = strip' xs (n+1)
| n < 5 = x : strip' xs (n+1)
strip l = strip' l 0
Though open-coding looks shorter:
strip (a:b:c:d:e:_:_:_:xs) = a:b:c:d:e:strip xs
strip (a:b:c:d:e:xs) = a:b:c:d:e:[]
strip xs = xs
Since nobody did a version with "unfoldr", here is my take:
drop3after5 lst = concat $ unfoldr chunk lst
where
chunk [] = Nothing
chunk lst = Just (take 5 lst, drop (5+3) lst)
Seems to be the shortest thus far
the take and drop functions may be able to help you here.
drop, take :: Int -> [a] -> [a]
from these we could construct a function to do one step.
takeNdropM :: Int -> Int -> [a] -> ([a], [a])
takeNdropM n m list = (take n list, drop (n+m) list)
and then we can use this to reduce our problem
takeEveryNafterEveryM :: Int -> Int -> [a] -> [a]
takeEveryNafterEveryM n m [] = []
takeEveryNafterEveryM n m list = taken ++ takeEveryNafterEveryM n m rest
where
(taken, rest) = takeNdropM n m list
*Main> takeEveryNafterEveryM 5 3 [1..20]
[1,2,3,4,5,9,10,11,12,13,17,18,19,20]
since this is not a primitive form of recursion, it is harder to express this as a simple fold.
so a new folding function could be defined to fit your needs
splitReduce :: ([a] -> ([a], [a])) -> [a] -> [a]
splitReduce f [] = []
splitReduce f list = left ++ splitReduce f right
where
(left, right) = f list
then the definition of takeEveryNafterEveryM is simply
takeEveryNafterEveryM2 n m = splitReduce (takeNdropM 5 3)
This is my solution. It's a lot like #barkmadley's answer, using only take and drop, but with less clutter in my opinion:
takedrop :: Int -> Int -> [a] -> [a]
takedrop _ _ [] = []
takedrop n m l = take n l ++ takedrop n m (drop (n + m) l)
Not sure if it'll win any awards for speed or cleverness, but I think it's pretty clear and concise, and it certainly works:
*Main> takedrop 5 3 [1..20]
[1,2,3,4,5,9,10,11,12,13,17,18,19,20]
*Main>
Here is my solution:
remElements step num=rem' step num
where rem' _ _ []=[]
rem' s n (x:xs)
|s>0 = x:rem' (s-1) num xs
|n==0 = x:rem' (step-1) num xs
|otherwise= rem' 0 (n-1) xs
example:
*Main> remElements 5 3 [1..20]
[1,2,3,4,5,9,10,11,12,13,17,18,19,20]
myRemove = map snd . filter fst . zip (cycle $ (replicate 5 True) ++ (replicate 3 False))