{-| Module      : Data.List.Predicate
    Description : Predicates on lists.
    Copyright   : (c) Preetham Gujjula, 2020
    License     : GPL-3
    Maintainer  : preetham.gujjula@gmail.com
    Stability   : experimental

Predicates (@True@/@False@ queries) on lists.

The functions in this module are as lazy as possible. For example,
@'sortedBy' undefined [undefined] == True@, since a list of one element must be
sorted, no matter the comparison function, or the value of the element.
-}
module Data.List.Predicate
  ( -- * All equal
    allEqual
  , allEqualBy

   -- * Sortedness
  , sorted
  , sortedBy

  -- * All unique
  , allUnique
  , allUniqueBy
  , allAdjUnique
  , allAdjUniqueBy

  -- * Sequential
  , ascSequential
  , descSequential

  -- * Miscellaneous
  , palindrome
  ) where

import Data.List (sort, sortBy)

{-| /O(n)./ Whether the elements are all equal.

    >>> allEqual [1..]
    False
    >>> allEqual [3, 3, 3, 3]
    True
    >>> allEqual []
    True
    >>> allEqual [1]
    True
-}
allEqual :: (Eq a) => [a] -> Bool
allEqual :: [a] -> Bool
allEqual = (a -> a -> Bool) -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> Bool
allEqualBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

{-| /O(n)./ Like 'allEqual', with a custom equality test.

    >>> allEqualBy ((==) `on` (`mod` 10)) [3, 13, 23]
    True
    >>> allEqualBy ((==) `on` (`mod` 10)) [3, 13, 24]
    False
-}
allEqualBy :: (a -> a -> Bool) -> [a] -> Bool
allEqualBy :: (a -> a -> Bool) -> [a] -> Bool
allEqualBy _  []       = Bool
True
allEqualBy eq :: a -> a -> Bool
eq (x :: a
x : xs :: [a]
xs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
eq a
x) [a]
xs

{-| /O(n)./ Whether the elements are in sorted order.

    >>> sorted [1, 2, 3, 3]
    True
    >>> sorted [1, 2, 3, 2]
    False
    >>> sorted []
    True
    >>> sorted [1]
    True
-}
sorted :: (Ord a) => [a] -> Bool
sorted :: [a] -> Bool
sorted = (a -> a -> Ordering) -> [a] -> Bool
forall a. (a -> a -> Ordering) -> [a] -> Bool
sortedBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

{-| /O(n)./ Like 'sorted', with a custom comparison test.

    >>> sortedBy (comparing Down) [3, 2, 1]
    True
    >>> sortedBy (comparing Down) [3, 2, 1, 2]
    False
-}
sortedBy :: (a -> a -> Ordering) -> [a] -> Bool
sortedBy :: (a -> a -> Ordering) -> [a] -> Bool
sortedBy _   []  = Bool
True
sortedBy _   [_] = Bool
True
sortedBy cmp :: a -> a -> Ordering
cmp xs :: [a]
xs  = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a :: a
a b :: a
b -> a -> a -> Ordering
cmp a
a a
b Ordering -> Ordering -> Bool
forall a. Ord a => a -> a -> Bool
<= Ordering
EQ) [a]
xs ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs)

{-| /O(n log(n))./ Whether the elements are all unique.

    >>> allUnique [1, 2, 5, 7]
    True
    >>> allUnique [1, 2, 5, 2]
    False
    >>> allUnique []
    True
    >>> allUnique [1]
    True
-}
allUnique :: (Ord a) => [a] -> Bool
allUnique :: [a] -> Bool
allUnique = [a] -> Bool
forall a. Eq a => [a] -> Bool
allAdjUnique ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort

{-| /O(n log(n))./ Like 'allUnique', with a custom comparison test.

    >>> allUniqueBy (comparing head) ["apple", "bow", "cat"]
    True
    >>> allUniqueBy (comparing head) ["apple", "bow", "ant"]
    False
-}
allUniqueBy :: (a -> a -> Ordering) -> [a] -> Bool
allUniqueBy :: (a -> a -> Ordering) -> [a] -> Bool
allUniqueBy cmp :: a -> a -> Ordering
cmp = (a -> a -> Bool) -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> Bool
allAdjUniqueBy a -> a -> Bool
eq ([a] -> Bool) -> ([a] -> [a]) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy a -> a -> Ordering
cmp
  where
    eq :: a -> a -> Bool
eq a :: a
a b :: a
b = a -> a -> Ordering
cmp a
a a
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

