How to remove second largest element in a list in haskell? - haskell

I have created a program to remove first smallest element but I dont how to do for second largest:
withoutBiggest (x:xs) =
withoutBiggestImpl (biggest x xs) [] (x:xs)
where
biggest :: (Ord a) => a -> [a] -> a
biggest big [] = big
biggest big (x:xs) =
if x < big then
biggest x xs
else
biggest big xs
withoutBiggestImpl :: (Eq a) => a -> [a] -> [a] -> [a]
withoutBiggestImpl big before (x:xs) =
if big == x then
before ++ xs
else
withoutBiggestImpl big (before ++ [x]) xs

Here is a simple solution.
Prelude> let list = [10,20,100,50,40,80]
Prelude> let secondLargest = maximum $ filter (/= (maximum list)) list
Prelude> let result = filter (/= secondLargest) list
Prelude> result
[10,20,100,50,40]
Prelude>

A possibility, surely not the best one.
import Data.Permute (rank)
x = [4,2,3]
ranks = rank (length x) x -- this gives [2,0,1]; that means 3 (index 1) is the second smallest
Then:
[x !! i | i <- [0 .. length x -1], i /= 1]
Hmm.. not very cool, let me some time to think to something better please and I'll edit my post.
EDIT
Moreover my previous solution was wrong. This one should be correct, but again not the best one:
import Data.Permute (rank, elems, inverse)
ranks = elems $ rank (length x) x
iranks = elems $ inverse $ rank (length x) x
>>> [x !! (iranks !! i) | i <- filter (/=1) ranks]
[4,2]
An advantage is that this preserves the order of the list, I think.

Here is a solution that removes the n smallest elements from your list:
import Data.List
deleteN :: Int -> [a] -> [a]
deleteN _ [] = []
deleteN i (a:as)
| i == 0 = as
| otherwise = a : deleteN (i-1) as
ntails :: Int -> [a] -> [(a, Int)] -> [a]
ntails 0 l _ = l
ntails n l s = ntails (n-1) (deleteN (snd $ head s) l) (tail s)
removeNSmallest :: Ord a => Int -> [a] -> [a]
removeNSmallest n l = ntails n l $ sort $ zip l [0..]
EDIT:
If you just want to remove the 2nd smallest element:
deleteN :: Int -> [a] -> [a]
deleteN _ [] = []
deleteN i (a:as)
| i == 0 = as
| otherwise = a : deleteN (i-1) as
remove2 :: [a] -> [(a, Int)] -> [a]
remove2 [] _ = []
remove2 [a] _ = []
remove2 l s = deleteN (snd $ head $ tail s) l
remove2Smallest :: Ord a => [a] -> [a]
remove2Smallest l = remove2 l $ sort $ zip l [0..]

It was not clear if the OP is looking for the biggest (as the name withoutBiggest implies) or what. In this case, one solution is to combine the filter :: (a->Bool) -> [a] -> [a] and maximum :: Ord a => [a] -> a functions from the Prelude.
withoutBiggest l = filter (/= maximum l) l

You can remove the biggest elements by first finding it and then filtering it:
withoutBiggest :: Ord a => [a] -> [a]
withoutBiggest [] = []
withoutBiggest xs = filter (/= maximum xs) xs
You can then remove the second-biggest element in much the same way:
withoutSecondBiggest :: Ord a => [a] -> [a]
withoutSecondBiggest xs =
case withoutBiggest xs of
[] -> xs
rest -> filter (/= maximum rest) xs
Assumptions made:
You want each occurrence of the second-biggest element removed.
When there is zero/one element in the list, there isn't a second element, so there isn't a second-biggest element. Having the list without an element that isn't there is equivalent to having the list.
When the list contains only values equivalent to maximum xs, there also isn't a second-biggest element even though there may be two or more elements in total.
The Ord type-class instance implies a total ordering. Otherwise you may have multiple maxima that are not equivalent; otherwise which one is picked as the biggest and second-biggest is not well-defined.

Related

How can I find the list with maximum length using recursion?

