phonetic-languages-simplified-generalized-properties-array 0.12.0.0 → 0.13.0.0

raw patch · 9 files changed

+802/−813 lines, 9 filesdep +logical-constraintsdep ~basedep ~lists-flinesdep ~mmsyn2-arrayPVP ok

version bump matches the API change (PVP)

Dependencies added: logical-constraints

Dependency ranges changed: base, lists-flines, mmsyn2-array, phonetic-languages-basis, phonetic-languages-phonetics-basics, phonetic-languages-rhythmicity

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−1
• LICENSE +1/−1
• Phladiprelio/General/EmphasisG.hs +245/−0
• Phladiprelio/General/PropertiesFuncRepG2.hs +247/−0
• Phladiprelio/General/PropertiesSyllablesG2.hs +298/−0
• Phonetic/Languages/Array/General/PropertiesFuncRepG2.hs +0/−253
• Phonetic/Languages/Array/General/PropertiesSyllablesG2.hs +0/−322
• Phonetic/Languages/EmphasisG.hs +0/−231
• phonetic-languages-simplified-generalized-properties-array.cabal +5/−5

@@ -108,4 +108,9 @@  ## 0.12.0.0 -- 2022-09-13 -* Twelfth version. Moved the common functionality for coeffs to the phonetic-languages-basis package. Added new functionality to use diverse2GGL function. +* Twelfth version. Moved the common functionality for coeffs to the phonetic-languages-basis package. Added new functionality to use diverse2GGL function.++## 0.13.0.0 -- 2023-03-02++* Thirteenth version. Switched to the NoImplicitPrelude extension. Some code deduplication. Updated+  the dependencies boundaries to use the new functionality. 

@@ -1,4 +1,4 @@-Copyright (c) 2021-2022 Oleksandr Zhabenko+Copyright (c) 2021-2023 Oleksandr Zhabenko  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the

