-----------------------------------------------------------------------------
-- |
-- Module      :  Data.List.Unique
-- Copyright   :  (c) Volodymyr Yashchenko
-- License     :  BSD3
--
-- Maintainer  :  ualinuxcn@gmail.com
-- Stability   :  Unstable
-- Portability :  portable
--
-- Library provides the functions to find unique and duplicate elements in the list

module Data.List.Unique
   ( uniq
   , complex
   , isUnique
   , isRepeated
   , sortUniq
   , repeated
   , repeatedBy
   , unique
   , allUnique
   , count
   , count_
   , occurrences
   , countElem
   )
   where


import           Data.List           (group, sort, sortBy, (\\))

import           Control.Applicative (liftA2)
import           Data.Function       (on)
import           Data.List.Extra     (nubOrd)
import           Data.Tuple          (swap)

-- | 'uniq' behaves the same as unix 'uniq' utility does (without cli additional options)
--
-- > uniq "1121331" == "12131"

uniq :: Eq b => [b] -> [b]
uniq :: [b] -> [b]
uniq = ([b] -> b) -> [[b]] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map [b] -> b
forall a. [a] -> a
head ([[b]] -> [b]) -> ([b] -> [[b]]) -> [b] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> [[b]]
forall a. Eq a => [a] -> [[a]]
group

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

sortUniq :: Ord a => [a] -> [a]
sortUniq :: [a] -> [a]
sortUniq = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
nubOrd