I am trying to use a recursive function that prints the list that has the maximum length out of the lists resulting from my following code:
allincreasing :: Ord a => [a] -> [[a]]
allincreasing = map nub . filter isSorted . subsequences
main = do
print $ allincreasing[3,2,6,4,5,1]
I need to pass the output below to a recursive function that find the one with max length :
[[],[3],[2],[6],[3,6],[2,6],[4],[3,4],[2,4],[5],[3,5],[2,5],[4,5],[3,4,5],[2,4,5],[1]]
I tried to do it using the following code based on my understanding of an answer to this question but I couldn't implement the recursion part well. Here is my attempt:
longest :: Ord a => [[a]] -> [a]
longest [y] = y --base case: if there's only one element left, return it.
longest (x:y:lst) --extract the first two elements x, y from the list.
| length x < length y = longest (y:lst)
| otherwise = x : (longest (y:lst))
lis :: Ord a => [a] -> a
lis = length . longest . allincreasing
Note: I am required to use recursion to solve the problem of longest increasing sequence.
When you want to track stuf alongsiede recursion (like the max list so far...) one use accumulators (you could read about them here...):
Edited due to comment request:
module Main where
import Data.List
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [x] = True
isSorted (x:y:xs) = x <= y && isSorted (y:xs)
allincreasing :: Ord a => [a] -> [[a]]
allincreasing = map nub . filter isSorted . subsequences
main :: IO ()
main = do
let list = [3,2,6,4,5,1]
print $ allincreasing list
print $ longest $ allincreasing list
longest :: Ord a => [[a]] -> [a]
longest list = longest' list []
where
longest' [] acc = acc
longest' (x:xs) [] = longest' xs x
longest' (x:xs) acc
| length acc >= length x = longest' xs acc
| length acc < length x = longest' xs x
longest' _ _ = error "something went wrong..."

create a function ved that will only remove the last occurrence of the largest item in the list using recursion

You must use recursion to define rmax2 and you must do so from “scratch”. That is, other than the cons operator, head, tail, and comparisons, you should not use any functions from the Haskell library.
I created a function that removes all instances of the largest item, using list comprehension. How do I remove the last instance of the largest number using recursion?
ved :: Ord a => [a] -> [a]
ved [] =[]
ved as = [ a | a <- as, m /= a ]
where m= maximum as
An easy way to split the problem into two easier subproblems consists in:
get the position index of the rightmost maximum value
write a general purpose function del that eliminates the element of a list at a given position. This does not require an Ord constraint.
If we were permitted to use regular library functions, ved could be written like this:
ved0 :: Ord a => [a] -> [a]
ved0 [] = []
ved0 (x:xs) =
let
(maxVal,maxPos) = maximum (zip (x:xs) [0..])
del k ys = let (ys0,ys1) = splitAt k ys in (ys0 ++ tail ys1)
in
del maxPos (x:xs)
where the pairs produced by zip are lexicographically ordered, thus ensuring the rightmost maximum gets picked.
We need to replace the library functions by manual recursion.
Regarding step 1, that is finding the position of the rightmost maximum, as is commonly done, we can use a recursive stepping function and a wrapper above it.
The recursive step function takes as arguments the whole context of the computation, that is:
current candidate for maximum value, mxv
current rightmost position of maximum value, mxp
current depth into the original list, d
rest of original list, xs
and it returns a pair: (currentMaxValue, currentMaxPos)
-- recursive stepping function:
findMax :: Ord a => a -> Int -> Int -> [a] -> (a, Int)
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (x:xs) = if (x >= mxv) then (findMax x d (d+1) xs)
else (findMax mxv mxp (d+1) xs)
-- top wrapper:
lastMaxPos :: Ord a => [a] -> Int
lastMaxPos [] = (-1)
lastMaxPos (x:xs) = snd (findMax x 0 1 xs)
Step 2, eliminating the list element at position k, can be handled in very similar fashion:
-- recursive stepping function:
del1 :: Int -> Int -> [a] -> [a]
del1 k d [] = []
del1 k d (x:xs) = if (d==k) then xs else x : del1 k (d+1) xs
-- top wrapper:
del :: Int -> [a] -> [a]
del k xs = del1 k 0 xs
Putting it all together:
We are now able to write our final recursion-based version of ved. For simplicity, we inline the content of wrapper functions instead of calling them.
-- ensure we're only using authorized functionality:
{-# LANGUAGE NoImplicitPrelude #-}
import Prelude (Ord, Eq, (==), (>=), (+), ($), head, tail,
IO, putStrLn, show, (++)) -- for testing only
ved :: Ord a => [a] -> [a]
ved [] = []
ved (x:xs) =
let
findMax mxv mxp d [] = (mxv,mxp)
findMax mxv mxp d (y:ys) = if (y >= mxv) then (findMax y d (d+1) ys)
else (findMax mxv mxp (d+1) ys)
(maxVal,maxPos) = findMax x 0 1 xs
del1 k d (y:ys) = if (d==k) then ys else y : del1 k (d+1) ys
del1 k d [] = []
in
del1 maxPos 0 (x:xs)
main :: IO ()
main = do
let xs = [1,2,3,7,3,2,1,7,3,5,7,5,4,3]
res = ved xs
putStrLn $ "input=" ++ (show xs) ++ "\n" ++ " res=" ++ (show res)
If you are strictly required to use recursion, you can use 2 helper functions: One to reverse the list and the second to remove the first largest while reversing the reversed list.
This result in a list where the last occurrence of the largest element is removed.
We also use a boolean flag to make sure we don't remove more than one element.
This is ugly code and I really don't like it. A way to make things cleaner would be to move the reversal of the list to a helper function outside of the current function so that there is only one helper function to the main function. Another way is to use the built-in reverse function and use recursion only for the removal.
removeLastLargest :: Ord a => [a] -> [a]
removeLastLargest xs = go (maximum xs) [] xs where
go n xs [] = go' n True [] xs
go n xs (y:ys) = go n (y:xs) ys
go' n f xs [] = xs
go' n f xs (y:ys)
| f && y == n = go' n False xs ys
| otherwise = go' n f (y:xs) ys
Borrowing the implementation of dropWhileEnd from Hackage, we can implement a helper function splitWhileEnd:
splitWhileEnd :: (a -> Bool) -> [a] -> ([a], [a])
splitWhileEnd p = foldr (\x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)) ([],[])
splitWhileEnd splits a list according to a predictor from the end. For example:
ghci> xs = [1,2,3,4,3,2,4,3,2]
ghci> splitWhileEnd (< maximum xs) xs
([1,2,3,4,3,2,4],[3,2])
With this helper function, you can write ven as:
ven :: Ord a => [a] -> [a]
ven xs =
let (x, y) = splitWhileEnd (< maximum xs) xs
in init x ++ y
ghci> ven xs
[1,2,3,4,3,2,3,2]
For your case, you can refactor splitWhileEnd as:
fun p = \x (xs, ys) -> if p x && null xs then ([], x:ys) else (x:xs, ys)
splitWhileEnd' p [] = ([], [])
splitWhileEnd' p (x : xs) = fun p x (splitWhileEnd' p xs)
ven' xs = let (x, y) = splitWhileEnd' (< maximum xs) xs in init x ++ y
If init and ++ are not allowed, you can implement them manually. It's easy!
BTW, I guess this may be your homework for Haskell course. I think it's ridiculous if your teacher gives the limitations. Who is programming from scratch nowadays?
Anyway, you can always work around this kind of limitations by reimplementing the built-in function manually. Good luck!

