{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK show-extensions #-}

{- |
Module      :  Aftovolio.DataG
Copyright   :  (c) Oleksandr Zhabenko 2020-2024
License     :  MIT
Stability   :  Experimental
Maintainer  :  oleksandr.zhabenko@yahoo.com

Simplified version of the @phonetic-languages-common@ and @phonetic-languages-general@ packages.
Uses less dependencies.
-}
module Aftovolio.DataG where

import Aftovolio.Basis
import qualified Data.Foldable as F
import Data.InsertLeft (InsertLeft (..), mapG, partitionG)
import Data.Maybe (fromJust)
import Data.MinMax1
import GHC.Base
import GHC.Num ((-))
import GHC.Real

maximumEl ::
    (F.Foldable t2, Ord c) =>
    FuncRep2 (t a) b c ->
    t2 (t a) ->
    Result t a b c
maximumEl :: forall (t2 :: * -> *) c (t :: * -> *) a b.
(Foldable t2, Ord c) =>
FuncRep2 (t a) b c -> t2 (t a) -> Result t a b c
maximumEl !FuncRep2 (t a) b c
frep2 t2 (t a)
data0 =
    let !l :: t a
l = (t a -> t a -> Ordering) -> t2 (t a) -> t a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (\t a
x t a
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FuncRep2 (t a) b c -> t a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 (t a) b c
frep2 t a
x) (FuncRep2 (t a) b c -> t a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 (t a) b c
frep2 t a
y)) t2 (t a)
data0
        !m :: b
m = FuncRep2 (t a) b c -> t a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 (t a) b c
frep2 t a
l
        !tm :: c
tm = FuncRep2 (t a) b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 (t a) b c
frep2 b
m
     in R{line :: t a
line = t a
l, propertiesF :: b
propertiesF = b
m, transPropertiesF :: c
transPropertiesF = c
tm}
{-# INLINE maximumEl #-}
{-# SPECIALIZE maximumEl ::
    (Ord c) => FuncRep2 [a] Double c -> [[a]] -> Result [] a Double c
    #-}

-- | Is intended to be used for the structures with at least two elements, though it is not checked.
minMaximumEls ::
    (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord (t a), Ord c) =>
    FuncRep2 (t a) b c ->
    t2 (t a) ->
    (Result t a b c, Result t a b c)
minMaximumEls :: forall (t2 :: * -> *) (t :: * -> *) a c b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), Ord (t a), Ord c) =>
FuncRep2 (t a) b c -> t2 (t a) -> (Result t a b c, Result t a b c)
minMaximumEls !FuncRep2 (t a) b c
frep2 t2 (t a)
data0 =
    let (!t a
ln, !t a
lx) =
            Maybe (t a, t a) -> (t a, t a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (t a, t a) -> (t a, t a))
-> (t2 (t a) -> Maybe (t a, t a)) -> t2 (t a) -> (t a, t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> t a -> Ordering) -> t2 (t a) -> Maybe (t a, t a)
forall a (t :: * -> *).
(Ord a, Foldable t) =>
(a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By (\t a
x t a
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FuncRep2 (t a) b c -> t a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 (t a) b c
frep2 t a
x) (FuncRep2 (t a) b c -> t a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 (t a) b c
frep2 t a
y)) (t2 (t a) -> (t a, t a)) -> t2 (t a) -> (t a, t a)
forall a b. (a -> b) -> a -> b
$ t2 (t a)
data0
        !mn :: b
mn = FuncRep2 (t a) b c -> t a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 (t a) b c
frep2 t a
ln
        !mx :: b
mx = FuncRep2 (t a) b c -> t a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 (t a) b c
frep2 t a
lx
        !tmn :: c
tmn = FuncRep2 (t a) b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 (t a) b c
frep2 b
mn
        !tmx :: c
