{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.General.PropertiesFuncRepG2
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package and the recent module Phonetic.Languages.Array.General.PropertiesFuncRepG2
-- from the @phonetic-languages-simplified-properties-array@. If you import the module with the last one
-- module, please, use the qualified import, because of common names.
--
-- Instead of vectors, uses arrays.

{-# LANGUAGE CPP, BangPatterns #-}

module Phonetic.Languages.Array.General.PropertiesFuncRepG2 (
  -- * Functions with 'Int16'
  procDiverse2I
  -- * Functions with 'Double'
  , procB2FG
  , procB2F
  , procB2FF
  , procB2InvFG
  , procB2InvF
  , procB2InvFF
  , procRhythm23F
  , procDiverse2F
  -- * Working with rhythmicity
  , procRhythmicity23F
) where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import GHC.Int
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.UniquenessPeriodsG
import Languages.Rhythmicity
import Languages.Rhythmicity.Factor
import Phonetic.Languages.Basis
import GHC.Float (int2Double)
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables hiding (D)
import Data.Maybe (fromMaybe,mapMaybe)
import Data.Monoid (mappend)
import Phonetic.Languages.EmphasisG
import Phonetic.Languages.Coeffs

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

procDiverse2I
  :: (Ord c) => GWritingSystemPRPLX
  -> String -- ^ Actually is the \' \':us ++ vs in the following functions where in the definition is us and vs 'String's. See the
  -- source code of the module.
  -> (Int16 -> c)
  -> String -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Int16 c
procDiverse2I :: forall c.
Ord c =>
GWritingSystemPRPLX
-> String
-> (Int16 -> c)
-> String
-> FuncRep2 ReadyForConstructionPL Int16 c
procDiverse2I GWritingSystemPRPLX
wrs String
zs Int16 -> c
g String
sels = 
  forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (\ReadyForConstructionPL
x -> case ReadyForConstructionPL
x of
             StrG String
xs -> forall (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *) a.
(Foldable t1, Foldable t2, Foldable t3, Ord a) =>
t3 a -> t1 a -> t2 a -> Int16
diverse2GGL String
sels String
zs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs forall a b. (a -> b) -> a -> b
$ String
xs
             FSLG [[[Int8]]]
tsss -> Int16
1) Int16 -> c
g
{-# INLINE procDiverse2I #-}

procDiverse2F
  :: (Ord c) => GWritingSystemPRPLX
  -> String -- ^ Actually is the \' \':us ++ vs in the following functions where in the definition is us and vs 'String's. See the
  -- source code of the module.
  -> (Double -> c)
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procDiverse2F :: forall c.
Ord c =>
GWritingSystemPRPLX
-> String
-> (Double -> c)
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procDiverse2F GWritingSystemPRPLX
wrs String
zs Double -> c
g String
sels = 
  forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (\ReadyForConstructionPL
x ->case ReadyForConstructionPL
x of
           StrG String
xs -> Int -> Double
int2Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *) a.
(Foldable t1, Foldable t2, Foldable t3, Ord a) =>
t3 a -> t1 a -> t2 a -> Int16
diverse2GGL String
sels String
zs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs forall a b. (a -> b) -> a -> b
$ String
xs
           FSLG [[[Int8]]]
_ -> Double
1.0) Double -> c
g
{-# INLINE procDiverse2F #-}

--------------------------------------------------------------------------------------------

eval23Coeffs :: Coeffs2 -> [Double] -> Double
eval23Coeffs :: Coeffs2 -> [Double] -> Double
eval23Coeffs (CF2 Maybe Double
x Maybe Double
y) = forall a. (RealFrac a, Floating a) => a -> a -> [a] -> a
evalRhythmicity23K (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
eval23Coeffs Coeffs2
CF0 = forall a. (RealFrac a, Floating a) => [a] -> a
evalRhythmicity23
{-# INLINE eval23Coeffs #-}

eval23CoeffsF :: Double -> Coeffs2 -> [Double] -> Double
eval23CoeffsF :: Double -> Coeffs2 -> [Double] -> Double
eval23CoeffsF Double
k (CF2 Maybe Double
x Maybe Double
y) = forall a. (RealFrac a, Floating a) => a -> a -> a -> [a] -> a
evalRhythmicity23KF Double
k (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
x) (forall a. a -> Maybe a -> a
fromMaybe Double
1.0 Maybe Double
y)
eval23CoeffsF Double
k Coeffs2
CF0 = forall a. (RealFrac a, Floating a) => a -> [a] -> a
evalRhythmicity23F Double
k
{-# INLINE eval23CoeffsF #-}

-------------------------------------------------------------------------------------------

procB2FG
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> ([Double] -> Double)
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String   -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2FG :: forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FG GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [Double] -> Double
h1 Double -> c
h MappingFunctionPL
g Coeffs2
coeffs String
sels =  
  forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (\ReadyForConstructionPL
t -> case ReadyForConstructionPL
t of
             StrG String
xs -> let ys :: String
ys = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs forall a b. (a -> b) -> a -> b
$ String
xs in
                                ((Int -> Double
int2Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *) a.
(Foldable t1, Foldable t2, Foldable t3, Ord a) =>
t3 a -> t1 a -> t2 a -> Int16
diverse2GGL String
sels String
zs forall a b. (a -> b) -> a -> b
$ String
ys)forall a. Num a => a -> a -> a
*([Double] -> Double
h1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const [[-Double
5.0]])  (MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])
fromPhoPaaW MappingFunctionPL
g)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([[PRS]] -> [[PRS]]
divSylls forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
                                 [PRS] -> [[PRS]]
groupSnds forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPhoneticClassification -> String -> [PRS]
str2PRSs CharPhoneticClassification
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t Char -> t Char -> Char -> Maybe Char
f String
us String
vs) forall a b. (a -> b) -> a -> b
$ String
ys))
             FSLG [[[Int8]]]
tsss -> [Double] -> Double
h1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const [[-Double
6.0]]) (MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])
fromSaaW MappingFunctionPL
g)) forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss) Double -> c
h
                  where  zs :: String
