-- |
-- Module      :  Languages.UniquenessPeriods.Vector.General.Simplified
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Simplified versions of the respective functions from the Languages.UniquenessPeriods.Vector.General.DebugG
-- module but they can be used basically once but not applied recursively to the same data (without additional processments).
--
{-# LANGUAGE BangPatterns, FlexibleContexts #-}

module Languages.UniquenessPeriods.Vector.General.Simplified (
  -- * Pure functions
  -- ** Self-recursive pure functions and connected with them ones
  maximumElBy
   -- ** Pure functions
  , maximumElByAll
  , maximumElGBy
  , maximumElByVec
  , maximumElByVecAll
) where

import Data.Foldable
import Data.Monoid
import Data.SubG
import qualified Data.Vector as VB
import Languages.UniquenessPeriods.Vector.AuxiliaryG
import Languages.UniquenessPeriods.Vector.StrictVG
import Languages.UniquenessPeriods.Vector.DataG
import  Languages.UniquenessPeriods.Vector.General.DebugG (uniquenessVariantsGN, equalSnDs)

-- | The function evaluates the 'VB.Vector' of 'UniquenessG1T2' @t@ @t2@ @a@ @b@ elements (related with the third argument) to retrieve the possibly maximum element
-- in it with respect to the order and significance (principality)  of the \"properties\" (represented as the functions @f :: [b] -> b@) being evaluated.
-- The most significant and principal is the \"property\", which index in the 'VB.Vector' of them is the 'Int' argument (so it is the first one) of the
-- function minus 1, then less significant is the next to the left \"property\" and so on.
-- The predefined library \"properties\" or related to them functions can be found in the package @phonetic-languages-properties@.
maximumElBy ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b) => Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> VB.Vector (UniquenessG1T2 t t2 a b) -- ^ The data to be analyzed.
  -> UniquenessG1T2 t t2 a b -- ^ The maximum element in respect with the given parameters.
maximumElBy :: Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
maximumElBy Int
k Vector (t2 b -> b)
vN Vector (UniquenessG1T2 t t2 a b)
v
 | Vector (UniquenessG1T2 t t2 a b) -> Bool
forall a. Vector a -> Bool
VB.null Vector (UniquenessG1T2 t t2 a b)
v = [Char] -> UniquenessG1T2 t t2 a b
forall a. HasCallStack => [Char] -> a
error [Char]
"Languages.UniquenessPeriods.Vector.General.Simplified.maximumElBy: undefined for the empty second element in the tuple. "
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = [Char] -> UniquenessG1T2 t t2 a b
forall a. HasCallStack => [Char] -> a
error [Char]
"Languages.UniquenessPeriods.Vector.General.Simplified.maximumElBy: undefined for that amount of norms. "
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT =
   let !maxK :: UniquenessG1T2 t t2 a b
maxK = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Vector (UniquenessG1T2 t t2 a b)
v
       vK :: Vector (UniquenessG1T2 t t2 a b)
vK = (UniquenessG1T2 t t2 a b -> Bool)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\(t2 b
_,Vector b
vN2,t a
_) -> Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN2 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex (UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
maxK) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Vector (UniquenessG1T2 t t2 a b)
v in
         Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
maximumElBy (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int -> Vector (t2 b -> b) -> Vector (t2 b -> b)
forall a. Int -> Int -> Vector a -> Vector a
VB.unsafeSlice Int
0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector (t2 b -> b)
vN) Vector (UniquenessG1T2 t t2 a b)
vK
 | Bool
