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

{-# LANGUAGE BangPatterns #-}

module Languages.UniquenessPeriods.Vector.FuncRepRelatedG where

import Data.Maybe (isNothing,fromMaybe)
import Text.Read
import CaseBi (getBFst')
import qualified Data.Vector as VB
import Languages.UniquenessPeriods.Vector.DataG
import String.Languages.UniquenessPeriods.VectorG
import Languages.UniquenessPeriods.Vector.PropertiesFuncRepG
import Languages.UniquenessPeriods.Vector.PropertiesSyllablesG
import Languages.UniquenessPeriods.Vector.PropertiesG

-- | Allows to choose the variant of the computations in case of usual processment.
chooseMax :: Coeffs2 -> String -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMax :: Coeffs2
-> String
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMax Coeffs2
coeffs String
choice
 | Coeffs2 -> Bool
forall a. CoeffTwo a -> Bool
isPair Coeffs2
coeffs =
     let !k2 :: Float
k2 = Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
1.0 (Maybe Float -> Float)
-> (Coeffs2 -> Maybe Float) -> Coeffs2 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coeffs2 -> Maybe Float
forall a. CoeffTwo a -> Maybe a
fstCF (Coeffs2 -> Float) -> Coeffs2 -> Float
forall a b. (a -> b) -> a -> b
$ Coeffs2
coeffs
         !k3 :: Float
k3 = Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
1.0 (Maybe Float -> Float)
-> (Coeffs2 -> Maybe Float) -> Coeffs2 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coeffs2 -> Maybe Float
forall a. CoeffTwo a -> Maybe a
sndCF (Coeffs2 -> Float) -> Coeffs2 -> Float
forall a b. (a -> b) -> a -> b
$ Coeffs2
coeffs in (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' (Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2InvF Coeffs2
coeffs, [(String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])]
-> Vector
     (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])
forall a. [a] -> Vector a
VB.fromList [(String
"02y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity232F String
"02y" Coeffs2
coeffs),
            (String
"0y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity23F String
"0y" Coeffs2
coeffs),(String
"y",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothF Coeffs2
coeffs),(String
"y0",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procDiverse2F),(String
"y2",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2F Coeffs2
coeffs),(String
"yy",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothInvF Coeffs2
coeffs)]) String
choice
 | Bool
otherwise = (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' (Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2InvF Coeffs2
coeffs, [(String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])]
-> Vector
     (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])
forall a. [a] -> Vector a
VB.fromList [(String
"02y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity232F String
"02y" Coeffs2
coeffs),(String
"0y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity23F String
"0y" Coeffs2
coeffs),
     (String
"y",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothF Coeffs2
coeffs),(String
"y0",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procDiverse2F),(String
"y2",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2F Coeffs2
coeffs),(String
"yy",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothInvF Coeffs2
coeffs)]) String
choice

-- | Allows to choose the variant of the computations in case of minimum lookup. Uses @-neg@ variants.
chooseMin :: Coeffs2 -> String -> FuncRep (VB.Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMin :: Coeffs2
-> String
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
chooseMin Coeffs2
coeffs String
choice
 | Coeffs2 -> Bool
forall a. CoeffTwo a -> Bool
isPair Coeffs2
coeffs =
     let !k2 :: Float
k2 = Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
1.0 (Maybe Float -> Float)
-> (Coeffs2 -> Maybe Float) -> Coeffs2 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coeffs2 -> Maybe Float
forall a. CoeffTwo a -> Maybe a
fstCF (Coeffs2 -> Float) -> Coeffs2 -> Float
forall a b. (a -> b) -> a -> b
$ Coeffs2
coeffs
         !k3 :: Float
k3 = Float -> Maybe Float -> Float
forall a. a -> Maybe a -> a
fromMaybe Float
1.0 (Maybe Float -> Float)
-> (Coeffs2 -> Maybe Float) -> Coeffs2 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coeffs2 -> Maybe Float
forall a. CoeffTwo a -> Maybe a
sndCF (Coeffs2 -> Float) -> Coeffs2 -> Float
forall a b. (a -> b) -> a -> b
$ Coeffs2
coeffs in (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' (Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2InvFneg Coeffs2
coeffs, [(String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])]
-> Vector
     (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])
forall a. [a] -> Vector a
VB.fromList [(String
"02y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity232Fneg String
"02y" Coeffs2
coeffs),
            (String
"0y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity23Fneg String
"0y" Coeffs2
coeffs),(String
"y",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothFneg Coeffs2
coeffs),(String
"y0",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procDiverse2Fneg),(String
"y2",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2Fneg Coeffs2
coeffs),
              (String
"yy",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothInvFneg Coeffs2
coeffs)]) String
choice
 | Bool
otherwise = (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' (Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2InvFneg Coeffs2
coeffs, [(String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])]
-> Vector
     (String, FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float])
forall a. [a] -> Vector a
VB.fromList [(String
"02y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity232Fneg String
"02y" Coeffs2
coeffs),(String
"0y",String
-> Coeffs2
-> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procRhythmicity23Fneg String
"0y" Coeffs2
coeffs),
     (String
"y",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothFneg Coeffs2
coeffs),(String
"y0",FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procDiverse2Fneg),(String
"y2",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBoth2Fneg Coeffs2
coeffs),(String
"yy",Coeffs2 -> FuncRep (Vector Char) (UniquenessGeneral2 Char) [Float]
procBothInvFneg Coeffs2
coeffs)]) String
choice

-- | 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)])