zs = Char
' 'forall a. a -> [a] -> [a]
:String
us forall a. Monoid a => a -> a -> a
`mappend` String
vs
{-# INLINE procB2FG #-}

procB2F
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String   -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2F :: forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2F GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
h MappingFunctionPL
g Coeffs2
coeffs = forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FG GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs (Coeffs2 -> [Double] -> Double
eval23Coeffs Coeffs2
coeffs) Double -> c
h MappingFunctionPL
g Coeffs2
coeffs
{-# INLINE procB2F #-}

procB2FF
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Double 
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2FF :: forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
h MappingFunctionPL
g Coeffs2
coeffs = forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2FG GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs (Double -> Coeffs2 -> [Double] -> Double
eval23CoeffsF Double
k Coeffs2
coeffs) Double -> c
h MappingFunctionPL
g Coeffs2
coeffs
{-# INLINE procB2FF #-}

procB2InvFG
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> ([Double] -> Double)
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2InvFG :: forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFG GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs [Double] -> Double
h1 Double -> c
h MappingFunctionPL
g Coeffs2
coeffs String
sels = 
  forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (\ReadyForConstructionPL
t -> case ReadyForConstructionPL
t of
             StrG String
xs ->
               let !ys :: String
ys = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PhoneticsRepresentationPLX -> String
string1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]
stringToXG GWritingSystemPRPLX
wrs forall a b. (a -> b) -> a -> b
$ String
xs
                   !z :: Int16
z = forall (t1 :: * -> *) (t2 :: * -> *) (t3 :: * -> *) a.
(Foldable t1, Foldable t2, Foldable t3, Ord a) =>
t3 a -> t1 a -> t2 a -> Int16
diverse2GGL String
sels String
zs String
ys in if Int16
z forall a. Eq a => a -> a -> Bool
== Int16
0 then  ([Double] -> Double
h1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const [[-Double
5.0]]) (MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])
fromPhoPaaW MappingFunctionPL
g)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([[PRS]] -> [[PRS]]
divSylls forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PRS] -> [[PRS]]
groupSnds forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                         CharPhoneticClassification -> String -> [PRS]
str2PRSs CharPhoneticClassification
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t Char -> t Char -> Char -> Maybe Char
f String
us String
vs) forall a b. (a -> b) -> a -> b
$ String
ys) forall a. Floating a => a -> a -> a
** Double
2.0
                           else  (([Double] -> Double
h1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const [[-Double
5.0]]) (MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])
fromPhoPaaW MappingFunctionPL
g)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([[PRS]] -> [[PRS]]
divSylls forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Char, Char)] -> SegmentRulesG -> [[PRS]] -> [[PRS]]
reSyllableCntnts [(Char, Char)]
ks SegmentRulesG
gs forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PRS] -> [[PRS]]
groupSnds forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPhoneticClassification -> String -> [PRS]
str2PRSs CharPhoneticClassification
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words1 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t Char -> t Char -> Char -> Maybe Char
f String
us String
vs) forall a b. (a -> b) -> a -> b
$ String
ys) forall a. Fractional a => a -> a -> a
/ (Int -> Double
int2Double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ Int16
z))
             FSLG [[[Int8]]]
