-- |
-- Module      :  Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- 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
import GHC.Arr (listArray)
import Phonetic.Languages.Basis
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
import Phonetic.Languages.EmphasisG
import Data.Char (isDigit, toLower)
import Data.Maybe (fromJust)
import Text.Read (readMaybe)
import Data.List (sort)
import Phonetic.Languages.Coeffs

-- | 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 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> (Double -> c)
  -> (Double -> String -> MappingFunctionPL) -- ^ 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
  -> String -- ^ A list of 'Char' to which the functions are sensitive to for diversity.
  -> [MappingFunctionPL] -- ^ A list of either 'PhoPaaW'-based or 'SaaW'-based (and not both ones) different functions that specifies the syllables durations in the PhoPaaW or SaaW mode respectively (the former one has been introduced earlier), analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one in case of 'PhoPaaW'-based ones 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.
  -> String -- ^ The starting 'String' which creates the order for the 'FSLG' representation
  -> FuncRep2 ReadyForConstructionPL Double c
chooseMax :: forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax = forall c.
Ord c =>
Double
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL 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 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> (Double -> c)
  -> (Double -> String -> MappingFunctionPL) -- ^ 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
  -> String -- ^ A list of 'Char' to which the functions are sensitive to for diversity.
  -> [MappingFunctionPL] -- ^ A list of either 'PhoPaaW'-based or 'SaaW'-based (and not both ones) different functions that specifies the syllables durations in the PhoPaaW or SaaW mode respectively (the former one has been introduced earlier), analogues of the
  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one in case of 'PhoPaaW'-based ones 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.
 -- @ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function
 -- with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then
 -- to rewrite it.
 -- Besides there are new lines of the arguments for the 'String' argument that can begin with \"c\", \"s\", \"t\",
 -- \"u\", \"v\", or some other letters. For more information, please, refer to the 'Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2.rhythmicity'.
  -> String -- ^ The starting 'String' which creates the order for the 'FSLG' representation
  -> FuncRep2 ReadyForConstructionPL Double c
chooseMaxG :: forall c.
Ord c =>
Double
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMaxG Double
k GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g Double -> String -> MappingFunctionPL
h Coeffs2
coeffs String
sels [MappingFunctionPL]
xs String
choice String
bbs
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'G') String
choice = forall c.
Ord c =>
Double
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMaxG Double
k GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g Double -> String -> MappingFunctionPL
h Coeffs2
coeffs String
sels [MappingFunctionPL]
xs (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'G') String
choice) String
bbs
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
==Char
'a') String
choice = forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procRhythmicity23F Double
k Double -> c
g (\Double
_ String
_ -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit String
choice) then ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
0) else ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! ((\Int
z -> if  Int
z forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
0 else Int
z) forall a b. (a -> b) -> a -> b
$ 
       forall a. HasCallStack => Maybe a -> a
fromJust (forall a. Read a => String -> Maybe a
readMaybe [forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit forall a b. (a -> b) -> a -> b
$ String
choice]::Maybe Int) forall a. Num a => a -> a -> a
- Int
1))) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'a') String
choice) Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs String
bbs
 | forall a. Int -> [a] -> [a]
take Int
1 String
choice forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"c",String
"C",String
"N"] Bool -> Bool -> Bool
|| (forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
>= String
"A" Bool -> Bool -> Bool
&& forall a. Int -> [a] -> [a]
take Int
1 String
choice forall a. Ord a => a -> a -> Bool
<= String
"F") Bool -> Bool -> Bool
||
   forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Bool