otherwise = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 Int
0) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 Int
0)) Vector (UniquenessG1T2 t t2 a b)
v
{-# NOINLINE maximumElBy #-}

-- | Variant of the 'maximumElBy' function where all the given \"properties\" are used.
-- The predefined library \"properties\" or related to them functions can be found in the package @uniqueness-periods-vector-properties@.
maximumElByAll ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> VB.Vector (UniquenessG1T2 t t2 a b) -- ^ The data to be analyzed.
  -> UniquenessG1T2 t t2 a b -- ^ The maximum element according to the given \"properties\".
maximumElByAll :: Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
maximumElByAll Vector (t2 b -> b)
vN = Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
maximumElBy (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Vector (t2 b -> b)
vN
{-# INLINE maximumElByAll #-}

-- | The function evaluates
-- the generated 'VB.Vector' of 'UniquenessG1T2' @t@ @t2@ @a@ @b@ elements to retrieve the possibly maximum element in it with respect to the order and significance (principality)
-- of the \"properties\" being evaluated. The most significant and principal is the \"property\", which index in the 'VB.Vector' of them is the 'Int' argument of the function
-- minus 1, then less significant is the next to the left \"property\" and so on.
maximumElGBy ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, UGG1 t (PreApp t a) a, Ord b, Show a, Show b) => t a -- ^ The \"whitespace symbols\" that delimit the subs in the 'Foldable' structure to be processed.
  -> a -- ^ The first \"whitespace symbol\" from the left.
  -> PreApp t a -- ^ A parameter to specify the lists to be prepended and postpended to the given data to be processed before actual processment.
  -> (t a -> VB.Vector a) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of @a@ so that the function can process further the permutations
  -> ((t (t a)) -> VB.Vector (VB.Vector a)) -- ^ The function that is used internally to convert to the boxed 'VB.Vector' of 'VB.Vector' of @a@ so that the function can process further
  -> (VB.Vector a -> t a) -- ^ The function that is used internally to convert from the boxed 'VB.Vector' of @a@ so that the function can process further
  -> VB.Vector (VB.Vector Int) -- ^ The list of permutations of 'Int' indices starting from 0 and up to n (n is probably less than 7).
  -> Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> FuncRep (t a) (VB.Vector c) (t2 b) -- ^ It includes the defined earlier variant with data constructor 'D2', but additionally allows to use just single argument with data constructor 'U1'
  -> t a -- ^ The data to be processed.
  -> UniquenessG1T2 t t2 a b
maximumElGBy :: t a
-> a
-> PreApp t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Int
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> UniquenessG1T2 t t2 a b
maximumElGBy t a
whspss a
hd PreApp t a
rr t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms Int
k Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep t a
v
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = [Char] -> UniquenessG1T2 t t2 a b
forall a. HasCallStack => [Char] -> a
error [Char]
"Languages.UniquenessPeriods.Vector.General.DebugG.maximumElGBy: undefined for that amount of norms. "
 | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
k Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT =
   let vM :: Vector (UniquenessG1T2 t t2 a b)
vM = t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) b (t2 :: * -> *) c.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Ord b, Foldable t2) =>
t a
-> t a
-> a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t (t a)
-> Vector (t2 b, Vector b, t a)
uniquenessVariants2GNPB (PreApp t a -> t a
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get1m PreApp t a
rr) (PreApp t a -> t a
forall (t :: * -> *) a b. UGG1 t a b => a -> t b
get2m PreApp t a
rr) a
hd t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep (t a -> t a -> t (t a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG t a
whspss t a
v)
       maxK :: UniquenessG1T2 t t2 a b
maxK = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Vector (UniquenessG1T2 t t2 a b)
vM
       vK :: Vector (UniquenessG1T2 t t2 a b)
vK = (UniquenessG1T2 t t2 a b -> Bool)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (\(t2 b
_,Vector b
vN2,t a
_) -> Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN2 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex (UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
maxK) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Vector (UniquenessG1T2 t t2 a b)
vM in
         Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
maximumElBy (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int -> Vector (t2 b -> b) -> Vector (t2 b -> b)
forall a. Int -> Int -> Vector a -> Vector a
VB.unsafeSlice Int
0 (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector (t2 b -> b)
vN) Vector (UniquenessG1T2 t t2 a b)
vK
 | Bool
otherwise = (UniquenessG1T2 t t2 a b -> UniquenessG1T2 t t2 a b -> Ordering)
-> Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b
forall a. (a -> a -> Ordering) -> Vector a -> a
VB.maximumBy (\(t2 b
_,Vector b
vN0,t a
_) (t2 b
_,Vector b
vN1,t a
_) -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN0 Int
0) (Vector b -> Int -> b
forall a. Vector a -> Int -> a
VB.unsafeIndex Vector b
vN1 Int
0)) (Vector (UniquenessG1T2 t t2 a b) -> UniquenessG1T2 t t2 a b)
-> (t a -> Vector (UniquenessG1T2 t t2 a b))
-> t a
-> UniquenessG1T2 t t2 a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> PreApp t a
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) (t2 :: * -> *) b c.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
a
-> t a
-> (t a -> Vector a)
-> (t (t a) -> Vector (Vector a))
-> (Vector a -> t a)
-> Vector (Vector Int)
-> PreApp t a
-> Vector (t2 b -> b)
-> FuncRep (t a) (Vector c) (t2 b)
-> t a
-> Vector (UniquenessG1T2 t t2 a b)
uniquenessVariantsGN a
hd t a
whspss t a -> Vector a
f1 t (t a) -> Vector (Vector a)
f2 Vector a -> t a
f3 Vector (Vector Int)
perms PreApp t a
rr Vector (t2 b -> b)
vN FuncRep (t a) (Vector c) (t2 b)
frep (t a -> UniquenessG1T2 t t2 a b) -> t a -> UniquenessG1T2 t t2 a b
forall a b. (a -> b) -> a -> b
$ t a
v

-- | Filters the last argument.
-- Finds out the group of maximum elements with respect of the @k@ \"properties\" (the most significant of which is the rightest one,
-- then to the left less significant etc.) of the second argument. The number of \"properties\" is given as the first argument. Then the function
-- rearranges the last argument by moving the elements equal by the second element in the triple to the maximum element to the first element in
-- the resulting tuple. The elements that are not equal to the maximum one are moved to the second element in the tuple.
-- If the second element of the tuple is empty, then just returns the last argument.
--
-- The last by significance \"property\" is the first element in the 'VB.Vector' of \"properties\" (@[b] -> b@) (so that the order of significance is
-- from the right to the left in the respective 'VB.Vector'). If the length of the vector of properties is greater than the first argument then
-- the last element(s) in the vector do not participate in producing the result (are ignored).
maximumElByVec ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => Int -- ^ The quantity of the represented as functions \"properties\" to be applied from the second argument. The order is from the right to the left.
  -> VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> VB.Vector (UniquenessG1T2 t t2 a b) -- ^ The data to be analyzed.
  -> VB.Vector (UniquenessG1T2 t t2 a b)
