{-# 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
#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)
-> FuncRep2 ReadyForConstructionPL Int16 c
procDiverse2I wrs zs g =
D (\x -> case x of
StrG xs -> diverse2GL 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)
-> FuncRep2 ReadyForConstructionPL Double c
procDiverse2F wrs zs g =
D (\x ->case x of
StrG xs -> int2Double . fromEnum . diverse2GL 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 \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> FuncRep2 ReadyForConstructionPL Double c
procB2FG wrs ks arr gs us vs h1 h g coeffs =
D (\t -> case t of
StrG xs -> let ys = concatMap string1 . stringToXG wrs $ xs in
((int2Double . fromEnum . diverse2GL 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 \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> 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 \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> 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 \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
-> ([Double] -> Double)
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> FuncRep2 ReadyForConstructionPL Double c
procB2InvFG wrs ks arr gs us vs h1 h g coeffs =
D (\t -> case t of
StrG xs ->
let !ys = concatMap string1 . stringToXG wrs $ xs
!z = diverse2GL 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 \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> 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 \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.
-> Double
-> (Double -> c)
-> MappingFunctionPL
-> Coeffs2
-> 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 \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters 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 #-}