-- |
-- 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.Maybe (fromJust)
import Data.SubG
import qualified Data.Foldable as F
import qualified Data.List as L (sort)

-- | 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
x a
y
 | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = (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
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
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k Bool -> Bool -> Bool
&& a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
t = Bool
True
 | Bool
otherwise = Bool
False
      where (a
t,a
k) = a -> a -> (a, a)
forall a. Ord a => a -> a -> (a, a)
minmaxP a
x a
y

-- | Finds out the minimum and maximum values of the finite structure. If the latter one is empty returns 'Nothing', if all the elements are equal
-- (or it has just one) then it returns 'Just' tuple of equal elements.
minMax :: (Ord a, Foldable t) => t a -> Maybe (a, a)
minMax :: t a -> Maybe (a, a)
minMax t a
xs
 | t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t a
xs = 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)
forall a. Ord a => a -> (a, a) -> (a, a)
f (a
x,a
x) (t a -> Maybe (a, a)) -> t a -> Maybe (a, a)
forall a b. (a -> b) -> a -> b
$ t a
xs
      where x :: a
x = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe a
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
safeHeadG (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
xs
            f :: a -> (a, a) -> (a, a)
f a
z (a
x,a
y)
              | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x = (a
z,a
y)
              | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = (a
x,a
z)
              | Bool
otherwise = (a
x,a
y)

-- | A generalized variant of the 'minMax' where you can specify your own comparison function.
minMaxBy :: (Ord a, Foldable t) => (a -> a -> Ordering) -> t a -> Maybe (a, a)
minMaxBy :: (a -> a -> Ordering) -> t a -> Maybe (a, a)
minMaxBy a -> a -> Ordering
g t a
xs
 | t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t a
xs = 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
x,a
x) (t a -> Maybe (a, a)) -> t a -> Maybe (a, a)
forall a b. (a -> b) -> a -> b
$ t a
xs
      where x :: a
x = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe a
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
safeHeadG (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
xs
            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 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)
forall a. Ord a => 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 x :: a
x = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe a
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
safeHeadG (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
xs
            (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]
forall a. Ord a => [a] -> [a]
L.sort ([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
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
t = ((a
x,a
y),a
z)
              | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x 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 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))
forall a. Ord a => 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 x :: a
x = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe a
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
safeHeadG (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
xs
            (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]
forall a. Ord a => [a] -> [a]
L.sort ([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
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x = (a
z,(a
y,a
t))
              | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
t 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 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))
forall a. Ord a => 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 x :: a
x = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe a
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
safeHeadG (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
xs
            (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]
forall a. Ord a => [a] -> [a]
L.sort ([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
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x then ((a
x,a
z),(a
t,a
w)) else ((a
z,a
x),(a
t,a
w))
              | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
t = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
w 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))