-- |
-- Module      :  Data.MinMax
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions to find both minimum and maximum elements of the 'F.Foldable' structure of the 'Ord'ered elements.

module Data.MinMax where

import Prelude hiding (takeWhile,dropWhile,span)
import Data.SubG
import qualified Data.Foldable as F
import qualified Data.List as L (sortBy)

-- | Returns a pair where the first element is the minimum element from the two given ones and the second one is the maximum. If the arguments are
-- equal then the tuple contains equal elements.
minmaxP :: (Ord a) => a -> a -> (a,a)
minmaxP :: a -> a -> (a, a)
minmaxP = (a -> a -> Ordering) -> a -> a -> (a, a)
forall a. Ord a => (a -> a -> Ordering) -> a -> a -> (a, a)
minmaxPBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minmaxP #-}

-- | A variant of the 'minmaxP' where you can specify your own comparison function.
minmaxPBy :: (Ord a) => (a -> a -> Ordering) -> a -> a -> (a,a)
minmaxPBy :: (a -> a -> Ordering) -> a -> a -> (a, a)
minmaxPBy a -> a -> Ordering
g a
x a
y
 | a -> a -> Ordering
g a
x a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = (a
x,a
y)
 | Bool
otherwise = (a
y,a
x)

-- | A ternary predicate to check whether the third argument lies between the first two unequal ones or whether they are all equal.
betweenNX :: (Ord a) => a -> a -> a -> Bool
betweenNX :: a -> a -> a -> Bool
betweenNX = (a -> a -> Ordering) -> a -> a -> a -> Bool
forall a. Ord a => (a -> a -> Ordering) -> a -> a -> a -> Bool
betweenNXBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE betweenNX #-}

-- | A variant of the 'betweenNX' where you can specify your own comparison function.
betweenNXBy :: (Ord a) => (a -> a -> Ordering) -> a -> a -> a -> Bool
betweenNXBy :: (a -> a -> Ordering) -> a -> a -> a -> Bool
betweenNXBy a -> a -> Ordering
g a
x a
y a
z
 | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z
 | a -> a -> Ordering
g a
z a
k Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT Bool -> Bool -> Bool
&& a -> a -> Ordering
g a
z a
t Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = Bool
True
 | Bool
otherwise = Bool
False
      where (a
t,a
k) = (a -> a -> Ordering) -> a -> a -> (a, a)
forall a. Ord a => (a -> a -> Ordering) -> a -> a -> (a, a)
minmaxPBy a -> a -> Ordering
g a
x a
y

-- | Finds out the minimum and maximum values of the finite structure that has not less than two elements. Otherwise returns 'Nothing'.
minMax11 :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> Maybe (a, a)
minMax11 :: t a -> Maybe (a, a)
minMax11 = (a -> a -> Ordering) -> t a -> Maybe (a, a)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minMax11 #-}

