{-# 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) -- S̶h̶o̶u̶l̶d̶ ̶r̶e̶a̶l̶l̶y̶ ̶b̶e̶ ̶(̶E̶q̶ ̶a̶,̶̶ ̶H̶a̶s̶h̶a̶b̶l̶e̶ ̶a̶)̶
fastNub :: FastNub a => [a] -> [a]
fastNub :: [a] -> [a]
fastNub = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort

-- | Simply a merge sort that discards equivalent elements.
fastNubBy :: (a->a->Ordering) -> [a] -> [a]
fastNubBy :: (a -> a -> Ordering) -> [a] -> [a]
fastNubBy a -> a -> Ordering
_ [] = []
fastNubBy a -> a -> Ordering
_ [a
e] = [a
e]
fastNubBy a -> a -> Ordering
cmp [a]
es = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
fnubMergeBy a -> a -> Ordering
cmp ((a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
fastNubBy a -> a -> Ordering
cmp [a]
lhs) ((a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
fastNubBy a -> a -> Ordering
cmp [a]
rhs)
 where ([a]
lhs,[a]
rhs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
es Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) [a]
es

fnubMergeBy :: (a->a->Ordering) -> [a] -> [a] -> [a]
fnubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
fnubMergeBy a -> a -> Ordering
_ [] [a]
rs = [a]
rs
fnubMergeBy a -> a -> Ordering
_ [a]
ls [] = [a]
ls
fnubMergeBy a -> a -> Ordering
cmp (a
l:[a]
ls) (a
r:[a]
rs) = case a -> a -> Ordering
cmp a
l a
r of
                              Ordering
LT -> a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
fnubMergeBy a -> a -> Ordering
cmp [a]
ls (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
                              Ordering
GT -> a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
fnubMergeBy a -> a -> Ordering
cmp (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) [a]
rs
                              Ordering
EQ -> (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
fnubMergeBy a -> a -> Ordering
cmp (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) [a]
rs

-- | Like 'fastNubBy', but doesn't just discard duplicates but \"merges\" them.
-- @'fastNubBy' cmp = cmp `'fastNubByWith'` 'const'@.
fastNubByWith :: (a->a->Ordering) -> (a->a->a) -> [a] -> [a]
fastNubByWith :: (a -> a -> Ordering) -> (a -> a -> a) -> [a] -> [a]
fastNubByWith a -> a -> Ordering
_ a -> a -> a
_ [] = []
fastNubByWith a -> a -> Ordering
_ a -> a -> a
_ [a
e] = [a
e]
fastNubByWith a -> a -> Ordering
cmp a -> a -> a
cmb [a]
es = [a] -> [a] -> [a]
merge((a -> a -> Ordering) -> (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> (a -> a -> a) -> [a] -> [a]
fastNubByWith a -> a -> Ordering
cmp a -> a -> a
cmb [a]
lhs)((a -> a -> Ordering) -> (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> (a -> a -> a) -> [a] -> [a]
fastNubByWith a -> a -> Ordering
cmp a -> a -> a
cmb [a]
rhs)
 where ([a]
lhs,[a]
rhs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
es Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) [a]
es
       merge :: [a] -> [a] -> [a]
merge [] [a]
rs = [a]
rs
       merge [a]
ls [] = [a]
ls
       merge (a
l:[a]
ls) (a
r:[a]
rs) = case a -> a -> Ordering
cmp a
l a
r of
                              Ordering
LT -> a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
ls (a
ra -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rs)
                              Ordering
GT -> a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls) [a]
rs
                              Ordering
EQ -> [a] -> [a] -> [a]
merge (a -> a -> a
cmb a
l a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls) [a]
rs

sfGroupBy :: (a->a->Ordering) -> [a] -> [[a]]
sfGroupBy :: (a -> a -> Ordering) -> [a] -> [[a]]
sfGroupBy a -> a -> Ordering
cmp = ([a] -> [a] -> Ordering) -> ([a] -> [a] -> [a]) -> [[a]] -> [[a]]
forall a. (a -> a -> Ordering) -> (a -> a -> a) -> [a] -> [a]
fastNubByWith (a -> a -> Ordering
cmp(a -> a -> Ordering) -> ([a] -> a) -> [a] -> [a] -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on`[a] -> a
forall a. [a] -> a
head) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map(a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])




fnubConcatBy :: (a->a->Ordering) -> [[a]] -> [a]
fnubConcatBy :: (a -> a -> Ordering) -> [[a]] -> [a]
fnubConcatBy a -> a -> Ordering
cmp = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
fnubMergeBy a -> a -> Ordering
cmp) [] ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
fastNubBy a -> a -> Ordering
cmp)

fnubConcat :: FastNub a => [[a]] -> [a]
fnubConcat :: [[a]] -> [a]
fnubConcat = ([a] -> [a] -> [a]) -> [a] -> [[a]] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
fnubMergeBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) [] ([[a]] -> [a]) -> ([[a]] -> [[a]]) -> [[a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. FastNub a => [a] -> [a]
fastNub

fnubConcatMap :: FastNub b => (a -> [b]) -> [a] -> [b]
fnubConcatMap :: (a -> [b]) -> [a] -> [b]
fnubConcatMap a -> [b]
f = [[b]] -> [b]
forall a. FastNub a => [[a]] -> [a]
fnubConcat ([[b]] -> [b]) -> ([a] -> [[b]]) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [b]) -> [a] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [b]
f

fnubIntersect :: FastNub a => [a] -> [a] -> [a]
fnubIntersect :: [a] -> [a] -> [a]
fnubIntersect [a]
xs [a]
ys = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
fis ([a] -> [a]
forall a. FastNub a => [a] -> [a]
fastNub [a]
xs) ([a] -> [a]
forall a. FastNub a => [a] -> [a]
fastNub [a]
ys)
 where fis :: [a] -> [a] -> [a]
fis [] [a]
_ = []
       fis [a]
_ [] = []
       fis (a
x:[a]
xs) (a
y:[a]
ys) | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y  = [a] -> [a] -> [a]
fis [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
                         | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
y  = [a] -> [a] -> [a]
fis (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
                         | Bool
otherwise  = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
fis [a]
xs [a]
ys


-- | This function is also defined in "GHC.Exts", but only in a version that requires
--   𝓞(𝑛⋅log 𝑛) function applications, as opposed to 𝑛 here.
sortWith :: Ord b => (a -> b) -> [a] -> [a]
sortWith :: (a -> b) -> [a] -> [a]
sortWith a -> b
f = ((b, a) -> a) -> [(b, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b, a) -> a
forall a b. (a, b) -> b
snd ([(b, a)] -> [a]) -> ([a] -> [(b, a)]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, a) -> (b, a) -> Ordering) -> [(b, a)] -> [(b, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((b, a) -> b) -> (b, a) -> (b, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (b, a) -> b
forall a b. (a, b) -> a
fst) ([(b, a)] -> [(b, a)]) -> ([a] -> [(b, a)]) -> [a] -> [(b, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (b, a)) -> [a] -> [(b, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> b
f (a -> b) -> (a -> a) -> a -> (b, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> a
forall a. a -> a
id)