-- |
-- Module      :  Data.MinMax3Plus
-- 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.MinMax3Plus 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)

-- | Given a finite structure with at least 5 elements returns a tuple with two minimum elements
-- and three 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.
minMax23 :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> Maybe ((a,a), (a,a,a))
minMax23 :: t a -> Maybe ((a, a), (a, a, a))
minMax23 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
5 = Maybe ((a, a), (a, a, a))
forall a. Maybe a
Nothing
 | Bool
otherwise = ((a, a), (a, a, a)) -> Maybe ((a, a), (a, a, a))
forall a. a -> Maybe a
Just (((a, a), (a, a, a)) -> Maybe ((a, a), (a, a, a)))
-> (t a -> ((a, a), (a, a, a))) -> t a -> Maybe ((a, 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), (a, a, a)) -> t a -> ((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, a, a))
forall a. Ord a => a -> ((a, a), (a, a, a)) -> ((a, a), (a, a, a))
f ((a
n,a
p),(a
q,a
r,a
s)) (t a -> Maybe ((a, a), (a, a, a)))
-> t a -> Maybe ((a, 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
5 t a
xs
            [a
n,a
p,a
q,a
r,a
s] = [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, a, a))
f a
z ((a
x,a
y),(a
t,a
w,a
u))
              | 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,a
u)) else ((a
z,a
x),(a
t,a
w,a
u))
              | 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,a
u)) else if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
u then ((a
x,a
y),(a
w,a
z,a
u)) else ((a
x,a
y),(a
t,a
w,a
u))
              | Bool
otherwise = ((a
x,a
y),(a
t,a
w,a
u))

-- | Given a finite structure with at least 5 elements returns a tuple with three 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.
minMax32 :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> Maybe ((a,a,a), (a,a))
minMax32 :: t a -> Maybe ((a, a, a), (a, a))
minMax32 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
5 = Maybe ((a, a, a), (a, a))
forall a. Maybe a
Nothing
 | Bool
otherwise = ((a, a, a), (a, a)) -> Maybe ((a, a, a), (a, a))
forall a. a -> Maybe a
Just (((a, a, a), (a, a)) -> Maybe ((a, a, a), (a, a)))
-> (t a -> ((a, a, a), (a, a))) -> t a -> Maybe ((a, 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, a), (a, a)) -> t a -> ((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), (a, a))
forall a. Ord a => a -> ((a, a, a), (a, a)) -> ((a, a, a), (a, a))
f ((a
n,a
m,a
p),(a
q,a
r)) (t a -> Maybe ((a, a, a), (a, a)))
-> t a -> Maybe ((a, 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
5 t a
xs
            [a
n,a
m,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), (a, a))
f a
z ((a
x,a
y,a
u),(a
t,a
w))
              | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
u = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y then ((a
x,a
y,a
z),(a
t,a
w)) else if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x then ((a
x,a
z,a
y),(a
t,a
w)) else ((a
z,a
x,a
y),(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
u),(a
z,a
w)) else ((a
x,a
y,a
u),(a
w,a
z))
              | Bool
otherwise = ((a
x,a
y,a
u),(a
t,a
w))

-- | Given a finite structure with at least 6 elements returns a tuple with three minimum elements
-- and three 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.
minMax33 :: (Ord a, InsertLeft t a, Monoid (t a)) => t a -> Maybe ((a,a,a), (a,a,a))
minMax33 :: t a -> Maybe ((a, a, a), (a, a, a))
minMax33 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
6 = Maybe ((a, a, a), (a, a, a))
forall a. Maybe a
Nothing
 | Bool
otherwise = ((a, a, a), (a, a, a)) -> Maybe ((a, a, a), (a, a, a))
forall a. a -> Maybe a
Just (((a, a, a), (a, a, a)) -> Maybe ((a, a, a), (a, a, a)))
-> (t a -> ((a, a, a), (a, a, a)))
-> t a
-> Maybe ((a, a, 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)))
-> ((a, a, a), (a, a, a)) -> t a -> ((a, 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, a), (a, a, a))
forall a.
Ord a =>
a -> ((a, a, a), (a, a, a)) -> ((a, a, a), (a, a, a))
f ((a
n,a
m,a
p),(a
q,a
r,a
s)) (t a -> Maybe ((a, a, a), (a, a, a)))
-> t a -> Maybe ((a, a, 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
6 t a
xs
            [a
n,a
m,a
p,a
q,a
r,a
s] = [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, a), (a, a, a))
f a
z ((a
x,a
y,a
u),(a
t,a
w,a
k))
              | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
u = if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y then ((a
x,a
y,a
z),(a
t,a
w,a
k)) else if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x then ((a
x,a
z,a
y),(a
t,a
w,a
k)) else ((a
z,a
x,a
y),(a
t,a
w,a
k))
              | 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
u),(a
z,a
w,a
k)) else if a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
k then ((a
x,a
y,a
u),(a
w,a
z,a
k)) else ((a
x,a
y,a
u),(a
w,a
k,a
z))
              | Bool
otherwise = ((a
x,a
y,a
u),(a
t,a
w,a
k))