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)

Upvotes: 4

Views: 342

Answers (3)

jhu
jhu

Reputation: 460

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]

Upvotes: 2

behzad.nouri
behzad.nouri

Reputation: 77941

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

Upvotes: 3

RoadRunner
RoadRunner

Reputation: 26315

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.

Upvotes: 3

Related Questions