-- | A generalized variant of the 'minMax11' where you can specify your own comparison function.
minMax11By :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By :: (a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By a -> a -> Ordering
g t a
xs
 | t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Maybe (a, a)
forall a. Maybe a
Nothing
 | Bool
otherwise = (a, a) -> Maybe (a, a)
forall a. a -> Maybe a
Just ((a, a) -> Maybe (a, a)) -> (t a -> (a, a)) -> t a -> Maybe (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, a) -> (a, a)) -> (a, a) -> t a -> (a, a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> (a, a) -> (a, a)
f (a
t,a
u) (t a -> Maybe (a, a)) -> t a -> Maybe (a, a)
forall a b. (a -> b) -> a -> b
$ t a
str1
      where (t a
str1,t a
str2) = Integer -> t a -> (t a, t a)
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> (t a, t a)
splitAtEndG Integer
2 (t a -> (t a, t a)) -> t a -> (t a, t a)
forall a b. (a -> b) -> a -> b
$ t a
xs
            [a
t,a
u] = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g ([a] -> [a]) -> (t a -> [a]) -> t a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (t a -> [a]) -> t a -> [a]
forall a b. (a -> b) -> a -> b
$ t a
str2
            f :: a -> (a, a) -> (a, a)
f a
z (a
x,a
y)
              | a -> a -> Ordering
g a
z a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = (a
z,a
y)
              | a -> a -> Ordering
g a
z a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = (a
x,a
z)
              | Bool
otherwise = (a
x,a
y)

-- | Given a finite structure with at least 3 elements returns a tuple with the two most minimum elements
-- (the first one is less than the second one) and the maximum element. If the structure has less elements, returns 'Nothing'.
-- Uses just three passes through the structure, so may be more efficient than some other approaches.
minMax21 :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> Maybe ((a,a), a)
minMax21 :: t a -> Maybe ((a, a), a)
minMax21 = (a -> a -> Ordering) -> t a -> Maybe ((a, a), a)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> Maybe ((a, a), a)
minMax21By a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minMax21 #-}

-- | A variant of the 'minMax21' where you can specify your own comparison function.
minMax21By :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> Maybe ((a,a), a)
minMax21By :: (a -> a -> Ordering) -> t a -> Maybe ((a, a), a)
minMax21By a -> a -> Ordering
g t a
xs
 | t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = Maybe ((a, a), a)
forall a. Maybe a
Nothing
 | Bool
otherwise = ((a, a), a) -> Maybe ((a, a), a)
forall a. a -> Maybe a
Just (((a, a), a) -> Maybe ((a, a), a))
-> (t a -> ((a, a), a)) -> t a -> Maybe ((a, a), a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ((a, a), a) -> ((a, a), a))
-> ((a, a), a) -> t a -> ((a, a), a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> ((a, a), a) -> ((a, a), a)
f ((a
n,a
p),a
q) (t a -> Maybe ((a, a), a)) -> t a -> Maybe ((a, a), a)
forall a b. (a -> b) -> a -> b
$ t a
str1
      where (t a
str1,t a
str2) = Integer -> t a -> (t a, t a)
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> (t a, t a)
splitAtEndG Integer
3 t a
xs
            [a
n,a
p,a
q] = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g ([a] -> [a]) -> (t a -> [a]) -> t a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (t a -> [a]) -> t a -> [a]
forall a b. (a -> b) -> a -> b
$ t a
str2
            f :: a -> ((a, a), a) -> ((a, a), a)
f a
z ((a
x,a
y),a
t)
              | a -> a -> Ordering
g a
z a
t Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = ((a
x,a
y),a
z)
              | a -> a -> Ordering
g a
z a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = if a -> a -> Ordering
g a
z a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then ((a
x,a
z),a
t) else ((a
z,a
x),a
t)
              | Bool
otherwise = ((a
x,a
y),a
t)

-- | Given a finite structure with at least 3 elements returns a tuple with the minimum element
-- and two maximum elements (the first one is less than the second one). If the structure has less elements, returns 'Nothing'.
-- Uses just three passes through the structure, so may be more efficient than some other approaches.
minMax12 :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> Maybe (a, (a,a))
minMax12 :: t a -> Maybe (a, (a, a))
minMax12 = (a -> a -> Ordering) -> t a -> Maybe (a, (a, a))
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> Maybe (a, (a, a))
minMax12By a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minMax12 #-}

-- | A variant of the 'minMax12' where you can specify your own comparison function.
minMax12By :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> Maybe (a, (a,a))
minMax12By :: (a -> a -> Ordering) -> t a -> Maybe (a, (a, a))
minMax12By a -> a -> Ordering
g t a
xs
 | t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = Maybe (a, (a, a))
forall a. Maybe a
Nothing
 | Bool
otherwise = (a, (a, a)) -> Maybe (a, (a, a))
forall a. a -> Maybe a
Just ((a, (a, a)) -> Maybe (a, (a, a)))
-> (t a -> (a, (a, a))) -> t a -> Maybe (a, (a, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, (a, a)) -> (a, (a, a)))
-> (a, (a, a)) -> t a -> (a, (a, a))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> (a, (a, a)) -> (a, (a, a))
f (a
n,(a
p,a
q)) (t a -> Maybe (a, (a, a))) -> t a -> Maybe (a, (a, a))
forall a b. (a -> b) -> a -> b
$ t a
str1
      where (t a
str1,t a
str2) = Integer -> t a -> (t a, t a)
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> (t a, t a)
splitAtEndG Integer
3 t a
xs
            [a
n,a
p,a
q] = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g ([a] -> [a]) -> (t a -> [a]) -> t a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (t a -> [a]) -> t a -> [a]
forall a b. (a -> b) -> a -> b
$ t a
str2
            f :: a -> (a, (a, a)) -> (a, (a, a))
f a
z (a
x,(a
y,a
t))
              | a -> a -> Ordering
g a
z a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = (a
z,(a
y,a
t))
              | a -> a -> Ordering
g a
z a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = if a -> a -> Ordering
g a
z a
t Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then (a
x,(a
z,a
t)) else (a
x,(a
t,a
z))
              | Bool
otherwise = (a
x,(a
y,a
t))

-- | Given a finite structure with at least 4 elements returns a tuple with two minimum elements
-- and two maximum elements. If the structure has less elements, returns 'Nothing'.
-- Uses just three passes through the structure, so may be more efficient than some other approaches.
minMax22 :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> Maybe ((a,a), (a,a))
minMax22 :: t a -> Maybe ((a, a), (a, a))
minMax22 = (a -> a -> Ordering) -> t a -> Maybe ((a, a), (a, a))
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> Maybe ((a, a), (a, a))
minMax22By a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minMax22 #-}

-- | A variant of the 'minMax22' where you can specify your own comparison function.
minMax22By :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> Maybe ((a,a), (a,a))
minMax22By :: (a -> a -> Ordering) -> t a -> Maybe ((a, a), (a, a))
minMax22By a -> a -> Ordering
g t a
xs
 | t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t a
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Maybe ((a, a), (a, a))
forall a. Maybe a
Nothing
 | Bool
otherwise = ((a, a), (a, a)) -> Maybe ((a, a), (a, a))
forall a. a -> Maybe a
Just (((a, a), (a, a)) -> Maybe ((a, a), (a, a)))
-> (t a -> ((a, a), (a, a))) -> t a -> Maybe ((a, a), (a, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ((a, a), (a, a)) -> ((a, a), (a, a)))
-> ((a, a), (a, a)) -> t a -> ((a, a), (a, a))
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> ((a, a), (a, a)) -> ((a, a), (a, a))
f ((a
n,a
p),(a
q,a
r)) (t a -> Maybe ((a, a), (a, a))) -> t a -> Maybe ((a, a), (a, a))
forall a b. (a -> b) -> a -> b
$ t a
str1
      where (t a
str1,t a
str2) = Integer -> t a -> (t a, t a)
forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> (t a, t a)
splitAtEndG Integer
4 t a
xs
            [a
n,a
p,a
q,a
r] = (a -> a -> Ordering) -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g ([a] -> [a]) -> (t a -> [a]) -> t a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (t a -> [a]) -> t a -> [a]
forall a b. (a -> b) -> a -> b
$ t a
str2
            f :: a -> ((a, a), (a, a)) -> ((a, a), (a, a))
f a
z ((a
x,a
y),(a
t,a
w))
              | a -> a -> Ordering
g a
z a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT = if a -> a -> Ordering
g a
z a
x Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then ((a
x,a
z),(a
t,a
w)) else ((a
z,a
x),(a
t,a
w))
              | a -> a -> Ordering
g a
z a
t Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = if a -> a -> Ordering
g a
z a
w Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then ((a
x,a
y),(a
z,a
w)) else ((a
x,a
y),(a
w,a
z))
              | Bool
otherwise = ((a
x,a
y),(a
t,a
w))