False (forall a b. [a] -> [b] -> [(a, b)]
zip [String
"02y",String
"02z",String
"03y",String
"03z",String
"04y",String
"04z",String
"0y",String
"0z",String
"I01",String
"I02",String
"I03",String
"I04",String
"I11",
     String
"I12",String
"I12",String
"I13",String
"I14",String
"I21",String
"I22",String
"I23",String
"I24",String
"I31",String
"I32",String
"I33",String
"I34",String
"I41",String
"I42",String
"I43",String
"I44",
     String
"I51",String
"I52",String
"I53",String
"I54",String
"I61",String
"I62",String
"I63",String
"I64",String
"I71",String
"I72",String
"I74",String
"J01",String
"J02",String
"J03",String
"J04",String
"J11",
     String
"J12",String
"J13",String
"J14",String
"J21",String
"J22",String
"J23",String
"J24",String
"J31",String
"J32",String
"J33",String
"J34",String
"J41",String
"J42",String
"J43",String
"J44",String
"J51",
     String
"J52",String
"J53",String
"J54",String
"J61",String
"J62",String
"J63",String
"J64",String
"J71",String
"J72",String
"J73",String
"J74",String
"K01",String
"K02",String
"K03",String
"K04",String
"K11",
     String
"K12",String
"K13",String
"K14",String
"K21",String
"K21",String
"K22",String
"K23",String
"K24",String
"K31",String
"K32",String
"K33",String
"K34",String
"K41",String
"K42",String
"K43",String
"K44",
     String
"K51",String
"K52",String
"K53",String
"K54",String
"K61",String
"K62",String
"K63",String
"K64",String
"K71",String
"K72",String
"K73",String
"K74",String
"L01",String
"L02",String
"L03",String
"L04",
     String
"L11",String
"L12",String
"L13",String
"L14",String
"L21",String
"L22",String
"L23",String
"L24",String
"L31",String
"L32",String
"L33",String
"L34",String
"L41",String
"L42",String
"L43",String
"L44",
     String
"L51",String
"L52",String
"L53",String
"L54",String
"L61",String
"L62",String
"L63",String
"L64",String
"L71",String
"L72",String
"L74",String
"O01",String
"O02",String
"O03",String
"O04",String
"O11",
     String
"O12",String
"O13",String
"O14",String
"O21",String
"O22",String
"O23",String
"O24",String
"O31",String
"O32",String
"O33",String
"O34",String
"O41",String
"O42",String
"O43",String
"O44",String
"O51",
     String
"O52",String
"O53",String
"O54",String
"O61",String
"O62",String
"O63",String
"O64",String
"O71",String
"O72",String
"O73",String
"O74",String
"P01",String
"P02",String
"P03",String
"P04",String
"P11",
     String
"P12",String
"P13",String
"P14",String
"P21",String
"P22",String
"P23",String
"P24",String
"P31",String
"P32",String
"P33",String
"P34",String
"P41",String
"P42",String
"P43",String
"P44",String
"P51",
     String
"P52",String
"P53",String
"P54",String
"P61",String
"P62",String
"P63",String
"P64",String
"P71",String
"P72",String
"P73",String
"P74",String
"Q01",String
"Q02",String
"Q03",String
"Q04",
     String
"Q11",String
"Q12",String
"Q13",String
"Q14",String
"Q21",String
"Q22",String
"Q23",String
"Q24",String
"Q31",String
"Q32",String
"Q33",String
"Q34",String
"Q41",String
"Q42",String
"Q43",String
"Q44",
     String
"Q51",String
"Q52",String
"Q53",String
"Q54",String
"Q61",String
"Q62",String
"Q63",String
"Q64",String
"Q71",String
"Q72",String
"Q74",String
"R01",String
"R02",String
"R03",String
"R04",String
"R11",
     String
"R12",String
"R13",String
"R14",String
"R21",String
"R22",String
"R23",String
"R24",String
"R31",String
"R32",String
"R33",String
"R34",String
"R41",String
"R42",String
"R43",String
"R44",String
"R51",
     String
"R52",String
"R53",String
"R54",String
"R61",String
"R62",String
"R63",String
"R64",String
"R71",String
"R72",String
"R73",String
"R74",String
"S01",String
"S02",String
"S03",String
"S04",String
"S11",
     String
"S12",String
"S12",String
"S13",String
"S14",String
"S21",String
"S22",String
"S23",String
"S24",String
"S31",String
"S32",String
"S33",String
"S34",String
"S41",String
"S42",String
"S43",String
"S44",
     String
"S51",String
"S52",String
"S53",String
"S54",String
"S61",String
"S62",String
"S63",String
"S64",String
"S71",String
"S72",String
"S74",String
"T01",String
"T02",String
"T03",String
"T04",String
"T11",
     String
"T12",String
"T13",String
"T14",String
"T21",String
"T22",String
"T23",String
"T24",String
"T31",String
"T32",String
"T33",String
"T34",String
"T41",String
"T42",String
"T43",String
"T44",String
"T51",
     String
"T52",String
"T53",String
"T54",String
"T61",String
"T62",String
"T63",String
"T64",String
"T71",String
"T72",String
"T73",String
"T74",String
"U01",String
"U02",String
"U03",String
"U04",String
"U11",
     String
"U12",String
"U13",String
"U14",String
"U21",String
"U21",String
"U22",String
"U23",String
"U24",String
"U31",String
"U32",String
"U33",String
"U34",String
"U41",String
"U42",String
"U43",String
"U44",
     String
"U51",String
"U52",String
"U53",String
"U54",String
"U61",String
"U62",String
"U63",String
"U64",String
"U71",String
"U72",String
"U73",String
"U74",String
"V01",String
"V02",String
"V03",String
"V04",
     String
"V11",String
"V12",String
"V13",String
"V14",String
"V21",String
"V22",String
"V23",String
"V24",String
"V31",String
"V32",String
"V33",String
"V34",String
"V41",String
"V42",String
"V43",String
"V44",
     String
"V51",String
"V52",String
"V53",String
"V54",String
"V61",String
"V62",String
"V63",String
"V64",String
"V71",String
"V72",String
"V74",String
"W01",String
"W02",String
"W03",String
"W04",String
"W11",
     String
"W12",String
"W13",String
"W14",String
"W21",String
"W22",String
"W23",String
"W24",String
"W31",String
"W32",String
"W33",String
"W34",String
"W41",String
"W42",String
"W43",String
"W44",String
"W51",
     String
"W52",String
"W53",String
"W54",String
"W61",String
"W62",String
"W63",String
"W64",String
"W71",String
"W72",String
"W73",String
"W74",String
"X01",String
"X02",String
"X03",String
"X04",String
"X11",
     String
"X12",String
"X13",String
"X14",String
"X21",String
"X22",String
"X23",String
"X24",String
"X31",String
"X32",String
"X33",String
"X34",String
"X41",String
"X42",String
"X43",String
"X44",String
"X51",
     String
"X52",String
"X53",String
"X54",String
"X61",String
"X62",String
"X63",String
"X64",String
"X71",String
"X72",String
"X73",String
"X74",String
"Y01",String
"Y02",String
"Y03",String
"Y04",
     String
"Y11",String
"Y12",String
"Y13",String
"Y14",String
"Y21",String
"Y22",String
"Y23",String
"Y24",String
"Y31",String
"Y32",String
"Y33",String
"Y34",String
"Y41",String
"Y42",String
"Y43",String
"Y44",
     String
"Y51",String
"Y52",String
"Y53",String
"Y54",String
"Y61",String
"Y62",String
"Y63",String
"Y64",String
"Y71",String
"Y72",String
"Y74",String
"Z01",String
"Z02",String
"Z03",String
"Z04",String
"Z11",
     String
"Z12",String
"Z13",String
"Z14",String
"Z21",String
"Z22",String
"Z23",String
"Z24",String
"Z31",String
"Z32",String
"Z33",String
"Z34",String
"Z41",String
"Z42",String
"Z43",String
"Z44",String
"Z51",
     String
"Z52",String
"Z53",String
"Z54",String
"Z61",String
"Z62",String
"Z63",String
"Z64",String
"Z71",String
"Z72",String
"Z73",String
"Z74",String
"b01",String
"b02",String
"b03",String
"b04",String
"b11",
     String
"b12",String
"b12",String
"b13",String
"b14",String
"b21",String
"b22",String
"b23",String
"b24",String
"b31",String
"b32",String
"b33",String
"b34",String
"b41",String
"b42",String
"b43",String
"b44",
     String
"b51",String
"b52",String
"b53",String
"b54",String
"b61",String
"b62",String
"b63",String
"b64",String
"b71",String
"b72",String
"b74",String
"d01",String
"d02",String
"d03",String
"d04",String
"d11",
     String
"d12",String
"d13",String
"d14",String
"d21",String
"d22",String
"d23",String
"d24",String
"d31",String
"d32",String
"d33",String
"d34",String
"d41",String
"d42",String
"d43",String
"d44",String
"d51",
     String
"d52",String
"d53",String
"d54",String
"d61",String
"d62",String
"d63",String
"d64",String
"d71",String
"d72",String
"d73",String
"d74",String
"e01",String
"e02",String
"e03",String
"e04",String
"e11",
     String
"e12",String
"e13",String
"e14",String
"e21",String
"e21",String
"e22",String
"e23",String
"e24",String
"e31",String
"e32",String
"e33",String
"e34",String
"e41",String
"e42",String
"e43",String
"e44",
     String
"e51",String
"e52",String
"e53",String
"e54",String
"e61",String
"e62",String
"e63",String
"e64",String
"e71",String
"e72",String
"e73",String
"e74",String
"f01",String
"f02",String
"f03",String
"f04",
     String
"f11",String
"f12",String
"f13",String
"f14",String
"f21",String
"f22",String
"f23",String
"f24",String
"f31",String
"f32",String
"f33",String
"f34",String
"f41",String
"f42",String
"f43",String
"f44",
     String
"f51",String
"f52",String
"f53",String
"f54",String
"f61",String
"f62",String
"f63",String
"f64",String
"f71",String
"f72",String
"f74",String
"g01",String
"g02",String
"g03",String
"g04",String
"g11",
     String
"g12",String
"g13",String
"g14",String
"g21",String
"g22",String
"g23",String
"g24",String
"g31",String
"g32",String
"g33",String
"g34",String
"g41",String
"g42",String
"g43",String
"g44",String
"g51",
     String
"g52",String
"g53",String
"g54",String
"g61",String
"g62",String
"g63",String
"g64",String
"g71",String
"g72",String
"g73",String
"g74",String
"h01",String
"h02",String
"h03",String
"h04",String
"h11",
     String
"h12",String
"h13",String
"h14",String
"h21",String
"h22",String
"h23",String
"h24",String
"h31",String
"h32",String
"h33",String
"h34",String
"h41",String
"h42",String
"h43",String
"h44",String
"h51",
     String
"h52",String
"h53",String
"h54",String
"h61",String
"h62",String
"h63",String
"h64",String
"h71",String
"h72",String
"h73",String
"h74",String
"i01",String
"i02",String
"i03",String
"i04",
     String
"i11",String
"i12",String
"i13",String
"i14",String
"i21",String
"i22",String
"i23",String
"i24",String
"i31",String
"i32",String
"i33",String
"i34",String
"i41",String
"i42",String
"i43",String
"i44",
     String
"i51",String
"i52",String
"i53",String
"i54",String
"i61",String
"i62",String
"i63",String
"i64",String
"i71",String
"i72",String
"i74",String
"j01",String
"j02",String
"j03",String
"j04",String
"j11",
     String
"j12",String
"j13",String
"j14",String
"j21",String
"j22",String
"j23",String
"j24",String
"j31",String
"j32",String
"j33",String
"j34",String
"j41",String
"j42",String
"j43",String
"j44",String
"j51",
     String
"j52",String
"j53",String
"j54",String
"j61",String
"j62",String
"j63",String
"j64",String
"j71",String
"j72",String
"j73",String
"j74",String
"k01",String
"k02",String
"k03",String
"k04",String
"k11",
     String
"k12",String
"k12",String
"k13",String
"k14",String
"k21",String
"k22",String
"k23",String
"k24",String
"k31",String
"k32",String
"k33",String
"k34",String
"k41",String
"k42",String
"k43",String
"k44",
     String
"k51",String
"k52",String
"k53",String
"k54",String
"k61",String
"k62",String
"k63",String
"k64",String
"k71",String
"k72",String
"k74",String
"l01",String
"l02",String
"l03",String
"l04",String
"l11",
     String
"l12",String
"l13",String
"l14",String
"l21",String
"l22",String
"l23",String
"l24",String
"l31",String
"l32",String
"l33",String
"l34",String
"l41",String
"l42",String
"l43",String
"l44",String
"l51",
     String
"l52",String
"l53",String
"l54",String
"l61",String
"l62",String
"l63",String
"l64",String
"l71",String
"l72",String
"l73",String
"l74",String
"m01",String
"m02",String
"m03",String
"m04",String
"m11",
     String
"m12",String
"m13",String
"m14",String
"m21",String
"m21",String
"m22",String
"m23",String
"m24",String
"m31",String
"m32",String
"m33",String
"m34",String
"m41",String
"m42",String
"m43",String
"m44",
     String
"m51",String
"m52",String
"m53",String
"m54",String
"m61",String
"m62",String
"m63",String
"m64",String
"m71",String
"m72",String
"m73",String
"m74",String
"n01",String
"n02",String
"n03",String
"n04",
     String
"n11",String
"n12",String
"n13",String
"n14",String
"n21",String
"n22",String
"n23",String
"n24",String
"n31",String
"n32",String
"n33",String
"n34",String
"n41",String
"n42",String
"n43",String
"n44",
     String
"n51",String
"n52",String
"n53",String
"n54",String
"n61",String
"n62",String
"n63",String
"n64",String
"n71",String
"n72",String
"n74",String
"o01",String
"o02",String
"o03",String
"o04",String
"o11",
     String
"o12",String
"o13",String
"o14",String
"o21",String
"o22",String
"o23",String
"o24",String
"o31",String
"o32",String
"o33",String
"o34",String
"o41",String
"o42",String
"o43",String
"o44",String
"o51",
     String
"o52",String
"o53",String
"o54",String
"o61",String
"o62",String
"o63",String
"o64",String
"o71",String
"o72",String
"o73",String
"o74",String
"p01",String
"p02",String
"p03",String
"p04",String
"p11",
     String
"p12",String
"p13",String
"p14",String
"p21",String
"p22",String
"p23",String
"p24",String
"p31",String
"p32",String
"p33",String
"p34",String
"p41",String
"p42",String
"p43",String
"p44",String
"p51",
     String
"p52",String
"p53",String
"p54",String
"p61",String
"p62",String
"p63",String
"p64",String
"p71",String
"p72",String
"p73",String
"p74",String
"q01",String
"q02",String
"q03",String
"q04",
     String
"q11",String
"q12",String
"q13",String
"q14",String
"q21",String
"q22",String
"q23",String
"q24",String
"q31",String
"q32",String
"q33",String
"q34",String
"q41",String
"q42",String
"q43",String
"q44",
     String
"q51",String
"q52",String
"q53",String
"q54",String
"q61",String
"q62",String
"q63",String
"q64",String
"q71",String
"q72",String
"q74",String
"r01",String
"r02",String
"r03",String
"r04",String
"r11",
     String
"r12",String
"r13",String
"r14",String
"r21",String
"r22",String
"r23",String
"r24",String
"r31",String
"r32",String
"r33",String
"r34",String
"r41",String
"r42",String
"r43",String
"r44",String
"r51",
     String
"r52",String
"r53",String
"r54",String
"r61",String
"r62",String
"r63",String
"r64",String
"r71",String
"r72",String
"r73",String
"r74",String
"s01",String
"s02",String
"s03",String
"s04",
     String
"s11",String
"s12",String
"s13",String
"s14",String
"s21",String
"s22",String
"s23",String
"s24",String
"s31",String
"s32",String
"s33",String
"s34",String
"s41",String
"s42",String
"s43",String
"s44",
     String
"s51",String
"s52",String
"s53",String
"s54",String
"s61",String
"s62",String
"s63",String
"s64",String
"s71",String
"s72",String
"s74",String
"t01",String
"t02",String
"t03",String
"t04",String
"t11",
     String
"t12",String
"t13",String
"t14",String
"t21",String
"t22",String
"t23",String
"t24",String
"t31",String
"t32",String
"t33",String
"t34",String
"t41",String
"t42",String
"t43",String
"t44",String
"t51",
     String
"t52",String
"t53",String
"t54",String
"t61",String
"t62",String
"t63",String
"t64",String
"t71",String
"t72",String
"t74",String
"u01",String
"u02",String
"u03",String
"u04",String
"u11",String
"u12",
     String
"u13",String
"u14",String
"u21",String
"u22",String
"u23",String
"u24",String
"u31",String
"u32",String
"u33",String
"u34",String
"u41",String
"u42",String
"u43",String
"u44",String
"u51",String
"u52",
     String
"u53",String
"u54",String
"u61",String
"u62",String
"u63",String
"u64",String
"u71",String
"u72",String
"u74",String
"v01",String
"v02",String
"v03",String
"v04",String
"v11",String
"v12",String
"v13",
     String
"v14",String
"v21",String
"v22",String
"v23",String
"v24",String
"v31",String
"v32",String
"v33",String
"v34",String
"v41",String
"v42",String
"v43",String
"v44",String
"v51",String
"v52",String
"v53",
     String
"v54",String
"v61",String
"v62",String
"v63",String
"v64",String
"v71",String
"v72",String
"v74",String
"w01",String
"w02",String
"w03",String
"w04",String
"w11",String
"w12",String
"w13",String
"w14",
     String
"w21",String
"w22",String
"w23",String
"w24",String
"w31",String
"w32",String
"w33",String
"w34",String
"x01",String
"x02",String
"x03",String
"x04",String
"x11",String
"x12",String
"x13",String
"x14",
     String
"x21",String
"x22",String
"x23",String
"x24",String
"x31",String
"x32",String
"x33",String
"x34"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
2000 forall a b. (a -> b) -> a -> b
$ Bool
True) String
choice =
        forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> MappingFunctionPL
h String
choice Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs String
bbs
 | Bool
otherwise = forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' (forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs String
sels)
     [(String
"y",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs String
sels),
      (String
"y0",forall c.
Ord c =>
GWritingSystemPRPLX
-> String
-> (Double -> c)
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procDiverse2F GWritingSystemPRPLX
wrs (Char
' 'forall a. a -> [a] -> [a]
:String
us forall a. Monoid a => a -> a -> a
`mappend` String
vs) Double -> c
g String
sels),
      (String
"y2",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs String
sels),
      (String
"y3",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs String
sels),
      (String
"y4",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
3) Coeffs2
coeffs String
sels),
      (String
"yy",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs String
sels),
      (String
"yy2",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs String
sels),
      (String
"yy3",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs String
sels),
      (String
"z",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs String
sels),
      (String
"z2",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs String
sels),
      (String
"z3",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs String
sels),
      (String
"z4",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
3) Coeffs2
coeffs String
sels),
      (String
"zz",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
0) Coeffs2
coeffs String
sels),
      (String
"zz2",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
1) Coeffs2
coeffs String
sels),
      (String
"zz3",forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
2) Coeffs2
coeffs String
sels),
      (String
"zz4", forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
g ([MappingFunctionPL]
xs forall a. [a] -> Int -> a
!! Int
3) Coeffs2
coeffs String
sels)] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') forall a b. (a -> b) -> a -> b
$ 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.
 -- @ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function
 -- with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then
 -- to rewrite it.
 -- Besides there are new lines of the arguments for the 'String' argument that can begin with \"c\", \"s\", \"t\",
 -- \"u\", \"v\", or some other letters. For more information, please, refer to the 'Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2.rhythmicity'.
 -> Maybe Int