tmx = FuncRep2 (t a) b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 (t a) b c
frep2 b
mx
     in ( R{line :: t a
line = t a
ln, propertiesF :: b
propertiesF = b
mn, transPropertiesF :: c
transPropertiesF = c
tmn}
        , R{line :: t a
line = t a
lx, propertiesF :: b
propertiesF = b
mx, transPropertiesF :: c
transPropertiesF = c
tmx}
        )
{-# INLINE minMaximumEls #-}
{-# SPECIALIZE minMaximumEls ::
    (Ord a, Ord c) =>
    FuncRep2 [a] Double c ->
    [[a]] ->
    (Result [] a Double c, Result [] a Double c)
    #-}

maximumElR ::
    (F.Foldable t2, Ord c) =>
    t2 (Result t a b c) ->
    Result t a b c
maximumElR :: forall (t2 :: * -> *) c (t :: * -> *) a b.
(Foldable t2, Ord c) =>
t2 (Result t a b c) -> Result t a b c
maximumElR = (Result t a b c -> Result t a b c -> Ordering)
-> t2 (Result t a b c) -> Result t a b c
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (\Result t a b c
x Result t a b c
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Result t a b c -> c
forall (t :: * -> *) a b c. Result t a b c -> c
transPropertiesF Result t a b c
x) (Result t a b c -> c
forall (t :: * -> *) a b c. Result t a b c -> c
transPropertiesF Result t a b c
y))
{-# INLINE maximumElR #-}
{-# SPECIALIZE maximumElR ::
    (Ord c) => [Result [] a Double c] -> Result [] a Double c
    #-}

-- | Is intended to be used for the structures with at least two elements, though it is not checked.
minMaximumElRs ::
    ( InsertLeft t2 (Result t a b c)
    , Monoid (t2 (Result t a b c))
    , Ord (t a)
    , Ord b
    , Ord c
    ) =>
    t2 (Result t a b c) ->
    (Result t a b c, Result t a b c)
minMaximumElRs :: forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 Ord (t a), Ord b, Ord c) =>
t2 (Result t a b c) -> (Result t a b c, Result t a b c)
minMaximumElRs =
    Maybe (Result t a b c, Result t a b c)
-> (Result t a b c, Result t a b c)
forall a. HasCallStack => Maybe a -> a
fromJust
        (Maybe (Result t a b c, Result t a b c)
 -> (Result t a b c, Result t a b c))
-> (t2 (Result t a b c) -> Maybe (Result t a b c, Result t a b c))
-> t2 (Result t a b c)
-> (Result t a b c, Result t a b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result t a b c -> Result t a b c -> Ordering)
-> t2 (Result t a b c) -> Maybe (Result t a b c, Result t a b c)
forall a (t :: * -> *).
(Ord a, Foldable t) =>
(a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By (\Result t a b c
x Result t a b c
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Result t a b c -> c
forall (t :: * -> *) a b c. Result t a b c -> c
transPropertiesF Result t a b c
x) (Result t a b c -> c
forall (t :: * -> *) a b c. Result t a b c -> c
transPropertiesF Result t a b c
y))
{-# INLINE minMaximumElRs #-}
{-# SPECIALIZE minMaximumElRs ::
    (Ord a, Ord c) =>
    [Result [] a Double c] ->
    (Result [] a Double c, Result [] a Double c)
    #-}

-----------------------------------------------------------------------------------

-- | The second argument must be not empty for the function to work correctly.
innerPartitioning ::
    (InsertLeft t2 (t a), Monoid (t2 (t a)), InsertLeft t2 c, Monoid (t2 c), Ord c) =>
    FuncRep2 (t a) b c ->
    t2 (t a) ->
    (t2 (t a), t2 (t a))
innerPartitioning :: forall (t2 :: * -> *) (t :: * -> *) a c b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), InsertLeft t2 c,
 Monoid (t2 c), Ord c) =>
FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
innerPartitioning !FuncRep2 (t a) b c
frep2 t2 (t a)
data0 =
    let !l :: c
l = t2 c -> c
forall a. Ord a => t2 a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.maximum (t2 c -> c) -> (t2 (t a) -> t2 c) -> t2 (t a) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> c) -> t2 (t a) -> t2 c
forall (t :: * -> *) b a.
(InsertLeft t b, Monoid (t b)) =>
(a -> b) -> t a -> t b
mapG (FuncRep2 (t a) b c -> t a -> c
forall (t :: * -> *) a b c. FuncRep2 (t a) b c -> t a -> c
toTransPropertiesF' FuncRep2 (t a) b c
frep2) (t2 (t a) -> c) -> t2 (t a) -> c
forall a b. (a -> b) -> a -> b
$ t2 (t a)
data0
     in (t a -> Bool) -> t2 (t a) -> (t2 (t a), t2 (t a))
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
partitionG ((c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
l) (c -> Bool) -> (t a -> c) -> t a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 (t a) b c -> t a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 (t a) b c
frep2) t2 (t a)
data0
{-# INLINE innerPartitioning #-}
{-# SPECIALIZE innerPartitioning ::
    (Eq a, Ord c) => FuncRep2 [a] Double c -> [[a]] -> ([[a]], [[a]])
    #-}

-- | The first argument must be not empty for the function to work correctly.
innerPartitioningR ::
    ( InsertLeft t2 (Result t a b c)
    , Monoid (t2 (Result t a b c))
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Ord c
    ) =>
    t2 (Result t a b c) ->
    (t2 (Result t a b c), t2 (Result t a b c))
innerPartitioningR :: forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c))
innerPartitioningR t2 (Result t a b c)
dataR =
    let !l :: c
l = t2 c -> c
forall a. Ord a => t2 a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.maximum (t2 c -> c)
-> (t2 (Result t a b c) -> t2 c) -> t2 (Result t a b c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result t a b c -> c) -> t2 (Result t a b c) -> t2 c
forall (t :: * -> *) b a.
(InsertLeft t b, Monoid (t b)) =>
(a -> b) -> t a -> t b
mapG Result t a b c -> c
forall (t :: * -> *) a b c. Result t a b c -> c
transPropertiesF (t2 (Result t a b c) -> c) -> t2 (Result t a b c) -> c
forall a b. (a -> b) -> a -> b
$ t2 (Result t a b c)
dataR
     in (Result t a b c -> Bool)
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
partitionG ((c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
l) (c -> Bool) -> (Result t a b c -> c) -> Result t a b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result t a b c -> c
forall (t :: * -> *) a b c. Result t a b c -> c
transPropertiesF) t2 (Result t a b c)
dataR
{-# INLINE innerPartitioningR #-}
{-# SPECIALIZE innerPartitioningR ::
    (Eq a, Ord c) =>
    [Result [] a Double c] ->
    ([Result [] a Double c], [Result [] a Double c])
    #-}

maximumGroupsClassification ::
    ( InsertLeft t2 (t a)
    , Monoid (t2 (t a))
    , Ord c
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Integral d
    ) =>
    d ->
    FuncRep2 (t a) b c ->
    (t2 (t a), t2 (t a)) ->
    (t2 (t a), t2 (t a))
maximumGroupsClassification :: forall (t2 :: * -> *) (t :: * -> *) a c d b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d
-> FuncRep2 (t a) b c
-> (t2 (t a), t2 (t a))
-> (t2 (t a), t2 (t a))
maximumGroupsClassification !d
nGroups !FuncRep2 (t a) b c
frep2 (t2 (t a)
dataT, t2 (t a)
dataF)
    | t2 (t a) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (t a)
dataF = (t2 (t a)
dataT, t2 (t a)
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = (t2 (t a)
dataT, t2 (t a)
dataF)
    | Bool
otherwise =
        d
-> FuncRep2 (t a) b c
-> (t2 (t a), t2 (t a))
-> (t2 (t a), t2 (t a))
forall (t2 :: * -> *) (t :: * -> *) a c d b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d
-> FuncRep2 (t a) b c
-> (t2 (t a), t2 (t a))
-> (t2 (t a), t2 (t a))
maximumGroupsClassification (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) FuncRep2 (t a) b c
frep2 (t2 (t a)
dataT t2 (t a) -> t2 (t a) -> t2 (t a)
forall a. Monoid a => a -> a -> a
`mappend` t2 (t a)
partT, t2 (t a)
partF)
  where
    (!t2 (t a)
partT, !t2 (t a)
partF) = FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
forall (t2 :: * -> *) (t :: * -> *) a c b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), InsertLeft t2 c,
 Monoid (t2 c), Ord c) =>
FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
innerPartitioning FuncRep2 (t a) b c
frep2 t2 (t a)
dataF
{-# NOINLINE maximumGroupsClassification #-}

maximumGroupsClassification1 ::
    ( InsertLeft t2 (t a)
    , Monoid (t2 (t a))
    , Ord c
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Integral d
    ) =>
    d ->
    FuncRep2 (t a) b c ->
    t2 (t a) ->
    (t2 (t a), t2 (t a))
maximumGroupsClassification1 :: forall (t2 :: * -> *) (t :: * -> *) a c d b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d -> FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
maximumGroupsClassification1 !d
nGroups !FuncRep2 (t a) b c
frep2 t2 (t a)
data0
    | t2 (t a) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (t a)
data0 = (t2 (t a)
forall a. Monoid a => a
mempty, t2 (t a)
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
forall (t2 :: * -> *) (t :: * -> *) a c b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), InsertLeft t2 c,
 Monoid (t2 c), Ord c) =>
FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
innerPartitioning FuncRep2 (t a) b c
frep2 t2 (t a)
data0
    | Bool
otherwise =
        d
-> FuncRep2 (t a) b c
-> (t2 (t a), t2 (t a))
-> (t2 (t a), t2 (t a))
forall (t2 :: * -> *) (t :: * -> *) a c d b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d
-> FuncRep2 (t a) b c
-> (t2 (t a), t2 (t a))
-> (t2 (t a), t2 (t a))
maximumGroupsClassification (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) FuncRep2 (t a) b c
frep2 ((t2 (t a), t2 (t a)) -> (t2 (t a), t2 (t a)))
-> (t2 (t a) -> (t2 (t a), t2 (t a)))
-> t2 (t a)
-> (t2 (t a), t2 (t a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
forall (t2 :: * -> *) (t :: * -> *) a c b.
(InsertLeft t2 (t a), Monoid (t2 (t a)), InsertLeft t2 c,
 Monoid (t2 c), Ord c) =>
FuncRep2 (t a) b c -> t2 (t a) -> (t2 (t a), t2 (t a))
innerPartitioning FuncRep2 (t a) b c
frep2 (t2 (t a) -> (t2 (t a), t2 (t a)))
-> t2 (t a) -> (t2 (t a), t2 (t a))
forall a b. (a -> b) -> a -> b
$
            t2 (t a)
data0
{-# NOINLINE maximumGroupsClassification1 #-}

maximumGroupsClassificationR2 ::
    ( Eq a
    , Eq b
    , Eq (t a)
    , InsertLeft t2 (Result t a b c)
    , Monoid (t2 (Result t a b c))
    , Ord c
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Integral d
    ) =>
    d ->
    (t2 (Result t a b c), t2 (Result t a b c)) ->
    (t2 (Result t a b c), t2 (Result t a b c))
maximumGroupsClassificationR2 :: forall a b (t :: * -> *) (t2 :: * -> *) c d.
(Eq a, Eq b, Eq (t a), InsertLeft t2 (Result t a b c),
 Monoid (t2 (Result t a b c)), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d
-> (t2 (Result t a b c), t2 (Result t a b c))
-> (t2 (Result t a b c), t2 (Result t a b c))
maximumGroupsClassificationR2 !d
nGroups (t2 (Result t a b c)
dataT, t2 (Result t a b c)
dataF)
    | t2 (Result t a b c) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result t a b c)
dataF = (t2 (Result t a b c)
dataT, t2 (Result t a b c)
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = (t2 (Result t a b c)
dataT, t2 (Result t a b c)
dataF)
    | Bool
otherwise =
        d
-> (t2 (Result t a b c), t2 (Result t a b c))
-> (t2 (Result t a b c), t2 (Result t a b c))
forall a b (t :: * -> *) (t2 :: * -> *) c d.
(Eq a, Eq b, Eq (t a), InsertLeft t2 (Result t a b c),
 Monoid (t2 (Result t a b c)), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d
-> (t2 (Result t a b c), t2 (Result t a b c))
-> (t2 (Result t a b c), t2 (Result t a b c))
maximumGroupsClassificationR2 (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) (t2 (Result t a b c)
dataT t2 (Result t a b c) -> t2 (Result t a b c) -> t2 (Result t a b c)
forall a. Monoid a => a -> a -> a
`mappend` t2 (Result t a b c)
partT, t2 (Result t a b c)
partF)
  where
    (!t2 (Result t a b c)
partT, !t2 (Result t a b c)
partF) = t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c))
forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c))
innerPartitioningR t2 (Result t a b c)
dataF
{-# NOINLINE maximumGroupsClassificationR2 #-}

maximumGroupsClassificationR ::
    ( Eq a
    , Eq b
    , Eq (t a)
    , InsertLeft t2 (Result t a b c)
    , Monoid (t2 (Result t a b c))
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Ord c
    , Integral d
    ) =>
    d ->
    t2 (Result t a b c) ->
    (t2 (Result t a b c), t2 (Result t a b c))
maximumGroupsClassificationR :: forall a b (t :: * -> *) (t2 :: * -> *) c d.
(Eq a, Eq b, Eq (t a), InsertLeft t2 (Result t a b c),
 Monoid (t2 (Result t a b c)), InsertLeft t2 c, Monoid (t2 c),
 Ord c, Integral d) =>
d
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
maximumGroupsClassificationR !d
nGroups t2 (Result t a b c)
dataR
    | t2 (Result t a b c) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result t a b c)
dataR = (t2 (Result t a b c)
forall a. Monoid a => a
mempty, t2 (Result t a b c)
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c))
forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c))
innerPartitioningR t2 (Result t a b c)
dataR
    | Bool
