-- |
-- Module      :  Languages.Phonetic.Ukrainian.Syllable.Double.Arr
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- This module works with syllable segmentation in Ukrainian. Uses 'Double' whenever possible.
--

module Languages.Phonetic.Ukrainian.Syllable.Double.Arr where

import CaseBi.Arr
import Languages.Phonetic.Ukrainian.Syllable.Arr (UZPP(..),UZPP2,PhoneticType(..))

-- | Is inspired by the DobutokO.Sound.DIS5G6G module from @dobutokO2@ package.
-- See: 'https://hackage.haskell.org/package/dobutokO2-0.43.0.0/docs/DobutokO-Sound-DIS5G6G.html'. The 'Double' data are gotten from there.
str2DuratD1 :: String -> Double
str2DuratD1 :: String -> Double
str2DuratD1 = Double -> [(String, Double)] -> String -> Double
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Double
0.153016 [(String
"-", (Double
0.101995)), (String
"0", (Double
0.051020)), (String
"1", (Double
0.153016)), (String
"а", Double
0.138231), (String
"б", Double
0.057143),
  (String
"в", Double
0.082268), (String
"г", Double
0.076825), (String
"д", Double
0.072063), (String
"дж", Double
0.048934), (String
"дз", Double
0.055601), (String
"е", Double
0.093605), (String
"ж", Double
0.070658), (String
"з", Double
0.056054),
    (String
"и", Double
0.099955), (String
"й", Double
0.057143), (String
"к", Double
0.045351), (String
"л", Double
0.064036), (String
"м", Double
0.077370), (String
"н", Double
0.074240), (String
"о", Double
0.116463), (String
"п", Double
0.134830),
      (String
"р", Double
0.049206), (String
"с", Double
0.074603), (String
"сь", Double
0.074558), (String
"т", Double
0.110658), (String
"у", Double
0.109070), (String
"ф", Double
0.062268), (String
"х", Double
0.077188), (String
"ц", Double
0.053061),
        (String
"ць", Double
0.089342), (String
"ч", Double
0.057596), (String
"ш", Double
0.066077), (String
"ь", Double
0.020227), (String
"і", Double
0.094150), (String
"ґ", Double
0.062948)]

-- | Just another possible duration approximation obtained by usage of the @r-glpk-phonetic-languages-ukrainian-durations@ package
-- https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations.
-- It is generated for the set of the words-durations pairs that the words contents ('Char') converts to the elements of the
-- \"ABCEFXYabcdefghijklmnopqrstuvxyz\" (for more information, pleas, refer to the
-- https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations).
uzpp2DuratD2 :: UZPP2 -> Double
uzpp2DuratD2 :: UZPP2 -> Double
uzpp2DuratD2 = Double -> [(UZPP2, Double)] -> UZPP2 -> Double
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Double
0.06408817 [(Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
D, Double
0.07729654), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
K, Double
0.07729654), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
D, Double
0.08048113), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
K, Double
0.08048113),
  (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'C' PhoneticType
S, Double
0.08226452), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'D' PhoneticType
N, Double
0.07512999), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
L, Double
0.12541547), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
M, Double
0.12541547), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
L, Double
0.12838476), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
M, Double
0.12838476),
    (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'a' PhoneticType
W, Double
0.27161466), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
D, Double
0.10977617), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
K, Double
0.10977617), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'c' PhoneticType
D, Double
0.05616409), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
D, Double
0.06586550), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
K, Double
0.06586550),
      (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'e' PhoneticType
W, Double
0.27192511), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
L, Double
0.15776219), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
M, Double
0.15776219), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
D, Double
0.07751571), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
K, Double
0.07751571), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
D, Double
0.05392745),
        (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
K, Double
0.05392745), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'i' PhoneticType
W, Double
0.20026538), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
D, Double
0.08900757), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
K, Double
0.08900757), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
L, Double
0.04917820), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
M, Double
0.04917820),
          (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
S, Double
0.11159399), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
O, Double
0.11159399), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
S, Double
0.14303837), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
O, Double
0.14303837), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
S, Double
0.05639178),
            (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
O, Double
0.05639178), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'o' PhoneticType
W, Double
0.28539351), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
L, Double
0.09603085), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
M, Double
0.09603085), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'q' PhoneticType
E, Double
0.02218624), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
S, Double
0.06354637),
              (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
O, Double
0.06354637), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
's' PhoneticType
L, Double
0.05294375), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
L, Double
0.05047358), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
M, Double
0.05047358), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'u' PhoneticType
W, Double
0.25250039),
                (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
S, Double
0.08404524), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
O, Double
0.08404524), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'w' PhoneticType
N, Double
0.07835033), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
L, Double
0.07905155), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
M, Double
0.07905155),
                  (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'y' PhoneticType
W, Double
0.20509350), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
D, Double
0.06099951), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
K, Double
0.06099951)]

