-- |
-- Module      :  Data.MinMax.Preconditions
-- Copyright   :  (c) OleksandrZhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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).

{-# LANGUAGE NoImplicitPrelude #-}

module Data.MinMax.Preconditions where

import GHC.Base
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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C = forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> (a, a)
minMax11ByC 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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> (a, a)
minMax11ByC a -> a -> Ordering
g t a
xs =
  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) = forall b (t :: * -> *) a.
(Integral b, InsertLeft t a, Monoid (t a)) =>
b -> t a -> (t a, t a)
splitAtEndG Integer
2 forall a b. (a -> b) -> a -> b
$ t a
xs
          [a
t,a
u] = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList 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 forall a. Eq a => a -> a -> Bool
== Ordering
LT = (a
z,a
y)
            | a -> a -> Ordering
g a
z a
y 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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> ((a, a), a)
minMax21C = forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> ((a, a), a)
minMax21ByC 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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> ((a, a), a)
minMax21ByC a -> a -> Ordering
g t a
xs =
  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) = 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] = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList 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 forall a. Eq a => a -> a -> Bool
== Ordering
GT = ((a
x,a
y),a
z)
            | a -> a -> Ordering
g a
z a
y forall a. Eq a => a -> a -> Bool
== Ordering
LT = if a -> a -> Ordering
g a
z a
x 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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, (a, a))
minMax12C = forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> (a, (a, a))
minMax12ByC 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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> (a, (a, a))
minMax12ByC a -> a -> Ordering
g t a
xs =
  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)) forall a b. (a -> b) -> a -> b
$ t a
str1
    where (t a
str1,t a
str2) = 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] = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList 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 forall a. Eq a => a -> a -> Bool
== Ordering
LT = (a
z,(a
y,a
t))
            | a -> a -> Ordering
g a
z a
y forall a. Eq a => a -> a -> Bool
== Ordering
GT = if a -> a -> Ordering
g a
z a
t 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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> ((a, a), (a, a))
minMax22C = forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> ((a, a), (a, a))
minMax22ByC 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 :: forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
(a -> a -> Ordering) -> t a -> ((a, a), (a, a))
minMax22ByC a -> a -> Ordering
g t a
xs =
  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)) forall a b. (a -> b) -> a -> b
$ t a
str1
    where (t a
str1,t a
str2) = 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] = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy a -> a -> Ordering
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList 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 forall a. Eq a => a -> a -> Bool
== Ordering
LT = if a -> a -> Ordering
g a
z a
x 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 forall a. Eq a => a -> a -> Bool
== Ordering
GT = if a -> a -> Ordering
g a
z a
w 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))