phonetic-languages-simplified-generalized-properties-array 0.12.0.0 → 0.13.1.0
raw patch · 9 files changed
Files
- ChangeLog.md +12/−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
ChangeLog.md view
@@ -108,4 +108,15 @@ ## 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. ++## 0.13.1.0 -- 2023-03-15++* Thirteenth version revised A. Updated the dependecies boundaries so that to support the new +code deduplication for different implementations of PhLADiPreLiO.+
LICENSE view
@@ -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
+ Phladiprelio/General/EmphasisG.hs view
@@ -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 [])+
+ Phladiprelio/General/PropertiesFuncRepG2.hs view
@@ -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 #-}++
+ Phladiprelio/General/PropertiesSyllablesG2.hs view
@@ -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++
− Phonetic/Languages/Array/General/PropertiesFuncRepG2.hs
@@ -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 #-}--
− Phonetic/Languages/Array/General/PropertiesSyllablesG2.hs
@@ -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--
− Phonetic/Languages/EmphasisG.hs
@@ -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 [])-
phonetic-languages-simplified-generalized-properties-array.cabal view
@@ -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.1.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.11.0.2, phladiprelio-rhythmicity-shared ==0.1.0.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