Discussion: Implementation of fromList for Data.Set and Data.Map

[wren romano]

On Sat, Feb 11, 2017 at 8:56 PM, David Feuer <david.feuer at gmail.com> wrote:
> spanIncreasing :: Ord a => [a] -> ([a], [a])
> spanIncreasing [] = ([], [])
> spanIncreasing (a : as) = first (a:) (go a as)
>   where
>     go _prev [] = ([], [])
>     go prev q@(a : as) = case compare prev a of
>       LT -> first (a :) $ go a as
>       EQ -> go a as
>       GT -> ([], q)

Suggest CPSing away the intermediate list:

spanIncreasing :: Ord a => r -> (r -> a -> r) -> [a] -> (r, [a])
spanIncreasing z k [] = (z, [])
spanIncreasing z k (x:xs) = go z k x xs
    case
    go !z k !x [] = (z, [])
    go z k x yys@(y:ys)
        | x < y = go (k z x) y ys
        | x == y = go z k x ys
        | otherwise = (k z x, yys)


> spanDecreasing :: Ord a => [a] -> ([a], [a])
> spanDecreasing [] = ([], [])
> spanDecreasing (a : as) = first (a:) (go a as)
>   where
>     go _prev [] = ([], [])
>     go prev q@(a : as) = case compare prev a of
>       GT -> first (a :) (go a as)
>       EQ -> go a as
>       LT -> ([], q)

Ditto


> fromList :: Ord a => [a] -> Set a
> fromList = up empty
>   where
>     up !acc [] = acc
>     up acc xs = case spanIncreasing xs of
>       ([x], rest) -> down (insert x acc) rest
>       (ups, rest) -> down (union (fromDistinctAscList ups) acc) rest
>
>     down !acc [] = acc
>     down acc xs = case spanDecreasing xs of
>       ([x], rest) -> up (insert x acc) rest
>       (downs, rest) -> up (union (fromDistinctDescList downs) acc) rest

Here, I suggest inlining the above to dynamically choose whether to
call `up` or `down`. E.g., something like (untested):

fromList :: Ord a => [a] -> Set a
fromList [] = empty
fromList (x0:xs0) = start empty x0 xs0
    where
    start !acc !x [] = insert x acc
    start acc x (y:ys) =
        case compare x y of
        LT -> up acc (singletonUp x) y ys
        EQ -> start acc x ys
        GT -> down acc (singletonDown x) y ys

    up !acc1 !acc2 !x [] = union acc1 (upSet (insertUp x acc2))
    up acc1 acc2 x (y:ys) =
        case compare x y of
        LT -> up acc1 (insertUp x acc2) y ys
        EQ -> up acc1 acc2 x ys
        GT -> start (union acc1 (upSet (insertUp x acc2))) y ys

    down !acc1 !acc2 !x [] = union acc1 (downSet (insertDown x acc2))
    down acc1 acc2 x (y:ys) =
        case compare x y of
        GT -> down acc1 (insertDown x acc2) y ys
        EQ -> down acc1 acc2 x ys
        LT -> start (union acc1 (downSet (insertDown x acc2))) y ys

where `insertUp` and `insertDown` are the incremental steps of
fromAscList/fromDescList, and `acc2` has whatever appropriate
intermediate type it needs for that to work, and upSet/downSet does
the conversion from that intermediate type into a standard Set.

A naive but workable intermediate type gives us:

    singletonUp = (:[])
    singletonDown = (:[])
    insertUp = (:)
    insertDown = (:)
    upSet = fromAscList
    downSet = fromDescList

Though we should be able to do better than that.

-- 
Live well,
~wren