{-| /O(n)./ Whether all adjacent pairs of elements are different. Useful for
    determining whether a sorted list is all unique.

    >>> allAdjUnique [1, 2, 3, 2]
    True
    >>> allAdjUnique [1, 2, 2, 3]
    False
    >>> allAdjUnique []
    True
    >>> allAdjUnique [1]
    True
-}
allAdjUnique :: (Eq a) => [a] -> Bool
allAdjUnique :: [a] -> Bool
allAdjUnique = (a -> a -> Bool) -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> Bool
allAdjUniqueBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)

{-| /O(n)./ Like 'allAdjUnique', with a custom equality test.

    >>> allAdjUniqueBy ((==) `on` head) ["apple", "bow", "cat", "ant"]
    True
    >>> allAdjUniqueBy ((==) `on` head) ["apple", "ant", "bow", "cat"]
    False
-}
allAdjUniqueBy :: (a -> a -> Bool) -> [a] -> Bool
allAdjUniqueBy :: (a -> a -> Bool) -> [a] -> Bool
allAdjUniqueBy eq :: a -> a -> Bool
eq xs :: [a]
xs = (Bool -> Bool
not (Bool -> Bool) -> ([Bool] -> Bool) -> [Bool] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or) ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Bool
eq [a]
xs ([a] -> [a]
forall a. [a] -> [a]
tail [a]
xs)

{-| /O(n)./ Whether the list is increasing sequentially (one-by-one).

    >>> ascSequential [1, 2, 3, 4, 5]
    True
    >>> ascSequential [1, 2, 3, 4, 8]
    False
    >>> ascSequential ([] :: [Int])
    True
    >>> ascSequential [1]
    True
-}
ascSequential :: (Enum a) => [a] -> Bool
ascSequential :: [a] -> Bool
ascSequential []  = Bool
True
ascSequential [_] = Bool
True
ascSequential xs :: [a]
xs  = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
xs' [[Int] -> Int
forall a. [a] -> a
head [Int]
xs' ..]
  where
    xs' :: [Int]
xs' = (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. Enum a => a -> Int
fromEnum [a]
xs

{-| /O(n)./ Whether the list is descending sequentially (one-by-one).

    >>> descSequential [5, 4, 3, 2, 1]
    True
    >>> descSequential [5, 4, 3, 3, 1]
    False
    >>> descSequential ([] :: [Int])
    True
    >>> descSequential [1]
    True
-}
descSequential :: (Enum a) => [a] -> Bool
descSequential :: [a] -> Bool
descSequential []  = Bool
True
descSequential [_] = Bool
True
descSequential xs :: [a]
xs  = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
xs' [Int
x, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1 ..]
  where
    xs' :: [Int]
xs' = (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. Enum a => a -> Int
fromEnum [a]
xs
    x :: Int
x   = [Int] -> Int
forall a. [a] -> a
head [Int]
xs'

{-| /O(n)./ Whether the input is a palindrome, i.e., the same forwards and
    backwards.

    >>> palindrome "rotor"
    True
    >>> palindrome "rover"
    False
    >>> palindrome ""
    True
    >>> palindrome "a"
    True
-}
palindrome :: (Eq a) => [a] -> Bool
palindrome :: [a] -> Bool
palindrome xs :: [a]
xs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2) ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) [a]
xs [a]
rev
  where
    (rev :: [a]
rev, len :: Int
len) = [a] -> ([a], Int)
forall a. [a] -> ([a], Int)
reverseLength [a]
xs

-- Get the reverse and the length of a list in one pass.
reverseLength :: [a] -> ([a], Int)
reverseLength :: [a] -> ([a], Int)
reverseLength = [a] -> Int -> [a] -> ([a], Int)
forall a. [a] -> Int -> [a] -> ([a], Int)
reverseLengthWith [] 0
  where
    -- Accumulate the reverse and the length.
    reverseLengthWith :: [a] -> Int -> [a] -> ([a], Int)
    reverseLengthWith :: [a] -> Int -> [a] -> ([a], Int)
reverseLengthWith ys :: [a]
ys n :: Int
n [] = ([a]
ys, Int
n)
    reverseLengthWith ys :: [a]
ys n :: Int
n (x :: a
x : xs :: [a]
xs) =
        let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
         in Int -> ([a], Int) -> ([a], Int)
forall a b. a -> b -> b
seq Int
n' ([a] -> Int -> [a] -> ([a], Int)
forall a. [a] -> Int -> [a] -> ([a], Int)
reverseLengthWith (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys) Int
n' [a]
xs)