otherwise =
        d
-> (t2 (Result t a b c), t2 (Result t a b c))
-> (t2 (Result t a b c), t2 (Result t a b c))
forall a b (t :: * -> *) (t2 :: * -> *) c d.
(Eq a, Eq b, Eq (t a), InsertLeft t2 (Result t a b c),
 Monoid (t2 (Result t a b c)), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d
-> (t2 (Result t a b c), t2 (Result t a b c))
-> (t2 (Result t a b c), t2 (Result t a b c))
maximumGroupsClassificationR2 (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) ((t2 (Result t a b c), t2 (Result t a b c))
 -> (t2 (Result t a b c), t2 (Result t a b c)))
-> (t2 (Result t a b c)
    -> (t2 (Result t a b c), t2 (Result t a b c)))
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c))
forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c))
innerPartitioningR (t2 (Result t a b c) -> (t2 (Result t a b c), t2 (Result t a b c)))
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
forall a b. (a -> b) -> a -> b
$ t2 (Result t a b c)
dataR
{-# NOINLINE maximumGroupsClassificationR #-}

toResultR ::
    FuncRep2 (t a) b c ->
    t a ->
    Result t a b c
toResultR :: forall (t :: * -> *) a b c.
FuncRep2 (t a) b c -> t a -> Result t a b c
toResultR !FuncRep2 (t a) b c
frep2 !t a
ys = R{line :: t a
line = t a
ys, propertiesF :: b
propertiesF = b
m, transPropertiesF :: c
transPropertiesF = c
tm}
  where
    !m :: b
m = FuncRep2 (t a) b c -> t a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 (t a) b c
frep2 t a
ys
    !tm :: c
tm = FuncRep2 (t a) b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 (t a) b c
frep2 b
m
{-# INLINE toResultR #-}

toPropertiesF' ::
    FuncRep2 (t a) b c ->
    t a ->
    b
toPropertiesF' :: forall (t :: * -> *) a b c. FuncRep2 (t a) b c -> t a -> b
toPropertiesF' !FuncRep2 (t a) b c
frep2 !t a
ys = FuncRep2 (t a) b c -> t a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 (t a) b c
frep2 t a
ys
{-# INLINE toPropertiesF' #-}

toTransPropertiesF' ::
    FuncRep2 (t a) b c ->
    t a ->
    c
toTransPropertiesF' :: forall (t :: * -> *) a b c. FuncRep2 (t a) b c -> t a -> c
toTransPropertiesF' !FuncRep2 (t a) b c
frep2 !t a
ys = FuncRep2 (t a) b c -> t a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 (t a) b c
frep2 t a
ys
{-# INLINE toTransPropertiesF' #-}

-- | The second argument must be not empty for the function to work correctly.
partiR ::
    (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), InsertLeft t2 c) =>
    (c -> Bool) ->
    t2 (Result t a b c) ->
    (t2 (Result t a b c), t2 (Result t a b c))
partiR :: forall (t2 :: * -> *) (t :: * -> *) a b c.
(InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)),
 InsertLeft t2 c) =>
(c -> Bool)
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
partiR c -> Bool
p t2 (Result t a b c)
dataR = (Result t a b c -> Bool)
-> t2 (Result t a b c)
-> (t2 (Result t a b c), t2 (Result t a b c))
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
partitionG (c -> Bool
p (c -> Bool) -> (Result t a b c -> c) -> Result t a b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result t a b c -> c
forall (t :: * -> *) a b c. Result t a b c -> c
transPropertiesF) t2 (Result t a b c)
dataR
{-# INLINE partiR #-}
{-# SPECIALIZE partiR ::
    (Eq a, Eq c) =>
    (c -> Bool) ->
    [Result [] a Double c] ->
    ([Result [] a Double c], [Result [] a Double c])
    #-}

-----------------------------------------------------------

maximumEl2 ::
    (F.Foldable t2, Ord c) =>
    FuncRep2 a b c ->
    t2 a ->
    Result2 a b c
maximumEl2 :: forall (t2 :: * -> *) c a b.
(Foldable t2, Ord c) =>
FuncRep2 a b c -> t2 a -> Result2 a b c
maximumEl2 !FuncRep2 a b c
frep2 t2 a
data0 =
    let !l :: a
l = (a -> a -> Ordering) -> t2 a -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (\a
x a
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FuncRep2 a b c -> a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 a b c
frep2 a
x) (FuncRep2 a b c -> a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 a b c
frep2 a
y)) t2 a
data0
        !m :: b
m = FuncRep2 a b c -> a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 a b c
frep2 a
l
        !tm :: c
tm = FuncRep2 a b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 a b c
frep2 b
m
     in R2{line2 :: a
line2 = a
l, propertiesF2 :: b
propertiesF2 = b
m, transPropertiesF2 :: c
transPropertiesF2 = c
tm}
{-# INLINE maximumEl2 #-}
{-# SPECIALIZE maximumEl2 ::
    (Ord c) => FuncRep2 a Double c -> [a] -> Result2 a Double c
    #-}

-- | Is intended to be used with the structures with at least two elements, though it is not checked.
minMaximumEls2 ::
    (InsertLeft t2 a, Monoid (t2 a), Ord a, Ord c) =>
    FuncRep2 a b c ->
    t2 a ->
    (Result2 a b c, Result2 a b c)
minMaximumEls2 :: forall (t2 :: * -> *) a c b.
(InsertLeft t2 a, Monoid (t2 a), Ord a, Ord c) =>
FuncRep2 a b c -> t2 a -> (Result2 a b c, Result2 a b c)
minMaximumEls2 !FuncRep2 a b c
frep2 t2 a
data0 =
    let (!a
ln, !a
lx) =
            Maybe (a, a) -> (a, a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (a, a) -> (a, a))
-> (t2 a -> Maybe (a, a)) -> t2 a -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> t2 a -> Maybe (a, a)
forall a (t :: * -> *).
(Ord a, Foldable t) =>
(a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By (\a
x a
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FuncRep2 a b c -> a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 a b c
frep2 a
x) (FuncRep2 a b c -> a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 a b c
frep2 a
y)) (t2 a -> (a, a)) -> t2 a -> (a, a)
forall a b. (a -> b) -> a -> b
$ t2 a
data0
        !mn :: b
mn = FuncRep2 a b c -> a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 a b c
frep2 a
ln
        !mx :: b
mx = FuncRep2 a b c -> a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 a b c
frep2 a
lx
        !tmn :: c
tmn = FuncRep2 a b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 a b c
frep2 b
mn
        !tmx :: c
tmx = FuncRep2 a b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 a b c
frep2 b
mx
     in ( R2{line2 :: a
line2 = a
ln, propertiesF2 :: b
propertiesF2 = b
mn, transPropertiesF2 :: c
transPropertiesF2 = c
tmn}
        , R2{line2 :: a
line2 = a
lx, propertiesF2 :: b
propertiesF2 = b
mx, transPropertiesF2 :: c
transPropertiesF2 = c
tmx}
        )
{-# INLINE minMaximumEls2 #-}
{-# SPECIALIZE minMaximumEls2 ::
    (Ord a, Ord c) =>
    FuncRep2 a Double c ->
    [a] ->
    (Result2 a Double c, Result2 a Double c)
    #-}

maximumElR2 ::
    (F.Foldable t2, Ord c) =>
    t2 (Result2 a b c) ->
    Result2 a b c
maximumElR2 :: forall (t2 :: * -> *) c a b.
(Foldable t2, Ord c) =>
t2 (Result2 a b c) -> Result2 a b c
maximumElR2 = (Result2 a b c -> Result2 a b c -> Ordering)
-> t2 (Result2 a b c) -> Result2 a b c
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.maximumBy (\Result2 a b c
x Result2 a b c
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Result2 a b c -> c
forall a b c. Result2 a b c -> c
transPropertiesF2 Result2 a b c
x) (Result2 a b c -> c
forall a b c. Result2 a b c -> c
transPropertiesF2 Result2 a b c
y))
{-# INLINE maximumElR2 #-}
{-# SPECIALIZE maximumElR2 ::
    (Ord c) => [Result2 a Double c] -> Result2 a Double c
    #-}

-- | Is intended to be used with the structures with at least two elements, though it is not checked.
minMaximumElRs2 ::
    ( InsertLeft t2 (Result2 a b c)
    , Monoid (t2 (Result2 a b c))
    , Ord a
    , Ord b
    , Ord c
    ) =>
    t2 (Result2 a b c) ->
    (Result2 a b c, Result2 a b c)
minMaximumElRs2 :: forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)), Ord a,
 Ord b, Ord c) =>
t2 (Result2 a b c) -> (Result2 a b c, Result2 a b c)
minMaximumElRs2 =
    Maybe (Result2 a b c, Result2 a b c)
-> (Result2 a b c, Result2 a b c)
forall a. HasCallStack => Maybe a -> a
fromJust
        (Maybe (Result2 a b c, Result2 a b c)
 -> (Result2 a b c, Result2 a b c))
-> (t2 (Result2 a b c) -> Maybe (Result2 a b c, Result2 a b c))
-> t2 (Result2 a b c)
-> (Result2 a b c, Result2 a b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result2 a b c -> Result2 a b c -> Ordering)
-> t2 (Result2 a b c) -> Maybe (Result2 a b c, Result2 a b c)
forall a (t :: * -> *).
(Ord a, Foldable t) =>
(a -> a -> Ordering) -> t a -> Maybe (a, a)
minMax11By (\Result2 a b c
x Result2 a b c
y -> c -> c -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Result2 a b c -> c
forall a b c. Result2 a b c -> c
transPropertiesF2 Result2 a b c
x) (Result2 a b c -> c
forall a b c. Result2 a b c -> c
transPropertiesF2 Result2 a b c
y))
{-# INLINE minMaximumElRs2 #-}
{-# SPECIALIZE minMaximumElRs2 ::
    (Ord a, Ord c) =>
    [Result2 a Double c] ->
    (Result2 a Double c, Result2 a Double c)
    #-}

-----------------------------------------------------------------------------------

-- | The second argument must be not empty for the function to work correctly.
innerPartitioning2 ::
    (InsertLeft t2 a, Monoid (t2 a), InsertLeft t2 c, Monoid (t2 c), Ord c) =>
    FuncRep2 a b c ->
    t2 a ->
    (t2 a, t2 a)
innerPartitioning2 :: forall (t2 :: * -> *) a c b.
(InsertLeft t2 a, Monoid (t2 a), InsertLeft t2 c, Monoid (t2 c),
 Ord c) =>
FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
innerPartitioning2 !FuncRep2 a b c
frep2 t2 a
data0 =
    let !l :: c
l = t2 c -> c
forall a. Ord a => t2 a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.maximum (t2 c -> c) -> (t2 a -> t2 c) -> t2 a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> c) -> t2 a -> t2 c
forall (t :: * -> *) b a.
(InsertLeft t b, Monoid (t b)) =>
(a -> b) -> t a -> t b
mapG (FuncRep2 a b c -> a -> c
forall a b c. FuncRep2 a b c -> a -> c
toTransPropertiesF'2 FuncRep2 a b c
frep2) (t2 a -> c) -> t2 a -> c
forall a b. (a -> b) -> a -> b
$ t2 a
data0
     in (a -> Bool) -> t2 a -> (t2 a, t2 a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
partitionG ((c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
l) (c -> Bool) -> (a -> c) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 a b c -> a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 a b c
frep2) t2 a
data0
{-# INLINE innerPartitioning2 #-}
{-# SPECIALIZE innerPartitioning2 ::
    (Eq a, Ord c) => FuncRep2 a Double c -> [a] -> ([a], [a])
    #-}

-- | The first argument must be not empty for the function to work correctly.
innerPartitioningR2 ::
    ( InsertLeft t2 (Result2 a b c)
    , Monoid (t2 (Result2 a b c))
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Ord c
    ) =>
    t2 (Result2 a b c) ->
    (t2 (Result2 a b c), t2 (Result2 a b c))
innerPartitioningR2 :: forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
innerPartitioningR2 t2 (Result2 a b c)
dataR =
    let !l :: c
l = t2 c -> c
forall a. Ord a => t2 a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
F.maximum (t2 c -> c)
-> (t2 (Result2 a b c) -> t2 c) -> t2 (Result2 a b c) -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result2 a b c -> c) -> t2 (Result2 a b c) -> t2 c
forall (t :: * -> *) b a.
(InsertLeft t b, Monoid (t b)) =>
(a -> b) -> t a -> t b
mapG Result2 a b c -> c
forall a b c. Result2 a b c -> c
transPropertiesF2 (t2 (Result2 a b c) -> c) -> t2 (Result2 a b c) -> c
forall a b. (a -> b) -> a -> b
$ t2 (Result2 a b c)
dataR
     in (Result2 a b c -> Bool)
-> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
partitionG ((c -> c -> Bool
forall a. Eq a => a -> a -> Bool
== c
l) (c -> Bool) -> (Result2 a b c -> c) -> Result2 a b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 a b c -> c
forall a b c. Result2 a b c -> c
transPropertiesF2) t2 (Result2 a b c)
dataR
{-# INLINE innerPartitioningR2 #-}
{-# SPECIALIZE innerPartitioningR2 ::
    (Eq a, Ord c) =>
    [Result2 a Double c] ->
    ([Result2 a Double c], [Result2 a Double c])
    #-}

maximumGroupsClassification2 ::
    ( InsertLeft t2 a
    , Monoid (t2 a)
    , Ord c
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Integral d
    ) =>
    d ->
    FuncRep2 a b c ->
    (t2 a, t2 a) ->
    (t2 a, t2 a)
maximumGroupsClassification2 :: forall (t2 :: * -> *) a c d b.
(InsertLeft t2 a, Monoid (t2 a), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d -> FuncRep2 a b c -> (t2 a, t2 a) -> (t2 a, t2 a)
maximumGroupsClassification2 !d
nGroups !FuncRep2 a b c
frep2 (t2 a
dataT, t2 a
dataF)
    | t2 a -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 a
dataF = (t2 a
dataT, t2 a
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = (t2 a
dataT, t2 a
dataF)
    | Bool
otherwise =
        d -> FuncRep2 a b c -> (t2 a, t2 a) -> (t2 a, t2 a)
forall (t2 :: * -> *) a c d b.
(InsertLeft t2 a, Monoid (t2 a), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d -> FuncRep2 a b c -> (t2 a, t2 a) -> (t2 a, t2 a)
maximumGroupsClassification2 (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) FuncRep2 a b c
frep2 (t2 a
dataT t2 a -> t2 a -> t2 a
forall a. Monoid a => a -> a -> a
`mappend` t2 a
partT, t2 a
partF)
  where
    (!t2 a
partT, !t2 a
partF) = FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
forall (t2 :: * -> *) a c b.
(InsertLeft t2 a, Monoid (t2 a), InsertLeft t2 c, Monoid (t2 c),
 Ord c) =>
FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
innerPartitioning2 FuncRep2 a b c
frep2 t2 a
dataF
{-# NOINLINE maximumGroupsClassification2 #-}

maximumGroupsClassification12 ::
    ( InsertLeft t2 a
    , Monoid (t2 a)
    , Ord c
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Integral d
    ) =>
    d ->
    FuncRep2 a b c ->
    t2 a ->
    (t2 a, t2 a)
maximumGroupsClassification12 :: forall (t2 :: * -> *) a c d b.
(InsertLeft t2 a, Monoid (t2 a), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d -> FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
maximumGroupsClassification12 !d
nGroups !FuncRep2 a b c
frep2 t2 a
data0
    | t2 a -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 a
data0 = (t2 a
forall a. Monoid a => a
mempty, t2 a
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
forall (t2 :: * -> *) a c b.
(InsertLeft t2 a, Monoid (t2 a), InsertLeft t2 c, Monoid (t2 c),
 Ord c) =>
FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
innerPartitioning2 FuncRep2 a b c
frep2 t2 a
data0
    | Bool
otherwise =
        d -> FuncRep2 a b c -> (t2 a, t2 a) -> (t2 a, t2 a)
forall (t2 :: * -> *) a c d b.
(InsertLeft t2 a, Monoid (t2 a), Ord c, InsertLeft t2 c,
 Monoid (t2 c), Integral d) =>
d -> FuncRep2 a b c -> (t2 a, t2 a) -> (t2 a, t2 a)
maximumGroupsClassification2 (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) FuncRep2 a b c
frep2 ((t2 a, t2 a) -> (t2 a, t2 a))
-> (t2 a -> (t2 a, t2 a)) -> t2 a -> (t2 a, t2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
forall (t2 :: * -> *) a c b.
(InsertLeft t2 a, Monoid (t2 a), InsertLeft t2 c, Monoid (t2 c),
 Ord c) =>
FuncRep2 a b c -> t2 a -> (t2 a, t2 a)
innerPartitioning2 FuncRep2 a b c
frep2 (t2 a -> (t2 a, t2 a)) -> t2 a -> (t2 a, t2 a)
forall a b. (a -> b) -> a -> b
$
            t2 a
data0
{-# NOINLINE maximumGroupsClassification12 #-}

maximumGroupsClassificationR2_2 ::
    ( Eq a
    , Eq b
    , InsertLeft t2 (Result2 a b c)
    , Monoid (t2 (Result2 a b c))
    , Ord c
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Integral d
    ) =>
    d ->
    (t2 (Result2 a b c), t2 (Result2 a b c)) ->
    (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR2_2 :: forall a b (t2 :: * -> *) c d.
(Eq a, Eq b, InsertLeft t2 (Result2 a b c),
 Monoid (t2 (Result2 a b c)), Ord c, InsertLeft t2 c, Monoid (t2 c),
 Integral d) =>
d
-> (t2 (Result2 a b c), t2 (Result2 a b c))
-> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR2_2 !d
nGroups (t2 (Result2 a b c)
dataT, t2 (Result2 a b c)
dataF)
    | t2 (Result2 a b c) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result2 a b c)
dataF = (t2 (Result2 a b c)
dataT, t2 (Result2 a b c)
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = (t2 (Result2 a b c)
dataT, t2 (Result2 a b c)
dataF)
    | Bool
otherwise =
        d
-> (t2 (Result2 a b c), t2 (Result2 a b c))
-> (t2 (Result2 a b c), t2 (Result2 a b c))
forall a b (t2 :: * -> *) c d.
(Eq a, Eq b, InsertLeft t2 (Result2 a b c),
 Monoid (t2 (Result2 a b c)), Ord c, InsertLeft t2 c, Monoid (t2 c),
 Integral d) =>
d
-> (t2 (Result2 a b c), t2 (Result2 a b c))
-> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR2_2 (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) (t2 (Result2 a b c)
dataT t2 (Result2 a b c) -> t2 (Result2 a b c) -> t2 (Result2 a b c)
forall a. Monoid a => a -> a -> a
`mappend` t2 (Result2 a b c)
partT, t2 (Result2 a b c)
partF)
  where
    (!t2 (Result2 a b c)
partT, !t2 (Result2 a b c)
partF) = t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
innerPartitioningR2 t2 (Result2 a b c)
dataF
{-# NOINLINE maximumGroupsClassificationR2_2 #-}

maximumGroupsClassificationR_2 ::
    ( Eq a
    , Eq b
    , InsertLeft t2 (Result2 a b c)
    , Monoid (t2 (Result2 a b c))
    , InsertLeft t2 c
    , Monoid (t2 c)
    , Ord c
    , Integral d
    ) =>
    d ->
    t2 (Result2 a b c) ->
    (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR_2 :: forall a b (t2 :: * -> *) c d.
(Eq a, Eq b, InsertLeft t2 (Result2 a b c),
 Monoid (t2 (Result2 a b c)), InsertLeft t2 c, Monoid (t2 c), Ord c,
 Integral d) =>
d -> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR_2 !d
nGroups t2 (Result2 a b c)
dataR
    | t2 (Result2 a b c) -> Bool
forall a. t2 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t2 (Result2 a b c)
dataR = (t2 (Result2 a b c)
forall a. Monoid a => a
mempty, t2 (Result2 a b c)
forall a. Monoid a => a
mempty)
    | d
nGroups d -> d -> Bool
forall a. Ord a => a -> a -> Bool
<= d
0 = t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
innerPartitioningR2 t2 (Result2 a b c)
dataR
    | Bool
otherwise =
        d
-> (t2 (Result2 a b c), t2 (Result2 a b c))
-> (t2 (Result2 a b c), t2 (Result2 a b c))
forall a b (t2 :: * -> *) c d.
(Eq a, Eq b, InsertLeft t2 (Result2 a b c),
 Monoid (t2 (Result2 a b c)), Ord c, InsertLeft t2 c, Monoid (t2 c),
 Integral d) =>
d
-> (t2 (Result2 a b c), t2 (Result2 a b c))
-> (t2 (Result2 a b c), t2 (Result2 a b c))
maximumGroupsClassificationR2_2 (d
nGroups d -> d -> d
forall a. Num a => a -> a -> a
- d
1) ((t2 (Result2 a b c), t2 (Result2 a b c))
 -> (t2 (Result2 a b c), t2 (Result2 a b c)))
-> (t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c)))
-> t2 (Result2 a b c)
-> (t2 (Result2 a b c), t2 (Result2 a b c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c, Monoid (t2 c), Ord c) =>
t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
innerPartitioningR2 (t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c)))
-> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
forall a b. (a -> b) -> a -> b
$ t2 (Result2 a b c)
dataR
{-# NOINLINE maximumGroupsClassificationR_2 #-}

toResultR2 ::
    FuncRep2 a b c ->
    a ->
    Result2 a b c
toResultR2 :: forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 !FuncRep2 a b c
frep2 !a
y = R2{line2 :: a
line2 = a
y, propertiesF2 :: b
propertiesF2 = b
m, transPropertiesF2 :: c
transPropertiesF2 = c
tm}
  where
    !m :: b
m = FuncRep2 a b c -> a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 a b c
frep2 a
y
    !tm :: c
tm = FuncRep2 a b c -> b -> c
forall a b c. FuncRep2 a b c -> b -> c
getBC FuncRep2 a b c
frep2 b
m
{-# INLINE toResultR2 #-}

toPropertiesF'2 ::
    FuncRep2 a b c ->
    a ->
    b
toPropertiesF'2 :: forall a b c. FuncRep2 a b c -> a -> b
toPropertiesF'2 !FuncRep2 a b c
frep2 !a
y = FuncRep2 a b c -> a -> b
forall a b c. FuncRep2 a b c -> a -> b
getAB FuncRep2 a b c
frep2 a
y
{-# INLINE toPropertiesF'2 #-}

toTransPropertiesF'2 ::
    FuncRep2 a b c ->
    a ->
    c
toTransPropertiesF'2 :: forall a b c. FuncRep2 a b c -> a -> c
toTransPropertiesF'2 !FuncRep2 a b c
frep2 !a
y = FuncRep2 a b c -> a -> c
forall a b c. FuncRep2 a b c -> a -> c
getAC FuncRep2 a b c
frep2 a
y
{-# INLINE toTransPropertiesF'2 #-}

-- | The second argument must be not empty for the function to work correctly.
partiR2 ::
    (InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)), InsertLeft t2 c) =>
    (c -> Bool) ->
    t2 (Result2 a b c) ->
    (t2 (Result2 a b c), t2 (Result2 a b c))
partiR2 :: forall (t2 :: * -> *) a b c.
(InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)),
 InsertLeft t2 c) =>
(c -> Bool)
-> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
partiR2 c -> Bool
p t2 (Result2 a b c)
dataR = (Result2 a b c -> Bool)
-> t2 (Result2 a b c) -> (t2 (Result2 a b c), t2 (Result2 a b c))
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
partitionG (c -> Bool
p (c -> Bool) -> (Result2 a b c -> c) -> Result2 a b c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result2 a b c -> c
forall a b c. Result2 a b c -> c
transPropertiesF2) t2 (Result2 a b c)
dataR
{-# INLINE partiR2 #-}
{-# SPECIALIZE partiR2 ::
    (Eq a, Eq c) =>
    (c -> Bool) ->
    [Result2 a Double c] ->
    ([Result2 a Double c], [Result2 a Double c])
    #-}