{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}

-- |
-- Module      :  Languages.Phonetic.Ukrainian.Syllable.Arr
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- This module works with syllable segmentation in Ukrainian. It is rewritten
-- module MMSyn7.Syllable from the @mmsyn7s@ package : https://hackage.haskell.org/package/mmsyn7s
--

module Languages.Phonetic.Ukrainian.Syllable.Arr where

import Prelude hiding (mappend)
import Data.Monoid
import Data.Typeable
import qualified Data.List as L (groupBy)
import Melodics.ByteString.Ukrainian.Arr
import CaseBi.Arr
import Data.List.InnToOut.Basic (mapI)
import Data.Maybe (mapMaybe)

-- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0

-- CAUTION: Please, do not mix with the show7s functions, they are not interoperable.

data UZPP a b = UZ a b deriving ( UZPP a b -> UZPP a b -> Bool
(UZPP a b -> UZPP a b -> Bool)
-> (UZPP a b -> UZPP a b -> Bool) -> Eq (UZPP a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => UZPP a b -> UZPP a b -> Bool
/= :: UZPP a b -> UZPP a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => UZPP a b -> UZPP a b -> Bool
== :: UZPP a b -> UZPP a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => UZPP a b -> UZPP a b -> Bool
Eq, Typeable )

instance (Ord a, Ord b) => Ord (UZPP a b) where
  compare :: UZPP a b -> UZPP a b -> Ordering
compare (UZ a
x1 b
y1) (UZ a
x2 b
y2) =
    case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x1 a
x2 of
      Ordering
EQ -> b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare b
y1 b
y2
      ~Ordering
z -> Ordering
z

data PhoneticType = W | S | O | D | K | L | M | N | E deriving ( PhoneticType -> PhoneticType -> Bool
(PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool) -> Eq PhoneticType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhoneticType -> PhoneticType -> Bool
$c/= :: PhoneticType -> PhoneticType -> Bool
== :: PhoneticType -> PhoneticType -> Bool
$c== :: PhoneticType -> PhoneticType -> Bool
Eq, Eq PhoneticType
Eq PhoneticType
-> (PhoneticType -> PhoneticType -> Ordering)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> Bool)
-> (PhoneticType -> PhoneticType -> PhoneticType)
-> (PhoneticType -> PhoneticType -> PhoneticType)
-> Ord PhoneticType
PhoneticType -> PhoneticType -> Bool
PhoneticType -> PhoneticType -> Ordering
PhoneticType -> PhoneticType -> PhoneticType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PhoneticType -> PhoneticType -> PhoneticType
$cmin :: PhoneticType -> PhoneticType -> PhoneticType
max :: PhoneticType -> PhoneticType -> PhoneticType
$cmax :: PhoneticType -> PhoneticType -> PhoneticType
>= :: PhoneticType -> PhoneticType -> Bool
$c>= :: PhoneticType -> PhoneticType -> Bool
> :: PhoneticType -> PhoneticType -> Bool
$c> :: PhoneticType -> PhoneticType -> Bool
<= :: PhoneticType -> PhoneticType -> Bool
$c<= :: PhoneticType -> PhoneticType -> Bool
< :: PhoneticType -> PhoneticType -> Bool
$c< :: PhoneticType -> PhoneticType -> Bool
compare :: PhoneticType -> PhoneticType -> Ordering
$ccompare :: PhoneticType -> PhoneticType -> Ordering
$cp1Ord :: Eq PhoneticType
Ord, Typeable )

type UZPP2 = UZPP Char PhoneticType

instance Show (UZPP Char PhoneticType) where
  show :: UZPP Char PhoneticType -> String
show (UZ Char
x PhoneticType
y)
   | PhoneticType