precChoice :: String -> Maybe Int
precChoice String
choice
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
t -> Char
t forall a. Eq a => a -> a -> Bool
==Char
'G' Bool -> Bool -> Bool
|| Char
t forall a. Eq a => a -> a -> Bool
== Char
'a') String
choice = String -> Maybe Int
precChoice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
t -> Char
tforall a. Eq a => a -> a -> Bool
/=Char
'G' Bool -> Bool -> Bool
&& Char
t forall a. Eq a => a -> a -> Bool
/= Char
'a') forall a b. (a -> b) -> a -> b
$ String
choice
 | Bool
otherwise = forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' (forall a. a -> Maybe a
Just Int
4) [(String
"02y",forall a. a -> Maybe a
Just Int
0),(String
"02z",forall a. a -> Maybe a
Just Int
0),(String
"03y",forall a. a -> Maybe a
Just Int
0),(String
"03z",forall a. a -> Maybe a
Just Int
0),(String
"04y",forall a. a -> Maybe a
Just Int
0),
  (String
"04z",forall a. a -> Maybe a
Just Int
0),(String
"0y",forall a. a -> Maybe a
Just Int
0),(String
"0z",forall a. a -> Maybe a
Just Int
0),(String
"y",forall a. a -> Maybe a
Just Int
0),(String
"y0",forall a. a -> Maybe a
Just Int
0),(String
"y2",forall a. a -> Maybe a
Just Int
0),(String
"y3",forall a. a -> Maybe a
Just Int
0), (String
"y4",forall a. a -> Maybe a
Just Int
0),
    (String
"z",forall a. a -> Maybe a
Just Int
0),(String
"z0",forall a. a -> Maybe a
Just Int
0),(String
"z2",forall a. a -> Maybe a
Just Int
0),(String
"z3",forall a. a -> Maybe a
Just Int
0), (String
"z4",forall a. a -> Maybe a
Just Int
0)] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'.') forall a b. (a -> b) -> a -> b
$ String
choice

