-- |
-- Module      :  Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions to choose from the 'FuncRep2' variants for the general phonetic languages approach.

{-# LANGUAGE BangPatterns #-}

module Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2 where

import CaseBi.Arr (getBFstL')
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Array.General.PropertiesFuncRepG2
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Data.Monoid (mappend)
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables

-- | Allows to choose the variant of the computations in case of usual processment. The coefficient 1.3 (anyway, it must
-- be greater than 1.0) )is an empirical and approximate, you can use your own if you like.
chooseMax
  :: (Ord c) => GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. 
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
  -> (Double -> c)
  -> (Double -> String -> ([[[PRS]]] -> [[Double]])) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters.
  -> Coeffs2
  -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
  -- exact one and, therefore, the default one.
  -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one (that is the default one). Since the 0.5.0.0 version
 -- you can use also \"w\" and \"x\"-based lines of properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions. 
  -> FuncRep2 String Double c
chooseMax :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> Coeffs2
-> [[[[PRS]]] -> [[Double]]]
-> String
-> FuncRep2 String Double c
chooseMax = Double
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> Coeffs2
-> [[[[PRS]]] -> [[Double]]]
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> Coeffs2
-> [[[[PRS]]] -> [[Double]]]
-> String
-> FuncRep2 String Double c
chooseMaxG Double
1.3
{-# INLINE chooseMax #-}

-- | Allows to choose the variant of the computations in case of usual processment.
chooseMaxG
  :: (Ord c) => Double -- ^ Must be greater than 1.0 though it is not checked.
  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly. 
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
  -> (Double -> c)
  -> (Double -> String -> ([[[PRS]]] -> [[Double]])) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters.
  -> Coeffs2
  -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
  -- exact one and, therefore, the default one.
  -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one (that is the default one). Since the 0.5.0.0 version
 -- you can use also \"w\" and \"x\"-based lines of properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions. 
  -> FuncRep2 String Double c
chooseMaxG :: Double
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> Coeffs2
-> [[[[PRS]]] -> [[Double]]]
-> String
-> FuncRep2 String Double c
chooseMaxG Double
k GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h Coeffs2
coeffs [[[[PRS]]] -> [[Double]]]
xs String
choice = FuncRep2 String Double c
-> [(String, FuncRep2 String Double c)]
-> String
-> FuncRep2 String Double c
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
3) Coeffs2
coeffs)
 [(String
"02y",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"02y" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
  (String
"02z",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"02z" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
   (String
"03y",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"03y" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
    (String
"03z",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"03z" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
     (String
"04y",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"04y" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
      (String
"04z",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"04z" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
       (String
"0y",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"0y" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
        (String
"0z",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"0z" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w01",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w01" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w02",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w02" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w03",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w03" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w04",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w04" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w11",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w11" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w12",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w12" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w13",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w13" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w14",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w14" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w21",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w21" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w22",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w22" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w23",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w23" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w24",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w24" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w31",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w31" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w32",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w32" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w33",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w33" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"w34",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"w34" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x01",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x01" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x02",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x02" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x03",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x03" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x04",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x04" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x11",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x11" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x12",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x12" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x13",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x13" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x14",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x14" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x21",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x21" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x22",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x22" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x23",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x23" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x24",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x24" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x31",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x31" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x32",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x32" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x33",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x33" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"x34",Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> [[[PRS]]] -> [[Double]])
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> FuncRep2 String Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> [[[PRS]]] -> [[Double]]
h String
"x34" Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs),
         (String
"y",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs),
          (String
"y0",GWritingSystemPRPLX
-> String -> (Double -> c) -> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> String -> (Double -> c) -> FuncRep2 String Double c
procDiverse2F GWritingSystemPRPLX
wrs (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
us String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs) Double -> c
g),
           (String
"y2",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs),
            (String
"y3",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs),
             (String
"y4",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
3) Coeffs2
coeffs),
              (String
"yy",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs),
               (String
"yy2",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs),
                (String
"yy3",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs),
                 (String
"z",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs),
                  (String
"z2",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs),
                   (String
"z3",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs),
                    (String
"z4",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
3) Coeffs2
coeffs),
                     (String
"zz",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs),
                      (String
"zz2",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs),
                       (String
"zz3",GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs),
                        (String
"zz4", GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> ([[[PRS]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([[[[PRS]]] -> [[Double]]]
xs [[[[PRS]]] -> [[Double]]] -> Int -> [[[PRS]]] -> [[Double]]
forall a. [a] -> Int -> a
!! Int
3) Coeffs2
coeffs)] String
choice                        
 
-- | Allows to choose precision in the Numeric.showFDouble function being given a choice parameter.
precChoice
 :: String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one (that is the default one). Since the 0.5.0.0 version
 -- you can use also \"w\" and \"x\"-based lines of properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions. 
 -> Maybe Int
precChoice :: String -> Maybe Int
precChoice = Maybe Int -> [(String, Maybe Int)] -> String -> Maybe Int
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) [(String
"02y",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"02z",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"03y",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"03z",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"04y",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),
  (String
"04z",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
"0z",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),(String
"y3",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0), (String
"y4",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),
    (String
"z",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"z0",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"z2",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0),(String
"z3",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0), (String
"z4",Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)]