maximumElByVec :: Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
maximumElByVec Int
k Vector (t2 b -> b)
vN Vector (UniquenessG1T2 t t2 a b)
v
 | Vector (UniquenessG1T2 t t2 a b) -> Bool
forall a. Vector a -> Bool
VB.null Vector (UniquenessG1T2 t t2 a b)
v = Vector (UniquenessG1T2 t t2 a b)
forall a. Vector a
VB.empty
 | Bool
otherwise = let !uniq :: UniquenessG1T2 t t2 a b
uniq = Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b) =>
Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
maximumElBy Int
k Vector (t2 b -> b)
vN Vector (UniquenessG1T2 t t2 a b)
v in let !snD :: Vector b
snD = UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3 UniquenessG1T2 t t2 a b
uniq in (UniquenessG1T2 t t2 a b -> Bool)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
forall a. (a -> Bool) -> Vector a -> Vector a
VB.filter (Vector b -> Vector b -> Bool
forall b. Ord b => Vector b -> Vector b -> Bool
equalSnDs Vector b
snD (Vector b -> Bool)
-> (UniquenessG1T2 t t2 a b -> Vector b)
-> UniquenessG1T2 t t2 a b
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UniquenessG1T2 t t2 a b -> Vector b
forall a b c. (a, b, c) -> b
secondFrom3) Vector (UniquenessG1T2 t t2 a b)
v
{-# NOINLINE maximumElByVec #-}

-- | A variant of the 'maximumElByVec' where all the given \"properties\" are used.
maximumElByVecAll ::
  (Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Foldable t2, Ord b, Show a, Show b) => VB.Vector (t2 b -> b) -- ^ 'VB.Vector' of the represented as functions \"properties\" to be applied consequently.
  -> VB.Vector (UniquenessG1T2 t t2 a b) -- ^ The data to be analyzed.
  -> VB.Vector (UniquenessG1T2 t t2 a b)
maximumElByVecAll :: Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
maximumElByVecAll Vector (t2 b -> b)
vN = Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
forall a (t :: * -> *) (t2 :: * -> *) b.
(Eq a, Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a)),
 Foldable t2, Ord b, Show a, Show b) =>
Int
-> Vector (t2 b -> b)
-> Vector (UniquenessG1T2 t t2 a b)
-> Vector (UniquenessG1T2 t t2 a b)
maximumElByVec (Vector (t2 b -> b) -> Int
forall a. Vector a -> Int
VB.length Vector (t2 b -> b)
vN) Vector (t2 b -> b)
vN
{-# INLINE maximumElByVecAll #-}