-----------------------------------------------------------------------------
-- |
-- Module      :  Data.List.UniqueStrict
-- Copyright   :  (c) Volodymyr Yashchenko
-- License     :  BSD3
--
-- Maintainer  :  ualinuxcn@gmail.com
-- Stability   :  Unstable
-- Portability :  portable
--
-- Library provides functions to find unique and duplicate elements in the list.
-- Unlike Data.List.Unique this one uses Data.Map.Strict for calculations.
-- So it's much faster and it uses less memory.

module Data.List.UniqueStrict
        ( sortUniq
        , isUnique
        , isRepeated
        , repeated
        , repeatedBy
        , unique
        , allUnique
        , count
        , count_
        , occurrences )
        where

import qualified Data.Map.Strict    as MS (Map, filter, fromListWith, keys,
                                           toList, lookup, map, foldr')
import qualified Data.IntMap.Strict as IM (fromAscListWith, toList)
import qualified Data.Set           as DS (fromList, toList)

import Data.List                          (sortBy)
import Data.Function                      (on)


countMap :: Ord a => [a] -> MS.Map a Int
countMap :: [a] -> Map a Int
countMap = (Int -> Int -> Int) -> [(a, Int)] -> Map a Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
MS.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ([(a, Int)] -> Map a Int)
-> ([a] -> [(a, Int)]) -> [a] -> Map a Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [Int] -> [(a, Int)]) -> [Int] -> [a] -> [(a, Int)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int]
forall a. a -> [a]
repeat Int
1)

-- | 'isUnique' function is to check whether the given element is unique in the list or not.
--
-- It returns Nothing when the element does not present in the list. Examples:
--
-- > isUnique 'f' "foo bar" == Just True
-- > isUnique 'o' "foo bar" == Just False
-- > isUnique '!' "foo bar" == Nothing
--
-- Since 0.4.7.2
--

isUnique :: Ord a => a -> [a] -> Maybe Bool
isUnique :: a -> [a] -> Maybe Bool
isUnique a
x = (Int -> Bool) -> Maybe Int -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Maybe Int -> Maybe Bool)
-> ([a] -> Maybe Int) -> [a] -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Map a Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
MS.lookup a
x (Map a Int -> Maybe Int) -> ([a] -> Map a Int) -> [a] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Map a Int
forall a. Ord a => [a] -> Map a Int
countMap

-- | 'isRepeated' is a reverse function to 'isUnique'
--
-- Since 0.4.5

isRepeated :: Ord a => a -> [a] -> Maybe Bool
isRepeated :: a -> [a] -> Maybe Bool
isRepeated a
x = (Bool -> Bool) -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Maybe Bool -> Maybe Bool)
-> ([a] -> Maybe Bool) -> [a] -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a] -> Maybe Bool
forall a. Ord a => a -> [a] -> Maybe Bool
isUnique a
x

-- | 'sortUniq' sorts the list and removes the duplicates of elements. Example:
--
-- > sortUniq "foo bar" == " abfor"

sortUniq :: Ord a => [a] -> [a]
sortUniq :: [a] -> [a]
sortUniq = Set a -> [a]
forall a. Set a -> [a]
DS.toList (Set a -> [a]) -> ([a] -> Set a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
DS.fromList

-- | The 'repeatedBy' function behaves just like repeated, except it uses a user-supplied equality predicate.
--
-- > repeatedBy (>2) "This is the test line" == " eist"

repeatedBy :: Ord a => (Int -> Bool) -> [a] -> [a]
repeatedBy :: (Int -> Bool) -> [a] -> [a]
repeatedBy Int -> Bool
p = Map a Int -> [a]
forall k a. Map k a -> [k]
MS.keys (Map a Int -> [a]) -> ([a] -> Map a Int) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Map a Int -> Map a Int
forall a k. (a -> Bool) -> Map k a -> Map k a
MS.filter Int -> Bool
p (Map a Int -> Map a Int) -> ([a] -> Map a Int) -> [a] -> Map a Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Map a Int
forall a. Ord a => [a] -> Map a Int
countMap

-- | 'repeated' finds only the elements that are present more than once in the list. Example:
--
-- > repeated  "foo bar" == "o"

repeated :: Ord a => [a] -> [a]
repeated :: [a] -> [a]
repeated = (Int -> Bool) -> [a] -> [a]
forall a. Ord a => (Int -> Bool) -> [a] -> [a]
repeatedBy (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1)

-- | 'unique' gets only unique elements, that do not have duplicates.
-- It sorts them. Example:
--
-- > unique  "foo bar" == " abfr"

unique :: Ord a => [a] -> [a]
unique :: [a] -> [a]
unique = (Int -> Bool) -> [a] -> [a]
forall a. Ord a => (Int -> Bool) -> [a] -> [a]
repeatedBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1)