How to extract the same elements from two lists in Haskell?

here's my question:
How to extract the same elements from two equal length lists to another list?
For example: given two lists [2,4,6,3,2,1,3,5] and [7,3,3,2,8,8,9,1] the answer should be [1,2,3,3]. Note that the order is immaterial. I'm actually using the length of the return list.
I tried this:
sameElem as bs = length (nub (intersect as bs))
but the problem is nub removes all the duplications. The result of using my function to the former example is 3 the length of [1,3,2] instead of 4 the length of [1,3,3,2]. Is there a solution? Thank you.
Since the position seems to be irrelevant, you can simply sort the lists beforehand and then traverse both lists:
import Data.List (sort)
intersectSorted :: Ord a => [a] -> [a] -> [a]
intersectSorted (x:xs) (y:ys)
| x == y = x : intersectSorted xs ys
| x < y = intersectSorted xs (y:ys)
| x > y = intersectSorted (x:xs) ys
intersectSorted _ _ = []
intersect :: Ord a => [a] -> [a] -> [a]
intersect xs ys = intersectSorted (sort xs) (sort ys)
Note that it's also possible to achieve this with a Map:
import Data.Map.Strict (fromListWith, assocs, intersectionWith, Map)
type Counter a = Map a Int
toCounter :: Ord a => [a] -> Counter a
toCounter = fromListWith (+) . flip zip (repeat 1)
intersectCounter :: Ord a => Counter a -> Counter a -> Counter a
intersectCounter = intersectionWith min
toList :: Counter a -> [a]
toList = concatMap (\(k,c) -> replicate c k) . assocs
intersect :: Ord a => [a] -> [a] -> [a]
intersect xs ys = toList $ intersectCounter (toCounter xs) (toCounter ys)
You could write a function for this. There is probably a more elegant version of this involving lambda's or folds, but this does work for your example:
import Data.List
same (x:xs) ys = if x `elem` ys
then x:same xs (delete x ys)
else same xs ys
same [] _ = []
same _ [] = []
The delete x ys in the then-clause is important, without that delete command items from the first list that occur at least once will be counted every time they're encountered.
Note that the output is not sorted, since you were only interested in the length of the resulting list.
import Data.List (delete)
mutuals :: Eq a => [a] -> [a] -> [a]
mutuals [] _ = []
mutuals (x : xs) ys | x `elem` ys = x : mutuals xs (delete x ys)
| otherwise = mutuals xs ys
gives
mutuals [2,4,6,3,2,1,3,5] [7,3,3,2,8,8,9,1] == [2,3,1,3]

