{-# LANGUAGE ConstraintKinds #-}
module Data.List.FastNub where
import Data.List
import Data.Function
import Data.Ord
import Control.Arrow ((&&&))
type FastNub a = (Eq a, Ord a)
fastNub :: FastNub a => [a] -> [a]
fastNub = map head . group . sort
fastNubBy :: (a->a->Ordering) -> [a] -> [a]
fastNubBy _ [] = []
fastNubBy _ [e] = [e]
fastNubBy cmp es = fnubMergeBy cmp (fastNubBy cmp lhs) (fastNubBy cmp rhs)
where (lhs,rhs) = splitAt (length es `quot` 2) es
fnubMergeBy :: (a->a->Ordering) -> [a] -> [a] -> [a]
fnubMergeBy _ [] rs = rs
fnubMergeBy _ ls [] = ls
fnubMergeBy cmp (l:ls) (r:rs) = case cmp l r of
LT -> l : fnubMergeBy cmp ls (r:rs)
GT -> r : fnubMergeBy cmp (l:ls) rs
EQ -> fnubMergeBy cmp (l:ls) rs
fastNubByWith :: (a->a->Ordering) -> (a->a->a) -> [a] -> [a]
fastNubByWith _ _ [] = []
fastNubByWith _ _ [e] = [e]
fastNubByWith cmp cmb es = merge(fastNubByWith cmp cmb lhs)(fastNubByWith cmp cmb rhs)
where (lhs,rhs) = splitAt (length es `quot` 2) es
merge [] rs = rs
merge ls [] = ls
merge (l:ls) (r:rs) = case cmp l r of
LT -> l : merge ls (r:rs)
GT -> r : merge (l:ls) rs
EQ -> merge (cmb l r : ls) rs
sfGroupBy :: (a->a->Ordering) -> [a] -> [[a]]
sfGroupBy cmp = fastNubByWith (cmp`on`head) (++) . map(:[])
fnubConcatBy :: (a->a->Ordering) -> [[a]] -> [a]
fnubConcatBy cmp = foldr (fnubMergeBy cmp) [] . map (fastNubBy cmp)
fnubConcat :: FastNub a => [[a]] -> [a]
fnubConcat = foldr (fnubMergeBy compare) [] . map fastNub
fnubConcatMap :: FastNub b => (a -> [b]) -> [a] -> [b]
fnubConcatMap f = fnubConcat . map f
fnubIntersect :: FastNub a => [a] -> [a] -> [a]
fnubIntersect xs ys = fis (fastNub xs) (fastNub ys)
where fis [] _ = []
fis _ [] = []
fis (x:xs) (y:ys) | x<y = fis xs (y:ys)
| x>y = fis (x:xs) ys
| otherwise = x : fis xs ys
sortWith :: Ord b => (a -> b) -> [a] -> [a]
sortWith f = map snd . sortBy (comparing fst) . map (f &&& id)