-- |
-- Module      :  Languages.UniquenessPeriods.Vector.FuncRepRelatedG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions to choose from the 'FuncRep' variants.

module Languages.UniquenessPeriods.Vector.FuncRepRelatedG where

import CaseBi (getBFst')
import qualified Data.Vector as VB
import Languages.UniquenessPeriods.Vector.DataG
import String.Languages.UniquenessPeriods.VectorG
import Languages.UniquenessPeriods.Vector.PropertiesFuncRepG

-- | Allows to choose the variant of the computations in case of usual processment.
chooseMax :: String -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMax :: String -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMax =
  (FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float],
 Vector
   (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]))
-> String
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
getBFst' (FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2InvF, [(String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])]
-> Vector
     (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])
forall a. [a] -> Vector a
VB.fromList [(String
"02y",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity232F),(String
"0y",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity23F),(String
"y",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothF),(String
"y0",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procDiverse2F),(String
"y2",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2F)])

-- | Allows to choose the variant of the computations in case of minimum lookup. Uses @-neg@ variants.
chooseMin :: String -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMin :: String -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMin = (FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float],
 Vector
   (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]))
-> String
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
getBFst' (FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2InvFneg, [(String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])]
-> Vector
     (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])
forall a. [a] -> Vector a
VB.fromList [(String
"02y",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity232Fneg),(String
"0y",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity23Fneg),(String
"y",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothFneg),
   (String
"y0",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procDiverse2Fneg),(String
"y2",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2Fneg)])

-- | Allows to choose precision in the Numeric.showFFloat function being given a choice parameter.
precChoice :: String -> Maybe Int
precChoice :: String -> Maybe Int
precChoice = (Maybe Int, Vector (String, Maybe Int)) -> String -> Maybe Int
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
getBFst' (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4, [(String, Maybe Int)] -> Vector (String, Maybe Int)
forall a. [a] -> Vector a
VB.fromList [(String
"02y",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"0y",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"y",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"y0",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"y2",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)])