[Haskell-cafe] Help with Bird problem 4.5.6: sequence of
successive maxima
Daniel Fischer
daniel.is.fischer at web.de
Sun Mar 15 19:49:54 EDT 2009
Am Sonntag, 15. März 2009 21:09 schrieb R J:
> This Bird problem vexes me, in the first instance because it doesn't seem
> to specify a unique solution:
>
> Given a list xs = [x_1, x_2, . . . , x_n], the sequence of successive
> maxima "ssm xs" is the longest subsequence [x_j1, x_j2, x_j3..x_jk] such
> that j_1 = 1 and j_m < j_n => x_jm < x_jn. For example, xs = [3, 1, 3, 4,
> 9, 2, 10, 7] => ssm xs = [3, 4, 9, 10]. Define "ssm" in terms of "foldl".
>
> From this specification, I infer:
>
> ssm [] = []
> ssm [1] = [1]
> ssm [1, 2, 3] = [1, 2, 3]
> ssm [1, 0, 3, 2] = [1, 3]
>
> However, what is ssm [1,0,100,2,3,4,5]? Is it [1, 100] or [1, 2, 3, 4, 5]?
> I think the latter, but am not certain. Whichever it is, what's the
> solution?
>
> Thanks.
>
Not particularly efficient, but
module SSM where
import Data.List (maximumBy)
import Data.Ord
ssm :: Ord a => [a] -> [a]
ssm = reverse . maximumBy (comparing length) . foldl comb [[]]
where
comb [[]] a = [[a]]
comb lists a = do
xs@(h:_) <- lists
if h < a then [xs,a:xs] else [xs]
I think it is impossible to implement ssm as
foldl f z
without any post-processing and since foldl can't foresee what comes in the
remainder of the list, you must keep several candidates around.
You can probably make it more efficient by removing all lists
lst@(h:_) where there's a longer list with head <= h or an equally long list
with head < h in the store (but doing that efficiently is not trivial).
More information about the Haskell-Cafe
mailing list