----------------------------------------------------------------------------- -- | -- Module : Data.List.Ordered -- Copyright : (c) 2009-2010 Leon P Smith -- License : BSD3 -- -- Maintainer : leon@melding-monads.com -- Stability : experimental -- Portability : portable -- -- This module implements bag and set operations on ordered lists. -- Except for variations of the 'sort' and 'isSorted' functions, -- every function assumes that any list arguments are sorted lists. -- Assuming this precondition is met, every resulting list is also -- sorted. -- -- Note that these functions handle multisets, and are left-biased. -- Thus, even assuming the arguments are sorted, 'isect' does not always -- return the same results as Data.List.intersection, due to multiplicity. -- ----------------------------------------------------------------------------- module Data.List.Ordered ( -- * Predicates member, memberBy, has, hasBy , subset, subsetBy , isSorted, isSortedBy -- * Insertion Functions , insertBag, insertBagBy , insertSet, insertSetBy -- * Set-like operations , isect, isectBy , union, unionBy , minus, minusBy , xunion, xunionBy , merge, mergeBy -- * Lists to Ordered Lists , nub, nubBy , sort, sortBy , sortOn, sortOn' , nubSort, nubSortBy , nubSortOn, nubSortOn' ) where import Data.List(sort,sortBy) -- | 'isSorted' returns 'True' if the elements of a list occur in non-descending order, equivalent to 'isSortedBy' ('<=') isSorted :: (Ord a) => [a] -> Bool isSorted = isSortedBy (<=) -- | 'isSortedBy' returns 'True' if the predicate returns true for all adjacent pairs of elements in the list isSortedBy :: (a -> a -> Bool) -> [a] -> Bool isSortedBy lte = loop where loop [] = True loop [_] = True loop (x:y:zs) = (x `lte` y) && loop (y:zs) -- | 'member' returns 'True' if the element appears in the ordered list member :: (Ord a) => a -> [a] -> Bool member = memberBy compare -- | 'memberBy' is the non-overloaded version of 'member' memberBy :: (a -> a -> Ordering) -> a -> [a] -> Bool memberBy cmp x = loop where loop [] = False loop (y:ys) = case cmp x y of LT -> False EQ -> True GT -> loop ys -- | 'has' returns 'True' if the element appears in the list; it is a function from an ordered list to its characteristic function. has :: (Ord a) => [a] -> a -> Bool has xs y = memberBy compare y xs -- | 'hasBy' is the non-overloaded version of 'has' hasBy :: (a -> a -> Ordering) -> [a] -> a -> Bool hasBy cmp xs y = memberBy cmp y xs -- | 'insertBag' inserts an element into a list, allowing for duplicate elements insertBag :: (Ord a) => a -> [a] -> [a] insertBag = insertBagBy compare -- | 'insertBagBy' is the non-overloaded version of 'insertBag' insertBagBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertBagBy cmp = loop where loop x [] = [x] loop x (y:ys) = case cmp x y of GT -> y:loop x ys _ -> x:y:ys -- | 'insertSet' inserts an element into an ordered list, or replaces the first occurrence if it is already there. insertSet :: (Ord a) => a -> [a] -> [a] insertSet = insertSetBy compare -- | 'insertSetBy' is the non-overloaded version of 'insertSet' insertSetBy :: (a -> a -> Ordering) -> a -> [a] -> [a] insertSetBy cmp = loop where loop x [] = [x] loop x (y:ys) = case cmp x y of LT -> x:y:ys EQ -> x:ys GT -> y:loop x ys -- | 'isect' computes the intersection of two ordered lists. -- The result contains those elements contained in both arguments -- -- > isect [1,3,5] [2,4,6] == [] -- > isect [2,4,6,8] [3,6,9] == [6] -- > isect [1,2,2,2] [1,1,1,2,2] == [1,2,2] isect :: (Ord a) => [a] -> [a] -> [a] isect = isectBy compare -- | 'isectBy' is the non-overloaded version of 'isect' isectBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] isectBy cmp = loop where loop [] _ys = [] loop _xs [] = [] loop (x:xs) (y:ys) = case cmp x y of LT -> loop xs (y:ys) EQ -> x : loop xs ys GT -> loop (x:xs) ys -- | 'union' computes the union of two ordered lists. -- The result contains those elements contained in either argument; -- elements that appear in both lists are appear in the result only once. -- -- > union [1,3,5] [2,4,6] == [1..6] -- > union [2,4,6,8] [3,6,9] == [2,3,4,6,8,9] -- > union [1,2,2,2] [1,1,1,2,2] == [1,1,1,2,2,2] union :: (Ord a) => [a] -> [a] -> [a] union = unionBy compare -- | 'unionBy' is the non-overloaded version of 'union' unionBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] unionBy cmp = loop where loop [] ys = ys loop xs [] = xs loop (x:xs) (y:ys) = case cmp x y of LT -> x : loop xs (y:ys) EQ -> x : loop xs ys GT -> y : loop (x:xs) ys -- | 'minus' computes the multiset difference of two ordered lists. -- Each occurence of an element in the second argument is removed from the first list, if it is there. -- -- > minus [1,3,5] [2,4,6] == [1,3,5] -- > minus [2,4,6,8] [3,6,9] == [2,4,8] -- > minus [1,2,2,2] [1,1,1,2,2] == [2] minus :: (Ord a) => [a] -> [a] -> [a] minus = minusBy compare -- | 'minusBy' is the non-overloaded version of 'minus' minusBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] minusBy cmp = loop where loop [] _ys = [] loop xs [] = xs loop (x:xs) (y:ys) = case cmp x y of LT -> x : loop xs (y:ys) EQ -> loop xs ys GT -> loop (x:xs) ys -- | 'xunion' computes the multiset exclusive union of two ordered lists. -- The result contains those elements that appear in either list, but not both. -- -- > xunion [1,3,5] [2,4,6] == [1..6] -- > xunion [2,4,6,8] [3,6,9] == [2,3,4,8] -- > xunion [1,2,2,2] [1,1,1,2,2] == [1,1,2] xunion :: (Ord a) => [a] -> [a] -> [a] xunion = xunionBy compare -- | 'xunionBy' is the non-overloaded version of 'xunion' xunionBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] xunionBy cmp = loop where loop [] ys = ys loop xs [] = xs loop (x:xs) (y:ys) = case cmp x y of LT -> x : loop xs (y:ys) EQ -> loop xs ys GT -> y : loop (x:xs) ys {- genSectBy cmp p = loop where loop [] ys | p False True = ys | otherwise = [] loop xs [] | p True False = xs | otherwise = [] loop (x:xs) (y:ys) = case cmp x y of LT | p True False -> x : loop xs (y:ys) | otherwise -> loop xs (y:ys) EQ | p True True -> x : loop xs ys | otherwise -> loop xs ys GT | p False True -> y : loop (x:xs) ys | otherwise -> loop (x:xs) ys -} -- | 'merge' combines all elements of two ordered lists. The result contains those elements that appear in either list; elements that appear in both lists appear in the result multiple times. -- -- > merge [1,3,5] [2,4,6] == [1,2,3,4,5,6] -- > merge [2,4,6,8] [3,6,9] == [2,3,4,6,6,8,9] -- > merge [1,2,2,2] [1,1,1,2,2] == [1,1,1,1,2,2,2,2,2] merge :: (Ord a) => [a] -> [a] -> [a] merge = mergeBy compare -- | 'mergeBy' is the non-overloaded version of 'merge' mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a] mergeBy cmp = loop where loop [] ys = ys loop xs [] = xs loop (x:xs) (y:ys) = case cmp x y of GT -> y : loop (x:xs) ys _ -> x : loop xs (y:ys) -- | 'subset' returns true if the first list is a sub-list of the second. subset :: (Ord a) => [a] -> [a] -> Bool subset = subsetBy compare -- | 'subsetBy' is the non-overloaded version of 'subset' subsetBy :: (a -> a -> Ordering) -> [a] -> [a] -> Bool subsetBy cmp = loop where loop [] _ys = True loop _xs [] = False loop (x:xs) (y:ys) = case cmp x y of LT -> False EQ -> loop xs ys GT -> loop (x:xs) ys {- sort :: Ord a => [a] -> [a] sort = sortBy compare -- This is Ian Lynaugh's mergesort implementation provided in Data.List.sort with the -- static argument transformation applied. It's not clear if this is really worthwhile or not. 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 [] = [] merge_pairs [xs] = [xs] merge_pairs (xs:ys:xss) = mergeBy cmp xs ys : merge_pairs xss -} -- | 'sortOn' provides the decorate-sort-undecorate idiom, aka the \"Schwartzian transform\" sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortOn' fst . map (\x -> (f x, x)) -- | This variant of 'sortOn' recomputes the function to sort on every comparison. This can is better -- for functions that are cheap to compute, including projections. sortOn' :: Ord b => (a -> b) -> [a] -> [a] sortOn' f = sortBy (\x y -> compare (f x) (f y)) -- | 'nubSort' 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'. nubSort :: Ord a => [a] -> [a] nubSort = nubSortBy compare -- | 'nubSortBy' is the non-overloaded version of 'nubSort' nubSortBy :: (a -> a -> Ordering) -> [a] -> [a] nubSortBy cmp = loop . map (\x -> [x]) where loop [] = [] loop [xs] = xs loop xss = loop (union_pairs xss) union_pairs [] = [] union_pairs [xs] = [xs] union_pairs (xs:ys:xss) = unionBy cmp xs ys : union_pairs xss -- | 'nubSortOn' provides decorate-sort-undecorate for 'nubSort' nubSortOn :: Ord b => (a -> b) -> [a] -> [a] nubSortOn f = map snd . nubSortOn' fst . map (\x -> (f x, x)) -- | This variant of 'nubSortOn' recomputes the function for each comparison. nubSortOn' :: Ord b => (a -> b) -> [a] -> [a] nubSortOn' f = nubSortBy (\x y -> compare (f x) (f y)) -- | On ordered lists, 'nub' is equivalent to 'Data.List.nub', except that -- it runs in linear time instead of quadratic. On unordered lists it also -- removes elements that are smaller than any preceding element. -- -- > nub [1,1,1,2,2] == [1,2] -- > nub [2,0,1,3,3] == [2,3] -- > nub = nubBy (<) nub :: (Ord a) => [a] -> [a] nub = nubBy (<) -- | 'nubBy' is the greedy algorithm that returns a sublist of its -- input such that 'isSortedBy' is true. -- -- > isSortedBy pred (nubBy pred xs) == True nubBy :: (a -> a -> Bool) -> [a] -> [a] nubBy p [] = [] nubBy p (x:xs) = x : loop x xs where loop _ [] = [] loop x (y:ys) | p x y = y : loop y ys | otherwise = loop x ys