tsss -> [Double] -> Double
h1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> b -> a
const [[-Double
6.0]]) (MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])
fromSaaW MappingFunctionPL
g)) forall a b. (a -> b) -> a -> b
$ [[[Int8]]]
tsss) Double -> c
h
                   where  zs :: String
zs = Char
' 'forall a. a -> [a] -> [a]
:String
us forall a. Monoid a => a -> a -> a
`mappend` String
vs
{-# INLINE procB2InvFG #-}

procB2InvF
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2InvF :: forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double -> c
h MappingFunctionPL
g Coeffs2
coeffs= forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFG GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs (Coeffs2 -> [Double] -> Double
eval23Coeffs Coeffs2
coeffs) Double -> c
h MappingFunctionPL
g Coeffs2
coeffs
{-# INLINE procB2InvF #-}

procB2InvFF
  :: (Ord c) =>  GWritingSystemPRPLX
  -> [(Char,Char)]
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Double
  -> (Double -> c)
  -> MappingFunctionPL
  -> Coeffs2
  -> String  -- ^ Specifies the list of 'Char' that the function is sensitive to.
  -> FuncRep2 ReadyForConstructionPL Double c
procB2InvFF :: forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFF GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs Double
k Double -> c
h MappingFunctionPL
g Coeffs2
coeffs = forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFG GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
us String
vs (Double -> Coeffs2 -> [Double] -> Double
eval23CoeffsF Double
k Coeffs2
coeffs) Double -> c
h MappingFunctionPL
g Coeffs2
coeffs
{-# INLINE procB2InvFF #-}

---------------------------------------------------------------------

procRhythm23F
  :: (Ord c) => (Double -> c)
  -> String
  -> (String -> Coeffs2 -> ReadyForConstructionPL -> Double)
  -> Coeffs2
  -> FuncRep2 ReadyForConstructionPL Double c
procRhythm23F :: forall c.
Ord c =>
(Double -> c)
-> String
-> (String -> Coeffs2 -> ReadyForConstructionPL -> Double)
-> Coeffs2
-> FuncRep2 ReadyForConstructionPL Double c
procRhythm23F Double -> c
h String
choice String -> Coeffs2 -> ReadyForConstructionPL -> Double
g Coeffs2
coeffs = forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (String -> Coeffs2 -> ReadyForConstructionPL -> Double
g String
choice Coeffs2
coeffs) Double -> c
h
{-# INLINE procRhythm23F #-}

procRhythmicity23F
  :: (Ord c) => Double
  -> (Double -> c)
  -> (Double -> String -> MappingFunctionPL)
  -> String
  -> Coeffs2
  -> GWritingSystemPRPLX
  -> [(Char,Char)]
  -> CharPhoneticClassification
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ The starting 'String' which defines the line to be constructed
  -> FuncRep2 ReadyForConstructionPL Double c
procRhythmicity23F :: forall c.
Ord c =>
Double
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> String
-> Coeffs2
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
procRhythmicity23F Double
k Double -> c
g Double -> String -> MappingFunctionPL
h String
choice Coeffs2
coeffs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs String
bbs = forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (Double
-> String
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> String
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> ReadyForConstructionPL
-> Double
rhythmicity Double
k String
choice Double -> String -> MappingFunctionPL
h Coeffs2
coeffs String
bbs GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
hs String
us String
vs) Double -> c
g
{-# INLINE procRhythmicity23F #-}

-------------------------------------------------------------

f :: t Char -> t Char -> Char -> Maybe Char
f t Char
us t Char
vs Char
x
  | Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Char
us = forall a. Maybe a
Nothing
  | Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t Char
vs = forall a. a -> Maybe a
Just Char
x
  | Bool
otherwise = forall a. a -> Maybe a
Just Char
' '
{-# INLINE f #-}

words1 :: String -> [String]
words1 String
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ts then [] else String
w 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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') String
xs
        (String
w, String
s'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
' ') String
ts
{-# NOINLINE words1 #-}