parsey0Choice 
  :: (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.
  -> String 
  -> String
parsey0Choice :: (String -> String) -> String -> String
parsey0Choice String -> String
g String
xs 
  | forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Bool
False, forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
24) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [String
"02y",String
"02z",String
"03y",String
"03z",String
"04y",String
"04z",String
"0y",String
"0z",String
"y",String
"y0",String
"y2",String
"y3",String
"y4",String
"yy",String
"yy2",String
"yy3",String
"yy4",String
"z",String
"z2",String
"z3",String
"z4",String
"zz",String
"zz2",String
"zz3",String
"zz4"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
25 forall a b. (a -> b) -> a -> b
$ Bool
True) String
ts = forall {a}. Eq a => [a] -> [a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c  forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
' ' else Char -> Char
toLower Char
c) forall a b. (a -> b) -> a -> b
$ String
us
  | Bool
otherwise = []
    where (String
ts,String
us) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'.') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'H' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'G') forall a b. (a -> b) -> a -> b
$ String
xs
          f :: [a] -> [a]
f (a
x:ts :: [a]
ts@(a
y:[a]
xs)) 
           | a
x forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a]
f [a]
ts
           | Bool
otherwise = a
xforall a. a -> [a] -> [a]
:[a] -> [a]
f [a]
ts
          f [a]
xs = [a]
xs