-- |
-- Module      :  Data.MinMax.Preconditions
-- 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. With the preconditions that the
-- structure at least have enough elements (this is contrary to the functions from the module Data.MinMax not checked internally).

module Data.MinMax.Preconditions where

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

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

-- | A generalized variant of the 'minMax' where you can specify your own comparison function.
minMax11ByC :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> (a, a)
minMax11ByC :: (a -> a -> Ordering) -> t a -> (a, a)
minMax11ByC a -> a -> Ordering
g t a
xs =
  (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
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 returns a tuple with the two most minimum elements
-- (the first one is less than the second one) and the maximum element.
-- Uses just two passes through the structure, so may be more efficient than some other approaches.
minMax21C :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> ((a,a), a)
minMax21C :: t a -> ((a, a), a)
minMax21C = (a -> a -> Ordering) -> t a -> ((a, a), a)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> ((a, a), a)
minMax21ByC a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minMax21C #-}

-- | A variant of the 'minMax21C' where you can specify your own comparison function.
minMax21ByC :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> ((a,a), a)
minMax21ByC :: (a -> a -> Ordering) -> t a -> ((a, a), a)
minMax21ByC a -> a -> Ordering
g t a
xs =
  (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
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 returns a tuple with the minimum element
-- and two maximum elements (the first one is less than the second one).
-- Uses just two passes through the structure, so may be more efficient than some other approaches.
minMax12C :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> (a, (a,a))
minMax12C :: t a -> (a, (a, a))
minMax12C = (a -> a -> Ordering) -> t a -> (a, (a, a))
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> (a, (a, a))
minMax12ByC a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minMax12C #-}

-- | A variant of the 'minMax12C' where you can specify your own comparison function.
minMax12ByC :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> (a, (a,a))
minMax12ByC :: (a -> a -> Ordering) -> t a -> (a, (a, a))
minMax12ByC a -> a -> Ordering
g t a
xs =
  (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 -> (a, (a, a))) -> t 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
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 returns a tuple with two minimum elements
-- and two maximum elements. Uses just two passes through the structure, so may be more efficient than some other approaches.
minMax22C :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> ((a,a), (a,a))
minMax22C :: t a -> ((a, a), (a, a))
minMax22C = (a -> a -> Ordering) -> t a -> ((a, a), (a, a))
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> ((a, a), (a, a))
minMax22ByC a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# INLINE minMax22C #-}

-- | A variant of the 'minMax22C' where you can specify your own comparison function.
minMax22ByC :: (Ord a, InsertLeft t a, Monoid (t a)) => (a -> a -> Ordering) -> t a -> ((a,a), (a,a))
minMax22ByC :: (a -> a -> Ordering) -> t a -> ((a, a), (a, a))
minMax22ByC a -> a -> Ordering
g t a
xs =
  (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 -> ((a, a), (a, a))) -> t a -> ((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))