-- | 'allUnique' checks whether all elements of the list are unique
--
-- > allUnique "foo bar" == False
-- > allUnique ['a'..'z'] == True
-- > allUnique [] == True (!)
-- Since 0.4.7.2

allUnique :: Ord a => [a] -> Bool
allUnique :: [a] -> Bool
allUnique = (Bool -> Bool -> Bool) -> Bool -> Map a Bool -> Bool
forall a b k. (a -> b -> b) -> b -> Map k a -> b
MS.foldr' Bool -> Bool -> Bool
(&&) Bool
True (Map a Bool -> Bool) -> ([a] -> Map a Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Map a Int -> Map a Bool
forall a b k. (a -> b) -> Map k a -> Map k b
MS.map (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1) (Map a Int -> Map a Bool)
-> ([a] -> Map a Int) -> [a] -> Map a Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Map a Int
forall a. Ord a => [a] -> Map a Int
countMap

-- | 'count' of each element in the list, it sorts by keys (elements). Example:
--
-- > count "foo bar" == [(' ',1),('a',1),('b',1),('f',1),('o',2),('r',1)]

count :: Ord a => [a] -> [(a, Int)]
count :: [a] -> [(a, Int)]
count = Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
MS.toList (Map a Int -> [(a, Int)])
-> ([a] -> Map a Int) -> [a] -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Map a Int
forall a. Ord a => [a] -> Map a Int
countMap

-- | 'count_' of each elements in the list, it sorts by their number. Example:
--
-- > count_ "foo bar" == [(' ',1),('a',1),('b',1),('f',1),('r',1),('o',2)]

count_ :: Ord a => [a] -> [(a, Int)]
count_ :: [a] -> [(a, Int)]
count_ = ((a, Int) -> (a, Int) -> Ordering) -> [(a, Int)] -> [(a, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((a, Int) -> Int) -> (a, Int) -> (a, Int) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, Int) -> Int
forall a b. (a, b) -> b
snd) ([(a, Int)] -> [(a, Int)])
-> ([a] -> [(a, Int)]) -> [a] -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
MS.toList (Map a Int -> [(a, Int)])
-> ([a] -> Map a Int) -> [a] -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Map a Int
forall a. Ord a => [a] -> Map a Int
countMap

-- | 'occurrences' like 'count' or 'count_' but shows the list of elements that occur X times
--
-- > occurrences "This is the test line" == [(1,"Tln"),(2,"h"),(3,"eist"),(4," ")]
-- Since 0.4.7.5
--

occurrences :: Ord a => [a] -> [(Int, [a])]
occurrences :: [a] -> [(Int, [a])]
occurrences = IntMap [a] -> [(Int, [a])]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap [a] -> [(Int, [a])])
-> ([a] -> IntMap [a]) -> [a] -> [(Int, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]) -> [(Int, [a])] -> IntMap [a]
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
IM.fromAscListWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) ([(Int, [a])] -> IntMap [a])
-> ([a] -> [(Int, [a])]) -> [a] -> IntMap [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Int) -> (Int, [a])) -> [(a, Int)] -> [(Int, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
k , Int
x) -> (Int
x, [a
k]) ) ([(a, Int)] -> [(Int, [a])])
-> ([a] -> [(a, Int)]) -> [a] -> [(Int, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [(a, Int)]
forall a. Ord a => [a] -> [(a, Int)]
count_