diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -82,3 +82,8 @@ ## 0.11.0.0 -- 2021-10-31 * Eleventh version. Switched back to the CaseBi.Arr.getBFstLSorted' function. + +## 0.12.0.0 -- 2021-11-04 + +* Twelth version. Switched to the Int8 representation. Updated the dependencies accordingly. Splitted the two main modules into +several ones with the similar name and some suffix. Made the main modules just reimporting the new ones. diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2.hs --- a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2.hs +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2.hs @@ -46,277 +46,10 @@ , procRhythmicity23FH ) 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.Ukrainian.PropertiesSyllablesG2 -import Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base -import Languages.Rhythmicity -import Languages.Rhythmicity.Factor -import Phonetic.Languages.Simplified.DataG.Base -import GHC.Float (int2Double) -import Melodics.ByteString.Ukrainian.Arr -import qualified Languages.Phonetic.Ukrainian.Syllable.Double.Arr as SD -import qualified Languages.Phonetic.Ukrainian.Syllable.Arr as S -import Data.Maybe (isNothing,fromMaybe,mapMaybe) -import Text.Read (readMaybe) - -#ifdef __GLASGOW_HASKELL__ -#if __GLASGOW_HASKELL__==708 -/* code that applies only to GHC 7.8.* */ -mconcat = concat -#endif -#endif - -procDiverse2I - :: (Ord c) => (Int16 -> c) - -> FuncRep2 String Int16 c -procDiverse2I g = D (diverse2GL " 01-" . convertToProperUkrainianS) g -{-# INLINE procDiverse2I #-} - -procDiverse2F - :: (Ord c) => (Double -> c) - -> FuncRep2 String Double c -procDiverse2F g = D (int2Double . fromEnum . diverse2GL " 01-" . convertToProperUkrainianS) 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) => ([Double] -> Double) - -> (Double -> c) - -> ([[[S.UZPP2]]] -> [[Double]]) - -> Coeffs2 - -> FuncRep2 String Double c -procB2FG h1 h g coeffs = D (\xs -> let ys = convertToProperUkrainianS . map (\x -> if x == '-' then ' ' else x) $ xs in ((int2Double . fromEnum . diverse2GL " 01-" $ ys)*(h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . S.str2UZPP2s) . words1 . mapMaybe f $ ys))) h -{-# INLINE procB2FG #-} - -procB2F - :: (Ord c) => (Double -> c) - -> ([[[S.UZPP2]]] -> [[Double]]) - -> Coeffs2 - -> FuncRep2 String Double c -procB2F h g coeffs = procB2FG (eval23Coeffs coeffs) h g coeffs -{-# INLINE procB2F #-} - -procB2FF - :: (Ord c) => Double - -> (Double -> c) - -> ([[[S.UZPP2]]] -> [[Double]]) - -> Coeffs2 - -> FuncRep2 String Double c -procB2FF k h g coeffs = procB2FG (eval23CoeffsF k coeffs) h g coeffs -{-# INLINE procB2FF #-} - -procB2InvFG - :: (Ord c) => ([Double] -> Double) - -> (Double -> c) - -> ([[[S.UZPP2]]] -> [[Double]]) - -> Coeffs2 - -> FuncRep2 String Double c -procB2InvFG h1 h g coeffs = D (\xs -> - let !ys = convertToProperUkrainianS . map (\x -> if x == '-' then ' ' else x) $ xs - !z = diverse2GL " 01-" ys in if z == 0 then (h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . - S.str2UZPP2s) . words1 . mapMaybe f $ ys) ** 2.0 - else ((h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . S.str2UZPP2s) . words1 . mapMaybe f $ ys) / (int2Double . fromEnum $ z))) h -{-# INLINE procB2InvFG #-} - -procB2InvF - :: (Ord c) => (Double -> c) - -> ([[[S.UZPP2]]] -> [[Double]]) - -> Coeffs2 - -> FuncRep2 String Double c -procB2InvF h g coeffs = procB2InvFG (eval23Coeffs coeffs) h g coeffs -{-# INLINE procB2InvF #-} - -procB2InvFF - :: (Ord c) => Double - -> (Double -> c) - -> ([[[S.UZPP2]]] -> [[Double]]) - -> Coeffs2 - -> FuncRep2 String Double c -procB2InvFF k h g coeffs = procB2InvFG (eval23CoeffsF k coeffs) h g coeffs -{-# INLINE procB2InvFF #-} - ---------------------------------------------------------------------- - -procRhythm23F - :: (Ord c) => (Double -> c) - -> String - -> (String -> Coeffs2 -> String -> Double) - -> Coeffs2 - -> FuncRep2 String Double c -procRhythm23F h choice g coeffs = D (g choice coeffs) h -{-# INLINE procRhythm23F #-} - -procRhythmicity23F - :: (Ord c) => Double - -> (Double -> c) - -> String - -> Coeffs2 - -> FuncRep2 String Double c -procRhythmicity23F k g choice coeffs = procRhythm23F g choice (rhythmicity k) coeffs -{-# INLINE procRhythmicity23F #-} - -procRhythmicity23FH - :: (Ord c) => Double - -> (Double -> c) - -> [[[[S.UZPP2]]] -> [[Double]]] - -> String - -> Coeffs2 - -> FuncRep2 String Double c -procRhythmicity23FH k g syllableDurationsDs choice coeffs = D (rhythmicityH k choice syllableDurationsDs coeffs) g -{-# INLINE procRhythmicity23FH #-} - -procBothF - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBothF g coeffs = procB2F g SD.syllableDurationsD coeffs -{-# INLINE procBothF #-} - -procBothFF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBothFF k g coeffs = procB2FF k g SD.syllableDurationsD coeffs -{-# INLINE procBothFF #-} - -procBothInvF - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBothInvF g coeffs = procB2InvF g SD.syllableDurationsD coeffs -{-# INLINE procBothInvF #-} - -procBothInvFF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBothInvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD coeffs -{-# INLINE procBothInvFF #-} - -------------------------------------------------------------------------------- - -procBoth2F - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth2F g coeffs = procB2F g SD.syllableDurationsD2 coeffs -{-# INLINE procBoth2F #-} - -procBoth2InvF - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth2InvF g coeffs = procB2InvF g SD.syllableDurationsD2 coeffs -{-# INLINE procBoth2InvF #-} - -procBoth2FF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth2FF k g coeffs = procB2FF k g SD.syllableDurationsD2 coeffs -{-# INLINE procBoth2FF #-} - -procBoth2InvFF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth2InvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD2 coeffs -{-# INLINE procBoth2InvFF #-} - -------------------------------------------------------------- - -procBoth3F - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth3F g coeffs = procB2F g SD.syllableDurationsD3 coeffs -{-# INLINE procBoth3F #-} - -procBoth3InvF - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth3InvF g coeffs = procB2InvF g SD.syllableDurationsD3 coeffs -{-# INLINE procBoth3InvF #-} - -procBoth3FF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth3FF k g coeffs = procB2FF k g SD.syllableDurationsD3 coeffs -{-# INLINE procBoth3FF #-} - -procBoth3InvFF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth3InvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD3 coeffs -{-# INLINE procBoth3InvFF #-} - -------------------------------------------------------------- - -procBoth4F - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth4F g coeffs = procB2F g SD.syllableDurationsD4 coeffs -{-# INLINE procBoth4F #-} - -procBoth4InvF - :: (Ord c) => (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth4InvF g coeffs = procB2InvF g SD.syllableDurationsD4 coeffs -{-# INLINE procBoth4InvF #-} - -procBoth4FF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth4FF k g coeffs = procB2FF k g SD.syllableDurationsD4 coeffs -{-# INLINE procBoth4FF #-} - -procBoth4InvFF - :: (Ord c) => Double - -> (Double -> c) - -> Coeffs2 - -> FuncRep2 String Double c -procBoth4InvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD4 coeffs -{-# INLINE procBoth4InvFF #-} - -------------------------------------------------------------- - -f x - | x == '0' = Nothing - | x /= '1' && x /= '-' = 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'') = span (/= ' ') ts -{-# NOINLINE words1 #-} +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Diverse +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Rhythmicity +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG21 +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG22 +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG23 +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG24 diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG21.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG21.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG21.hs @@ -0,0 +1,57 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG21 +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Instead of vectors, uses arrays. + +module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG21 ( + -- ** Usual ones + procBothF + , procBothFF + , procBothInvF + , procBothInvFF +) where + +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common +import Phonetic.Languages.Simplified.DataG.Base +import qualified Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 as SD +import Melodics.Ukrainian.ArrInt8 + +procBothF + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBothF g coeffs = procB2F g SD.syllableDurationsD coeffs +{-# INLINE procBothF #-} + +procBothFF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBothFF k g coeffs = procB2FF k g SD.syllableDurationsD coeffs +{-# INLINE procBothFF #-} + +procBothInvF + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBothInvF g coeffs = procB2InvF g SD.syllableDurationsD coeffs +{-# INLINE procBothInvF #-} + +procBothInvFF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBothInvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD coeffs +{-# INLINE procBothInvFF #-} + diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG22.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG22.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG22.hs @@ -0,0 +1,57 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG22 +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Instead of vectors, uses arrays. + +module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG22 ( + -- * Functions with 'Double' + -- ** Working with generated by r-glpk-phonetic-languages-ukrainian-durations syllable durations + procBoth2F + , procBoth2FF + , procBoth2InvF + , procBoth2InvFF +) where + +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common +import Phonetic.Languages.Simplified.DataG.Base +import qualified Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 as SD + +procBoth2F + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth2F g coeffs = procB2F g SD.syllableDurationsD2 coeffs +{-# INLINE procBoth2F #-} + +procBoth2InvF + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth2InvF g coeffs = procB2InvF g SD.syllableDurationsD2 coeffs +{-# INLINE procBoth2InvF #-} + +procBoth2FF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth2FF k g coeffs = procB2FF k g SD.syllableDurationsD2 coeffs +{-# INLINE procBoth2FF #-} + +procBoth2InvFF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth2InvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD2 coeffs +{-# INLINE procBoth2InvFF #-} + diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG23.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG23.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG23.hs @@ -0,0 +1,56 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG23 +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Instead of vectors, uses arrays. + +module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG23 ( + -- * Functions with 'Double' + -- ** NEW Working with generated by r-glpk-phonetic-languages-ukrainian-durations syllable durations + procBoth3F + , procBoth3FF + , procBoth3InvF + , procBoth3InvFF +) where + +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common +import Phonetic.Languages.Simplified.DataG.Base +import qualified Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 as SD + +procBoth3F + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth3F g coeffs = procB2F g SD.syllableDurationsD3 coeffs +{-# INLINE procBoth3F #-} + +procBoth3InvF + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth3InvF g coeffs = procB2InvF g SD.syllableDurationsD3 coeffs +{-# INLINE procBoth3InvF #-} + +procBoth3FF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth3FF k g coeffs = procB2FF k g SD.syllableDurationsD3 coeffs +{-# INLINE procBoth3FF #-} + +procBoth3InvFF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth3InvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD3 coeffs +{-# INLINE procBoth3InvFF #-} diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG24.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG24.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG24.hs @@ -0,0 +1,57 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG24 +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Instead of vectors, uses arrays. + +module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG24 ( + -- * Functions with 'Double' + -- ** NEW Working with generated by r-glpk-phonetic-languages-ukrainian-durations syllable durations + procBoth4F + , procBoth4FF + , procBoth4InvF + , procBoth4InvFF +) where + +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common +import Phonetic.Languages.Simplified.DataG.Base +import qualified Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 as SD + +procBoth4F + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth4F g coeffs = procB2F g SD.syllableDurationsD4 coeffs +{-# INLINE procBoth4F #-} + +procBoth4InvF + :: (Ord c) => (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth4InvF g coeffs = procB2InvF g SD.syllableDurationsD4 coeffs +{-# INLINE procBoth4InvF #-} + +procBoth4FF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth4FF k g coeffs = procB2FF k g SD.syllableDurationsD4 coeffs +{-# INLINE procBoth4FF #-} + +procBoth4InvFF + :: (Ord c) => Double + -> (Double -> c) + -> Coeffs2 + -> FuncRep2 String Double c +procBoth4InvFF k g coeffs = procB2InvFF k g SD.syllableDurationsD4 coeffs +{-# INLINE procBoth4InvFF #-} + diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Common.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Common.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Common.hs @@ -0,0 +1,112 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Instead of vectors, uses arrays. + +{-# LANGUAGE CPP, BangPatterns #-} + +module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common 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 Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base +import Languages.Rhythmicity +import Languages.Rhythmicity.Factor +import Phonetic.Languages.Simplified.DataG.Base +import GHC.Float (int2Double) +import qualified Languages.Phonetic.Ukrainian.Syllable.ArrInt8 as S +import Melodics.Ukrainian.ArrInt8 +import Data.Maybe (fromMaybe) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +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) => ([Double] -> Double) + -> (Double -> c) + -> ([[[Sound8]]] -> [[Double]]) + -> Coeffs2 + -> FuncRep2 String Double c +procB2FG h1 h g coeffs = D (\xs -> let ys = convertToProperUkrainianI8 . map (\x -> if x == '-' then ' ' else x) $ xs in ((int2Double . fromEnum . diverse2GLInt8 [-1,0] $ ys)*(h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds) . words1 $ ys))) h +{-# INLINE procB2FG #-} + +procB2InvFG + :: (Ord c) => ([Double] -> Double) + -> (Double -> c) + -> ([[[Sound8]]] -> [[Double]]) + -> Coeffs2 + -> FuncRep2 String Double c +procB2InvFG h1 h g coeffs = D (\xs -> + let !ys = convertToProperUkrainianI8 . map (\x -> if x == '-' then ' ' else x) $ xs + !z = diverse2GLInt8 [-1,0] ys in if z == 0 then (h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds) . + words1 $ ys) ** 2.0 + else ((h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds) . words1 $ ys) / (int2Double . fromEnum $ z))) h +{-# INLINE procB2InvFG #-} + +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 (< 1) xs + (w, s'') = span (> 0) ts +{-# NOINLINE words1 #-} + +procB2F + :: (Ord c) => (Double -> c) + -> ([[[Sound8]]] -> [[Double]]) + -> Coeffs2 + -> FuncRep2 String Double c +procB2F h g coeffs = procB2FG (eval23Coeffs coeffs) h g coeffs +{-# INLINE procB2F #-} + +procB2FF + :: (Ord c) => Double + -> (Double -> c) + -> ([[[Sound8]]] -> [[Double]]) + -> Coeffs2 + -> FuncRep2 String Double c +procB2FF k h g coeffs = procB2FG (eval23CoeffsF k coeffs) h g coeffs +{-# INLINE procB2FF #-} + +procB2InvF + :: (Ord c) => (Double -> c) + -> ([[[Sound8]]] -> [[Double]]) + -> Coeffs2 + -> FuncRep2 String Double c +procB2InvF h g coeffs = procB2InvFG (eval23Coeffs coeffs) h g coeffs +{-# INLINE procB2InvF #-} + +procB2InvFF + :: (Ord c) => Double + -> (Double -> c) + -> ([[[Sound8]]] -> [[Double]]) + -> Coeffs2 + -> FuncRep2 String Double c +procB2InvFF k h g coeffs = procB2InvFG (eval23CoeffsF k coeffs) h g coeffs +{-# INLINE procB2InvFF #-} + diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Diverse.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Diverse.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Diverse.hs @@ -0,0 +1,37 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Diverse +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Instead of vectors, uses arrays. + +module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Diverse ( + -- * Functions with 'Int16' + procDiverse2I + -- ** Usual ones + , procDiverse2F +) where + +import GHC.Int +import Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base +import Phonetic.Languages.Simplified.DataG.Base +import GHC.Float (int2Double) +import Melodics.Ukrainian.ArrInt8 + +procDiverse2I + :: (Ord c) => (Int16 -> c) + -> FuncRep2 String Int16 c +procDiverse2I g = D (diverse2GLInt8 [-1,0] . convertToProperUkrainianI8) g +{-# INLINE procDiverse2I #-} + +procDiverse2F + :: (Ord c) => (Double -> c) + -> FuncRep2 String Double c +procDiverse2F g = D (int2Double . fromEnum . diverse2GLInt8 [-1,0] . convertToProperUkrainianI8) g +{-# INLINE procDiverse2F #-} diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Rhythmicity.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Rhythmicity.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2Rhythmicity.hs @@ -0,0 +1,53 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Rhythmicity +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Instead of vectors, uses arrays. + +module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Rhythmicity ( + -- * Working with rhythmicity + procRhythmicity23F + -- ** Working with rhythmicity that can be defined by the user (using 'rhythmicityH') + , procRhythmicity23FH +) where + +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Hprime +import Phonetic.Languages.Simplified.DataG.Base +import Melodics.Ukrainian.ArrInt8 + +procRhythm23F + :: (Ord c) => (Double -> c) + -> String + -> (String -> Coeffs2 -> String -> Double) + -> Coeffs2 + -> FuncRep2 String Double c +procRhythm23F h choice g coeffs = D (g choice coeffs) h +{-# INLINE procRhythm23F #-} + +procRhythmicity23F + :: (Ord c) => Double + -> (Double -> c) + -> String + -> Coeffs2 + -> FuncRep2 String Double c +procRhythmicity23F k g choice coeffs = procRhythm23F g choice (rhythmicity k) coeffs +{-# INLINE procRhythmicity23F #-} + +procRhythmicity23FH + :: (Ord c) => Double + -> (Double -> c) + -> [[[[Sound8]]] -> [[Double]]] + -> String + -> Coeffs2 + -> FuncRep2 String Double c +procRhythmicity23FH k g syllableDurationsDs choice coeffs = D (rhythmicityH k choice syllableDurationsDs coeffs) g +{-# INLINE procRhythmicity23FH #-} diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2.hs --- a/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2.hs +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2.hs @@ -12,8 +12,6 @@ -- from the @dobutokO-poetry@ package. Uses syllables information. -- Instead of the vector-related, uses just arrays. -{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-} - module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 ( -- * Newtype to work with CoeffTwo(..) @@ -61,551 +59,7 @@ , rhythmicityH' ) 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 Languages.Phonetic.Ukrainian.Syllable.Double.Arr -import Languages.Phonetic.Ukrainian.Syllable.Arr -import Data.Maybe (isNothing,fromMaybe,fromJust) -import Text.Read (readMaybe) -import Rhythmicity.TwoFourth -import Rhythmicity.PolyRhythm - -#ifdef __GLASGOW_HASKELL__ -#if __GLASGOW_HASKELL__==708 -/* code that applies only to GHC 7.8.* */ -mconcat = concat -#endif -#endif - -data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (Eq) - -isEmpty :: CoeffTwo a -> Bool -isEmpty CF0 = True -isEmpty _ = False - -isPair :: CoeffTwo a -> Bool -isPair CF0 = False -isPair _ = True - -fstCF :: CoeffTwo a -> Maybe a -fstCF (CF2 x _) = x -fstCF _ = Nothing - -sndCF :: CoeffTwo a -> Maybe a -sndCF (CF2 _ y) = y -sndCF _ = Nothing - -readCF :: String -> Coeffs2 -readCF xs - | any (== '_') xs = let (!ys,!zs) = (\(ks,ts) -> (readMaybe ks::Maybe Double,readMaybe (drop 1 ts)::Maybe Double)) . break (== '_') $ xs in - if (isNothing ys && isNothing zs) then CF0 else CF2 ys zs - | otherwise = CF0 - -type Coeffs2 = CoeffTwo Double - --------------------------------------------------------------------------------------------- - -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 #-} - -rhythmicityGH :: ([[[UZPP2]]] -> [[Double]]) -> ([[Double]] -> Double) -> String -> Double -rhythmicityGH f g xs - | null xs = 0.0 - | otherwise = g . f . createSyllablesUkrS $ xs -{-# INLINE rhythmicityGH #-} - -------------------------------------------------------- - -rhythmicity0H :: ([[[UZPP2]]] -> [[Double]]) -> String -> Double -rhythmicity0H f = rhythmicityGH f eval23 -{-# INLINE rhythmicity0H #-} - -rhythmicity0 :: String -> Double -rhythmicity0 = rhythmicity0H syllableDurationsD -{-# INLINE rhythmicity0 #-} - -rhythmicity02 :: String -> Double -rhythmicity02 = rhythmicity0H syllableDurationsD2 -{-# INLINE rhythmicity02 #-} - -rhythmicity03 :: String -> Double -rhythmicity03 = rhythmicity0H syllableDurationsD3 -{-# INLINE rhythmicity03 #-} - -rhythmicity04 :: String -> Double -rhythmicity04 = rhythmicity0H syllableDurationsD4 -{-# INLINE rhythmicity04 #-} - -------------------------------------------------------- - -rhythmicityKH :: ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> String -> Double -rhythmicityKH f k2 k3 = rhythmicityGH f (eval23K k2 k3) -{-# INLINE rhythmicityKH #-} - -rhythmicityK :: Double -> Double -> String -> Double -rhythmicityK k2 k3 = rhythmicityKH syllableDurationsD k2 k3 -{-# INLINE rhythmicityK #-} - -rhythmicityK2 :: Double -> Double -> String -> Double -rhythmicityK2 k2 k3 = rhythmicityKH syllableDurationsD2 k2 k3 -{-# INLINE rhythmicityK2 #-} - -rhythmicityK3 :: Double -> Double -> String -> Double -rhythmicityK3 k2 k3 = rhythmicityKH syllableDurationsD3 k2 k3 -{-# INLINE rhythmicityK3 #-} - -rhythmicityK4 :: Double -> Double -> String -> Double -rhythmicityK4 k2 k3 = rhythmicityKH syllableDurationsD4 k2 k3 -{-# INLINE rhythmicityK4 #-} - --------------------------------------------------------- - -rhythmicity0FH :: ([[[UZPP2]]] -> [[Double]]) -> Double -> String -> Double -rhythmicity0FH f k = rhythmicityGH f (eval23F k) -{-# INLINE rhythmicity0FH #-} - -rhythmicity0F :: Double -> String -> Double -rhythmicity0F k = rhythmicity0FH syllableDurationsD k -{-# INLINE rhythmicity0F #-} - -rhythmicity02F :: Double -> String -> Double -rhythmicity02F k = rhythmicity0FH syllableDurationsD2 k -{-# INLINE rhythmicity02F #-} - -rhythmicity03F :: Double -> String -> Double -rhythmicity03F k = rhythmicity0FH syllableDurationsD3 k -{-# INLINE rhythmicity03F #-} - -rhythmicity04F :: Double -> String -> Double -rhythmicity04F k = rhythmicity0FH syllableDurationsD4 k -{-# INLINE rhythmicity04F #-} - --------------------------------------------------------- - -rhythmicityKFH :: ([[[UZPP2]]] -> [[Double]]) -> Double -> Double -> Double -> String -> Double -rhythmicityKFH f k k2 k3 = rhythmicityGH f (eval23KF k k2 k3) -{-# INLINE rhythmicityKFH #-} - -rhythmicityKF :: Double -> Double -> Double -> String -> Double -rhythmicityKF k k2 k3 = rhythmicityKFH syllableDurationsD k k2 k3 -{-# INLINE rhythmicityKF #-} - -rhythmicityKF2 :: Double -> Double -> Double -> String -> Double -rhythmicityKF2 k k2 k3 = rhythmicityKFH syllableDurationsD2 k k2 k3 -{-# INLINE rhythmicityKF2 #-} - -rhythmicityKF3 :: Double -> Double -> Double -> String -> Double -rhythmicityKF3 k k2 k3 = rhythmicityKFH syllableDurationsD3 k k2 k3 -{-# INLINE rhythmicityKF3 #-} - -rhythmicityKF4 :: Double -> Double -> Double -> String -> Double -rhythmicityKF4 k k2 k3 = rhythmicityKFH syllableDurationsD4 k k2 k3 -{-# INLINE rhythmicityKF4 #-} - --------------------------------------------------------- - -rhythmicityG - :: ([[[UZPP2]]] -> [[Double]])-- ^ A function that specifies the syllables durations, analogue of (or one of) the - -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. - -> String - -> [Double] -rhythmicityG f xs - | null xs = [] - | otherwise = mconcat . f . createSyllablesUkrS $ xs -{-# INLINE rhythmicityG #-} - --------------------------------------------------------- - -rhythmicity :: Double -> String -> Coeffs2 -> String -> Double -rhythmicity k choice CF0 = if - | 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 n) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - Just (P2 ch rh r n) -> case take 1 choice of - "A" -> rhythmicityPolyWeightedLEF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "D" -> rhythmicityPolyWeightedLF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "E" -> rhythmicityPolyWeightedLEF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "F" -> rhythmicityPolyWeightedLF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "B" -> rhythmicityPolyWeightedEF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "C" -> rhythmicityPolyWeightedF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "M" -> rhythmicityPolyWeightedEF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "N" -> rhythmicityPolyWeightedF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - "c" -> rhythmicityPoly 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS - _ -> rhythmicity04 - | choice == "0y" -> rhythmicity0 - | choice == "02y" -> rhythmicity02 - | choice == "03y" -> rhythmicity03 - | choice == "0z" -> rhythmicity0F k - | choice == "02z" -> rhythmicity02F k - | choice == "03z" -> rhythmicity03F k - | choice == "04z" -> rhythmicity04F k - | take 1 choice == "0" -> rhythmicity04 - | take 1 choice == "w" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity04 - | otherwise -> rhythmicity04 - | take 1 choice == "x" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity04 - | otherwise -> rhythmicity04 - | otherwise -> if - | (take 1 choice == "b" || ((take 1 choice >= "d" && take 1 choice <= "v") || (take 1 choice >= "I" && take 1 choice <= "Z"))) && (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 1 choice of - "b" -> g rhythmicityPolyWeightedLEF3 5 1 - "d" -> g rhythmicityPolyWeightedLEF30 5 1 - "e" -> g rhythmicityPolyWeightedLEF3 6 2 - "f" -> g rhythmicityPolyWeightedLEF30 6 2 - "g" -> g rhythmicityPolyWeightedLEF2 5 1 - "h" -> g rhythmicityPolyWeightedLEF20 5 1 - "i" -> g rhythmicityPolyWeightedLEF2 6 2 - "j" -> g rhythmicityPolyWeightedLEF20 6 2 - "k" -> g rhythmicityPolyWeightedLF3 5 1 - "l" -> g rhythmicityPolyWeightedLF30 5 1 - "m" -> g rhythmicityPolyWeightedLF3 6 2 - "n" -> g rhythmicityPolyWeightedLF30 6 2 - "o" -> g rhythmicityPolyWeightedLF2 5 1 - "p" -> g rhythmicityPolyWeightedLF20 5 1 - "q" -> g rhythmicityPolyWeightedLF2 6 2 - "r" -> g rhythmicityPolyWeightedLF20 6 2 - "I" -> g rhythmicityPolyWeightedEF3 5 1 - "J" -> g rhythmicityPolyWeightedEF30 5 1 - "K" -> g rhythmicityPolyWeightedEF3 6 2 - "L" -> g rhythmicityPolyWeightedEF30 6 2 - "O" -> g rhythmicityPolyWeightedEF2 5 1 - "P" -> g rhythmicityPolyWeightedEF20 5 1 - "Q" -> g rhythmicityPolyWeightedEF2 6 2 - "R" -> g rhythmicityPolyWeightedEF20 6 2 - "W" -> g rhythmicityPolyWeightedF3 5 1 - "X" -> g rhythmicityPolyWeightedF30 5 1 - "Y" -> g rhythmicityPolyWeightedF3 6 2 - "Z" -> g rhythmicityPolyWeightedF30 6 2 - "U" -> g rhythmicityPolyWeightedF2 5 1 - "V" -> g rhythmicityPolyWeightedF20 5 1 - "S" -> g rhythmicityPolyWeightedF2 6 2 - "T" -> g rhythmicityPolyWeightedF20 6 2 - "u" -> g rhythmicityPoly 5 1 - "v" -> g rhythmicityPoly0 5 1 - "s" -> g rhythmicityPoly 6 2 - "t" -> g rhythmicityPoly0 6 2 - | otherwise -> rhythmicity04 - where h1 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [1,2,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrS - h2 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [2,1,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrS - g f m n - | drop 1 choice `elem` ["01","02","03","04"] = h1 f (drop 2 . take 3 $ choice) [True,True,True] m n - | drop 1 choice `elem` ["11","12","13","14"] = h1 f (drop 2 . take 3 $ choice) [True,True,False] m n - | drop 1 choice `elem` ["21","22","23","24"] = h1 f (drop 2 . take 3 $ choice) [True,False,True] m n - | drop 1 choice `elem` ["31","32","33","34"] = h1 f (drop 2 . take 3 $ choice) [True,False,False] m n - | drop 1 choice `elem` ["41","42","43","44"] = h2 f (drop 2 . take 3 $ choice) [True,True,True] m n - | drop 1 choice `elem` ["51","52","53","54"] = h2 f (drop 2 . take 3 $ choice) [True,True,False] m n - | drop 1 choice `elem` ["61","62","63","64"] = h2 f (drop 2 . take 3 $ choice) [True,False,True] m n - | drop 1 choice `elem` ["71","72","73","74"] = h2 f (drop 2 . take 3 $ choice) [True,False,False] m n - | otherwise = rhythmicity04 - w1F f ch rh = rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS - wwF2 g2 xs = let (Just n) = readMaybe xs::Maybe Int in - case n `rem` 4 of - 1 -> g2 syllableDurationsD - 2 -> g2 syllableDurationsD2 - 3 -> g2 syllableDurationsD3 - _ -> g2 syllableDurationsD4 - x1F f ch rh = rhythmicityABC0 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS - xxF = wwF2 x1F - wwF = wwF2 w1F - {-# INLINE w1F #-} - {-# INLINE wwF2 #-} - {-# INLINE x1F #-} - {-# INLINE xxF #-} - {-# INLINE wwF #-} -rhythmicity k choice (CF2 x y) = - case take 1 choice of - "0" -> case choice of - "0y" -> rhythmicityK (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "02y" -> rhythmicityK2 (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "03y" -> rhythmicityK3 (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "0z" -> rhythmicityKF k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "02z" -> rhythmicityKF2 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "03z" -> rhythmicityKF3 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "04z" -> rhythmicityKF4 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - _ -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "w" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity04 - | otherwise -> rhythmicity04 - where w1F f ch rh = rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS - wwF xs = let (Just n) = readMaybe xs::Maybe Int in - case n `rem` 4 of - 1 -> w1F syllableDurationsD - 2 -> w1F syllableDurationsD2 - 3 -> w1F syllableDurationsD3 - _ -> w1F syllableDurationsD4 - {-# INLINE w1F #-} - {-# INLINE wwF #-} - "x" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity04 - | otherwise -> rhythmicity04 - where x1F f ch rh = rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS - xxF xs = let (Just n) = readMaybe xs::Maybe Int in - case n `rem` 4 of - 1 -> x1F syllableDurationsD - 2 -> x1F syllableDurationsD2 - 3 -> x1F syllableDurationsD3 - _ -> x1F syllableDurationsD4 - {-# INLINE x1F #-} - {-# INLINE xxF #-} - _ -> if - | ((take 1 choice >= "b" && take 1 choice <= "v") || (take 1 choice >= "A" && take 1 choice <= "Z" && take 1 choice `notElem` ["G","H"])) -> rhythmicity k choice CF0 - | otherwise -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y) - -helperF4 :: Int -> [[[UZPP2]]] -> [[Double]] -helperF4 n - | n == 1 = syllableDurationsD - | n == 2 = syllableDurationsD2 - | n == 3 = syllableDurationsD3 - | otherwise = syllableDurationsD4 - -parseChRhEndMaybe :: ParseChRh -> Maybe Int -parseChRhEndMaybe (P0 _) = Nothing -parseChRhEndMaybe (P1 _ _ n) = Just n -parseChRhEndMaybe (P2 _ _ _ n) = Just n - ----------------------------------------------------------------- - -{-| Allows to use the user-defined custom 'UZPP2' durations. This is used when the first character in the second argument is -\'H\'. --} -rhythmicityH - :: Double - -> String - -> [[[[UZPP2]]] -> [[Double]]] - -> Coeffs2 - -> String - -> Double -rhythmicityH k choice syllableDurationsDs coeffs - | take 1 choice == "H" = rhythmicityH' k (drop 1 choice) syllableDurationsDs coeffs - | otherwise = rhythmicity k choice coeffs - -rhythmicityH' - :: Double - -> String - -> [[[[UZPP2]]] -> [[Double]]] - -> Coeffs2 - -> String - -> Double -rhythmicityH' k choice syllableDurationsDs CF0 = if - | 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 n) -> rhythmicityABC 1.0 2.0 0.125 ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - Just (P2 ch rh r n) -> case take 1 choice of - "A" -> rhythmicityPolyWeightedLEF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "D" -> rhythmicityPolyWeightedLF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "E" -> rhythmicityPolyWeightedLEF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "F" -> rhythmicityPolyWeightedLF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "B" -> rhythmicityPolyWeightedEF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "C" -> rhythmicityPolyWeightedF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "M" -> rhythmicityPolyWeightedEF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "N" -> rhythmicityPolyWeightedF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - "c" -> rhythmicityPoly 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) - _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | choice == "0y" -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | take 1 choice == "0" && drop 2 (take 3 choice) == "y" -> - let n2 = readMaybe (drop 1 . take 2 $ choice)::Maybe Int in - case n2 of - Just n3 -> rhythmicity0H (helperHF4 n3 syllableDurationsDs) - Nothing -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | choice == "0z" -> rhythmicity0FH (helperHF4 1 syllableDurationsDs) k - | take 1 choice == "0" && drop 2 (take 3 choice) == "z" -> - let n2 = readMaybe (drop 1 . take 2 $ choice)::Maybe Int in - case n2 of - Just n3 -> rhythmicity0FH (helperHF4 n3 syllableDurationsDs) k - Nothing -> rhythmicity0FH (helperHF4 1 syllableDurationsDs) k - | take 1 choice == "0" -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | take 1 choice == "w" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | take 1 choice == "x" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | otherwise -> if - | (take 1 choice == "b" || ((take 1 choice >= "d" && take 1 choice <= "v") || (take 1 choice >= "I" && take 1 choice <= "Z"))) && (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "9" -> - case take 1 choice of - "b" -> g rhythmicityPolyWeightedLEF3 5 1 - "d" -> g rhythmicityPolyWeightedLEF30 5 1 - "e" -> g rhythmicityPolyWeightedLEF3 6 2 - "f" -> g rhythmicityPolyWeightedLEF30 6 2 - "g" -> g rhythmicityPolyWeightedLEF2 5 1 - "h" -> g rhythmicityPolyWeightedLEF20 5 1 - "i" -> g rhythmicityPolyWeightedLEF2 6 2 - "j" -> g rhythmicityPolyWeightedLEF20 6 2 - "k" -> g rhythmicityPolyWeightedLF3 5 1 - "l" -> g rhythmicityPolyWeightedLF30 5 1 - "m" -> g rhythmicityPolyWeightedLF3 6 2 - "n" -> g rhythmicityPolyWeightedLF30 6 2 - "o" -> g rhythmicityPolyWeightedLF2 5 1 - "p" -> g rhythmicityPolyWeightedLF20 5 1 - "q" -> g rhythmicityPolyWeightedLF2 6 2 - "r" -> g rhythmicityPolyWeightedLF20 6 2 - "I" -> g rhythmicityPolyWeightedEF3 5 1 - "J" -> g rhythmicityPolyWeightedEF30 5 1 - "K" -> g rhythmicityPolyWeightedEF3 6 2 - "L" -> g rhythmicityPolyWeightedEF30 6 2 - "O" -> g rhythmicityPolyWeightedEF2 5 1 - "P" -> g rhythmicityPolyWeightedEF20 5 1 - "Q" -> g rhythmicityPolyWeightedEF2 6 2 - "R" -> g rhythmicityPolyWeightedEF20 6 2 - "W" -> g rhythmicityPolyWeightedF3 5 1 - "X" -> g rhythmicityPolyWeightedF30 5 1 - "Y" -> g rhythmicityPolyWeightedF3 6 2 - "Z" -> g rhythmicityPolyWeightedF30 6 2 - "U" -> g rhythmicityPolyWeightedF2 5 1 - "V" -> g rhythmicityPolyWeightedF20 5 1 - "S" -> g rhythmicityPolyWeightedF2 6 2 - "T" -> g rhythmicityPolyWeightedF20 6 2 - "u" -> g rhythmicityPoly 5 1 - "v" -> g rhythmicityPoly0 5 1 - "s" -> g rhythmicityPoly 6 2 - "t" -> g rhythmicityPoly0 6 2 - | otherwise -> rhythmicity0H - (let ts = drop 2 . take 3 $ choice in - case ts of { [] -> syllableDurationsD4 ; ks -> - let q = readMaybe ks::Maybe Int in - case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) - where h1 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [1,2,1,n]) . mconcat . - (case ts of { [] -> syllableDurationsD4 ; ks -> let q = readMaybe ks::Maybe Int in - case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) . - createSyllablesUkrS - h2 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [2,1,1,n]) . mconcat . - (case ts of { [] -> syllableDurationsD4 ; ks -> let q = readMaybe ks::Maybe Int in - case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) . - createSyllablesUkrS - g f m n - | drop 1 (take 2 choice) == "0" = h1 f (drop 2 . take 3 $ choice) [True,True,True] m n - | drop 1 (take 2 choice) == "1" = h1 f (drop 2 . take 3 $ choice) [True,True,False] m n - | drop 1 (take 2 choice) == "2" = h1 f (drop 2 . take 3 $ choice) [True,False,True] m n - | drop 1 (take 2 choice) == "3" = h1 f (drop 2 . take 3 $ choice) [True,False,False] m n - | drop 1 (take 2 choice) == "4" = h2 f (drop 2 . take 3 $ choice) [True,True,True] m n - | drop 1 (take 2 choice) == "5" = h2 f (drop 2 . take 3 $ choice) [True,True,False] m n - | drop 1 (take 2 choice) == "6" = h2 f (drop 2 . take 3 $ choice) [True,False,True] m n - | drop 1 (take 2 choice) == "7" = h2 f (drop 2 . take 3 $ choice) [True,False,False] m n - | otherwise = rhythmicity0H (helperHF4 n syllableDurationsDs) - w1F f ch rh = rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS - wwF2 g2 xs = - let n1 = readMaybe xs::Maybe Int in - case n1 of - Just n2 -> g2 (helperHF4 n2 syllableDurationsDs) - Nothing -> g2 syllableDurationsD4 - x1F f ch rh = rhythmicityABC0 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS - xxF = wwF2 x1F - wwF = wwF2 w1F - {-# INLINE w1F #-} - {-# INLINE wwF2 #-} - {-# INLINE x1F #-} - {-# INLINE xxF #-} - {-# INLINE wwF #-} -rhythmicityH' k choice syllableDurationsDs (CF2 x y) = - case take 1 choice of - "0" -> case choice of - "0y" -> rhythmicityKH (helperHF4 1 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "02y" -> rhythmicityKH (helperHF4 2 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "03y" -> rhythmicityKH (helperHF4 3 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "0z" -> rhythmicityKFH (helperHF4 1 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "02z" -> rhythmicityKFH (helperHF4 2 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "03z" -> rhythmicityKFH (helperHF4 3 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "04z" -> rhythmicityKFH (helperHF4 4 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) - _ -> rhythmicityKH (helperHF4 1 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) - "w" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - where w1F f ch rh = rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS - wwF xs = - let n1 = readMaybe xs::Maybe Int in - case n1 of - Just n2 -> w1F (helperHF4 n2 syllableDurationsDs) - Nothing -> w1F syllableDurationsD4 - {-# INLINE w1F #-} - {-# INLINE wwF #-} - "x" -> if - | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> - case take 2 choice of - "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) - "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) - "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) - "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) - _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) - where x1F f ch rh = rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS - xxF xs = - let n1 = readMaybe xs::Maybe Int in - case n1 of - Just n2 -> x1F (helperHF4 n2 syllableDurationsDs) - Nothing -> x1F syllableDurationsD4 - {-# INLINE x1F #-} - {-# INLINE xxF #-} - _ -> if - | ((take 1 choice >= "b" && take 1 choice <= "v") || (take 1 choice >= "A" && take 1 choice <= "Z" && take 1 choice `notElem` ["G","H"])) -> rhythmicityH' k choice syllableDurationsDs CF0 - | otherwise -> rhythmicityKH - (let ts = drop 2 . take 3 $ choice in - case ts of { [] -> syllableDurationsD4 ; ks -> - let q = readMaybe ks::Maybe Int in - case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) - (fromMaybe 1.0 x) (fromMaybe 1.0 y) - - -helperHF4 :: Int -> [[[[UZPP2]]] -> [[Double]]] -> [[[UZPP2]]] -> [[Double]] -helperHF4 n xs - | null xs = syllableDurationsD4 - | (n `rem` length xs) == 0 = head xs - | otherwise = xs !! ((n `rem` length xs) - 1) +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201 +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Hprime diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG201.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG201.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG201.hs @@ -0,0 +1,167 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201 +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Uses syllables information. +-- Instead of the vector-related, uses just arrays. + +{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-} + +module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201 ( + -- * Rhythmicity properties (semi-empirical) + -- ** General ones + rhythmicity0H + , rhythmicity0FH + , rhythmicityKH + , rhythmicityKFH + -- ** Simple one + , rhythmicity0 + , rhythmicity0F + -- ** With weight coefficients + , rhythmicityK + , rhythmicityKF + -- * Rhythmicity properties from generated with r-glpk-phonetic-languages-ukrainian-durations package (since 0.2.0.0 version) + -- ** Simple one + , rhythmicity02 + , rhythmicity02F + -- ** With weight coefficients + , rhythmicityK2 + , rhythmicityKF2 + -- * NEW Rhythmicity properties from generated with r-glpk-phonetic-languages-ukrainian-durations package + -- ** Simple ones + , rhythmicity03 + , rhythmicity03F + , rhythmicity04 + , rhythmicity04F + -- ** With weight coefficients + , rhythmicityK3 + , rhythmicityKF3 + , rhythmicityK4 + , rhythmicityKF4 + -- * General + , rhythmicityG +) 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.Phonetic.Ukrainian.Syllable.Double.ArrInt8 +import Melodics.Ukrainian.ArrInt8 (Sound8) +import Languages.Phonetic.Ukrainian.Syllable.ArrInt8 +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +rhythmicity0H :: ([[[Sound8]]] -> [[Double]]) -> String -> Double +rhythmicity0H f = rhythmicityGH f eval23 +{-# INLINE rhythmicity0H #-} + +rhythmicity0 :: String -> Double +rhythmicity0 = rhythmicity0H syllableDurationsD +{-# INLINE rhythmicity0 #-} + +rhythmicity02 :: String -> Double +rhythmicity02 = rhythmicity0H syllableDurationsD2 +{-# INLINE rhythmicity02 #-} + +rhythmicity03 :: String -> Double +rhythmicity03 = rhythmicity0H syllableDurationsD3 +{-# INLINE rhythmicity03 #-} + +rhythmicity04 :: String -> Double +rhythmicity04 = rhythmicity0H syllableDurationsD4 +{-# INLINE rhythmicity04 #-} + +------------------------------------------------------- + +rhythmicityKH :: ([[[Sound8]]] -> [[Double]]) -> Double -> Double -> String -> Double +rhythmicityKH f k2 k3 = rhythmicityGH f (eval23K k2 k3) +{-# INLINE rhythmicityKH #-} + +rhythmicityK :: Double -> Double -> String -> Double +rhythmicityK k2 k3 = rhythmicityKH syllableDurationsD k2 k3 +{-# INLINE rhythmicityK #-} + +rhythmicityK2 :: Double -> Double -> String -> Double +rhythmicityK2 k2 k3 = rhythmicityKH syllableDurationsD2 k2 k3 +{-# INLINE rhythmicityK2 #-} + +rhythmicityK3 :: Double -> Double -> String -> Double +rhythmicityK3 k2 k3 = rhythmicityKH syllableDurationsD3 k2 k3 +{-# INLINE rhythmicityK3 #-} + +rhythmicityK4 :: Double -> Double -> String -> Double +rhythmicityK4 k2 k3 = rhythmicityKH syllableDurationsD4 k2 k3 +{-# INLINE rhythmicityK4 #-} + +-------------------------------------------------------- + +rhythmicity0FH :: ([[[Sound8]]] -> [[Double]]) -> Double -> String -> Double +rhythmicity0FH f k = rhythmicityGH f (eval23F k) +{-# INLINE rhythmicity0FH #-} + +rhythmicity0F :: Double -> String -> Double +rhythmicity0F k = rhythmicity0FH syllableDurationsD k +{-# INLINE rhythmicity0F #-} + +rhythmicity02F :: Double -> String -> Double +rhythmicity02F k = rhythmicity0FH syllableDurationsD2 k +{-# INLINE rhythmicity02F #-} + +rhythmicity03F :: Double -> String -> Double +rhythmicity03F k = rhythmicity0FH syllableDurationsD3 k +{-# INLINE rhythmicity03F #-} + +rhythmicity04F :: Double -> String -> Double +rhythmicity04F k = rhythmicity0FH syllableDurationsD4 k +{-# INLINE rhythmicity04F #-} + +-------------------------------------------------------- + +rhythmicityKFH :: ([[[Sound8]]] -> [[Double]]) -> Double -> Double -> Double -> String -> Double +rhythmicityKFH f k k2 k3 = rhythmicityGH f (eval23KF k k2 k3) +{-# INLINE rhythmicityKFH #-} + +rhythmicityKF :: Double -> Double -> Double -> String -> Double +rhythmicityKF k k2 k3 = rhythmicityKFH syllableDurationsD k k2 k3 +{-# INLINE rhythmicityKF #-} + +rhythmicityKF2 :: Double -> Double -> Double -> String -> Double +rhythmicityKF2 k k2 k3 = rhythmicityKFH syllableDurationsD2 k k2 k3 +{-# INLINE rhythmicityKF2 #-} + +rhythmicityKF3 :: Double -> Double -> Double -> String -> Double +rhythmicityKF3 k k2 k3 = rhythmicityKFH syllableDurationsD3 k k2 k3 +{-# INLINE rhythmicityKF3 #-} + +rhythmicityKF4 :: Double -> Double -> Double -> String -> Double +rhythmicityKF4 k k2 k3 = rhythmicityKFH syllableDurationsD4 k k2 k3 +{-# INLINE rhythmicityKF4 #-} + +----------------------------------------- + +rhythmicityG + :: ([[[Sound8]]] -> [[Double]])-- ^ A function that specifies the syllables durations, analogue of (or one of) the + -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. + -> String + -> [Double] +rhythmicityG f xs + | null xs = [] + | otherwise = mconcat . f . createSyllablesUkrS $ xs +{-# INLINE rhythmicityG #-} diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2Common.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2Common.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2Common.hs @@ -0,0 +1,86 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Uses syllables information. +-- Instead of the vector-related, uses just arrays. + +{-# LANGUAGE CPP, BangPatterns #-} + +module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common 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 Melodics.Ukrainian.ArrInt8 (Sound8) +import Languages.Phonetic.Ukrainian.Syllable.ArrInt8 +import Data.Maybe (isNothing) +import Text.Read (readMaybe) + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (Eq) + +isEmpty :: CoeffTwo a -> Bool +isEmpty CF0 = True +isEmpty _ = False + +isPair :: CoeffTwo a -> Bool +isPair CF0 = False +isPair _ = True + +fstCF :: CoeffTwo a -> Maybe a +fstCF (CF2 x _) = x +fstCF _ = Nothing + +sndCF :: CoeffTwo a -> Maybe a +sndCF (CF2 _ y) = y +sndCF _ = Nothing + +readCF :: String -> Coeffs2 +readCF xs + | any (== '_') xs = let (!ys,!zs) = (\(ks,ts) -> (readMaybe ks::Maybe Double,readMaybe (drop 1 ts)::Maybe Double)) . break (== '_') $ xs in + if (isNothing ys && isNothing zs) then CF0 else CF2 ys zs + | otherwise = CF0 + +type Coeffs2 = CoeffTwo Double + +-------------------------------------------------------------------------------------------- + +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 #-} + +rhythmicityGH :: ([[[Sound8]]] -> [[Double]]) -> ([[Double]] -> Double) -> String -> Double +rhythmicityGH f g xs + | null xs = 0.0 + | otherwise = g . f . createSyllablesUkrS $ xs +{-# INLINE rhythmicityGH #-} + +------------------------------------------------------- diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2H.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2H.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2H.hs @@ -0,0 +1,219 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Uses syllables information. +-- Instead of the vector-related, uses just arrays. + +{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-} + +module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H ( + -- * General + rhythmicity + , parseChRhEndMaybe +) 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.Phonetic.Ukrainian.Syllable.Double.ArrInt8 +import Melodics.Ukrainian.ArrInt8 (Sound8) +import Languages.Phonetic.Ukrainian.Syllable.ArrInt8 +import Data.Maybe (fromMaybe) +import Text.Read (readMaybe) +import Rhythmicity.TwoFourth +import Rhythmicity.PolyRhythm +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201 + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +rhythmicity :: Double -> String -> Coeffs2 -> String -> Double +rhythmicity k choice CF0 = if + | 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 n) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + Just (P2 ch rh r n) -> case take 1 choice of + "A" -> rhythmicityPolyWeightedLEF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "D" -> rhythmicityPolyWeightedLF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "E" -> rhythmicityPolyWeightedLEF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "F" -> rhythmicityPolyWeightedLF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "B" -> rhythmicityPolyWeightedEF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "C" -> rhythmicityPolyWeightedF2 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "M" -> rhythmicityPolyWeightedEF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "N" -> rhythmicityPolyWeightedF3 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + "c" -> rhythmicityPoly 1.0 r ch rh . mconcat . (helperF4 n) . createSyllablesUkrS + _ -> rhythmicity04 + | choice == "0y" -> rhythmicity0 + | choice == "02y" -> rhythmicity02 + | choice == "03y" -> rhythmicity03 + | choice == "0z" -> rhythmicity0F k + | choice == "02z" -> rhythmicity02F k + | choice == "03z" -> rhythmicity03F k + | choice == "04z" -> rhythmicity04F k + | take 1 choice == "0" -> rhythmicity04 + | take 1 choice == "w" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity04 + | otherwise -> rhythmicity04 + | take 1 choice == "x" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity04 + | otherwise -> rhythmicity04 + | otherwise -> if + | (take 1 choice == "b" || ((take 1 choice >= "d" && take 1 choice <= "v") || (take 1 choice >= "I" && take 1 choice <= "Z"))) && (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 1 choice of + "b" -> g rhythmicityPolyWeightedLEF3 5 1 + "d" -> g rhythmicityPolyWeightedLEF30 5 1 + "e" -> g rhythmicityPolyWeightedLEF3 6 2 + "f" -> g rhythmicityPolyWeightedLEF30 6 2 + "g" -> g rhythmicityPolyWeightedLEF2 5 1 + "h" -> g rhythmicityPolyWeightedLEF20 5 1 + "i" -> g rhythmicityPolyWeightedLEF2 6 2 + "j" -> g rhythmicityPolyWeightedLEF20 6 2 + "k" -> g rhythmicityPolyWeightedLF3 5 1 + "l" -> g rhythmicityPolyWeightedLF30 5 1 + "m" -> g rhythmicityPolyWeightedLF3 6 2 + "n" -> g rhythmicityPolyWeightedLF30 6 2 + "o" -> g rhythmicityPolyWeightedLF2 5 1 + "p" -> g rhythmicityPolyWeightedLF20 5 1 + "q" -> g rhythmicityPolyWeightedLF2 6 2 + "r" -> g rhythmicityPolyWeightedLF20 6 2 + "I" -> g rhythmicityPolyWeightedEF3 5 1 + "J" -> g rhythmicityPolyWeightedEF30 5 1 + "K" -> g rhythmicityPolyWeightedEF3 6 2 + "L" -> g rhythmicityPolyWeightedEF30 6 2 + "O" -> g rhythmicityPolyWeightedEF2 5 1 + "P" -> g rhythmicityPolyWeightedEF20 5 1 + "Q" -> g rhythmicityPolyWeightedEF2 6 2 + "R" -> g rhythmicityPolyWeightedEF20 6 2 + "W" -> g rhythmicityPolyWeightedF3 5 1 + "X" -> g rhythmicityPolyWeightedF30 5 1 + "Y" -> g rhythmicityPolyWeightedF3 6 2 + "Z" -> g rhythmicityPolyWeightedF30 6 2 + "U" -> g rhythmicityPolyWeightedF2 5 1 + "V" -> g rhythmicityPolyWeightedF20 5 1 + "S" -> g rhythmicityPolyWeightedF2 6 2 + "T" -> g rhythmicityPolyWeightedF20 6 2 + "u" -> g rhythmicityPoly 5 1 + "v" -> g rhythmicityPoly0 5 1 + "s" -> g rhythmicityPoly 6 2 + "t" -> g rhythmicityPoly0 6 2 + | otherwise -> rhythmicity04 + where h1 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [1,2,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrS + h2 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [2,1,1,n]) . mconcat . (case readMaybe ts::Maybe Int of { Just 1 -> syllableDurationsD ; Just 2 -> syllableDurationsD2 ; Just 3 -> syllableDurationsD3 ; Just 4 -> syllableDurationsD4 }) . createSyllablesUkrS + g f m n + | drop 1 choice `elem` ["01","02","03","04"] = h1 f (drop 2 . take 3 $ choice) [True,True,True] m n + | drop 1 choice `elem` ["11","12","13","14"] = h1 f (drop 2 . take 3 $ choice) [True,True,False] m n + | drop 1 choice `elem` ["21","22","23","24"] = h1 f (drop 2 . take 3 $ choice) [True,False,True] m n + | drop 1 choice `elem` ["31","32","33","34"] = h1 f (drop 2 . take 3 $ choice) [True,False,False] m n + | drop 1 choice `elem` ["41","42","43","44"] = h2 f (drop 2 . take 3 $ choice) [True,True,True] m n + | drop 1 choice `elem` ["51","52","53","54"] = h2 f (drop 2 . take 3 $ choice) [True,True,False] m n + | drop 1 choice `elem` ["61","62","63","64"] = h2 f (drop 2 . take 3 $ choice) [True,False,True] m n + | drop 1 choice `elem` ["71","72","73","74"] = h2 f (drop 2 . take 3 $ choice) [True,False,False] m n + | otherwise = rhythmicity04 + w1F f ch rh = rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS + wwF2 g2 xs = let (Just n) = readMaybe xs::Maybe Int in + case n `rem` 4 of + 1 -> g2 syllableDurationsD + 2 -> g2 syllableDurationsD2 + 3 -> g2 syllableDurationsD3 + _ -> g2 syllableDurationsD4 + x1F f ch rh = rhythmicityABC0 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS + xxF = wwF2 x1F + wwF = wwF2 w1F + {-# INLINE w1F #-} + {-# INLINE wwF2 #-} + {-# INLINE x1F #-} + {-# INLINE xxF #-} + {-# INLINE wwF #-} +rhythmicity k choice (CF2 x y) = + case take 1 choice of + "0" -> case choice of + "0y" -> rhythmicityK (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "02y" -> rhythmicityK2 (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "03y" -> rhythmicityK3 (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "0z" -> rhythmicityKF k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "02z" -> rhythmicityKF2 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "03z" -> rhythmicityKF3 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "04z" -> rhythmicityKF4 k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + _ -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "w" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity04 + | otherwise -> rhythmicity04 + where w1F f ch rh = rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS + wwF xs = let (Just n) = readMaybe xs::Maybe Int in + case n `rem` 4 of + 1 -> w1F syllableDurationsD + 2 -> w1F syllableDurationsD2 + 3 -> w1F syllableDurationsD3 + _ -> w1F syllableDurationsD4 + {-# INLINE w1F #-} + {-# INLINE wwF #-} + "x" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity04 + | otherwise -> rhythmicity04 + where x1F f ch rh = rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS + xxF xs = let (Just n) = readMaybe xs::Maybe Int in + case n `rem` 4 of + 1 -> x1F syllableDurationsD + 2 -> x1F syllableDurationsD2 + 3 -> x1F syllableDurationsD3 + _ -> x1F syllableDurationsD4 + {-# INLINE x1F #-} + {-# INLINE xxF #-} + _ -> if + | ((take 1 choice >= "b" && take 1 choice <= "v") || (take 1 choice >= "A" && take 1 choice <= "Z" && take 1 choice `notElem` ["G","H"])) -> rhythmicity k choice CF0 + | otherwise -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y) + +helperF4 :: Int -> [[[Sound8]]] -> [[Double]] +helperF4 n + | n == 1 = syllableDurationsD + | n == 2 = syllableDurationsD2 + | n == 3 = syllableDurationsD3 + | otherwise = syllableDurationsD4 + +parseChRhEndMaybe :: ParseChRh -> Maybe Int +parseChRhEndMaybe (P0 _) = Nothing +parseChRhEndMaybe (P1 _ _ n) = Just n +parseChRhEndMaybe (P2 _ _ _ n) = Just n + +---------------------------------------------------------------- diff --git a/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2Hprime.hs b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2Hprime.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Array/Ukrainian/PropertiesSyllablesG2Hprime.hs @@ -0,0 +1,250 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Hprime +-- Copyright : (c) OleksandrZhabenko 2020-2021 +-- 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. Uses syllables information. +-- Instead of the vector-related, uses just arrays. + +{-# LANGUAGE CPP, BangPatterns, MultiWayIf #-} + +module Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Hprime ( + -- * General + rhythmicityH + , rhythmicityH' +) 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.Phonetic.Ukrainian.Syllable.Double.ArrInt8 +import Melodics.Ukrainian.ArrInt8 (Sound8) +import Languages.Phonetic.Ukrainian.Syllable.ArrInt8 +import Data.Maybe (fromMaybe) +import Text.Read (readMaybe) +import Rhythmicity.TwoFourth +import Rhythmicity.PolyRhythm +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201 +import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +{-| Allows to use the user-defined custom 'Sound8' durations. This is used when the first character in the second argument is +\'H\'. +-} +rhythmicityH + :: Double + -> String + -> [[[[Sound8]]] -> [[Double]]] + -> Coeffs2 + -> String + -> Double +rhythmicityH k choice syllableDurationsDs coeffs + | take 1 choice == "H" = rhythmicityH' k (drop 1 choice) syllableDurationsDs coeffs + | otherwise = rhythmicity k choice coeffs + +rhythmicityH' + :: Double + -> String + -> [[[[Sound8]]] -> [[Double]]] + -> Coeffs2 + -> String + -> Double +rhythmicityH' k choice syllableDurationsDs CF0 = if + | 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 n) -> rhythmicityABC 1.0 2.0 0.125 ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + Just (P2 ch rh r n) -> case take 1 choice of + "A" -> rhythmicityPolyWeightedLEF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "D" -> rhythmicityPolyWeightedLF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "E" -> rhythmicityPolyWeightedLEF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "F" -> rhythmicityPolyWeightedLF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "B" -> rhythmicityPolyWeightedEF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "C" -> rhythmicityPolyWeightedF2 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "M" -> rhythmicityPolyWeightedEF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "N" -> rhythmicityPolyWeightedF3 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + "c" -> rhythmicityPoly 1.0 r ch rh . rhythmicityG (helperHF4 n syllableDurationsDs) + _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | choice == "0y" -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | take 1 choice == "0" && drop 2 (take 3 choice) == "y" -> + let n2 = readMaybe (drop 1 . take 2 $ choice)::Maybe Int in + case n2 of + Just n3 -> rhythmicity0H (helperHF4 n3 syllableDurationsDs) + Nothing -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | choice == "0z" -> rhythmicity0FH (helperHF4 1 syllableDurationsDs) k + | take 1 choice == "0" && drop 2 (take 3 choice) == "z" -> + let n2 = readMaybe (drop 1 . take 2 $ choice)::Maybe Int in + case n2 of + Just n3 -> rhythmicity0FH (helperHF4 n3 syllableDurationsDs) k + Nothing -> rhythmicity0FH (helperHF4 1 syllableDurationsDs) k + | take 1 choice == "0" -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | take 1 choice == "w" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | take 1 choice == "x" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | otherwise -> if + | (take 1 choice == "b" || ((take 1 choice >= "d" && take 1 choice <= "v") || (take 1 choice >= "I" && take 1 choice <= "Z"))) && (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "9" -> + case take 1 choice of + "b" -> g rhythmicityPolyWeightedLEF3 5 1 + "d" -> g rhythmicityPolyWeightedLEF30 5 1 + "e" -> g rhythmicityPolyWeightedLEF3 6 2 + "f" -> g rhythmicityPolyWeightedLEF30 6 2 + "g" -> g rhythmicityPolyWeightedLEF2 5 1 + "h" -> g rhythmicityPolyWeightedLEF20 5 1 + "i" -> g rhythmicityPolyWeightedLEF2 6 2 + "j" -> g rhythmicityPolyWeightedLEF20 6 2 + "k" -> g rhythmicityPolyWeightedLF3 5 1 + "l" -> g rhythmicityPolyWeightedLF30 5 1 + "m" -> g rhythmicityPolyWeightedLF3 6 2 + "n" -> g rhythmicityPolyWeightedLF30 6 2 + "o" -> g rhythmicityPolyWeightedLF2 5 1 + "p" -> g rhythmicityPolyWeightedLF20 5 1 + "q" -> g rhythmicityPolyWeightedLF2 6 2 + "r" -> g rhythmicityPolyWeightedLF20 6 2 + "I" -> g rhythmicityPolyWeightedEF3 5 1 + "J" -> g rhythmicityPolyWeightedEF30 5 1 + "K" -> g rhythmicityPolyWeightedEF3 6 2 + "L" -> g rhythmicityPolyWeightedEF30 6 2 + "O" -> g rhythmicityPolyWeightedEF2 5 1 + "P" -> g rhythmicityPolyWeightedEF20 5 1 + "Q" -> g rhythmicityPolyWeightedEF2 6 2 + "R" -> g rhythmicityPolyWeightedEF20 6 2 + "W" -> g rhythmicityPolyWeightedF3 5 1 + "X" -> g rhythmicityPolyWeightedF30 5 1 + "Y" -> g rhythmicityPolyWeightedF3 6 2 + "Z" -> g rhythmicityPolyWeightedF30 6 2 + "U" -> g rhythmicityPolyWeightedF2 5 1 + "V" -> g rhythmicityPolyWeightedF20 5 1 + "S" -> g rhythmicityPolyWeightedF2 6 2 + "T" -> g rhythmicityPolyWeightedF20 6 2 + "u" -> g rhythmicityPoly 5 1 + "v" -> g rhythmicityPoly0 5 1 + "s" -> g rhythmicityPoly 6 2 + "t" -> g rhythmicityPoly0 6 2 + | otherwise -> rhythmicity0H + (let ts = drop 2 . take 3 $ choice in + case ts of { [] -> syllableDurationsD4 ; ks -> + let q = readMaybe ks::Maybe Int in + case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) + where h1 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [1,2,1,n]) . mconcat . + (case ts of { [] -> syllableDurationsD4 ; ks -> let q = readMaybe ks::Maybe Int in + case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) . + createSyllablesUkrS + h2 f ts xs m n = f 1.0 4 (PolyCh xs m) (PolyRhythm [2,1,1,n]) . mconcat . + (case ts of { [] -> syllableDurationsD4 ; ks -> let q = readMaybe ks::Maybe Int in + case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) . + createSyllablesUkrS + g f m n + | drop 1 (take 2 choice) == "0" = h1 f (drop 2 . take 3 $ choice) [True,True,True] m n + | drop 1 (take 2 choice) == "1" = h1 f (drop 2 . take 3 $ choice) [True,True,False] m n + | drop 1 (take 2 choice) == "2" = h1 f (drop 2 . take 3 $ choice) [True,False,True] m n + | drop 1 (take 2 choice) == "3" = h1 f (drop 2 . take 3 $ choice) [True,False,False] m n + | drop 1 (take 2 choice) == "4" = h2 f (drop 2 . take 3 $ choice) [True,True,True] m n + | drop 1 (take 2 choice) == "5" = h2 f (drop 2 . take 3 $ choice) [True,True,False] m n + | drop 1 (take 2 choice) == "6" = h2 f (drop 2 . take 3 $ choice) [True,False,True] m n + | drop 1 (take 2 choice) == "7" = h2 f (drop 2 . take 3 $ choice) [True,False,False] m n + | otherwise = rhythmicity0H (helperHF4 n syllableDurationsDs) + w1F f ch rh = rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS + wwF2 g2 xs = + let n1 = readMaybe xs::Maybe Int in + case n1 of + Just n2 -> g2 (helperHF4 n2 syllableDurationsDs) + Nothing -> g2 syllableDurationsD4 + x1F f ch rh = rhythmicityABC0 1.0 2.0 0.125 ch rh . mconcat . f . createSyllablesUkrS + xxF = wwF2 x1F + wwF = wwF2 w1F + {-# INLINE w1F #-} + {-# INLINE wwF2 #-} + {-# INLINE x1F #-} + {-# INLINE xxF #-} + {-# INLINE wwF #-} +rhythmicityH' k choice syllableDurationsDs (CF2 x y) = + case take 1 choice of + "0" -> case choice of + "0y" -> rhythmicityKH (helperHF4 1 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "02y" -> rhythmicityKH (helperHF4 2 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "03y" -> rhythmicityKH (helperHF4 3 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "0z" -> rhythmicityKFH (helperHF4 1 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "02z" -> rhythmicityKFH (helperHF4 2 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "03z" -> rhythmicityKFH (helperHF4 3 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "04z" -> rhythmicityKFH (helperHF4 4 syllableDurationsDs) k (fromMaybe 1.0 x) (fromMaybe 1.0 y) + _ -> rhythmicityKH (helperHF4 1 syllableDurationsDs) (fromMaybe 1.0 x) (fromMaybe 1.0 y) + "w" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "w0" -> wwF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "w1" -> wwF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "w2" -> wwF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "w3" -> wwF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + where w1F f ch rh = rhythmicityABC 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS + wwF xs = + let n1 = readMaybe xs::Maybe Int in + case n1 of + Just n2 -> w1F (helperHF4 n2 syllableDurationsDs) + Nothing -> w1F syllableDurationsD4 + {-# INLINE w1F #-} + {-# INLINE wwF #-} + "x" -> if + | (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" -> + case take 2 choice of + "x0" -> xxF (drop 2 . take 3 $ choice) (Ch 1 1 4) (Rhythm 1 1 2) + "x1" -> xxF (drop 2 . take 3 $ choice) (Ch 1 0 4) (Rhythm 2 1 1) + "x2" -> xxF (drop 2 . take 3 $ choice) (Ch 0 1 4) (Rhythm 1 2 1) + "x3" -> xxF (drop 2 . take 3 $ choice) (Ch 0 0 4) (Rhythm 1 1 2) + _ -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + | otherwise -> rhythmicity0H (helperHF4 1 syllableDurationsDs) + where x1F f ch rh = rhythmicityABC0 1.0 (fromMaybe 2.0 x) (fromMaybe 0.125 y) ch rh . mconcat . f . createSyllablesUkrS + xxF xs = + let n1 = readMaybe xs::Maybe Int in + case n1 of + Just n2 -> x1F (helperHF4 n2 syllableDurationsDs) + Nothing -> x1F syllableDurationsD4 + {-# INLINE x1F #-} + {-# INLINE xxF #-} + _ -> if + | ((take 1 choice >= "b" && take 1 choice <= "v") || (take 1 choice >= "A" && take 1 choice <= "Z" && take 1 choice `notElem` ["G","H"])) -> rhythmicityH' k choice syllableDurationsDs CF0 + | otherwise -> rhythmicityKH + (let ts = drop 2 . take 3 $ choice in + case ts of { [] -> syllableDurationsD4 ; ks -> + let q = readMaybe ks::Maybe Int in + case q of {Just q' -> helperHF4 q' syllableDurationsDs; ~Nothing -> syllableDurationsD4 }}) + (fromMaybe 1.0 x) (fromMaybe 1.0 y) + + +helperHF4 :: Int -> [[[[Sound8]]] -> [[Double]]] -> [[[Sound8]]] -> [[Double]] +helperHF4 n xs + | null xs = syllableDurationsD4 + | (n `rem` length xs) == 0 = head xs + | otherwise = xs !! ((n `rem` length xs) - 1) diff --git a/phonetic-languages-simplified-properties-array.cabal b/phonetic-languages-simplified-properties-array.cabal --- a/phonetic-languages-simplified-properties-array.cabal +++ b/phonetic-languages-simplified-properties-array.cabal @@ -2,7 +2,7 @@ -- For further documentation, see http://haskell.org/cabal/users-guide/ name: phonetic-languages-simplified-properties-array -version: 0.11.0.0 +version: 0.12.0.0 synopsis: Some properties of the data related to rhythmicity. description: A generalization of the uniqueness-periods-vector-properties package. Is a simplified version of the functionality of the former one. Uses lists and arrays as main processment data types. Uses Double whenever applicable. homepage: https://hackage.haskell.org/package/phonetic-languages-simplified-properties-array @@ -17,9 +17,9 @@ cabal-version: >=1.10 library - exposed-modules: Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2, Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 + exposed-modules: Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2, Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2, Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common, Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG201, Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2H, Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Hprime, Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common, Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Rhythmicity, Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Diverse, Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG21, Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG22, Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG23, Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG24 -- other-modules: other-extensions: BangPatterns, CPP, MultiWayIf - build-depends: base >=4.8 && <4.16, phonetic-languages-rhythmicity >=0.9.1 && <1, phonetic-languages-simplified-base >=0.3 && <1, ukrainian-phonetics-basic-array >=0.3 && <1 + build-depends: base >=4.8 && <4.16, phonetic-languages-rhythmicity >=0.9.1 && <1, phonetic-languages-simplified-base >=0.4 && <1, ukrainian-phonetics-basic-array >=0.4.2 && <1 -- hs-source-dirs: default-language: Haskell2010