uzpp2DuratD1 :: UZPP2 -> Double
uzpp2DuratD1 :: UZPP2 -> Double
uzpp2DuratD1 = Double -> [(UZPP2, Double)] -> UZPP2 -> Double
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Double
0.051020 [(Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
D, Double
0.055601), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
K, Double
0.055601), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
D, Double
0.070658), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
K, Double
0.070658), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'C' PhoneticType
S, Double
0.057143), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'D' PhoneticType
N, Double
0.074558),
  (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
L, Double
0.057596), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
M, Double
0.057596), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
L, Double
0.066077), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
M, Double
0.066077), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'a' PhoneticType
W, Double
0.138231), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
D, Double
0.057143), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
K, Double
0.057143), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'c' PhoneticType
D, Double
0.053061),
   (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
D, Double
0.072063), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
K, Double
0.072063), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'e' PhoneticType
W, Double
0.093605), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
L, Double
0.062268), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
M, Double
0.062268),  (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
D, Double
0.062948), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
K, Double
0.062948), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
D, Double
0.076825),
    (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
K, Double
0.076825), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'i' PhoneticType
W, Double
0.094150), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
D, Double
0.048934), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
K, Double
0.048934), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
L, Double
0.045351), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
M, Double
0.045351), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
S, Double
0.064036), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
O, Double
0.064036),
     (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
S, Double
0.077370), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
O, Double
0.077370), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
S, Double
0.074240), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
O, Double
0.074240), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'o' PhoneticType
W, Double
0.116463), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
L, Double
0.134830), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
M, Double
0.134830),
      (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'q' PhoneticType
E, Double
0.020227), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
S, Double
0.049206), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
O, Double
0.049206), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
's' PhoneticType
L, Double
0.074603),  (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
L, Double
0.110658), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
M, Double
0.110658), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'u' PhoneticType
W, Double
0.109070), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
S, Double
0.082268),
       (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
O, Double
0.082268), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'w' PhoneticType
N, Double
0.089342), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
L, Double
0.077188), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
M, Double
0.077188), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'y' PhoneticType
W, Double
0.099955), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
D, Double
0.056054), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
K, Double
0.056054)]

uzpp2DuratD3 :: UZPP2 -> Double
uzpp2DuratD3 :: UZPP2 -> Double
uzpp2DuratD3 = Double -> [(UZPP2, Double)] -> UZPP2 -> Double
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Double
0.05779993 [(Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
D, Double
0.08453724), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
K, Double
0.08453724),
 (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
D, Double
0.09996042), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
K, Double
0.09996042), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'C' PhoneticType
S, Double
0.10975353), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'D' PhoneticType
N, Double
0.08190674),
  (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
L, Double
0.11906522), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
M, Double
0.11906522), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
L, Double
0.13985258), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
M, Double
0.13985258),
   (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'a' PhoneticType
W, Double
0.25872483), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
D, Double
0.13787716), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
K, Double
0.13787716), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'c' PhoneticType
D, Double
0.05901357),
    (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
D, Double
0.07437409), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
K, Double
0.07437409), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'e' PhoneticType
W, Double
0.22876537), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
L, Double
0.15880087),
     (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
M, Double
0.15880087), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
D, Double
0.07985903), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
K, Double
0.07985903), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
D, Double
0.10289067),
      (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
K, Double
0.10289067), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'i' PhoneticType
W, Double
0.19777405), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
D, Double
0.10039843), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
K, Double
0.10039843),
       (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
L, Double
0.05893304), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
M, Double
0.05893304), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
S, Double
0.10906450), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
O, Double
0.10906450),
        (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
S, Double
0.14576594), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
O, Double
0.14576594), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
S, Double
0.06084464), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
O, Double
0.06084464),
         (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'o' PhoneticType
W, Double
0.25423777), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
L, Double
0.10765654), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
M, Double
0.10765654), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'q' PhoneticType
E, Double
0.01943042),
          (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
S, Double
0.05937718), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
O, Double
0.05937718), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
's' PhoneticType
L, Double
0.06247632), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
L, Double
0.06039120),
           (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
M, Double
0.06039120), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'u' PhoneticType
W, Double
0.20243791), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
S, Double
0.07798724), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
O, Double
0.07798724),
            (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'w' PhoneticType
N, Double
0.07844400), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
L, Double
0.13526622), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
M, Double
0.13526622), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'y' PhoneticType
W, Double
0.19849003),
             (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
D, Double
0.06643842), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
K, Double
0.06643842)]

