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

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..."

Related

How to remove second largest element in a list in 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.

Search in the list of integers, one of the longest ordered subsets (not necessarily consecutive) ordered by growth

Function, which finds in the list of integers one of the longest ordered increments of subscripts (not necessarily consecutive) numbers. Example:
• Sequence [21,27,15,14,18,16,14,17,22,13] = [14,16,17,22]
I have a problem with the function which takes the initial number from the array, and looks for a sequence:
fstLen:: Int -> [Int] -> [Int]
fstLen a [] = a: []
fstLen x (l:ls) = if x < l then x:(fstLen l ls) else fstLen x ls
I have problems in place, 14,18,16,14,17,22,13
14 < 18 but then 18 > 16 and my algorithm takes the number 16 as the basis and is looking for a new sequence and I need to go back to 14
How can I do it?
(sorry for my english)
You could always just use subsequences from Data.List to get all the possible subsequences in a list. When you get these subsequences, just take the sorted ones with this function and filter:
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
Then get the maximum length subsequence with maximumBy(or another method), with the ordering being comparinglength.
Here is what the code could look like:
import Data.Ord (comparing)
import Data.List (subsequences, maximumBy, nub)
isSorted :: (Ord a) => [a] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted(x:y:xs) = x <= y && isSorted (y:xs)
max_sequence :: (Ord a) => [a] -> [a]
max_sequence xs = maximumBy (comparing length) $ map nub $ filter isSorted (subsequences xs)
Which seems to work correctly:
*Main> max_sequence [21,27,15,14,18,16,14,17,22,13]
[14,16,17,22]
Note: used map nub to remove duplicate elements from the sub sequences. If this is not used, then this will return [14,14,17,22] as the maximum sub sequence, which may be fine if you allow this.
A more efficient n log n solution can be done by maintaining a map where
keys are the first element of an increasing sequence.
values are a tuple: (length of the sequence, the actual sequence)
and the map maintains the invariance that for each possible size of an increasing sequence, only the lexicographically largest one is retained.
Extra traceShow bellow to demonstrate how the map changes while folding from the end of the list:
import Debug.Trace (traceShow)
import Data.Map (empty, elems, insert, delete, lookupGT, lookupLT)
-- longest (strictly) increasing sequence
lis :: (Ord k, Show k, Foldable t) => t k -> [k]
lis = snd . maximum . elems . foldr go empty
where
go x m = traceShow m $ case x `lookupLT` m of
Nothing -> m'
Just (k, v) -> if fst a < fst v then m' else k `delete` m'
where
a = case x `lookupGT` m of
Nothing -> (1, [x])
Just (_, (i, r)) -> (i + 1, x:r)
m' = insert x a m
then:
\> lis [21,27,15,14,18,16,14,17,22,13]
fromList []
fromList [(13,(1,[13]))]
fromList [(22,(1,[22]))]
fromList [(17,(2,[17,22])),(22,(1,[22]))]
fromList [(14,(3,[14,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(17,(2,[17,22])),(22,(1,[22]))]
fromList [(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(14,(4,[14,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(22,(1,[22]))]
fromList [(15,(4,[15,16,17,22])),(16,(3,[16,17,22])),(18,(2,[18,22])),(27,(1,[27]))]
[15,16,17,22]
It is not necessary to retain the lists within the map. One can reconstruct the longest increasing sequence only using the keys and the length of the sequences (i.e. only the first element of the tuples).
Excellent question! Looking forward to a variety of answers.
Still improving my answer. The answer below folds to build increasing subsequences from the right. It also uses the the list monad to prepend new elements to subsequences if the new element is smaller than the head of the subsequence. (This is my first real application of the list monad.) For example,
λ> [[3], [1]] >>= (prepIfSmaller 2)
[[2,3],[3],[1]]
This solution is about as short as I can make it.
import Data.List (maximumBy)
maxSubsequence :: Ord a => [a] -> [a]
maxSubsequence [] = []
maxSubsequence xs = takeLongest $ go [] xs
where
takeLongest :: Ord a => [[a]] -> [a]
takeLongest = maximumBy (\ x y -> compare (length x) (length y))
go :: Ord a => [[a]] -> [a] -> [[a]]
go = foldr (\x subs -> [x] : (subs >>= (prepIfSmaller x)))
where prepIfSmaller x s#(h:_) = (if x < h then [x:s] else []) ++ [s]
Quick test.
λ> maxSubsequence [21,27,15,14,18,16,14,17,22,13]
[15,16,17,22]

string to multi set haskell

Convert string to multi set as the example below:
"bacaba" --> [(b,2),(a,3),(c,1)]
type MSet a = [(a,Int)]
convert :: Eq a => [a] -> MSet
what is wrong with my code and what is the better way to do it? ty
convert :: Eq a => [a] -> MSet a
convert [] = []
convert (x:xs) = ((x,1+count x xs) : converte xs)
where count x [] = 0
count x (y:ys) = if (x == y) then 1 + count x ys else count x ys
what is the better way to do it?
Your code performs O(n^2); If the type is an instance of Ord type class (as in your example), using Data.Map you may get an O(n log n) performance:
import Data.Map (toList, fromListWith)
convert :: (Ord a) => [a] -> [(a, Int)]
convert xs = toList . fromListWith (+) . zip xs $ repeat 1
This would result in the right counts but the list would be sorted by the keys:
\> convert "bacaba"
[('a',3),('b',2),('c',1)]
If you need to preserve the order, then
import qualified Data.Map as M
import Data.Map (delete, fromListWith)
convert :: (Ord a) => [a] -> [(a, Int)]
convert xs = foldr go (const []) xs . fromListWith (+) . zip xs $ repeat 1
where
go x f cnt = case M.lookup x cnt of
Just i -> (x, i): f (x `delete` cnt)
Nothing -> f cnt
which would output:
\> convert "bacaba"
[('b',2),('a',3),('c',1)]
You are almost there.
The problem is with your recursive call to the convert function. Since you have already computed the number of characters for a particular character, you don't need to calculate them again. Just use a filter function to remove that character out while calling to convert:
convert :: Eq a => [a] -> MSet a
convert [] = []
convert (x:xs) = (x,1+count x xs) : convert (filter (\y -> y /= x) xs)
where count x [] = 0
count x (y:ys) = if (x == y) then 1 + count x ys else count x ys
Or written more concisely:
convert :: Eq a => [a] -> MSet a
convert [] = []
convert (x:xs) = (x,1+count x xs) : convert (filter (/= x) xs)
where count x [] = 0
count x (y:ys) = if (x == y) then 1 + count x ys else count x ys
Demo in ghci:
ghci| > convert "bacaba"
[('b',2),('a',3),('c',1)]

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]

function that returns a list [0,[x1],[x1,x2],[x1,x2,x3]...] where [x1,x2,x3....] is the original list

How can I make in Haskell a function that gets a list and return a list of lists in this way:
[x1,x2,x3,x4,x5....]
it should return :
[[0],[x1],[x1,x2],[x1,x2,x3],[x1,x2,x3,x4][x1,x2,x3,x4,x5]....]
without using ready function that do it in Haskell.
I assume you mean the empty list [] at the start, not [0].
In which case, it's just inits.
Here's it's definition if you want to write it yourself:
inits xs = [] : case xs of [] -> []
x : xs' -> map (x :) (inits xs')
Assuming you want the empty list at the start:
prefixes :: [a] -> [[a]]
prefixes ls = map (\x -> take x ls) [0..(length ls)]
Code:
import System.IO
transform :: [Int] -> [[Int]]
transform list = trans 0
where trans n = case (length list) >= n of
True -> (take n list):( trans (n+1) )
False -> []
main = do
print . show $ transform [1..7]
Output:
$> ./transform
"[[],[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4,5],[1,2,3,4,5,6],[1,2,3,4,5,6,7]]"
Edit: To work with Infinite Lists
transform :: [a] -> [[a]]
transform list = trans 0 []
where
trans :: a -> [a] -> [[a]]
trans n last = case last == list of
False -> [take n list]++(trans (n+1) $ take n list)
True -> []

Resources