@@ -0,0 +1,245 @@+{-# OPTIONS_HADDOCK -show-extensions #-}+{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}++-- |+-- Module      :  Phladiprelio.General.General.EmphasisG+-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Some functionality for SaaW mode of operation for PhLADiPreLiO.+-- ++module Phladiprelio.General.EmphasisG where++import GHC.Base+import GHC.Num ((+),(-))+import GHC.Real (fromIntegral)+import Text.Show (Show (..))+import Data.Tuple (fst,snd)+import GHC.List +import Data.List (words)+import Phladiprelio.General.Base+import Phladiprelio.General.Syllables+import GHC.Int+import Data.Maybe (fromMaybe)+import Text.Read (readMaybe)+import Data.Char (toUpper)+import GHC.Arr+import Data.List (scanl',intersperse)+import CaseBi.Arr (getBFst',getBFstL',getBFstLSorted')+import Data.Lists.FLines (newLineEnding)+import Data.Traversable (traverse)+import Control.Applicative+import System.IO (stderr,hPutStr,getLine)++data SyllWeightsG = SyG {+  point :: ![PRS]+  , order :: !Int8 -- Is intended to begin at -128 up to 127 (maximum 256 entries).+  , weight :: !Double+}++showFSG :: FlowSoundG -> String+showFSG = map charS+{-# INLINE showFSG #-}++type FlowSoundG = [PRS]++instance Show SyllWeightsG where+  show (SyG ps i w) = showFSG ps `mappend` (' ':show i) `mappend` (' ':show w) `mappend` newLineEnding++weightSyllablesIO :: [FlowSoundG] -> IO [SyllWeightsG]+weightSyllablesIO = traverse (\(i,xs) -> (\d1 -> (SyG xs i d1)) <$> weightSyllAIO False xs)  . zip ([-128..127]::[Int8])++weightStringIO +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String +  -> IO ([[FlowSoundG]],[SyllWeightsG],[[[Int8]]])+weightStringIO wrs ks arr hs us vs xs = weightSyllablesIO fss >>= \zs -> pure (tsss, zs, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)+  where tsss = createSyllablesPL wrs ks arr hs us vs xs+        fss = [ ts | tss <- tsss , ts <- tss ]++weightStringNIO +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> Int +  ->  String +  -> IO ([[FlowSoundG]],[[SyllWeightsG]],[[[Int8]]])+weightStringNIO wrs ks arr hs us vs n xs = traverse (\_-> weightSyllablesIO fss) [1..n] >>= \zss -> pure (tsss, zss, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)+  where tsss = createSyllablesPL wrs ks arr hs us vs xs+        fss = [ ts | tss <- tsss , ts <- tss ]++weights2SyllableDurationsDArr :: [SyllWeightsG] -> Array Int (Int8,Double)+weights2SyllableDurationsDArr xs = listArray (0,l-1) . map (\(SyG _ i w) -> (i,w)) $ xs+  where l = length xs++weights2SyllableDurationsD :: [SyllWeightsG] -> [[[Int8]]] -> [[Double]]+weights2SyllableDurationsD xs = map (map (k (getBFst' (4.0, weights2SyllableDurationsDArr xs))))+  where k f = foldl' (\y x -> f x + y) 0+{-# INLINE weights2SyllableDurationsD #-}++helper1F :: [Int8] -> [[[Int8]]]+helper1F (x:y:ys) = map (:[]) [x..y-1]:helper1F (y:ys)+helper1F _ = []++weightSyllAIO :: Bool -> FlowSoundG -> IO Double+weightSyllAIO upper xs+  | null xs = pure 4.0+  | otherwise = +    (\d -> fromMaybe 4.0 (readMaybe d::Maybe Double)) <$> (hPutStr stderr ("?  " `mappend` ((if upper then map toUpper else id) . showFSG $ xs) `mappend` "   ") *> getLine) -- Well, definitely it should not be 'stderr' here, but 'stdout' gives some strange behaviour, probably related to optimizations or some strange 'Handle' behaviour. (?)+++data ReadyForConstructionPL = StrG String | FSLG [[[Int8]]] deriving (Eq,Ord)++showR :: ReadyForConstructionPL -> String+showR (StrG xs) = xs+showR (FSLG tsss) = show tsss++isStr :: ReadyForConstructionPL -> Bool+isStr (StrG _) = True+isStr _ = False++isFSL :: ReadyForConstructionPL -> Bool+isFSL (FSLG _) = True+isFSL _ = False++fromReadyFCPLS :: ReadyForConstructionPL -> Maybe String+fromReadyFCPLS (StrG xs) = Just xs+fromReadyFCPLS _ = Nothing++fromReadyFCPLF :: ReadyForConstructionPL -> Maybe [[[Int8]]]+fromReadyFCPLF (FSLG xsss) = Just xsss+fromReadyFCPLF _ = Nothing++helper2F :: [b] -> [a] -> [c] -> [[d]] -> [([b],[a],[c])]+helper2F vs xs ys tss = let (us,ks,rs) = unzip3 . zip3 vs xs $ ys in+  helper2F' us ks rs tss+    where helper2F' us@(_:_) ks@(_:_) rs@(_:_) tss@(ts:wss) =+            let l = length ts+                (wws,vvs) = splitAt l us+                (qs,ps) = splitAt l ks+                (ns,ms) = splitAt l rs+                in (wws,qs,ns):helper2F' vvs ps ms wss+          helper2F' _ _ _ _ = []+ +convF1 +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String +  -> [[FlowSoundG]]+convF1 wrs ks arr hs us vs xs+ | null xs = []+ | otherwise = [ tss | tss <- createSyllablesPL wrs ks arr hs us vs xs ]++convF3 +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String +  -> [([String],[[Int8]],[FlowSoundG])]+convF3 wrs ks arr hs us vs xs+ | null xs = [([],[],[])]+ | otherwise = helper2F (concatMap (map showFSG) tsss) (map (:[]) ([-128..127]::[Int8])) [ ts | tss <- qss, ts <- tss ] qss+    where tsss = createSyllablesPL wrs ks arr hs us vs xs+          qss = [ tss | tss <- tsss ]++convF3W +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String +  -> [(String,[[Int8]])]+convF3W wrs ks arr hs us vs xs+ | null xs = [([],[])]+ | otherwise = zipWith (\(_,ys,_) ts -> (ts,ys)) (convF3 wrs ks arr hs us vs xs) . words $ xs++convFI +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String +  -> String +  -> [[[Int8]]]+convFI wrs ks arr hs us vs ts = map f . words+  where !f = getBFstL' [] (convF3W wrs ks arr hs us vs ts)++convFSL +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String +  -> ReadyForConstructionPL +  -> String+convFSL wrs ps arr hs us vs ts r@(StrG xs) = concat . concat . intersperse [" "] . map (\(ks,_,_)-> ks) . convF3 wrs ps arr hs us vs $ xs+   where js =  unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 wrs ps arr hs us vs $ ts+convFSL wrs ps arr hs us vs ts r@(FSLG tsss) =  concat . concat . intersperse [" "] . map (map (getBFstLSorted' " " ks) ) $ tsss+   where js = unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 wrs ps arr hs us vs $ ts+         ks = zip (concat . fst $ js) (concat . snd $ js)++weightsString3IO +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> Bool +  -> String +  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)+weightsString3IO wrs ps arr hs us vs bool bs + | bool = do+   (syllDs1,sylws,fsls0) <- weightStringIO wrs ps arr hs us vs bs+   let syllableDurationsD2s = [weights2SyllableDurationsD sylws]+   return (syllDs1,syllableDurationsD2s,FSLG fsls0) + | otherwise = return ([],[],FSLG [])++weightsString3NIO +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> Int +  -> Bool +  -> String +  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)+weightsString3NIO wrs ps arr hs us vs n bool bs + | bool = (\(syllDs1,sylws,fsls0) -> (syllDs1,map weights2SyllableDurationsD sylws,FSLG fsls0)) <$> weightStringNIO wrs ps arr hs us vs n bs+ | otherwise = pure ([],[],FSLG [])+    

@@ -0,0 +1,247 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phladiprelio.General.PropertiesFuncRepG2+-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@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 Phladiprelio.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 BangPatterns, NoImplicitPrelude #-}++module Phladiprelio.General.PropertiesFuncRepG2 (+  -- * Functions with 'Int16'+  procDiverse2I+  -- * Functions with 'Double'+  , procB2FG+  , procB2F+  , procB2FF+  , procB2InvFG+  , procB2InvF+  , procB2InvFF+  , procRhythm23F+  , procDiverse2F+  -- * Working with rhythmicity+  , procRhythmicity23F+) where++import GHC.Base+import GHC.Int+import GHC.List+import GHC.Enum (fromEnum)+import GHC.Num ((+),(-),(*))+import GHC.Float ((**),int2Double)+import GHC.Real ((/))+import Phladiprelio.General.PropertiesSyllablesG2+import Phladiprelio.UniquenessPeriodsG+import Phladiprelio.Rhythmicity.Simple+import Phladiprelio.Rhythmicity.Factor+import Phladiprelio.Basis+import Phladiprelio.General.Base+import Phladiprelio.General.Syllables hiding (D)+import Data.Maybe (fromMaybe,mapMaybe)+import Phladiprelio.General.EmphasisG+import Phladiprelio.Coeffs++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 wrs zs g sels = +  D (\x -> case x of+             StrG xs -> diverse2GGL sels zs . concatMap string1 . stringToXG wrs $ xs+             FSLG tsss -> 1) 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 wrs zs g sels = +  D (\x ->case x of+           StrG xs -> int2Double . fromEnum . diverse2GGL sels zs . concatMap string1 . stringToXG wrs $ xs+           FSLG _ -> 1.0) g+{-# INLINE procDiverse2F #-}++--------------------------------------------------------------------------------------------++eval23Coeffs :: Coeffs2 -> [Double] -> Double+eval23Coeffs (CF2 x y) = evalRhythmicity23K (fromMaybe 1.0 x) (fromMaybe 1.0 y)+eval23Coeffs CF0 = evalRhythmicity23+{-# INLINE eval23Coeffs #-}++eval23CoeffsF :: Factors -> Double -> Coeffs2 -> [Double] -> Double+eval23CoeffsF ff k (CF2 x y) = evalRhythmicity23KF ff k (fromMaybe 1.0 x) (fromMaybe 1.0 y)+eval23CoeffsF ff k CF0 = evalRhythmicity23F ff 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 wrs ks arr gs us vs h1 h g coeffs sels =  +  D (\t -> case t of+             StrG xs -> let ys = concatMap string1 . stringToXG wrs $ xs in+                                ((int2Double . fromEnum . diverse2GGL sels zs $ ys)*(h1 . mconcat . (fromMaybe (const [[-5.0]])  (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . +                                 groupSnds . str2PRSs arr) . words1 . mapMaybe (f us vs) $ ys))+             FSLG tsss -> h1 . mconcat . (fromMaybe (const [[-6.0]]) (fromSaaW g)) $ tsss) h+                  where  zs = ' ':us `mappend` 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 wrs ks arr gs us vs h g coeffs = procB2FG wrs ks arr gs us vs (eval23Coeffs coeffs) h g coeffs+{-# INLINE procB2F #-}++procB2FF+  :: (Ord c) =>  Factors+  -> 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 ff wrs ks arr gs us vs k h g coeffs = procB2FG wrs ks arr gs us vs (eval23CoeffsF ff k coeffs) h g 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 wrs ks arr gs us vs h1 h g coeffs sels = +  D (\t -> case t of+             StrG xs ->+               let !ys = concatMap string1 . stringToXG wrs $ xs+                   !z = diverse2GGL sels zs ys in if z == 0 then  (h1 . mconcat . (fromMaybe (const [[-5.0]]) (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . groupSnds .+                         str2PRSs arr) . words1 . mapMaybe (f us vs) $ ys) ** 2.0+                           else  ((h1 . mconcat . (fromMaybe (const [[-5.0]]) (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . groupSnds . str2PRSs arr) . words1 .+                              mapMaybe (f us vs) $ ys) / (int2Double . fromEnum $ z))+             FSLG tsss -> h1 . mconcat . (fromMaybe (const [[-6.0]]) (fromSaaW g)) $ tsss) h+                   where  zs = ' ':us `mappend` 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 wrs ks arr gs us vs h g coeffs= procB2InvFG wrs ks arr gs us vs (eval23Coeffs coeffs) h g coeffs+{-# INLINE procB2InvF #-}++procB2InvFF+  :: (Ord c) => Factors+  -> 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 ff wrs ks arr gs us vs k h g coeffs = procB2InvFG wrs ks arr gs us vs (eval23CoeffsF ff k coeffs) h g coeffs+{-# INLINE procB2InvFF #-}++---------------------------------------------------------------------++procRhythm23F+  :: (Ord c) => (Double -> c)+  -> String+  -> (String -> Coeffs2 -> ReadyForConstructionPL -> Double)+  -> Coeffs2+  -> FuncRep2 ReadyForConstructionPL Double c+procRhythm23F h choice g coeffs = D (g choice coeffs) h+{-# INLINE procRhythm23F #-}++procRhythmicity23F+  :: (Ord c) => Factors+  -> 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 ff k g h choice coeffs wrs ks arr hs us vs bbs = D (rhythmicity ff k choice h coeffs bbs wrs ks arr hs us vs) g+{-# INLINE procRhythmicity23F #-}++-------------------------------------------------------------++f us vs x+  | x `elem` us = Nothing+  | x `notElem` vs = Just x+  | otherwise = Just ' '+{-# INLINE f #-}++words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.+  where ts = dropWhile (== ' ') xs+        (w, s'') = break (== ' ') ts+{-# NOINLINE words1 #-}++

@@ -0,0 +1,298 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phladiprelio.General.PropertiesSyllablesG2+-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Generalization and extension of the functionality of the DobutokO.Poetry.Norms+-- and DobutokO.Poetry.Norms.Extended modules+-- from the @dobutokO-poetry@ package and more recent package @phonetic-languages-simplified-properties-array@.+-- Uses syllables information.+-- Instead of the vector-related, uses arrays.+-- If you use the functionality of the Phladiprelio.Ukrainian.PropertiesSyllablesG2 module,+-- then import it qualified (or this module) because they have many common data. Is provided as a standalone one+-- to reduce dependencies list in general case.++{-# LANGUAGE BangPatterns, MultiWayIf, NoImplicitPrelude #-}++module Phladiprelio.General.PropertiesSyllablesG2 (+  -- * Mapping function data type+  MappingFunctionPL(..)+  , isPhoPaaW+  , isSaaW+  , fromPhoPaaW+  , fromSaaW+  -- * Rhythmicity properties (semi-empirical)+  -- ** Simple one+  , rhythmicity0i+  , rhythmicity0Fi+  -- ** With weight coefficients+  , rhythmicityKi+  , rhythmicityKFi+  -- * General+  , rhythmicityG+  , rhythmicity+) where++import GHC.Base+import GHC.List+import Phladiprelio.Rhythmicity.Simple+import Phladiprelio.Rhythmicity.Factor+import Phladiprelio.Rhythmicity.TwoFourth+import Phladiprelio.Rhythmicity.PolyRhythm+import Phladiprelio.General.Base+import Phladiprelio.General.Syllables+import Data.Maybe (isNothing,fromMaybe,fromJust)+import Text.Read (readMaybe)+import Phladiprelio.General.EmphasisG+import GHC.Int (Int8)+import Phladiprelio.Coeffs+import qualified Logical.OrdConstraints as L+++eval23 = evalRhythmicity23 . mconcat+{-# INLINE eval23 #-}++eval23K k2 k3 = evalRhythmicity23K k2 k3 . mconcat+{-# INLINE eval23K #-}++eval23F ff k = evalRhythmicity23F ff k . mconcat+{-# INLINE eval23F #-}++eval23KF ff k k2 k3 = evalRhythmicity23KF ff k k2 k3 . mconcat+{-# INLINE eval23KF #-}++--------------------------------------------------------------------------------------------++data MappingFunctionPL = PhoPaaW ([[[PRS]]] -> [[Double]]) | SaaW ([[[Int8]]] -> [[Double]])++isPhoPaaW :: MappingFunctionPL -> Bool+isPhoPaaW (PhoPaaW _) = True+isPhoPaaW _ = False++isSaaW :: MappingFunctionPL -> Bool+isSaaW (SaaW _) = True+isSaaW _ = False++fromPhoPaaW :: MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])+fromPhoPaaW (PhoPaaW f) = Just f+fromPhoPaaW _ = Nothing++fromSaaW :: MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])+fromSaaW (SaaW f) = Just f+fromSaaW _ = Nothing++rhythmicityG+  :: MappingFunctionPL-- ^ A function that specifies the syllables durations, analogue of the+  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.+  -> ([[Double]] -> Double) -- ^ Usually some kind of flattening of the double list into a single value.+  -> String -- ^ The starting 'String' which creates the order for the 'FSLG' representation+  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> ReadyForConstructionPL+  -> Double+rhythmicityG f g bbs wrs ks arr hs us vs xs@(FSLG tsss)+ | null tsss = -1.0+ | isSaaW f = g . (fromJust (fromSaaW f)) $ tsss+ | otherwise = -3.0+rhythmicityG f g bbs wrs ks arr hs us vs xs@(StrG ys)+ | null ys = -2.0+ | isPhoPaaW f = g . (fromJust (fromPhoPaaW f)) . createSyllablesPL wrs ks arr hs us vs $ ys+ | otherwise = g . (fromJust (fromSaaW f)) . convFI wrs ks arr hs us vs bbs $ ys+{-# INLINE rhythmicityG #-}++-------------------------------------------------------++rhythmicity0i+  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the+  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.+  -> String +  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> ReadyForConstructionPL+  -> Double+rhythmicity0i f = rhythmicityG f eval23 +{-# INLINE rhythmicity0i #-}++-------------------------------------------------------++rhythmicityKi+  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the+  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.+  -> Double+  -> Double+  -> String+  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> ReadyForConstructionPL+  -> Double+rhythmicityKi f k2 k3 = rhythmicityG f (eval23K k2 k3)+{-# INLINE rhythmicityKi #-}++--------------------------------------------------------++rhythmicity0Fi+  :: Factors+  -> MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the+  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.+  -> Double+  -> String+  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> ReadyForConstructionPL+  -> Double+rhythmicity0Fi ff f k = rhythmicityG f (eval23F ff k)+{-# INLINE rhythmicity0Fi #-}++--------------------------------------------------------++rhythmicityKFi+  :: Factors+  -> MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the+  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.+  -> Double+  -> Double+  -> Double+  -> String+  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> ReadyForConstructionPL+  -> Double+rhythmicityKFi ff f k k2 k3 = rhythmicityG f (eval23KF ff k k2 k3)+{-# INLINE rhythmicityKFi #-}++--------------------------------------------------------++-- | It is intended to provide different functions :: 'Double' -> 'String' -> ([[['PRS']]] -> [['Double']]).+-- The \"z\"-line uses \'F\' functions.+rhythmicity+  :: Factors+  -> Double+  -> String -- ^ The \"f\"-line uses \'F\' functions since the version 0.13.0.0.+  -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.+ -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and+ -- depends on two parameters.+  -> Coeffs2+  -> String+  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon+  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.+  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.+  -> SegmentRulesG+  -> String+  -> String+  -> ReadyForConstructionPL+  -> Double+rhythmicity ff k choice@(c1:c2@(c3:c4@(c5:cs))) h CF0+ | c1 == '0' && c2 `elem` ["2f","3f","4f"] = rhythmicity0Fi ff f k+ | c1 == '0' && c2 `elem` ["2y","3y","4y"] = rhythmicity0i f + | c1 `elem` "wx" = case c3 of+     '0' -> w0F (Ch 1 1 4) (Rhythm 1 1 2)+     '1' -> w0F (Ch 1 0 4) (Rhythm 2 1 1)+     '2' -> w0F (Ch 0 1 4) (Rhythm 1 2 1)+     '3' -> w0F (Ch 0 0 4) (Rhythm 1 1 2)+     _ -> w0F (Ch 0 0 4) (Rhythm 1 1 2)+ | L.ordCs2HPred1 [L.O "cMN", L.C "AF"] c1 = let just_probe = readRhythmicity choice in+           case just_probe of+             Just (P1 ch rh _) -> rhythmicityG f (rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat)+             Just (P2 ch rh r _) -> rhythmicityG f ((helperF5 c1) 1.0 r ch rh . mconcat)+             _ -> rhythmicity0i f+ | L.ordCs2HPred1 [L.O "z", L.C "begvIZ"] c1 && c3 >= '0' && c3 <= '7' = let u0F rs = rhythmicityG f ((helperF6 c1) 1.0 4 (PolyCh rs 5) (PolyRhythm (if c3 < '4' then [1,2,1,1] else [2,1,1,1])) . mconcat) in u0F +       (case c3 of+         '0' -> [True,True,True]+         '1' -> [True,True,False]+         '2' -> [True,False,True]+         '3' -> [True,False,False]+         '4' -> [False,False,True]+         '5' -> [False,True,False]+         '6' -> [False,True,True]+         '7' -> [False,False,False])+ | otherwise = rhythmicity0i f+     where f = h k choice+           w0F ch rh = rhythmicityG f ((if c1 == 'w' then rhythmicityABC else rhythmicityABC0) 1.0 2.0 0.125 ch rh . mconcat) +           {-# INLINE w0F #-}+rhythmicity ff k choice@(c1:c2@(c3:c4@(c5:cs))) h (CF2 x y)+ | c1 == '0' && c2 `elem` ["2f","3f","4f"] = rhythmicityKFi ff f k (fromMaybe 1.0 x) (fromMaybe 1.0 y)+ | c1 == '0' && c2 `elem` ["2y","3y","4y"] = rhythmicityKi f (fromMaybe 1.0 x) (fromMaybe 1.0 y)+ | c1 `elem` "wx" = if+   | c3 == '0' && (c5 >= '1' && c5 <= '4') -> w0F (Ch 1 1 4) (Rhythm 1 1 2)+   | c3 == '1' && (c5 >= '1' && c5 <= '4') -> w0F (Ch 1 0 4) (Rhythm 2 1 1)+   | c3 == '2' && (c5 >= '1' && c5 <= '4') -> w0F (Ch 0 1 4) (Rhythm 1 2 1)+   | c3 == '3' && (c5 >= '1' && c5 <= '4') -> w0F (Ch 0 0 4) (Rhythm 1 1 2)+   | otherwise -> w0F (Ch 1 0 4) (Rhythm 1 1 2)+ | L.ordCs2HPred1 [L.O "cz",L.C "begvAFIZ"] c1 = rhythmicity ff k choice h CF0+ | otherwise = rhythmicityKi f (fromMaybe 1.0 x) (fromMaybe 1.0 y)+     where f = h k choice+           w0F ch rh = rhythmicityG f ((if c1 == 'w' then rhythmicityABC else rhythmicityABC0) 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat)+           {-# INLINE w0F #-}+rhythmicity ff k choice@(c1:c2@(c3:cs)) h CF0+ | choice == "0f" = rhythmicity0Fi ff f k+ | otherwise = rhythmicity0i f+    where f = h k choice+rhythmicity ff k choice@(c1:c2@(c3:cs)) h (CF2 x y)+ | choice == "0f" = rhythmicityKFi ff f k (fromMaybe 1.0 x) (fromMaybe 1.0 y)+ | otherwise = rhythmicityKi f (fromMaybe 1.0 x) (fromMaybe 1.0 y)+    where f = h k choice+rhythmicity ff k choice h _ =  rhythmicity0i (h k choice)++helperF5 c + | c == 'A' = rhythmicityPolyWeightedLEF2+ | c == 'D' = rhythmicityPolyWeightedLF2+ | c == 'E' = rhythmicityPolyWeightedLEF3+ | c == 'F' = rhythmicityPolyWeightedLF3+ | c == 'B' = rhythmicityPolyWeightedEF2+ | c == 'C' = rhythmicityPolyWeightedF2+ | c == 'M' = rhythmicityPolyWeightedEF3+ | c == 'N' = rhythmicityPolyWeightedF3+ | otherwise = rhythmicityPoly++helperF6 c+   | c == 's' || c == 'u' = rhythmicityPoly+   | c == 't' || c == 'v' = rhythmicityPoly0+   | c == 'S' || c == 'U' = rhythmicityPolyWeightedF2+   | c == 'T' || c == 'V' = rhythmicityPolyWeightedF20+   | c == 'Y' || c == 'W' = rhythmicityPolyWeightedF3+   | c == 'X' || c == 'Z' = rhythmicityPolyWeightedF30+   | c == 'O' || c == 'Q' = rhythmicityPolyWeightedEF2+   | c == 'P' || c == 'R' = rhythmicityPolyWeightedEF20+   | c == 'I' || c == 'K' = rhythmicityPolyWeightedEF3+   | c == 'J' || c == 'L' = rhythmicityPolyWeightedEF30+   | c == 'o' || c == 'q' = rhythmicityPolyWeightedLF2+   | c == 'p' || c == 'r' = rhythmicityPolyWeightedLF20+   | c == 'k' || c == 'm' = rhythmicityPolyWeightedLF3+   | c == 'l' || c == 'n' = rhythmicityPolyWeightedLF30+   | c == 'g' || c == 'i' = rhythmicityPolyWeightedLEF2+   | c == 'h' || c == 'j' = rhythmicityPolyWeightedLEF20+   | c == 'b' || c == 'e' = rhythmicityPolyWeightedLEF3+   | c == 'd' || c == 'z' = rhythmicityPolyWeightedLEF30+   | otherwise = rhythmicityPoly++

@@ -1,253 +0,0 @@-{-# 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 wrs zs g sels = -  D (\x -> case x of-             StrG xs -> diverse2GGL sels zs . concatMap string1 . stringToXG wrs $ xs-             FSLG tsss -> 1) 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 wrs zs g sels = -  D (\x ->case x of-           StrG xs -> int2Double . fromEnum . diverse2GGL sels zs . concatMap string1 . stringToXG wrs $ xs-           FSLG _ -> 1.0) g-{-# INLINE procDiverse2F #-}------------------------------------------------------------------------------------------------eval23Coeffs :: Coeffs2 -> [Double] -> Double-eval23Coeffs (CF2 x y) = evalRhythmicity23K (fromMaybe 1.0 x) (fromMaybe 1.0 y)-eval23Coeffs CF0 = evalRhythmicity23-{-# INLINE eval23Coeffs #-}--eval23CoeffsF :: Double -> Coeffs2 -> [Double] -> Double-eval23CoeffsF k (CF2 x y) = evalRhythmicity23KF k (fromMaybe 1.0 x) (fromMaybe 1.0 y)-eval23CoeffsF k CF0 = evalRhythmicity23F 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 wrs ks arr gs us vs h1 h g coeffs sels =  -  D (\t -> case t of-             StrG xs -> let ys = concatMap string1 . stringToXG wrs $ xs in-                                ((int2Double . fromEnum . diverse2GGL sels zs $ ys)*(h1 . mconcat . (fromMaybe (const [[-5.0]])  (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . -                                 groupSnds . str2PRSs arr) . words1 . mapMaybe (f us vs) $ ys))-             FSLG tsss -> h1 . mconcat . (fromMaybe (const [[-6.0]]) (fromSaaW g)) $ tsss) h-                  where  zs = ' ':us `mappend` 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 wrs ks arr gs us vs h g coeffs = procB2FG wrs ks arr gs us vs (eval23Coeffs coeffs) h g 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 wrs ks arr gs us vs k h g coeffs = procB2FG wrs ks arr gs us vs (eval23CoeffsF k coeffs) h g 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 wrs ks arr gs us vs h1 h g coeffs sels = -  D (\t -> case t of-             StrG xs ->-               let !ys = concatMap string1 . stringToXG wrs $ xs-                   !z = diverse2GGL sels zs ys in if z == 0 then  (h1 . mconcat . (fromMaybe (const [[-5.0]]) (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . groupSnds .-                         str2PRSs arr) . words1 . mapMaybe (f us vs) $ ys) ** 2.0-                           else  ((h1 . mconcat . (fromMaybe (const [[-5.0]]) (fromPhoPaaW g)) . map (divSylls . reSyllableCntnts ks gs . groupSnds . str2PRSs arr) . words1 .-                              mapMaybe (f us vs) $ ys) / (int2Double . fromEnum $ z))-             FSLG tsss -> h1 . mconcat . (fromMaybe (const [[-6.0]]) (fromSaaW g)) $ tsss) h-                   where  zs = ' ':us `mappend` 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 wrs ks arr gs us vs h g coeffs= procB2InvFG wrs ks arr gs us vs (eval23Coeffs coeffs) h g 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 wrs ks arr gs us vs k h g coeffs = procB2InvFG wrs ks arr gs us vs (eval23CoeffsF k coeffs) h g coeffs-{-# INLINE procB2InvFF #-}-------------------------------------------------------------------------procRhythm23F-  :: (Ord c) => (Double -> c)-  -> String-  -> (String -> Coeffs2 -> ReadyForConstructionPL -> Double)-  -> Coeffs2-  -> FuncRep2 ReadyForConstructionPL Double c-procRhythm23F h choice g coeffs = D (g choice coeffs) 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 k g h choice coeffs wrs ks arr hs us vs bbs = D (rhythmicity k choice h coeffs bbs wrs ks arr hs us vs) g-{-# INLINE procRhythmicity23F #-}-----------------------------------------------------------------f us vs x-  | x `elem` us = Nothing-  | x `notElem` vs = Just x-  | otherwise = Just ' '-{-# INLINE f #-}--words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.-  where ts = dropWhile (== ' ') xs-        (w, s'') = break (== ' ') ts-{-# NOINLINE words1 #-}--

@@ -1,322 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Phonetic.Languages.Array.General.PropertiesSyllablesG2--- Copyright   :  (c) OleksandrZhabenko 2020-2022--- License     :  MIT--- Stability   :  Experimental--- Maintainer  :  olexandr543@yahoo.com------ Generalization and extension of the functionality of the DobutokO.Poetry.Norms--- and DobutokO.Poetry.Norms.Extended modules--- from the @dobutokO-poetry@ package and more recent package @phonetic-languages-simplified-properties-array@.--- Uses syllables information.--- Instead of the vector-related, uses arrays.--- If you use the functionality of the Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 module,--- then import it qualified (or this module) because they have many common data. Is provided as a standalone one--- to reduce dependencies list in general case.--{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-}--module Phonetic.Languages.Array.General.PropertiesSyllablesG2 (-  -- * Mapping function data type-  MappingFunctionPL(..)-  , isPhoPaaW-  , isSaaW-  , fromPhoPaaW-  , fromSaaW-  -- * Rhythmicity properties (semi-empirical)-  -- ** Simple one-  , rhythmicity0i-  , rhythmicity0Fi-  -- ** With weight coefficients-  , rhythmicityKi-  , rhythmicityKFi-  -- * General-  , rhythmicityG-  , rhythmicity-) 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 Languages.Rhythmicity-import Languages.Rhythmicity.Factor-import Rhythmicity.TwoFourth-import Rhythmicity.PolyRhythm-import Data.Phonetic.Languages.Base-import Data.Phonetic.Languages.Syllables-import Data.Maybe (isNothing,fromMaybe,fromJust)-import Text.Read (readMaybe)-import Phonetic.Languages.EmphasisG-import GHC.Int (Int8)-import Phonetic.Languages.Coeffs--#ifdef __GLASGOW_HASKELL__-#if __GLASGOW_HASKELL__==708-/* code that applies only to GHC 7.8.* */-mconcat = concat-#endif-#endif--eval23 = evalRhythmicity23 . mconcat-{-# INLINE eval23 #-}--eval23K k2 k3 = evalRhythmicity23K k2 k3 . mconcat-{-# INLINE eval23K #-}--eval23F k = evalRhythmicity23F k . mconcat-{-# INLINE eval23F #-}--eval23KF k k2 k3 = evalRhythmicity23KF k k2 k3 . mconcat-{-# INLINE eval23KF #-}------------------------------------------------------------------------------------------------data MappingFunctionPL = PhoPaaW ([[[PRS]]] -> [[Double]]) | SaaW ([[[Int8]]] -> [[Double]])--isPhoPaaW :: MappingFunctionPL -> Bool-isPhoPaaW (PhoPaaW _) = True-isPhoPaaW _ = False--isSaaW :: MappingFunctionPL -> Bool-isSaaW (SaaW _) = True-isSaaW _ = False--fromPhoPaaW :: MappingFunctionPL -> Maybe ([[[PRS]]] -> [[Double]])-fromPhoPaaW (PhoPaaW f) = Just f-fromPhoPaaW _ = Nothing--fromSaaW :: MappingFunctionPL -> Maybe ([[[Int8]]] -> [[Double]])-fromSaaW (SaaW f) = Just f-fromSaaW _ = Nothing--rhythmicityG-  :: MappingFunctionPL-- ^ A function that specifies the syllables durations, analogue of the-  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.-  -> ([[Double]] -> Double) -- ^ Usually some kind of flattening of the double list into a single value.-  -> String -- ^ The starting 'String' which creates the order for the 'FSLG' representation-  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> ReadyForConstructionPL-  -> Double-rhythmicityG f g bbs wrs ks arr hs us vs xs@(FSLG tsss)- | null tsss = -1.0- | isSaaW f = g . (fromJust (fromSaaW f)) $ tsss- | otherwise = -3.0-rhythmicityG f g bbs wrs ks arr hs us vs xs@(StrG ys)- | null ys = -2.0- | isPhoPaaW f = g . (fromJust (fromPhoPaaW f)) . createSyllablesPL wrs ks arr hs us vs $ ys- | otherwise = g . (fromJust (fromSaaW f)) . convFI wrs ks arr hs us vs bbs $ ys-{-# INLINE rhythmicityG #-}-----------------------------------------------------------rhythmicity0i-  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the-  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.-  -> String -  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> ReadyForConstructionPL-  -> Double-rhythmicity0i f = rhythmicityG f eval23 -{-# INLINE rhythmicity0i #-}-----------------------------------------------------------rhythmicityKi-  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the-  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.-  -> Double-  -> Double-  -> String-  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> ReadyForConstructionPL-  -> Double-rhythmicityKi f k2 k3 = rhythmicityG f (eval23K k2 k3)-{-# INLINE rhythmicityKi #-}------------------------------------------------------------rhythmicity0Fi-  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the-  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.-  -> Double-  -> String-  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> ReadyForConstructionPL-  -> Double-rhythmicity0Fi f k = rhythmicityG f (eval23F k)-{-# INLINE rhythmicity0Fi #-}------------------------------------------------------------rhythmicityKFi-  :: MappingFunctionPL -- ^ A function that specifies the syllables durations, analogue of the-  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package.-  -> Double-  -> Double-  -> Double-  -> String-  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> ReadyForConstructionPL-  -> Double-rhythmicityKFi f k k2 k3 = rhythmicityG f (eval23KF k k2 k3)-{-# INLINE rhythmicityKFi #-}-------------------------------------------------------------- | It is intended to provide different functions :: 'Double' -> 'String' -> ([[['PRS']]] -> [['Double']]) for at least the--- following values: \"0z\", \"02z\", \"03z\", \"04z\", \"0y\", \"02y\", \"03y\" and the default one for other variants.--- The \"z\"-line uses \'F\' functions.-rhythmicity-  :: Double-  -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",- -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",- -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one (that is the default one). Since the version 0.3.0.0 you- -- can also use \"w\" or \"x\"-based lines. Specifies the applied properties- -- to get the result. The \"z\"-line uses \'F\' functions.-  -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.- -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and- -- depends on two parameters.-  -> Coeffs2-  -> String-  -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String-  -> String-  -> ReadyForConstructionPL-  -> Double-rhythmicity k choice h CF0- | choice `elem` ["0z","02z","03z","04z"] = rhythmicity0Fi f k- | take 1 choice == "w" = case take 2 choice of-     "w0" -> w0F (Ch 1 1 4) (Rhythm 1 1 2)-     "w1" -> w0F (Ch 1 0 4) (Rhythm 2 1 1)-     "w2" -> w0F (Ch 0 1 4) (Rhythm 1 2 1)-     "w3" -> w0F (Ch 0 0 4) (Rhythm 1 1 2)-     _ -> w0F (Ch 0 0 4) (Rhythm 1 1 2)- | take 1 choice == "x" = case take 2 choice of-     "x0" -> x0F (Ch 1 1 4) (Rhythm 1 1 2)-     "x1" -> x0F (Ch 1 0 4) (Rhythm 2 1 1)-     "x2" -> x0F (Ch 0 1 4) (Rhythm 1 2 1)-     "x3" -> x0F (Ch 0 0 4) (Rhythm 1 1 2)-     _ -> x0F (Ch 0 0 4) (Rhythm 1 1 2)- | take 1 choice `elem` ["c","M","N"] || (take 1 choice >= "A" && take 1 choice <= "F") = let just_probe = readRhythmicity choice in-           case just_probe of-             Just (P1 ch rh _) -> rhythmicityG f (rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat)-             Just (P2 ch rh r _) -> rhythmicityG f ((helperF5 (take 1 choice)) 1.0 r ch rh . mconcat)-             _ -> rhythmicity0i f- | (take 1 choice >= "b" && take 1 choice <= "v") || (take 1 choice >= "I" && take 1 choice <= "Z") = if-     | (drop 1 . take 2 $ choice) >= "0" && (drop 1 . take 2 $ choice) <= "3" ->-         let u0F rs = rhythmicityG f ((helperF6 (take 1 choice)) 1.0 4 (PolyCh rs 5) (PolyRhythm [1,2,1,1]) . mconcat) in-               case drop 1 . take 2 $ choice of-                 "0" -> u0F [True,True,True]-                 "1" -> u0F [True,True,False]-                 "2" -> u0F [True,False,True]-                 _ -> u0F [True,False,False]-     | (drop 1 . take 2 $ choice) >= "4" && (drop 1 . take 2 $ choice) <= "7" ->-         let u0F rs = rhythmicityG f ((helperF6 (take 1 choice)) 1.0 4 (PolyCh rs 5) (PolyRhythm [2,1,1,1]) . mconcat) in-               case drop 1 . take 2 $ choice of-                 "4" -> u0F [True,True,True]-                 "5" -> u0F [True,True,False]-                 "6" -> u0F [True,False,True]-                 ~"7" -> u0F [True,False,False]-     | otherwise -> rhythmicity0i f- | otherwise = rhythmicity0i f-     where f = h k choice-           w0F ch rh = rhythmicityG f (rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat) -           x0F ch rh = rhythmicityG f (rhythmicityABC0 1.0 2.0 0.125 ch rh . mconcat)-           {-# INLINE w0F #-}-           {-# INLINE x0F #-}-rhythmicity k choice h (CF2 x y)- | choice `elem` ["0z","02z","03z","04z"] = rhythmicityKFi f k (fromMaybe 1.0 x) (fromMaybe 1.0 y)- | take 1 choice == "w" = if-   | choice `elem` ["w01","w02","w03","w04"] -> w0F (Ch 1 1 4) (Rhythm 1 1 2)-   | choice `elem` ["w11","w12","w13","w14"] -> w0F (Ch 1 0 4) (Rhythm 2 1 1)-   | choice `elem` ["w21","w22","w23","w24"] -> w0F (Ch 0 1 4) (Rhythm 1 2 1)-   | choice `elem` ["w31","w32","w33","w34"] -> w0F (Ch 0 0 4) (Rhythm 1 1 2)-   | otherwise -> w0F (Ch 1 0 4) (Rhythm 1 1 2)- | take 1 choice == "x" = if-   | choice `elem` ["x01","x02","x03","x04"] -> x0F (Ch 1 1 4) (Rhythm 1 1 2)-   | choice `elem` ["x11","x12","x13","x14"] -> x0F (Ch 1 0 4) (Rhythm 2 1 1)-   | choice `elem` ["x21","x22","x23","x24"] -> x0F (Ch 0 1 4) (Rhythm 1 2 1) -   | choice `elem` ["x31","x32","x33","x34"] -> x0F (Ch 0 0 4) (Rhythm 1 1 2)-   | otherwise -> x0F (Ch 1 0 4) (Rhythm 1 1 2)- | take 1 choice == "c" || (take 1 choice >= "A" && take 1 choice <= "Z" && take 1 choice `notElem` ["G","H"]) = rhythmicity k choice h CF0- | take 1 choice >= "b" && take 1 choice <= "v" = rhythmicity k choice h CF0- | otherwise = rhythmicityKi f (fromMaybe 1.0 x) (fromMaybe 1.0 y)-     where f = h k choice-           w0F ch rh = rhythmicityG f (rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat)-           x0F ch rh = rhythmicityG f (rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat)-           {-# INLINE w0F #-}-           {-# INLINE x0F #-}--helperF5 xs- | xs == "A" = rhythmicityPolyWeightedLEF2- | xs == "D" = rhythmicityPolyWeightedLF2- | xs == "E" = rhythmicityPolyWeightedLEF3- | xs == "F" = rhythmicityPolyWeightedLF3- | xs == "B" = rhythmicityPolyWeightedEF2- | xs == "C" = rhythmicityPolyWeightedF2- | xs == "M" = rhythmicityPolyWeightedEF3- | xs == "N" = rhythmicityPolyWeightedF3- | otherwise = rhythmicityPoly--helperF6 xs-   | xs == "s" || xs == "u" = rhythmicityPoly-   | xs == "t" || xs == "v" = rhythmicityPoly0-   | xs == "S" || xs == "U" = rhythmicityPolyWeightedF2-   | xs == "T" || xs == "V" = rhythmicityPolyWeightedF20-   | xs == "Y" || xs == "W" = rhythmicityPolyWeightedF3-   | xs == "X" || xs == "Z" = rhythmicityPolyWeightedF30-   | xs == "O" || xs == "Q" = rhythmicityPolyWeightedEF2-   | xs == "P" || xs == "R" = rhythmicityPolyWeightedEF20-   | xs == "I" || xs == "K" = rhythmicityPolyWeightedEF3-   | xs == "J" || xs == "L" = rhythmicityPolyWeightedEF30-   | xs == "o" || xs == "q" = rhythmicityPolyWeightedLF2-   | xs == "p" || xs == "r" = rhythmicityPolyWeightedLF20-   | xs == "k" || xs == "m" = rhythmicityPolyWeightedLF3-   | xs == "l" || xs == "n" = rhythmicityPolyWeightedLF30-   | xs == "g" || xs == "i" = rhythmicityPolyWeightedLEF2-   | xs == "h" || xs == "j" = rhythmicityPolyWeightedLEF20-   | xs == "b" || xs == "e" = rhythmicityPolyWeightedLEF3-   | xs == "d" || xs == "f" = rhythmicityPolyWeightedLEF30-   | otherwise = rhythmicityPoly--

@@ -1,231 +0,0 @@-{-# LANGUAGE BangPatterns #-}----module Phonetic.Languages.EmphasisG where--import Data.Phonetic.Languages.Base-import Data.Phonetic.Languages.Syllables-import GHC.Int-import Data.Maybe (fromMaybe)-import Text.Read (readMaybe)-import Data.Char (toUpper)-import GHC.Arr-import Data.List (scanl',intersperse)-import CaseBi.Arr-import Data.Foldable (foldl')-import CaseBi.Arr (getBFst',getBFstLSorted')-import Data.Lists.FLines (newLineEnding)-import Data.Traversable (traverse)-import Control.Applicative-import System.IO--data SyllWeightsG = SyG {-  point :: ![PRS]-  , order :: !Int8 -- Is intended to begin at -128 up to 127 (maximum 256 entries).-  , weight :: !Double-}--showFSG :: FlowSoundG -> String-showFSG = map charS-{-# INLINE showFSG #-}--type FlowSoundG = [PRS]--instance Show SyllWeightsG where-  show (SyG ps i w) = showFSG ps `mappend` (' ':show i) `mappend` (' ':show w) `mappend` newLineEnding--weightSyllablesIO :: [FlowSoundG] -> IO [SyllWeightsG]-weightSyllablesIO = traverse (\(i,xs) -> (\d1 -> (SyG xs i d1)) <$> weightSyllAIO False xs)  . zip ([-128..127]::[Int8])--weightStringIO -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -  -> IO ([[FlowSoundG]],[SyllWeightsG],[[[Int8]]])-weightStringIO wrs ks arr hs us vs xs = weightSyllablesIO fss >>= \zs -> pure (tsss, zs, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)-  where tsss = createSyllablesPL wrs ks arr hs us vs xs-        fss = [ ts | tss <- tsss , ts <- tss ]--weightStringNIO -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> Int -  ->  String -  -> IO ([[FlowSoundG]],[[SyllWeightsG]],[[[Int8]]])-weightStringNIO wrs ks arr hs us vs n xs = traverse (\_-> weightSyllablesIO fss) [1..n] >>= \zss -> pure (tsss, zss, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)-  where tsss = createSyllablesPL wrs ks arr hs us vs xs-        fss = [ ts | tss <- tsss , ts <- tss ]--weights2SyllableDurationsDArr :: [SyllWeightsG] -> Array Int (Int8,Double)-weights2SyllableDurationsDArr xs = listArray (0,l-1) . map (\(SyG _ i w) -> (i,w)) $ xs-  where l = length xs--weights2SyllableDurationsD :: [SyllWeightsG] -> [[[Int8]]] -> [[Double]]-weights2SyllableDurationsD xs = map (map (k (getBFst' (4.0, weights2SyllableDurationsDArr xs))))-  where k f = foldl' (\y x -> f x + y) 0-{-# INLINE weights2SyllableDurationsD #-}--helper1F :: [Int8] -> [[[Int8]]]-helper1F (x:y:ys) = map (:[]) [x..y-1]:helper1F (y:ys)-helper1F _ = []--weightSyllAIO :: Bool -> FlowSoundG -> IO Double-weightSyllAIO upper xs-  | null xs = pure 4.0-  | otherwise = -    (\d -> fromMaybe 4.0 (readMaybe d::Maybe Double)) <$> (hPutStr stderr ("?  " `mappend` ((if upper then map toUpper else id) . showFSG $ xs) `mappend` "   ") *> getLine) -- Well, definitely it should not be 'stderr' here, but 'stdout' gives some strange behaviour, probably related to optimizations or some strange 'Handle' behaviour. (?)---data ReadyForConstructionPL = StrG String | FSLG [[[Int8]]] deriving (Eq,Ord)--showR :: ReadyForConstructionPL -> String-showR (StrG xs) = xs-showR (FSLG tsss) = show tsss--isStr :: ReadyForConstructionPL -> Bool-isStr (StrG _) = True-isStr _ = False--isFSL :: ReadyForConstructionPL -> Bool-isFSL (FSLG _) = True-isFSL _ = False--fromReadyFCPLS :: ReadyForConstructionPL -> Maybe String-fromReadyFCPLS (StrG xs) = Just xs-fromReadyFCPLS _ = Nothing--fromReadyFCPLF :: ReadyForConstructionPL -> Maybe [[[Int8]]]-fromReadyFCPLF (FSLG xsss) = Just xsss-fromReadyFCPLF _ = Nothing--helper2F :: [b] -> [a] -> [c] -> [[d]] -> [([b],[a],[c])]-helper2F vs xs ys tss = let (us,ks,rs) = unzip3 . zip3 vs xs $ ys in-  helper2F' us ks rs tss-    where helper2F' us@(_:_) ks@(_:_) rs@(_:_) tss@(ts:wss) =-            let l = length ts-                (wws,vvs) = splitAt l us-                (qs,ps) = splitAt l ks-                (ns,ms) = splitAt l rs-                in (wws,qs,ns):helper2F' vvs ps ms wss-          helper2F' _ _ _ _ = []- -convF1 -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -  -> [[FlowSoundG]]-convF1 wrs ks arr hs us vs xs- | null xs = []- | otherwise = [ tss | tss <- createSyllablesPL wrs ks arr hs us vs xs ]--convF3 -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -  -> [([String],[[Int8]],[FlowSoundG])]-convF3 wrs ks arr hs us vs xs- | null xs = [([],[],[])]- | otherwise = helper2F (concatMap (map showFSG) tsss) (map (:[]) ([-128..127]::[Int8])) [ ts | tss <- qss, ts <- tss ] qss-    where tsss = createSyllablesPL wrs ks arr hs us vs xs-          qss = [ tss | tss <- tsss ]--convF3W -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -  -> [(String,[[Int8]])]-convF3W wrs ks arr hs us vs xs- | null xs = [([],[])]- | otherwise = zipWith (\(_,ys,_) ts -> (ts,ys)) (convF3 wrs ks arr hs us vs xs) . words $ xs--convFI -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -  -> String -  -> [[[Int8]]]-convFI wrs ks arr hs us vs ts = map f . words-  where !f = getBFstL' [] (convF3W wrs ks arr hs us vs ts)--convFSL -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -  -> ReadyForConstructionPL -  -> String-convFSL wrs ps arr hs us vs ts r@(StrG xs) = concat . concat . intersperse [" "] . map (\(ks,_,_)-> ks) . convF3 wrs ps arr hs us vs $ xs-   where js =  unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 wrs ps arr hs us vs $ ts-convFSL wrs ps arr hs us vs ts r@(FSLG tsss) =  concat . concat . intersperse [" "] . map (map (getBFstLSorted' " " ks) ) $ tsss-   where js = unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 wrs ps arr hs us vs $ ts-         ks = zip (concat . fst $ js) (concat . snd $ js)--weightsString3IO -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> Bool -  -> String -  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)-weightsString3IO wrs ps arr hs us vs bool bs - | bool = do-   (syllDs1,sylws,fsls0) <- weightStringIO wrs ps arr hs us vs bs-   let syllableDurationsD2s = [weights2SyllableDurationsD sylws]-   return (syllDs1,syllableDurationsD2s,FSLG fsls0) - | otherwise = return ([],[],FSLG [])--weightsString3NIO -  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.-  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon-      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.-  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.-  -> SegmentRulesG-  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.-  -> Int -  -> Bool -  -> String -  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)-weightsString3NIO wrs ps arr hs us vs n bool bs - | bool = (\(syllDs1,sylws,fsls0) -> (syllDs1,map weights2SyllableDurationsD sylws,FSLG fsls0)) <$> weightStringNIO wrs ps arr hs us vs n bs- | otherwise = pure ([],[],FSLG [])-    

@@ -3,14 +3,14 @@ -- http://haskell.org/cabal/users-guide/  name:                phonetic-languages-simplified-generalized-properties-array-version:             0.12.0.0+version:             0.13.0.0 synopsis:            Some 'properties' of the phonetic languages approach text. description:         Generalizes the functionality of the https://hackage.haskell.org/package/phonetic-languages-simplified-properties-array homepage:            https://hackage.haskell.org/package/phonetic-languages-simplified-generalized-properties-array license:             MIT license-file:        LICENSE author:              Oleksandr Zhabenko-maintainer:          olexandr543@yahoo.com+maintainer:          oleksandr.zhabenko@yahoo.com copyright:           Oleksandr Zhabenko category:            Language, Math, Game build-type:          Simple@@ -18,9 +18,9 @@ cabal-version:       >=1.10  library-  exposed-modules:     Phonetic.Languages.Array.General.PropertiesFuncRepG2, Phonetic.Languages.Array.General.PropertiesSyllablesG2, Phonetic.Languages.EmphasisG+  exposed-modules:     Phladiprelio.General.PropertiesFuncRepG2, Phladiprelio.General.PropertiesSyllablesG2, Phladiprelio.General.EmphasisG   -- other-modules:-  other-extensions:    CPP, BangPatterns, MultiWayIf-  build-depends:       base >=4.8 && <5, phonetic-languages-basis ==0.2.0.0, phonetic-languages-rhythmicity ==0.9.2.0, phonetic-languages-phonetics-basics ==0.9.1.0, lists-flines ==0.1.2.0, mmsyn2-array ==0.3.0.0+  other-extensions:    BangPatterns, MultiWayIf, NoImplicitPrelude+  build-depends:       base >=4.13 && <5, phonetic-languages-basis ==0.3.0.0, phonetic-languages-rhythmicity ==0.10.2.0, phonetic-languages-phonetics-basics ==0.10.0.2, lists-flines ==0.1.3.0, mmsyn2-array ==0.3.1.1, logical-constraints ==0.1.3.0   -- hs-source-dirs:   default-language:    Haskell2010