y PhoneticType -> [PhoneticType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PhoneticType
O,PhoneticType
K,PhoneticType
M] =
       String -> [(Char, String)] -> Char -> String
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' String
"" [(Char
'-',String
" "),(Char
'0',String
" "),(Char
'1',String
" "),(Char
'A',String
"дз"),(Char
'B',String
"ж"),(Char
'C',String
"й"),(Char
'D',String
"сь"),(Char
'E',String
"ч"),(Char
'F',String
"ш"),(Char
'G',String
"щ"),(Char
'L',String
"\700"),(Char
'M',String
"\8217"),
        (Char
'a',String
"а"),(Char
'b',String
"б"),(Char
'c',String
"ц"),(Char
'd',String
"д"),(Char
'e',String
"е"),(Char
'f',String
"ф"),(Char
'g',String
"ґ"),(Char
'h',String
"г"),(Char
'i',String
"і"),(Char
'j',String
"дж"),(Char
'k',String
"к"),(Char
'l',String
"л"),(Char
'm',String
"м"),(Char
'n',String
"н"),(Char
'o',String
"о"),(Char
'p',String
"п"),(Char
'q',String
"ь"),
          (Char
'r',String
"р"),(Char
's',String
"с"),(Char
't',String
"т"),(Char
'u',String
"у"),(Char
'v',String
"в"),(Char
'w',String
"ць"),(Char
'x',String
"х"),(Char
'y',String
"и"),(Char
'z',String
"з")] Char
x
   | Bool
otherwise =
       String -> [(Char, String)] -> Char -> String
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' String
"" [(Char
'-',String
" "),(Char
'0',String
" "),(Char
'1',String
" "),(Char
'A',String
"дзь"),(Char
'B',String
"жь"),(Char
'E',String
"чь"),(Char
'F',String
"шь"),(Char
'G',String
"щь"),(Char
'b',String
"бь"),(Char
'd',String
"дь"),(Char
'f',String
"фь"),(Char
'g',String
"ґь"),
        (Char
'h',String
"гь"),(Char
'j',String
"джь"),(Char
'k',String
"кь"),(Char
'l',String
"ль"),(Char
'm',String
"мь"),(Char
'n',String
"нь"),(Char
'p',String
"пь"),(Char
'q',String
"ь"),(Char
'r',String
"рь"),(Char
't',String
"ть"),(Char
'v',String
"вь"),(Char
'x',String
"хь"),(Char
'z',String
"зь")] Char
x

phoneType :: UZPP2 -> PhoneticType
phoneType :: UZPP Char PhoneticType -> PhoneticType
phoneType (UZ Char
_ PhoneticType
y) = PhoneticType
y
{-# INLINE phoneType #-}

charUkr :: UZPP2 -> Char
charUkr :: UZPP Char PhoneticType -> Char
charUkr (UZ Char
x PhoneticType
_) = Char
x
{-# INLINE charUkr #-}

str2UZPP2s :: String -> [UZPP2]
str2UZPP2s :: String -> [UZPP Char PhoneticType]
str2UZPP2s (Char
y:String
ys)
  | Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(Char
'a',Bool
True),(Char
'e',Bool
True),(Char
'i',Bool
True),(Char
'o',Bool
True),(Char
'u',Bool
True),(Char
'y',Bool
True)] Char
y = Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
WUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s String
ys
  | Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D' Bool -> Bool -> Bool
|| Char
y Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w' = Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
NUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s String
ys
  | (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
ys Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'q') Bool -> Bool -> Bool
&& Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(Char
'C',Bool
True),(Char
'l',Bool
True),(Char
'm',Bool
True),(Char
'n',Bool
True),(Char
'r',Bool
True),(Char
'v',Bool
True)] Char
y = Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
SUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s String
ys
  | (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
ys Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'q') Bool -> Bool -> Bool
&&
      Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(Char
'A',Bool
True),(Char
'B',Bool
True),(Char
'b',Bool
True),(Char
'd',Bool
True),(Char
'g',Bool
True),(Char
'h',Bool
True),(Char
'j',Bool
True),(Char
'z',Bool
True)] Char
y = Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
DUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s String
ys
  | (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys Bool -> Bool -> Bool
|| String -> Char
forall a. [a] -> a
head String
ys Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'q') = Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
LUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s String
ys
  | Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(Char
'l',Bool
True),(Char
'm',Bool
True),(Char
'n',Bool
True),(Char
'r',Bool
True),(Char
'v',Bool
True)] Char
y = Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
OUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
ys)
  | Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(Char
'A',Bool
True),(Char
'B',Bool
True),(Char
'b',Bool
True),(Char
'd',Bool
True),(Char
'g',Bool
True),(Char
'h',Bool
True),(Char
'j',Bool
True),(Char
'z',Bool
True)] Char
y =
      Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
KUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
ys)
  | Bool
otherwise = Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
y PhoneticType
MUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:String -> [UZPP Char PhoneticType]
str2UZPP2s (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
ys)
str2UZPP2s String
_ = []

-- | Function-predicate 'isVowel1' checks whether its argument is a vowel representation in the 'UZPP2' format.
isVowel1 :: UZPP2 -> Bool
isVowel1 :: UZPP Char PhoneticType -> Bool
isVowel1 = (PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticType
W) (PhoneticType -> Bool)
-> (UZPP Char PhoneticType -> PhoneticType)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType
{-# INLINE isVowel1 #-}

-- | Function-predicate 'isVwl' checks whether its argument is a vowel representation in the 'Char' format.
isVwl :: Char -> Bool
isVwl :: Char -> Bool
isVwl = Bool -> [(Char, Bool)] -> Char -> Bool
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Bool
False [(Char
'a',Bool
True),(Char
'e',Bool
True),(Char
'i',Bool
True),(Char
'o',Bool
True),(Char
'u',Bool
True),(Char
'y',Bool
True)]
{-# INLINE isVwl #-}

-- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'UZPP2' format.
isSonorous1 :: UZPP2 -> Bool
isSonorous1 :: UZPP Char PhoneticType -> Bool
isSonorous1 =  (PhoneticType -> [PhoneticType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PhoneticType
S,PhoneticType
O]) (PhoneticType -> Bool)
-> (UZPP Char PhoneticType -> PhoneticType)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType
{-# INLINE isSonorous1 #-}

-- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'UZPP2' format.
isVoicedC1 ::  UZPP2 -> Bool
isVoicedC1 :: UZPP Char PhoneticType -> Bool
isVoicedC1 = (PhoneticType -> [PhoneticType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PhoneticType
D,PhoneticType
K]) (PhoneticType -> Bool)
-> (UZPP Char PhoneticType -> PhoneticType)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType
{-# INLINE isVoicedC1 #-}

-- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'UZPP2' format.
isVoicelessC1 ::  UZPP2 -> Bool
isVoicelessC1 :: UZPP Char PhoneticType -> Bool
isVoicelessC1 =  (PhoneticType -> [PhoneticType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PhoneticType
L,PhoneticType
M]) (PhoneticType -> Bool)
-> (UZPP Char PhoneticType -> PhoneticType)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType
{-# INLINE isVoicelessC1 #-}

-- | Binary function-predicate 'isNotVowel2' checks whether its arguments are both consonant representations in the 'UZPP2' format.
isNotVowel2 :: UZPP2 -> UZPP2 -> Bool
isNotVowel2 :: UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool
isNotVowel2 UZPP Char PhoneticType
x UZPP Char PhoneticType
y
  | UZPP Char PhoneticType -> PhoneticType
phoneType UZPP Char PhoneticType
x PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticType
W Bool -> Bool -> Bool
|| UZPP Char PhoneticType -> PhoneticType
phoneType UZPP Char PhoneticType
y PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticType
W = Bool
False
  | Bool
otherwise = Bool
True
{-# INLINE isNotVowel2 #-}

-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).
notEqC :: UZPP2 -> UZPP2 -> Bool
notEqC :: UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool
notEqC UZPP Char PhoneticType
x UZPP Char PhoneticType
y
  | UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
's' Bool -> Bool -> Bool
|| UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D' =
      case UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
y of
        Char
's' -> Bool
False
        Char
'D' -> Bool
False
        Char
_   -> Bool
True
  | UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'w' Bool -> Bool -> Bool
|| UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'c' =
      case UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
y of
        Char
'w' -> Bool
False
        Char
'c' -> Bool
False
        Char
_   -> Bool
True
  | Bool
otherwise = UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= UZPP Char PhoneticType -> Char
charUkr UZPP Char PhoneticType
y

-- | Function 'sndGroups' converts a Ukrainian word being a list of 'UZPP2' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)
-- sounds representations in 'UZPP2' format.
sndGroups :: [UZPP2] -> [[UZPP2]]
sndGroups :: [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
sndGroups ys :: [UZPP Char PhoneticType]
ys@(UZPP Char PhoneticType
_:[UZPP Char PhoneticType]
_) = (UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool)
-> [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool
isNotVowel2 [UZPP Char PhoneticType]
ys
sndGroups [UZPP Char PhoneticType]
_ = []

groupSnds :: [UZPP2] -> [[UZPP2]]
groupSnds :: [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
groupSnds = (UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool)
-> [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\UZPP Char PhoneticType
x UZPP Char PhoneticType
y -> ((PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticType
W) (PhoneticType -> Bool)
-> (UZPP Char PhoneticType -> PhoneticType)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType (UZPP Char PhoneticType -> Bool) -> UZPP Char PhoneticType -> Bool
forall a b. (a -> b) -> a -> b
$ UZPP Char PhoneticType
x) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ((PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticType
W) (PhoneticType -> Bool)
-> (UZPP Char PhoneticType -> PhoneticType)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType (UZPP Char PhoneticType -> Bool) -> UZPP Char PhoneticType -> Bool
forall a b. (a -> b) -> a -> b
$ UZPP Char PhoneticType
y))

-- | Function 'divCnsnts' is used to divide groups of Ukrainian consonants into two-elements lists that later are made belonging to
-- different neighbour syllables if the group is between two vowels in a word. The group must be not empty, but this is not checked.
-- The phonetical information for the proper performance is taken from the:
-- https://msn.khnu.km.ua/pluginfile.php/302375/mod_resource/content/1/%D0%9B.3.%D0%86%D0%86.%20%D0%A1%D0%BA%D0%BB%D0%B0%D0%B4.%D0%9D%D0%B0%D0%B3%D0%BE%D0%BB%D0%BE%D1%81.pdf
divCnsnts :: [UZPP2] -> ([UZPP2] -> [UZPP2],[UZPP2] -> [UZPP2])
divCnsnts :: [UZPP Char PhoneticType]
-> ([UZPP Char PhoneticType] -> [UZPP Char PhoneticType],
    [UZPP Char PhoneticType] -> [UZPP Char PhoneticType])
divCnsnts xs :: [UZPP Char PhoneticType]
xs@(UZPP Char PhoneticType
x:ys :: [UZPP Char PhoneticType]
ys@(UZPP Char PhoneticType
_:UZPP Char PhoneticType
_:UZPP Char PhoneticType
_:[UZPP Char PhoneticType]
_))
  | (UZPP Char PhoneticType -> Bool
isSonorous1 UZPP Char PhoneticType
x) Bool -> Bool -> Bool
|| (UZPP Char PhoneticType -> Bool
isVoicedC1 UZPP Char PhoneticType
x) = (([UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend` [UZPP Char PhoneticType
x]),([UZPP Char PhoneticType]
ys [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))
  | Bool
otherwise = (([UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> a
id),([UZPP Char PhoneticType]
xs [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))
divCnsnts xs :: [UZPP Char PhoneticType]
xs@(UZPP Char PhoneticType
x:ys :: [UZPP Char PhoneticType]
ys@(UZPP Char PhoneticType
y:zs :: [UZPP Char PhoneticType]
zs@(UZPP Char PhoneticType
_:[UZPP Char PhoneticType]
_)))
  | UZPP Char PhoneticType -> Bool
isSonorous1 UZPP Char PhoneticType
x = (([UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend` [UZPP Char PhoneticType
x]),([UZPP Char PhoneticType]
ys [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))
  | UZPP Char PhoneticType -> Bool
isSonorous1 UZPP Char PhoneticType
y = (([UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend` [UZPP Char PhoneticType
x,UZPP Char PhoneticType
y]),([UZPP Char PhoneticType]
zs [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))
  | Bool
otherwise = (([UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> a
id),([UZPP Char PhoneticType]
xs [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))
divCnsnts xs :: [UZPP Char PhoneticType]
xs@(UZPP Char PhoneticType
x:ys :: [UZPP Char PhoneticType]
ys@(UZPP Char PhoneticType
y:[UZPP Char PhoneticType]
_))
  | ((UZPP Char PhoneticType -> Bool
isSonorous1 UZPP Char PhoneticType
x) Bool -> Bool -> Bool
&& (UZPP Char PhoneticType
x UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool
`notEqC` UZPP Char PhoneticType
y)) Bool -> Bool -> Bool
|| ((UZPP Char PhoneticType -> Bool
isVoicedC1 UZPP Char PhoneticType
x) Bool -> Bool -> Bool
&& (UZPP Char PhoneticType -> Bool
isVoicelessC1 UZPP Char PhoneticType
y)) = (([UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend` [UZPP Char PhoneticType
x]),([UZPP Char PhoneticType]
ys [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))
  | Bool
otherwise = (([UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> a
id),([UZPP Char PhoneticType]
xs [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))
divCnsnts [UZPP Char PhoneticType]
xs = (([UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> a
id),([UZPP Char PhoneticType]
xs [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend`))

reSyllableCntnts :: [[UZPP2]] -> [[UZPP2]]
reSyllableCntnts :: [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
reSyllableCntnts ([UZPP Char PhoneticType]
xs:[UZPP Char PhoneticType]
ys:[UZPP Char PhoneticType]
zs:[[UZPP Char PhoneticType]]
xss)
  | (PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
/= PhoneticType
W) (PhoneticType -> Bool)
-> ([UZPP Char PhoneticType] -> PhoneticType)
-> [UZPP Char PhoneticType]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType (UZPP Char PhoneticType -> PhoneticType)
-> ([UZPP Char PhoneticType] -> UZPP Char PhoneticType)
-> [UZPP Char PhoneticType]
-> PhoneticType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UZPP Char PhoneticType] -> UZPP Char PhoneticType
forall a. [a] -> a
last ([UZPP Char PhoneticType] -> Bool)
-> [UZPP Char PhoneticType] -> Bool
forall a b. (a -> b) -> a -> b
$ [UZPP Char PhoneticType]
ys = ([UZPP Char PhoneticType] -> [UZPP Char PhoneticType],
 [UZPP Char PhoneticType] -> [UZPP Char PhoneticType])
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a b. (a, b) -> a
fst ([UZPP Char PhoneticType]
-> ([UZPP Char PhoneticType] -> [UZPP Char PhoneticType],
    [UZPP Char PhoneticType] -> [UZPP Char PhoneticType])
divCnsnts [UZPP Char PhoneticType]
ys) [UZPP Char PhoneticType]
xs[UZPP Char PhoneticType]
-> [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
forall a. a -> [a] -> [a]
:[[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
reSyllableCntnts (([UZPP Char PhoneticType] -> [UZPP Char PhoneticType],
 [UZPP Char PhoneticType] -> [UZPP Char PhoneticType])
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a b. (a, b) -> b
snd ([UZPP Char PhoneticType]
-> ([UZPP Char PhoneticType] -> [UZPP Char PhoneticType],
    [UZPP Char PhoneticType] -> [UZPP Char PhoneticType])
divCnsnts [UZPP Char PhoneticType]
ys) [UZPP Char PhoneticType]
zs[UZPP Char PhoneticType]
-> [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
forall a. a -> [a] -> [a]
:[[UZPP Char PhoneticType]]
xss)
  | Bool
otherwise = [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
reSyllableCntnts (([UZPP Char PhoneticType]
xs [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend` [UZPP Char PhoneticType]
ys)[UZPP Char PhoneticType]
-> [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
forall a. a -> [a] -> [a]
:[UZPP Char PhoneticType]
zs[UZPP Char PhoneticType]
-> [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
forall a. a -> [a] -> [a]
:[[UZPP Char PhoneticType]]
xss)
reSyllableCntnts ([UZPP Char PhoneticType]
xs:[UZPP Char PhoneticType]
ys:[[UZPP Char PhoneticType]]
_) = [([UZPP Char PhoneticType]
xs [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend` [UZPP Char PhoneticType]
ys)]
reSyllableCntnts [[UZPP Char PhoneticType]]
xss = [[UZPP Char PhoneticType]]
xss

divVwls :: [[UZPP2]] -> [[UZPP2]]
divVwls :: [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
divVwls = ([UZPP Char PhoneticType] -> Bool)
-> ([UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]])
-> [[UZPP Char PhoneticType]]
-> [[UZPP Char PhoneticType]]
forall a. (a -> Bool) -> (a -> [a]) -> [a] -> [a]
mapI (\[UZPP Char PhoneticType]
ws -> ([UZPP Char PhoneticType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([UZPP Char PhoneticType] -> Int)
-> ([UZPP Char PhoneticType] -> [UZPP Char PhoneticType])
-> [UZPP Char PhoneticType]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UZPP Char PhoneticType -> Bool)
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticType
W) (PhoneticType -> Bool)
-> (UZPP Char PhoneticType -> PhoneticType)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> PhoneticType
phoneType) ([UZPP Char PhoneticType] -> Int)
-> [UZPP Char PhoneticType] -> Int
forall a b. (a -> b) -> a -> b
$ [UZPP Char PhoneticType]
ws) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
h3
  where h3 :: [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
h3 [UZPP Char PhoneticType]
us = [[UZPP Char PhoneticType]
ys [UZPP Char PhoneticType]
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Monoid a => a -> a -> a
`mappend` Int -> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Int -> [a] -> [a]
take Int
1 [UZPP Char PhoneticType]
zs] [[UZPP Char PhoneticType]]
-> [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
forall a. Monoid a => a -> a -> a
`mappend` ((UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool)
-> [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\UZPP Char PhoneticType
x UZPP Char PhoneticType
y -> UZPP Char PhoneticType -> PhoneticType
phoneType UZPP Char PhoneticType
x PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
== PhoneticType
W Bool -> Bool -> Bool
&& UZPP Char PhoneticType -> PhoneticType
phoneType UZPP Char PhoneticType
y PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
/= PhoneticType
W) ([UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]])
-> ([UZPP Char PhoneticType] -> [UZPP Char PhoneticType])
-> [UZPP Char PhoneticType]
-> [[UZPP Char PhoneticType]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. Int -> [a] -> [a]
drop Int
1 ([UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]])
-> [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
forall a b. (a -> b) -> a -> b
$ [UZPP Char PhoneticType]
zs)
                  where ([UZPP Char PhoneticType]
ys,[UZPP Char PhoneticType]
zs) = (UZPP Char PhoneticType -> Bool)
-> [UZPP Char PhoneticType]
-> ([UZPP Char PhoneticType], [UZPP Char PhoneticType])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\UZPP Char PhoneticType
t -> UZPP Char PhoneticType -> PhoneticType
phoneType UZPP Char PhoneticType
t PhoneticType -> PhoneticType -> Bool
forall a. Eq a => a -> a -> Bool
/= PhoneticType
W) [UZPP Char PhoneticType]
us

createSyllablesUkrS :: String -> [[[UZPP2]]]
createSyllablesUkrS :: String -> [[[UZPP Char PhoneticType]]]
createSyllablesUkrS = (String -> [[UZPP Char PhoneticType]])
-> [String] -> [[[UZPP Char PhoneticType]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
divVwls ([[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]])
-> (String -> [[UZPP Char PhoneticType]])
-> String
-> [[UZPP Char PhoneticType]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]]
reSyllableCntnts ([[UZPP Char PhoneticType]] -> [[UZPP Char PhoneticType]])
-> (String -> [[UZPP Char PhoneticType]])
-> String
-> [[UZPP Char PhoneticType]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]]
groupSnds ([UZPP Char PhoneticType] -> [[UZPP Char PhoneticType]])
-> (String -> [UZPP Char PhoneticType])
-> String
-> [[UZPP Char PhoneticType]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [UZPP Char PhoneticType]
str2UZPP2s) ([String] -> [[[UZPP Char PhoneticType]]])
-> (String -> [String]) -> String -> [[[UZPP Char PhoneticType]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Char) -> ShowS
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Char -> Maybe Char
g ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
convertToProperUkrainianS ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
' ' else Char
x)
  where g :: Char -> Maybe Char
g Char
x
          | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' = Maybe Char
forall a. Maybe a
Nothing
          | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'1' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
          | Bool
otherwise = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
' '
        words1 :: String -> [String]
words1 String
xs = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts then [] else String
w String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
words1 String
s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
          where ts :: String
ts = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
xs
                (String
w, String
s'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
ts
        {-# NOINLINE words1 #-}
{-# INLINE createSyllablesUkrS #-}

-- | Function 'representProlonged' converts duplicated consequent in the syllable consonants
-- so that they are represented by just one 'UZPP2'. After applying the function to the list of 'UZPP2' being a syllable all groups of duplicated consequent consonants
-- in every syllable are represented with only one 'UZPP2' respectively.
representProlonged :: [UZPP2] -> [UZPP2]
representProlonged :: [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
representProlonged (UZPP Char PhoneticType
x:UZPP Char PhoneticType
y:[UZPP Char PhoneticType]
xs)
  | UZPP Char PhoneticType -> Bool
isVowel1 UZPP Char PhoneticType
x = UZPP Char PhoneticType
xUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:[UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
representProlonged (UZPP Char PhoneticType
yUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:[UZPP Char PhoneticType]
xs)
  | Bool -> Bool
not (Bool -> Bool)
-> (UZPP Char PhoneticType -> Bool)
-> UZPP Char PhoneticType
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UZPP Char PhoneticType -> UZPP Char PhoneticType -> Bool
notEqC UZPP Char PhoneticType
x (UZPP Char PhoneticType -> Bool) -> UZPP Char PhoneticType -> Bool
forall a b. (a -> b) -> a -> b
$ UZPP Char PhoneticType
y = UZPP Char PhoneticType
yUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:[UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
representProlonged [UZPP Char PhoneticType]
xs
  | Bool
otherwise = UZPP Char PhoneticType
xUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:[UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
representProlonged (UZPP Char PhoneticType
yUZPP Char PhoneticType
-> [UZPP Char PhoneticType] -> [UZPP Char PhoneticType]
forall a. a -> [a] -> [a]
:[UZPP Char PhoneticType]
xs)
representProlonged [UZPP Char PhoneticType]
xs = [UZPP Char PhoneticType]
xs

-- | 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 'Float' data are gotten from there.
str2Durat1 :: String -> Float
str2Durat1 :: String -> Float
str2Durat1 = Float -> [(String, Float)] -> String -> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.153016 [(String
"-", (Float
0.101995)), (String
"0", (Float
0.051020)), (String
"1", (Float
0.153016)), (String
"а", Float
0.138231), (String
"б", Float
0.057143),
  (String
"в", Float
0.082268), (String
"г", Float
0.076825), (String
"д", Float
0.072063), (String
"дж", Float
0.048934), (String
"дз", Float
0.055601), (String
"е", Float
0.093605), (String
"ж", Float
0.070658), (String
"з", Float
0.056054),
    (String
"и", Float
0.099955), (String
"й", Float
0.057143), (String
"к", Float
0.045351), (String
"л", Float
0.064036), (String
"м", Float
0.077370), (String
"н", Float
0.074240), (String
"о", Float
0.116463), (String
"п", Float
0.134830),
      (String
"р", Float
0.049206), (String
"с", Float
0.074603), (String
"сь", Float
0.074558), (String
"т", Float
0.110658), (String
"у", Float
0.109070), (String
"ф", Float
0.062268), (String
"х", Float
0.077188), (String
"ц", Float
0.053061),
        (String
"ць", Float
0.089342), (String
"ч", Float
0.057596), (String
"ш", Float
0.066077), (String
"ь", Float
0.020227), (String
"і", Float
0.094150), (String
"ґ", Float
0.062948)]
{-# DEPRECATED str2Durat1 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}

-- | 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).
uzpp2Durat2 :: UZPP2 -> Float
uzpp2Durat2 :: UZPP Char PhoneticType -> Float
uzpp2Durat2 = Float
-> [(UZPP Char PhoneticType, Float)]
-> UZPP Char PhoneticType
-> Float
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Float
0.06408817 [(Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
D, Float
0.07729654), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
K, Float
0.07729654), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
D, Float
0.08048113), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
K, Float
0.08048113),
  (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'C' PhoneticType
S, Float
0.08226452), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'D' PhoneticType
N, Float
0.07512999), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
L, Float
0.12541547), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
M, Float
0.12541547), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
L, Float
0.12838476), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
M, Float
0.12838476),
    (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'a' PhoneticType
W, Float
0.27161466), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
D, Float
0.10977617), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
K, Float
0.10977617), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'c' PhoneticType
D, Float
0.05616409), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
D, Float
0.06586550), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
K, Float
0.06586550),
      (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'e' PhoneticType
W, Float
0.27192511), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
L, Float
0.15776219), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
M, Float
0.15776219), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
D, Float
0.07751571), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
K, Float
0.07751571), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
D, Float
0.05392745),
        (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
K, Float
0.05392745), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'i' PhoneticType
W, Float
0.20026538), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
D, Float
0.08900757), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
K, Float
0.08900757), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
L, Float
0.04917820), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
M, Float
0.04917820),
          (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
S, Float
0.11159399), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
O, Float
0.11159399), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
S, Float
0.14303837), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
O, Float
0.14303837), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
S, Float
0.05639178),
            (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
O, Float
0.05639178), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'o' PhoneticType
W, Float
0.28539351), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
L, Float
0.09603085), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
M, Float
0.09603085), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'q' PhoneticType
E, Float
0.02218624), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
S, Float
0.06354637),
              (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
O, Float
0.06354637), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
's' PhoneticType
L, Float
0.05294375), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
L, Float
0.05047358), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
M, Float
0.05047358), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'u' PhoneticType
W, Float
0.25250039),
                (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
S, Float
0.08404524), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
O, Float
0.08404524), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'w' PhoneticType
N, Float
0.07835033), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
L, Float
0.07905155), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
M, Float
0.07905155),
                  (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'y' PhoneticType
W, Float
0.20509350), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
D, Float
0.06099951), (Char -> PhoneticType -> UZPP Char PhoneticType
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
K, Float
0.06099951)]
{-# DEPRECATED uzpp2Durat2 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}

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

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

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

-- | General variant of the 'syllableDurations' function with the arbitrary 'uzpp2Durat1'-like function.
syllableDurationsG :: (UZPP2 -> Float) -> [[[UZPP2]]] -> [[Float]]
syllableDurationsG :: (UZPP Char PhoneticType -> Float)
-> [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurationsG UZPP Char PhoneticType -> Float
g = ([[UZPP Char PhoneticType]] -> [Float])
-> [[[UZPP Char PhoneticType]]] -> [[Float]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([UZPP Char PhoneticType] -> Float)
-> [[UZPP Char PhoneticType]] -> [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Float] -> Float)
-> ([UZPP Char PhoneticType] -> [Float])
-> [UZPP Char PhoneticType]
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UZPP Char PhoneticType -> Float)
-> [UZPP Char PhoneticType] -> [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UZPP Char PhoneticType -> Float
g))
{-# INLINABLE syllableDurationsG #-}
{-# DEPRECATED syllableDurationsG "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}

-- | Returns list of lists, every inner one of which contains approximate durations of the Ukrainian syllables.
syllableDurations :: [[[UZPP2]]] -> [[Float]]
syllableDurations :: [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurations = (UZPP Char PhoneticType -> Float)
-> [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurationsG UZPP Char PhoneticType -> Float
uzpp2Durat1
{-# DEPRECATED syllableDurations "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}

-- | Likewise 'syllableDurations', but uses 'uzpp2Durat2' instead of 'uzpp2Durat1'.
syllableDurations2 :: [[[UZPP2]]] -> [[Float]]
syllableDurations2 :: [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurations2 = (UZPP Char PhoneticType -> Float)
-> [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurationsG UZPP Char PhoneticType -> Float
uzpp2Durat2
{-# DEPRECATED syllableDurations2 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}

-- | Likewise 'syllableDurations', but uses 'uzpp2Durat3' instead of 'uzpp2Durat1'.
syllableDurations3 :: [[[UZPP2]]] -> [[Float]]
syllableDurations3 :: [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurations3 = (UZPP Char PhoneticType -> Float)
-> [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurationsG UZPP Char PhoneticType -> Float
uzpp2Durat3
{-# DEPRECATED syllableDurations3 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}

-- | Likewise 'syllableDurations', but uses 'uzpp2Durat4' instead of 'uzpp2Durat1'.
syllableDurations4 :: [[[UZPP2]]] -> [[Float]]
syllableDurations4 :: [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurations4 = (UZPP Char PhoneticType -> Float)
-> [[[UZPP Char PhoneticType]]] -> [[Float]]
syllableDurationsG UZPP Char PhoneticType -> Float
uzpp2Durat4
{-# DEPRECATED syllableDurations4 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}