sg :: Ord a => [a] -> [[a]]
sg :: [a] -> [[a]]
sg = [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

filterByLength :: Ord a => (Int -> Bool) -> [a] -> [[a]]
filterByLength :: (Int -> Bool) -> [a] -> [[a]]
filterByLength Int -> Bool
p = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Bool
p (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Ord a => [a] -> [[a]]
sg

-- | '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)

-- | 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 = ([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
. (Int -> Bool) -> [a] -> [[a]]
forall a. Ord a => (Int -> Bool) -> [a] -> [[a]]
filterByLength Int -> Bool
p

-- | '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 = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [a] -> [[a]]
forall a. Ord a => (Int -> Bool) -> [a] -> [[a]]
filterByLength (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1)

lh :: [a] -> (a, Int)
lh :: [a] -> (a, Int)
lh = (a -> Int -> (a, Int))
-> ([a] -> a) -> ([a] -> Int) -> [a] -> (a, Int)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) [a] -> a
forall a. [a] -> a
head [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

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

allUnique :: Ord a => [a] -> Bool
allUnique :: [a] -> Bool
allUnique = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Int
1 (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[a]] -> Bool) -> ([a] -> [[a]]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Ord a => [a] -> [[a]]
sg

-- | '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 = ([a] -> (a, Int)) -> [[a]] -> [(a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> (a, Int)
forall a. [a] -> (a, Int)
lh ([[a]] -> [(a, Int)]) -> ([a] -> [[a]]) -> [a] -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Ord a => [a] -> [[a]]
sg

-- | '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
. [a] -> [(a, Int)]
forall a. Ord a => [a] -> [(a, Int)]
count

-- | 'countElem' gets the number of occurrences of the specified element. Example:
--
-- > countElem 'o' "foo bar" == 2

countElem :: Eq a => a -> [a] -> Int
countElem :: a -> [a] -> Int
countElem a
x = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> ([a] -> [a]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)

-- | 'complex' function is a complex investigation of the list. It returns triple:
--
-- * the first - all elements with removed duplicates (like 'sortUniq' but the result is not sorted)
--
-- * the second - the elements that are repeated at least once in the list (result is the same as 'repeated' but not sorted)
--
-- * the third - the unique elements that do not have duplicates (result is the same as 'unique' but not sorted)
--
-- 'complex' does not sort the resulted elements of triple as well as it can be used for types that does not have Ord instance.
--
-- Anyway, it's better to use 'sortUniq', 'repeated' and 'unique' instead of 'complex' when type 'a' has Ord instance.
--
-- > complex "This is the test line" == ("This teln","is hte","Tln")
--
-- Since 0.4.4
--

complex :: Eq a => [a] -> ([a], [a], [a])
complex :: [a] -> ([a], [a], [a])
complex = ([a] -> [a]) -> ([a], [a], [a]) -> ([a], [a], [a])
forall a b. (a -> b) -> (a, a, a) -> (b, b, b)
triplet [a] -> [a]
forall a. [a] -> [a]
reverse (([a], [a], [a]) -> ([a], [a], [a]))
-> ([a] -> ([a], [a], [a])) -> [a] -> ([a], [a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([a]
z,[a]
y) ->  ([a]
z, [a]
y, [a]
z [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
y )) (([a], [a]) -> ([a], [a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> ([a], [a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a], [a]) -> [a] -> ([a], [a])
forall a. Eq a => ([a], [a]) -> [a] -> ([a], [a])
go ([], [])
    where
      go :: ([a], [a]) -> [a] -> ([a], [a])
go ([a]
occurred, [a]
repeated') [] = ([a]
occurred, [a]
repeated')
      go ([a]
occurred, [a]
repeated') (a
x:[a]
xs)
          | a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
repeated' = ([a], [a]) -> [a] -> ([a], [a])
go ([a]
occurred, [a]
repeated')   [a]
xs
          | a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
occurred  = ([a], [a]) -> [a] -> ([a], [a])
go ([a]
occurred, a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
repeated') [a]
xs
          | Bool
otherwise        = ([a], [a]) -> [a] -> ([a], [a])
go (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
occurred, [a]
repeated') [a]
xs

triplet :: (a -> b) -> (a, a, a) -> (b, b, b)
triplet :: (a -> b) -> (a, a, a) -> (b, b, b)
triplet a -> b
f (a
x, a
y, a
z) = (a -> b
f a
x, a -> b
f a
y, a -> b
f a
z)

merge :: Eq a => [(a,b)] -> [(a,[b])]
merge :: [(a, b)] -> [(a, [b])]
merge [] = []
merge ((a
x,b
y):[(a, b)]
xs) = (a
x, b
y b -> [b] -> [b]
forall a. a -> [a] -> [a]
: ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
ys) (a, [b]) -> [(a, [b])] -> [(a, [b])]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, [b])]
forall a b. Eq a => [(a, b)] -> [(a, [b])]
merge [(a, b)]
zs
    where ([(a, b)]
ys,[(a, b)]
zs) = ((a, b) -> Bool) -> [(a, b)] -> ([(a, b)], [(a, b)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ( (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
xs

-- | '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.4
--

occurrences :: Ord a => [a] -> [(Int, [a])]
occurrences :: [a] -> [(Int, [a])]
occurrences = [(Int, a)] -> [(Int, [a])]
forall a b. Eq a => [(a, b)] -> [(a, [b])]
merge ([(Int, a)] -> [(Int, [a])])
-> ([a] -> [(Int, a)]) -> [a] -> [(Int, [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, Int) -> (Int, a)
forall a b. (a, b) -> (b, a)
swap ([(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_

-- | '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.5
--

isUnique :: Eq a => a -> [a] -> Maybe Bool
isUnique :: a -> [a] -> Maybe Bool
isUnique a
a = Maybe Bool -> a -> [a] -> Maybe Bool
forall a. Eq a => Maybe Bool -> a -> [a] -> Maybe Bool
go Maybe Bool
forall a. Maybe a
Nothing a
a
    where go :: Maybe Bool -> a -> [a] -> Maybe Bool
go Maybe Bool
s a
_ [] = Maybe Bool
s
          go s :: Maybe Bool
s@Maybe Bool
Nothing a
x (a
z:[a]
zs)
            | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z = Maybe Bool -> a -> [a] -> Maybe Bool
go (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) a
x [a]
zs
            | Bool
otherwise = Maybe Bool -> a -> [a] -> Maybe Bool
go Maybe Bool
s a
x [a]
zs
          go s :: Maybe Bool
s@(Just Bool
True) a
x (a
z:[a]
zs)
            | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
            | Bool
otherwise = Maybe Bool -> a -> [a] -> Maybe Bool
go Maybe Bool
s a
x [a]
zs
          go s :: Maybe Bool
s@(Just Bool
False) a
_ [a]
_ = Maybe Bool
s

-- | 'isRepeated' is a reverse function to 'isUnique'
--
-- Since 0.4.5
isRepeated :: Eq 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. Eq a => a -> [a] -> Maybe Bool
isUnique a
x