diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,12 @@ +Version 0.4.3: (2010-03-02) + + * Improved the implementation of `nubSort`, mirroring the improvements made + to `Data.List.sort` currently in GHC HEAD. Instead of initially breaking + the input list into singletons before the merge process, the improved + version breaks the input list into monotonic runs. + + * Minor formatting improvements in the Haddock documentation. + Version 0.4.2: (2010-02-18) * Fixed non-productive loop in `unionAll` when applied to an infinite list diff --git a/Data/List/Ordered.hs b/Data/List/Ordered.hs --- a/Data/List/Ordered.hs +++ b/Data/List/Ordered.hs @@ -51,7 +51,7 @@ import Data.List(sort,sortBy) --- | The 'isSorted' predicate returns 'True' if the elements of a list occur in non-descending order, equivalent to 'isSortedBy' ('<='). +-- | The 'isSorted' predicate returns 'True' if the elements of a list occur in non-descending order, equivalent to @'isSortedBy' ('<=')@. isSorted :: (Ord a) => [a] -> Bool isSorted = isSortedBy (<=) @@ -293,14 +293,7 @@ sort = sortBy compare sortBy :: (a -> a -> Ordering) -> [a] -> [a] -sortBy cmp = loop . map (\x -> [x]) - where - loop [] = [] - loop [xs] = xs - loop xss = loop (merge_pairs xss) - - merge_pairs (xs:ys:xss) = mergeBy cmp xs ys : merge_pairs xss - merge_pairs xs = xs +sortBy cmp = foldTree merge . map (\x -> [x]) -} -- | The 'sortOn' function provides the decorate-sort-undecorate idiom, @@ -316,24 +309,42 @@ sortOn' :: Ord b => (a -> b) -> [a] -> [a] sortOn' f = sortBy (\x y -> compare (f x) (f y)) --- | The 'nubSort' function is equivalent to 'nub' '.' 'sort', except +-- | The 'nubSort' function is equivalent to @'nub' '.' 'sort'@, except -- somewhat more efficient as duplicates are removed as it sorts. It is --- essentially Data.List.sort, a mergesort by Ian Lynagh, with 'merge' --- replaced by 'union'. +-- essentially Data.List.sort, with 'merge' replaced by 'union'. nubSort :: Ord a => [a] -> [a] nubSort = nubSortBy compare -- | The 'nubSortBy' function is the non-overloaded version of 'nubSort'. nubSortBy :: (a -> a -> Ordering) -> [a] -> [a] -nubSortBy cmp = loop . map (\x -> [x]) +nubSortBy cmp = foldTree (unionBy cmp) . runs where - loop [] = [] - loop [xs] = xs - loop xss = loop (union_pairs xss) + -- 'runs' partitions the input into sublists that are monotonic, + -- contiguous, and non-overlapping. Descending runs are + -- reversed and adjacent duplicates are eliminated, so + -- every run returned is strictly ascending. - union_pairs (xs:ys:xss) = unionBy cmp xs ys : union_pairs xss - union_pairs xs = xs + runs (a:b:xs) + = case cmp a b of + LT -> asc b (a:) xs + EQ -> runs (a:xs) + GT -> desc b [a] xs + runs xs = [xs] + desc a as [] = [a:as] + desc a as (b:bs) + = case cmp a b of + LT -> (a:as) : runs (b:bs) + EQ -> desc a as bs + GT -> desc b (a:as) bs + + asc a as [] = [as [a]] + asc a as (b:bs) + = case cmp a b of + LT -> asc b (\ys -> as (a:ys)) bs + EQ -> asc a as bs + GT -> as [a] : runs (b:bs) + -- | The 'nubSortOn' function provides decorate-sort-undecorate for 'nubSort'. nubSortOn :: Ord b => (a -> b) -> [a] -> [a] nubSortOn f = map snd . nubSortOn' fst . map (\x -> (f x, x)) @@ -370,11 +381,24 @@ | p x y = y : loop y ys | otherwise = loop x ys -data People a = VIP a (People a) | Crowd [a] +-- Helper function used in nubSortBy -foldTree f [] = Crowd [] +foldTree _ [] = undefined foldTree f xs = loop xs where + loop [x] = x + loop xs = loop (pairs xs) + + pairs (x:y:zs) = f x y : pairs zs + pairs zs = zs + +-- Helper functions used in 'mergeAll' and 'unionAll' + +data People a = VIP a (People a) | Crowd [a] + +lazyFoldTree _ [] = Crowd [] +lazyFoldTree f xs = loop xs + where loop [x] = x loop (x:xs) = x `f` loop (pairs xs) @@ -386,7 +410,7 @@ vips xss = [ VIP x (Crowd xs) | (x:xs) <- xss ] --- | The 'mergeAll' function generalizes \"'foldr' 'merge' []\" to a +-- | The 'mergeAll' function generalizes @'foldr' 'merge' []@ to a -- (possibly infinite) list of (possibly infinite) ordered lists. To make -- this possible, it adds the assumption that the heads of the non-empty -- lists themselves form a sorted list. @@ -412,7 +436,7 @@ -- | The 'mergeAllBy' function is the non-overloaded variant of the 'mergeAll' function. mergeAllBy :: (a -> a -> Ordering) -> [[a]] -> [a] -mergeAllBy cmp = serve . foldTree merge' . vips +mergeAllBy cmp = serve . lazyFoldTree merge' . vips where merge' (VIP x xs) ys = VIP x (merge' xs ys) merge' (Crowd []) ys = ys @@ -422,7 +446,7 @@ GT -> VIP y (merge' xs yt) _ -> VIP x (merge' (Crowd xt) ys) --- | The 'unionAll' function generalizes \"'foldr' 'union' []\" to a +-- | The 'unionAll' function generalizes @'foldr' 'union' []@ to a -- (possibly infinite) list of (possibly infinite) ordered lists. -- To make this possible, it adds the assumption that the heads of the -- non-empty lists themselves form a sorted list. @@ -442,14 +466,14 @@ -- > unionAll [[1,2],[1,2]] == foldr union [] [[1,2],[1,2]] == [1,2] -- -- The first equality is only true when both sets of assumptions are met: --- \"foldr union []\" assumes the outer list is finite, and 'unionAll' +-- @foldr union []@ assumes the outer list is finite, and 'unionAll' -- assumes that the heads of the inner lists are sorted. unionAll :: (Ord a) => [[a]] -> [a] unionAll = unionAllBy compare -- | The 'unionAllBy' function is the non-overloaded variant of the 'unionAll' function. unionAllBy :: (a -> a -> Ordering) -> [[a]] -> [a] -unionAllBy cmp = serve . foldTree union' . vips +unionAllBy cmp = serve . lazyFoldTree union' . vips where msg = "Data.List.Ordered.unionAllBy: the heads of the lists are not sorted" union' (VIP x xs) ys diff --git a/data-ordlist.cabal b/data-ordlist.cabal --- a/data-ordlist.cabal +++ b/data-ordlist.cabal @@ -1,5 +1,5 @@ Name: data-ordlist -Version: 0.4.2 +Version: 0.4.3 Description: This module provides set and multiset operations on ordered lists. License: BSD3 @@ -22,4 +22,4 @@ source-repository this type: darcs location: http://patch-tag.com/r/lpsmith/data-ordlist/pullrepo - tag: 0.4.2 + tag: 0.4.3