{-# OPTIONS_HADDOCK show-extensions #-}
-- |
-- Module : Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
-- 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.PropertiesSyllablesG2 (
-- * Newtype to work with
CoeffTwo(..)
, Coeffs2
, isEmpty
, isPair
, fstCF
, sndCF
, readCF
-- * Rhythmicity properties (semi-empirical)
-- ** 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
, rhythmicity
) where
#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import Languages.Rhythmicity
import Languages.Rhythmicity.Factor
import Languages.Phonetic.Ukrainian.Syllable.Double.Arr
import Languages.Phonetic.Ukrainian.Syllable.Arr
import Data.Maybe (isNothing,fromMaybe)
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 #-}
rhythmicityG :: ([[[UZPP2]]] -> [[Double]]) -> ([[Double]] -> Double) -> String -> Double
rhythmicityG f g xs
| null xs = 0.0
| otherwise = g . f . createSyllablesUkrS $ xs
{-# INLINE rhythmicityG #-}
-------------------------------------------------------
rhythmicity0 :: String -> Double
rhythmicity0 = rhythmicityG syllableDurationsD eval23
{-# INLINE rhythmicity0 #-}
rhythmicity02 :: String -> Double
rhythmicity02 = rhythmicityG syllableDurationsD2 eval23
{-# INLINE rhythmicity02 #-}
rhythmicity03 :: String -> Double
rhythmicity03 = rhythmicityG syllableDurationsD3 eval23
{-# INLINE rhythmicity03 #-}
rhythmicity04 :: String -> Double
rhythmicity04 = rhythmicityG syllableDurationsD4 eval23
{-# INLINE rhythmicity04 #-}
-------------------------------------------------------
rhythmicityK :: Double -> Double -> String -> Double
rhythmicityK k2 k3 = rhythmicityG syllableDurationsD (eval23K k2 k3)
{-# INLINE rhythmicityK #-}
rhythmicityK2 :: Double -> Double -> String -> Double
rhythmicityK2 k2 k3 = rhythmicityG syllableDurationsD2 (eval23K k2 k3)
{-# INLINE rhythmicityK2 #-}
rhythmicityK3 :: Double -> Double -> String -> Double
rhythmicityK3 k2 k3 = rhythmicityG syllableDurationsD3 (eval23K k2 k3)
{-# INLINE rhythmicityK3 #-}
rhythmicityK4 :: Double -> Double -> String -> Double
rhythmicityK4 k2 k3 = rhythmicityG syllableDurationsD4 (eval23K k2 k3)
{-# INLINE rhythmicityK4 #-}
--------------------------------------------------------
rhythmicity0F :: Double -> String -> Double
rhythmicity0F k = rhythmicityG syllableDurationsD (eval23F k)
{-# INLINE rhythmicity0F #-}
rhythmicity02F :: Double -> String -> Double
rhythmicity02F k = rhythmicityG syllableDurationsD2 (eval23F k)
{-# INLINE rhythmicity02F #-}
rhythmicity03F :: Double -> String -> Double
rhythmicity03F k = rhythmicityG syllableDurationsD3 (eval23F k)
{-# INLINE rhythmicity03F #-}
rhythmicity04F :: Double -> String -> Double
rhythmicity04F k = rhythmicityG syllableDurationsD4 (eval23F k)
{-# INLINE rhythmicity04F #-}
--------------------------------------------------------
rhythmicityKF :: Double -> Double -> Double -> String -> Double
rhythmicityKF k k2 k3 = rhythmicityG syllableDurationsD (eval23KF k k2 k3)
{-# INLINE rhythmicityKF #-}
rhythmicityKF2 :: Double -> Double -> Double -> String -> Double
rhythmicityKF2 k k2 k3 = rhythmicityG syllableDurationsD2 (eval23KF k k2 k3)
{-# INLINE rhythmicityKF2 #-}
rhythmicityKF3 :: Double -> Double -> Double -> String -> Double
rhythmicityKF3 k k2 k3 = rhythmicityG syllableDurationsD3 (eval23KF k k2 k3)
{-# INLINE rhythmicityKF3 #-}
rhythmicityKF4 :: Double -> Double -> Double -> String -> Double
rhythmicityKF4 k k2 k3 = rhythmicityG syllableDurationsD4 (eval23KF k k2 k3)
{-# INLINE rhythmicityKF4 #-}
--------------------------------------------------------
rhythmicity :: Double -> String -> Coeffs2 -> String -> Double
rhythmicity k choice CF0 =
case take 1 choice of
"0" -> case choice of
"0y" -> rhythmicity0
"02y" -> rhythmicity02
"03y" -> rhythmicity03
"0z" -> rhythmicity0F k
"02z" -> rhythmicity02F k
"03z" -> rhythmicity03F k
"04z" -> rhythmicity04F k
_ -> rhythmicity04
"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 2.0 0.125 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 2.0 0.125 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 #-}
"c" -> let just_probe = readRhythmicity choice in
case just_probe of
Just (P1 ch rh 1) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD . createSyllablesUkrS
Just (P1 ch rh 2) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD2 . createSyllablesUkrS
Just (P1 ch rh 3) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD3 . createSyllablesUkrS
Just (P1 ch rh 4) -> rhythmicityABC 1.0 2.0 0.125 ch rh . mconcat . syllableDurationsD4 . createSyllablesUkrS
Just (P2 ch rh r 1) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD . createSyllablesUkrS
Just (P2 ch rh r 2) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD2 . createSyllablesUkrS
Just (P2 ch rh r 3) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD3 . createSyllablesUkrS
Just (P2 ch rh r 4) -> rhythmicityPoly 1.0 r ch rh . mconcat . syllableDurationsD4 . createSyllablesUkrS
_ -> rhythmicity04
_ -> if
| (take 1 choice == "u" || take 1 choice == "v" || take 1 choice == "s" || take 1 choice == "t") && (drop 2 . take 3 $ choice) >= "1" && (drop 2 . take 3 $ choice) <= "4" ->
case take 1 choice of
"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
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 `elem` ["c","u","v","s","t"] -> rhythmicity k choice CF0
| otherwise -> rhythmicityK4 (fromMaybe 1.0 x) (fromMaybe 1.0 y)