uzpp2DuratD4 :: UZPP2 -> Double
uzpp2DuratD4 :: UZPP2 -> Double
uzpp2DuratD4 = Double -> [(UZPP2, Double)] -> UZPP2 -> Double
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Double
0.14160713 [(Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
D, Double
0.08508446), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
K, Double
0.08508446), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
D, Double
0.17053331),
 (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
K, Double
0.17053331), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'C' PhoneticType
S, Double
0.06241711), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'D' PhoneticType
N, Double
0.12159184), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
L, Double
0.21173804), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
M, Double
0.21173804),
  (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
L, Double
0.24441358), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
M, Double
0.24441358), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'a' PhoneticType
W, Double
0.20859653), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
D, Double
0.07768941),
   (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
K, Double
0.07768941), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'c' PhoneticType
D, Double
0.05705798), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
D, Double
0.12987485), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
K, Double
0.12987485),
    (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'e' PhoneticType
W, Double
0.21194045), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
L, Double
0.19044721), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
M, Double
0.19044721), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
D, Double
0.14343568),
     (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
K, Double
0.14343568), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
D, Double
0.22822145), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
K, Double
0.22822145), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'i' PhoneticType
W, Double
0.20167924),
      (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
D, Double
0.16712392), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
K, Double
0.16712392), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
L, Double
0.10747824), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
M, Double
0.10747824),
       (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
S, Double
0.16563571), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
O, Double
0.16563571), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
S, Double
0.26940890), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
O, Double
0.26940890),
        (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
S, Double
0.13174949), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
O, Double
0.13174949), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'o' PhoneticType
W, Double
0.20890920), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
L, Double
0.05737927),
         (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
M, Double
0.05737927), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'q' PhoneticType
E, Double
0.01957491), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
S, Double
0.05978079), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
O, Double
0.05978079),
          (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
's' PhoneticType
L, Double
0.10201693), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
L, Double
0.18138075), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
M, Double
0.18138075), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'u' PhoneticType
W, Double
0.19826109),
           (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
S, Double
0.09572877), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
O, Double
0.09572877), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'w' PhoneticType
N, Double
0.07663289), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
L, Double
0.26765448),
            (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
M, Double
0.26765448), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'y' PhoneticType
W, Double
0.20249813), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
D, Double
0.08566847), (Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
K, Double
0.08566847)]

-- | General variant of the 'syllableDurationsD' function with the arbitrary 'uzpp2DuratD1'-like function.
syllableDurationsGD :: (UZPP2 -> Double) -> [[[UZPP2]]] -> [[Double]]
syllableDurationsGD :: (UZPP2 -> Double) -> [[[UZPP2]]] -> [[Double]]
syllableDurationsGD UZPP2 -> Double
g = ([[UZPP2]] -> [Double]) -> [[[UZPP2]]] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([UZPP2] -> Double) -> [[UZPP2]] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> ([UZPP2] -> [Double]) -> [UZPP2] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UZPP2 -> Double) -> [UZPP2] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UZPP2 -> Double
g))
{-# INLINABLE syllableDurationsGD #-}

-- | Returns list of lists, every inner one of which contains approximate durations of the Ukrainian syllables.
syllableDurationsD :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD = (UZPP2 -> Double) -> [[[UZPP2]]] -> [[Double]]
syllableDurationsGD UZPP2 -> Double
uzpp2DuratD1

-- | Likewise 'syllableDurations', but uses 'uzpp2DuratD2' instead of 'uzpp2DuratD1'.
syllableDurationsD2 :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD2 = (UZPP2 -> Double) -> [[[UZPP2]]] -> [[Double]]
syllableDurationsGD UZPP2 -> Double
uzpp2DuratD2

-- | Likewise 'syllableDurations', but uses 'uzpp2DuratD3' instead of 'uzpp2DuratD1'.
syllableDurationsD3 :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD3 = (UZPP2 -> Double) -> [[[UZPP2]]] -> [[Double]]
syllableDurationsGD UZPP2 -> Double
uzpp2DuratD3

-- | Likewise 'syllableDurations', but uses 'uzpp2DuratD4' instead of 'uzpp2DuratD1'.
syllableDurationsD4 :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 :: [[[UZPP2]]] -> [[Double]]
syllableDurationsD4 = (UZPP2 -> Double) -> [[[UZPP2]]] -> [[Double]]
syllableDurationsGD UZPP2 -> Double
uzpp2DuratD4