calculating number of inversions in a list in haskell

how do we get calculate inversions in a list in Haskell?
eg. [1, 2, 3, 1] , xi > xj where i < j is the condition for inversion. In the given example it would be 3.
I tried the following code:
module Inversion where
inv :: Ord a => [a] -> [(a, a)]
inv [] = []
inv xs = [(a, b) | a <- xs, b <- tail xs, a > b]
I even tried to zip it with tail and then get the pairs.
import Data.List
inv :: Ord a => [a] -> [(a, a)]
inv xs = [(a,b) | (a:bs) <- tails xs, b <- bs, a > b]
This is a naive implementation close to what you already got:
inv :: Ord a => [a] -> [(a, a)]
inv [] = []
inv xs = [(a, b) | b <- xs', a > b] ++ inv xs'
where xs' = tail xs
a = head xs
It does the first thing that comes to mind: compare the first element with every other element in the list and then do the same with the rest of the list.
Your example:
*Main> inv [1,2,3,1]
[(2,1),(3,1)]
This seems to work for me:
inv lst = filter nonOrdPair $ zip lst (tail lst)
where nonOrdPair (a,b) = a > b
on your example gives
Prelude> inv [1, 2, 3, 1]
[(3,1)]
if you only need the first element you can get it with map fst.
You can't use zip and tail in this case. This would lead to only comparing consecutive pairs where you need all pairs. So given a list (x:xs), you need to check whether any of the xs is smaller than x:
import Data.Maybe (mapMaybe)
checkInv :: Ord a => a -> a -> Maybe (a,a)
checkInv x y = if x <= y then Nothing
else Just (x, y)
inv :: Ord a => [a] -> [(a,a)]
inv [] = []
inv (x:xs) = mapMaybe (checkInv x) xs ++ inv xs
> inv [1,2,3,1]
[(2,1), (3,1)]
Just to throw some folds into the matter:
inv :: Ord a => [a] -> [(a,a)]
inv [x] = [] :: [(x,x)]
inv xs = foldl (\acc x -> if (head xs) > x then (head xs, x) : acc else acc) [] xs
Zipping and then filtering the pairs is not a bad idea, but you have to consider all the pairs for that to work:
inv xs = filter (\(a, b) -> a > b) $ allPairs xs
where
allPairs xs = allPairsHelp xs (tail xs)
where
allPairsHelp xs [] = []
allPairsHelp xs ys = zip xs ys ++ allPairsHelp xs (tail ys)

What's an efficient way to pluck an element out of a list and return the element, and rest of list in a tuple?

This seems to be a very common operation but I can't find it in hoogle for some reason. Either way, it's an interesting thought exercise. My naive implementation:
pluckL :: [a] -> Int -> Maybe ( a, [a] )
pluckL xs idx = if idx < length xs then Just $ pluck' xs idx else Nothing
where
pluck' l n = let subl = drop n l in ( head subl, rest l n ++ tail subl )
rest l n = reverse $ drop ( length l - n ) $ reverse l
My main gripe is that I'm flipping the list too many times, so I'm looking for a creative way where you can traverse the list once and generate the tuple.
There will never be an efficient way. But there can at least be a pretty way:
pluckL xs i = case splitAt i xs of
(b, v:e) -> Just (v, b ++ e)
_ -> Nothing
You can get by with one fewer reverse and fewer operations on the list if you use an accumulator:
pluckL :: [a] -> Int -> Maybe (a, [a])
pluckL xs idx = pluck xs idx [] where
pluck (x:xs) 0 acc = Just $ ( x, (reverse acc) ++ xs )
pluck (x:xs) i acc = pluck xs (i-1) (x:acc)
pluck [] i acc = Nothing
You can use elem to check if the elem is in the list or not, then depending of the result return Nothing or use delete x to remove x from the list, as follow for example,
pluckL :: Eq a => [a] -> a -> Maybe (a, [a])
pluckL xs0 x =
if (x `elem` xs0)
then Just (x, xs)
else Nothing
where xs = delete x xs0

Resources