diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -96,3 +96,9 @@ ## 0.9.2.0 -- 2022-03-24 * Ninth version revised B. Updated the dependency boundaries to support the latest GHC and Cabal versions. + +## 0.10.0.0 -- 2023-02-05 + +* Tenth version. Switched to NoImplicitPrelude extension. Changed the computational schemes in the Phladiprelio.Rhythmicity.Simple and +Phladiprelio.Rhythmicity.Factor modules. Updated the dependency boundaries. + diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2020 OleksandrZhabenko +Copyright (c) 2020-2023 Oleksandr Zhabenko Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/Languages/Rhythmicity.hs b/Languages/Rhythmicity.hs deleted file mode 100644 --- a/Languages/Rhythmicity.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# OPTIONS_HADDOCK show-extensions #-} - --- | --- Module : Languages.Rhythmicity --- Copyright : (c) OleksandrZhabenko 2020 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- Allows to evaluate (approximately, so better to say, to estimate) the --- rhythmicity properties for the text (usually, the poetic one). - -module Languages.Rhythmicity where - -import GHC.Int - -maxPosition2 :: (RealFrac a) => [a] -> a -maxPosition2 xs - | null xs = 0.0 - | mx2 == 0.0 = 2.0 * abs (maxP21 xs 0) - | abs mx2 == 1 = 1.6 * abs (maxP21 xs 0) - | otherwise = abs (maxP21 xs 0 / mx2) - where maxP21 (x:y:ys) !acc1 = maxP21 ys (if x < y then (acc1 + 1)::Int16 else (acc1 - 1)::Int16) - maxP21 _ !acc1 = fromIntegral acc1 - maxP22 (x:y:ys) !acc1 = maxP22 (y:ys) (if x < y then (acc1 + 1)::Int16 else (acc1 - 1)::Int16) - maxP22 _ !acc1 = fromIntegral acc1 - !mx2 = maxP22 xs (0::Int16) - -posMaxIn3 - :: (Ord a) => a - -> a - -> a - -> Int16 -posMaxIn3 x y z - | x < y = if y < z then 3 else 2 - | x < z = 3 - | otherwise = 1 - -maxPosition3 :: RealFrac a => [a] -> a -maxPosition3 xs - | null xs = 0.0 - | length xs `rem` 3 == 0 = 3.0 * fromIntegral (go (h xs) ((0, 0, 0)::(Int16,Int16,Int16))) - | otherwise = fromIntegral (go (h xs) ((0, 0, 0)::(Int16,Int16,Int16))) - where h (x:y:z:ys) = posMaxIn3 x y z:h ys - h _ = [] - go (x:zs) (!acc21,!acc22,!acc23) = go zs (h1 x (acc21,acc22,acc23)) - go _ (!acc21,!acc22,!acc23) - | acc21 > acc22 = if acc21 > acc23 then acc21 else acc23 - | acc22 > acc23 = acc22 - | otherwise = acc23 - h1 !x (!t,!u,!w) - | x == 1 = (t + (1::Int16), u, w) - | x == 2 = (t, u + (1::Int16), w) - | otherwise = (t,u,w + (1::Int16)) - -evalRhythmicity23 :: (RealFrac a, Floating a) => [a] -> a -evalRhythmicity23 xs = maxPosition2 xs * maxPosition2 xs + maxPosition3 xs * maxPosition3 xs - -evalRhythmicity23K - :: (RealFrac a, Floating a) => a - -> a - -> [a] - -> a -evalRhythmicity23K k2 k3 xs = k2 * maxPosition2 xs * maxPosition2 xs + k3 * maxPosition3 xs * maxPosition3 xs diff --git a/Languages/Rhythmicity/Factor.hs b/Languages/Rhythmicity/Factor.hs deleted file mode 100644 --- a/Languages/Rhythmicity/Factor.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# OPTIONS_HADDOCK show-extensions #-} -{-# OPTIONS_GHC -funbox-strict-fields #-} - --- | --- Module : Languages.Rhythmicity.Factor --- Copyright : (c) OleksandrZhabenko 2020 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- Allows to evaluate (approximately, so better to say, to estimate) the --- rhythmicity properties for the text (usually, the poetic one). Tries to use --- somewhat \'improved\' versions of the functions similar to the ones in the --- Languages.Rhythmicity module. - -module Languages.Rhythmicity.Factor where - -import GHC.Int - --- | The first argument must be greater than 1, though it is not checked. -maxPosition2F :: (RealFrac a) => a -> [a] -> a -maxPosition2F !k xs - | null xs = 0.0 - | mx2 == 0.0 = 2.0 * abs (maxP21 k xs 0) - | abs mx2 == 1 = 1.6 * abs (maxP21 k xs 0) - | otherwise = abs (maxP21 k xs 0 / mx2) - where maxP21 k (x:y:ys) !acc1 = maxP21 k ys (f k x y acc1) - maxP21 k _ !acc1 = fromIntegral acc1 - maxP22 k (x:y:ys) !acc1 = maxP22 k (y:ys) (f k x y acc1) - maxP22 k _ !acc1 = fromIntegral acc1 - !mx2 = maxP22 k xs (0::Int16) - f !k !z !t !acc - | z < t = (acc + 1)::Int16 - | z > k * t = (acc - 1)::Int16 - | otherwise = acc::Int16 - -data Pos3F = P !Int8 !Int16 - -posMaxIn3F - :: (Ord a, Num a) => a - -> a - -> a - -> Pos3F -posMaxIn3F x y z - | x < y && y < z = - case 3 * (x + y) > 5 * z of - True -> P 3 0 - _ -> case 2 * (x + y) > 3 * z of - True -> P 3 1 - _ -> P 3 2 - | x < y = - case 3 * (x + z) > 5 * y of - True -> P 2 0 - _ -> case 2 * (x + z) > 3 * y of - True -> P 2 1 - _ -> P 2 2 - | x < z = - case 3 * (x + y) > 5 * z of - True -> P 3 0 - _ -> case 2 * (x + y) > 3 * z of - True -> P 3 1 - _ -> P 3 2 - | otherwise = - case 3 * (y + z) > 5 * x of - True -> P 1 0 - _ -> case 2 * (y + z) > 3 * x of - True -> P 1 1 - _ -> P 1 2 - -maxPosition3F :: RealFrac a => [a] -> a -maxPosition3F xs - | null xs = 0.0 - | length xs `rem` 3 == 0 = 3.0 * fromIntegral (go (h xs) ((0, 0, 0)::(Int16,Int16,Int16))) - | otherwise = fromIntegral (go (h xs) ((0, 0, 0)::(Int16,Int16,Int16))) - where h (x:y:z:ys) = posMaxIn3F x y z:h ys - h _ = [] - go (x:zs) (!acc21,!acc22,!acc23) = go zs (h1 x (acc21,acc22,acc23)) - go _ (!acc21,!acc22,!acc23) - | acc21 > acc22 = if acc21 > acc23 then acc21 else acc23 - | acc22 > acc23 = acc22 - | otherwise = acc23 - h1 (P !x !y) (!t,!u,!w) - | x == 1 = (t + y, u, w) - | x == 2 = (t, u + y, w) - | otherwise = (t,u,w + y) - -evalRhythmicity23F :: (RealFrac a, Floating a) => a -> [a] -> a -evalRhythmicity23F k xs = maxPosition2F k xs * maxPosition2F k xs + maxPosition3F xs * maxPosition3F xs - -evalRhythmicity23KF - :: (RealFrac a, Floating a) => a - -> a - -> a - -> [a] - -> a -evalRhythmicity23KF k k2 k3 xs = k2 * maxPosition2F k xs * maxPosition2F k xs + k3 * maxPosition3F xs * maxPosition3F xs diff --git a/Phladiprelio/Rhythmicity/Factor.hs b/Phladiprelio/Rhythmicity/Factor.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/Rhythmicity/Factor.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE BangPatterns, NoImplicitPrelude, MultiWayIf #-} +{-# OPTIONS_HADDOCK show-extensions #-} +{-# OPTIONS_GHC -funbox-strict-fields #-} + +-- | +-- Module : Phladiprelio.Rhythmicity.Factor +-- Copyright : (c) Oleksandr Zhabenko 2020-2023 +-- License : MIT +-- Stability : Experimental +-- Maintainer : oleksandr.zhabenko@yahoo.com +-- +-- Allows to evaluate (approximately, so better to say, to estimate) the +-- rhythmicity properties for the text (usually, the poetic one). Tries to use +-- somewhat \'improved\' versions of the functions similar to the ones in the +-- Phladiprelio.Rhythmicity.Simple module. + +module Phladiprelio.Rhythmicity.Factor where + +import GHC.Base +import GHC.Int +import GHC.Num (Num,(+),(-),(*),abs) +import GHC.Real +import GHC.Float +import GHC.List +import Text.Show +import Text.Read (read) +import Phladiprelio.Rhythmicity.Simple +import Data.Char (isDigit) + +data Factors = F !Double !Double !Double !Double !Double !Double !Double !Double !Double !Double deriving (Eq, Show) + +readFactors :: String -> Factors +readFactors xs + | length xs == 10 = let (x1:x2:x3:x4:x5:x6:x7:x8:x9:[x10]) = map f2 xs in F x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 + | otherwise = undefined + where f2 x + | isDigit x = read [x]::Double + | otherwise = case x of { 'p' -> 4.743; 'i' -> 4.153; ~rrr -> 0 } + +-- | The first argument must be greater than 1 and the values in the list greater than 0 though it is not checked. +maxPosition2F :: Factors -> Double -> [Double] -> Double +maxPosition2F ff !k xs + | null xs = 0.0 + | otherwise = maxP21 ff k xs 0 + where maxP21 ff k (x:ks@(y:t:ys)) !acc1 + | abs (x - t) / max x t < 0.05 = maxP21 ff k ks (acc1 + f1 ff k s y w acc1) + | otherwise = maxP21 ff k ks (acc1 + f ff k s y w acc1) + where s = min x t + w = max x t + f ff@(F x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) k s y w acc + | t > w = if + | t >= k * s && t <= k*w -> x1 -- the default is 5.0 + | t < k*s -> x2 -- the default is 4.0 + | t > k*w -> x3 -- the default is 3.0 + | t > s = x4 -- the default is 2.0 + | t < s = x5 -- the default is 1.0 + | t == w = x6 -- the default is 4.743 + | otherwise = x7 -- the default is 4.153 + f1 ff@(F x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) k s y w acc + | t > w = x8 -- the default is 5.0 + | t < s = x9 -- the default is 4.0 + | otherwise = x10 -- the default is 3.0 + maxP21 _ _ _ !acc1 = acc1 + +defFactors :: Factors +defFactors = F 5 4 3 2 1 4.743 4.153 5 4 3 + +-- | +-- > readFactors defFactorsStr == defFactors +defFactorsStr :: String +defFactorsStr = "54321pi543" + +evalRhythmicity23F :: Factors -> Double -> [Double] -> Double +evalRhythmicity23F ff k xs = maxPosition2F ff k xs + maxPosition3 xs +{-# INLINE evalRhythmicity23F #-} + +evalRhythmicity23KF + :: Factors + -> Double + -> Double + -> Double + -> [Double] + -> Double +evalRhythmicity23KF ff k k2 k3 xs = k2 * maxPosition2F ff k xs + k3 * maxPosition3 xs +{-# INLINE evalRhythmicity23KF #-} diff --git a/Phladiprelio/Rhythmicity/PolyRhythm.hs b/Phladiprelio/Rhythmicity/PolyRhythm.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/Rhythmicity/PolyRhythm.hs @@ -0,0 +1,1075 @@ +{-# LANGUAGE BangPatterns, NoImplicitPrelude #-} +{-# LANGUAGE MultiWayIf #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phladiprelio.Rhythmicity.PolyRhythm +-- Copyright : (c) Oleksandr Zhabenko 2021-2023 +-- License : MIT +-- Stability : Experimental +-- Maintainer : oleksandr.zhabenko@yahoo.com +-- +-- The module is highly experimental approach to estimate further the rhythmicity (using some extent of the +-- music concept of polyrhythm) of the not very long lists (well, not longer than e. g. 30 elements). +-- Is rather computationally expensive, so must be used with caution. If the period +-- of rhythm is less than 5 or even 6 it is not effective. + +module Phladiprelio.Rhythmicity.PolyRhythm where + +import GHC.Base +import GHC.Int +import GHC.Num (Num,(+),(-),(*),abs) +import GHC.Real +import GHC.List +import Text.Show +import Data.List (sort) +import Data.Maybe (fromJust,fromMaybe) +import Data.Char (toLower,isDigit) +import GHC.Float (int2Double,(**)) +import qualified Phladiprelio.Rhythmicity.TwoFourth as TF +import Text.Read (readMaybe) +import qualified Data.Either as Either (Either(..)) + +{-| The data type that is used to mark the syllables accordingly to +their importance in general rhythm constituting. More important syllables +are marked with the less data constuctors (since the data type has an +instance of the 'Ord' type class). Contrary to 'PolyMarkers' and 'TF.Marker3s', +can be used in case of three levels of importance for rhythm constituting +with the last, fourth 'G' level of the syllables which position is thought as +not significant (though it actually, is not, but for simplicity). +-} +data Marker4s = D | E | F | G deriving (Eq,Ord,Show) + +{-| The data type that is used to mark the syllables accordingly to +their importance in general rhythm constituting. More important syllables +are marked with the less data constuctors (since the data type has an +instance of the 'Ord' type class). A generalization of the +'Marker4s' and 'TF.Marker3s' for the cases of multiple (may be 4, or 3, or more) +levels of importance in general rhythm constituting. +-} +newtype PolyMarkers = PolyMs Char deriving (Eq,Ord) + +instance Show PolyMarkers where + show (PolyMs c) = 'P':' ':[toLower c] + +{-| A data type is used to allow usage of the 'Marker4s' and 'PolyMarkers' data types in the +functions as just one single (unified) data type. +-} +data PolyMrks = R4 Marker4s | RP PolyMarkers deriving (Eq,Ord,Show) + +is4s :: PolyMrks -> Bool +is4s (R4 _) = True +is4s _ = False + +isPoly :: PolyMrks -> Bool +isPoly (RP _) = True +isPoly _ = False + +{-| Data to specify some quantitative information of the structure of rhythmicity. +-} +data PolyRhythmBasis = PolyRhythm [Int] deriving (Eq,Show) + +vals :: PolyRhythmBasis -> [Int] +vals (PolyRhythm xs) = xs + +{-| Data to specify (mostly) the qualitative information of the structure of rhythmicity. +-} +data PolyChoices = PolyCh { + xn :: [Bool], -- ^ the 'True' corresponds to maximums, 'False' -- to minimums + pqty :: Int -- ^ general quantity of the elements to be taken as one period. Must be not less than the sum of 'cheis' and 'chbis'. Symbolically, it must be 'sum' . 'vals' . 'PolyRhythm' $ ['Int'] = 'PolyCh' 'pqty'. +} deriving Eq + +{-| The predicate to check whether the two given arguments can be used together to get meaningful results. +The 'pqty' of the first argument must be equal to the 'sum' of the 'PolyRhythmBasis' 'Int' values +inside the list. There are also other logical constraints that the function takes into account. +-} +validPolyChRhPair :: PolyChoices -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> Bool +validPolyChRhPair (PolyCh xs n) (PolyRhythm ys) + | ks <= [0] = False + | any (<0) rs = False + | length xs < n && drop l ys > [0] && l == length xs = n == sum ys + | otherwise = False + where (ks,rs) = splitAt 1 ys + l = length ys - 1 + +{-| Auxiliary data type that is used internally in the 'getPolyChRhData' function in the module. +-} +data Intermediate a = J a | I PolyMarkers deriving (Eq, Ord) + +isJI :: Intermediate a -> Bool +isJI (J _) = True +isJI _ = False + +fromIntermediate :: Intermediate a -> Maybe PolyMrks +fromIntermediate (I k) = Just (RP k) +fromIntermediate _ = Nothing + +getPolyChRhData + :: (Ord a) => Char -- ^ The start of the 'RP' 'PolyMarkers' count in case of 'PolyMrks' with 'Char's. The usual one can be \'a\' or \'h\'. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> [[PolyMrks]] +getPolyChRhData c r choice@(PolyCh ts l1) rhythm@(PolyRhythm ys) xs + | r <= 4 && validPolyChRhPair choice rhythm = map (g4 choice rhythm) . f choice $ xs + | r > 4 && validPolyChRhPair choice rhythm = + map (\ks -> map (fromJust . fromIntermediate) . gPoly [c..] choice rhythm ks . map J $ ks) . f choice $ xs + | otherwise = error "Rhythmicity.PolyRhythm.getPolyChRhData: the first two arguments cannot be used together to get some meaningful result. " + where g4 (PolyCh js l) (PolyRhythm ys) us = let ws = sort us in case (ys,js) of + (x1:x2:x3:zs,[False,False,False]) -> let !k1 = ws !! (x1 - 1) + !k2 = ws !! (x1 + x2 - 1) + !k3 = ws !! (x1 + x2 + x3 - 1) in + map (\t -> if + | t <= k1 -> R4 D + | x2 == 0 -> R4 G + | t <= k2 -> R4 E + | x3 == 0 -> R4 G + | t <= k3 -> R4 F + | otherwise -> R4 G) us + (x1:x2:x3:zs,[True,False,False]) -> let !k1 = ws !! (length ws - x1) + !k2 + | x2 < 2 = head ws + | otherwise = ws !! (x2 - 1) + !k3 + | x2 == 0 = head ws + | otherwise = ws !! (x2 + x3 - 1) in + map (\t -> if + | t >= k1 -> R4 D + | x2 == 0 -> R4 G + | t <= k2 -> R4 E + | x3 == 0 -> R4 G + | t <= k3 -> R4 F + | otherwise -> R4 G) us + (x1:x2:x3:zs,[False,True,False]) -> let !k1 = ws !! (x1 - 1) + !k2 + | x2 == 0 = last ws + | otherwise = ws !! (length ws - x2) + !k3 = ws !! (x1 + x3 - 1) in + map (\t -> if + | t <= k1 -> R4 D + | x2 == 0 -> R4 G + | t >= k2 -> R4 E + | x3 == 0 -> R4 G + | t <= k3 -> R4 F + | otherwise -> R4 G) us + (x1:x2:x3:zs,[False,False,True]) -> let !k1 = ws !! (x1 - 1) + !k2 = ws !! (x1 + x2 - 1) + !k3 + | x3 == 0 = last ws + | otherwise = ws !! (length ws - x3) in + map (\t -> if + | t <= k1 -> R4 D + | x2 == 0 -> R4 G + | t <= k2 -> R4 E + | x3 == 0 -> R4 G + | t >= k3 -> R4 F + | otherwise -> R4 G) us + (x1:x2:x3:zs,[True,True,False]) -> let !k1 = ws !! (length ws - x1) + !k2 = ws !! (length ws - x1 - x2 - 1) + !k3 + | x3 == 0 = head ws + | otherwise = ws !! (x3 - 1) in + map (\t -> if + | t >= k1 -> R4 D + | x2 == 0 -> R4 G + | t >= k2 -> R4 E + | x3 == 0 -> R4 G + | t <= k3 -> R4 F + | otherwise -> R4 G) us + (x1:x2:x3:zs,[True,False,True]) -> let !k1 = ws !! (length ws - x1) + !k2 + | x2 == 0 = head ws + | otherwise = ws !! (x2 - 1) + !k3 = ws !! (length ws - x1 - x3) in + map (\t -> if + | t >= k1 -> R4 D + | x2 == 0 -> R4 G + | t <= k2 -> R4 E + | x3 == 0 -> R4 G + | t >= k3 -> R4 F + | otherwise -> R4 G) us + (x1:x2:x3:zs,[False,True,True]) -> let !k1 = ws !! (x1 - 1) + !k2 + | x2 == 0 = last ws + | otherwise = ws !! (length ws - x2) + !k3 + | x2 == 0 = last ws + | otherwise = ws !! (length ws - x2 - x3) in + map (\t -> if + | t <= k1 -> R4 D + | x2 == 0 -> R4 G + | t >= k2 -> R4 E + | x3 == 0 -> R4 G + | t >= k3 -> R4 F + | otherwise -> R4 G) us + (x1:x2:x3:zs,[_,_,_]) -> let !k1 = ws !! (length ws - x1) + !k2 = ws !! (length ws - x1 - x2) + !k3 = ws !! (length ws - x1 - x2 - x3) in + map (\t -> if + | t >= k1 -> R4 D + | x2 == 0 -> R4 G + | t >= k2 -> R4 E + | x3 == 0 -> R4 G + | t >= k3 -> R4 F + | otherwise -> R4 G) us + gPoly wws (PolyCh (j:js) l) (PolyRhythm (y:ys)) vs us + | null vs = map (\r -> if | isJI r -> (\q@(J rr) -> I (PolyMs (head wws))) r + | otherwise -> r) us + | y == 0 = map (\r -> if | isJI r -> (\q@(J rr) -> I (PolyMs (head wws))) r + | otherwise -> r) us + | otherwise = let ws = sort vs in case j of + False -> let !k = ws !! (y - 1) in + gPoly (drop 1 wws) (PolyCh js l) (PolyRhythm ys) (filter (> k) vs) + (map (\r -> if + | isJI r -> (\q@(J rr) -> if + | rr <= k -> I (PolyMs (head wws)) + | otherwise -> q) r + | otherwise -> r) us) + _ -> let !k = ws !! (length ws - y) in + gPoly (drop 1 wws) (PolyCh js l) (PolyRhythm ys) (filter (< k) vs) + (map (\r -> if + | isJI r -> (\q@(J rr) -> if + | rr >= k -> I (PolyMs (head wws)) + | otherwise -> q) r + | otherwise -> r) us) + gPoly wws (PolyCh [] l) _ vs us = map (\r -> if isJI r then I (PolyMs (head wws)) else r) us + f ch@(PolyCh _ l1) ys@(_:_) = + let !q = length ys `quot` l1 + rs = take (q * l1) ys in f' ch rs + f' ch@(PolyCh _ l1) qs@(_:_) = let (ts,zs) = splitAt l1 qs in ts : f' ch zs + f' _ [] = [] + +increasingF + :: Int + -> Double + -> Double +increasingF n x + | n <= 0 || x < 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.increasingF: not defined for the arguments. " ++ show n ++ " " ++ show x + | x == 0.0 = 0.001 + | n == 1 = x + min (x * 0.25) 0.125 + | x < 1 = x ** (1.0 / int2Double n) + | x <= 1.1 = x + 1.0 / int2Double n + | otherwise = x ^ n +{-# INLINE increasingF #-} + +increasingF1 + :: Int + -> Double + -> Double +increasingF1 n x + | n <= 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.increasingF1: not defined for the argument. " ++ show n + | otherwise = x + int2Double n +{-# INLINE increasingF1 #-} + +increasingFG + :: Int + -> Double + -> (Int -> Double -> Double -> Double) + -> Double + -> Double +increasingFG n k f x + | n <= 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.increasingFG: not defined for the argument. " ++ show n + | otherwise = x + abs (f n k x) +{-# INLINE increasingFG #-} + +decreasingF1 + :: Int + -> Double + -> Double +decreasingF1 n x + | n <= 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.decreasingF1: not defined for the argument. " ++ show n + | otherwise = x - int2Double n +{-# INLINE decreasingF1 #-} + +decreasingFG + :: Int + -> Double + -> (Int -> Double -> Double -> Double) + -> Double + -> Double +decreasingFG n k f x + | n <= 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.decreasingFG: not defined for the argument. " ++ show n + | otherwise = x - abs (f n k x) +{-# INLINE decreasingFG #-} + +decreasingFG2 + :: Int + -> Double + -> (Double -> Double -> Double) + -> Double + -> Double +decreasingFG2 n k f x + | n <= 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.decreasingFG2: not defined for the argument. " ++ show n + | otherwise = x - int2Double n * abs (f k x) +{-# INLINE decreasingFG2 #-} + +increasingFG2 + :: Int + -> Double + -> (Double -> Double -> Double) + -> Double + -> Double +increasingFG2 n k f x + | n <= 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.increasingFG2: not defined for the argument. " ++ show n + | otherwise = x + int2Double n * abs (f k x) +{-# INLINE increasingFG2 #-} + +decreasingF + :: Int + -> Double + -> Double +decreasingF n x + | n <= 0 || x < 0 = error $ "Phladiprelio.Rhythmicity.PolyRhythm.decreasingF: not defined for the arguments. " ++ show n ++ " " ++ show x + | x == 0.0 = 0.000000000001 + | n == 1 = x - min (x * 0.25) 0.125 + | x < 1 = x ** int2Double n + | x <= 1.1 = 1.0 / (x + 1.0 / int2Double n) + | otherwise = x ** (1.0 / int2Double n) +{-# INLINE decreasingF #-} + +similarityF1 + :: Char -- ^ The start of the counting. + -> PolyMrks + -> PolyMrks + -> Double -- ^ The initial value. + -> Double +similarityF1 = similarityFG12 1.0 (\_ _ -> 1.0) +{-# INLINE similarityF1 #-} + +{-| The more straightforward variant of the 'similarityF1' function. -} +similarityF0 + :: Char -- ^ The start of the counting. + -> PolyMrks + -> PolyMrks + -> Double -- ^ The initial value. + -> Double +similarityF0 = similarityFG02 1.0 (\_ _ -> 1.0) +{-# INLINE similarityF0 #-} + +similarityFGE1 + :: Double + -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char + -> PolyMrks + -> PolyMrks + -> Double + -> Double +similarityFGE1 k f c m1 m2 x + | is4s m1 = let !h = case (\(R4 t0) -> t0) m1 of { D -> 4 ; E -> 3 ; F -> 2 ; ~rrr -> 1 } in case m1 == m2 of + True -> case f of + Either.Left f2 -> increasingFG2 h k f2 x + Either.Right f3 -> increasingFG h k f3 x + _ -> case f of + Either.Left f2 -> decreasingFG2 h k f2 x + Either.Right f3 -> decreasingFG h k f3 x + | otherwise = let l = length [c..(\(RP (PolyMs t0)) -> t0) (min m1 m2)] in + if + | m1 == m2 -> case f of + Either.Left f2 -> increasingFG2 l k f2 x + Either.Right f3 -> increasingFG l k f3 x + | otherwise -> case f of + Either.Left f2 -> decreasingFG2 l k f2 x + Either.Right f3 -> decreasingFG l k f3 x +{-# INLINE similarityFGE1 #-} + +similarityFG1 + :: Double + -> (Int -> Double -> Double -> Double) + -> Char + -> PolyMrks + -> PolyMrks + -> Double + -> Double +similarityFG1 k f = similarityFGE1 k (Either.Right f) +{-# INLINE similarityFG1 #-} + +similarityFG12 + :: Double + -> (Double -> Double -> Double) + -> Char + -> PolyMrks + -> PolyMrks + -> Double + -> Double +similarityFG12 k f = similarityFGE1 k (Either.Left f) +{-# INLINE similarityFG12 #-} + +similarityFGE0 + :: Double + -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char + -> PolyMrks + -> PolyMrks + -> Double + -> Double +similarityFGE0 k f c m1 m2 x + | is4s m1 = let h = case (\(R4 t0) -> t0) m1 of { D -> 4 ; E -> 3 ; F -> 2 ; ~rrr -> 1 } in case m1 == m2 of + True -> case f of + Either.Left f2 -> increasingFG2 h k f2 x + Either.Right f3 -> increasingFG h k f3 x + _ -> x + | otherwise = let l = length [c..(\(RP (PolyMs t0)) -> t0) (min m1 m2)] in + if + | m1 == m2 -> case f of + Either.Left f2 -> increasingFG2 l k f2 x + Either.Right f3 -> increasingFG l k f3 x + | otherwise -> x +{-# INLINE similarityFGE0 #-} + +similarityFG0 + :: Double + -> (Int -> Double -> Double -> Double) + -> Char + -> PolyMrks + -> PolyMrks + -> Double + -> Double +similarityFG0 k f = similarityFGE0 k (Either.Right f) +{-# INLINE similarityFG0 #-} + +similarityFG02 + :: Double + -> (Double -> Double -> Double) + -> Char + -> PolyMrks + -> PolyMrks + -> Double + -> Double +similarityFG02 k f = similarityFGE0 k (Either.Left f) +{-# INLINE similarityFG02 #-} + +{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) +lists of 'PolyMrks'. Uses both increasing and decreasing functions. +-} +similarityLogics + :: Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. +similarityLogics c x0 (x:xs) (y:ys) = similarityLogics c (similarityF1 c x y x0) xs ys +similarityLogics c x0 _ _ = x0 + +{-| The more straightforward variant of the 'similarityLogics' function. -} +similarityLogics0 + :: Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. +similarityLogics0 c x0 (x:xs) (y:ys) = similarityLogics0 c (similarityF0 c x y x0) xs ys +similarityLogics0 c x0 _ _ = x0 + +{-| +-} +similarityLogicsGE + :: Double + -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double +similarityLogicsGE k f c x0 (x:xs) (y:ys) = similarityLogicsGE k f c (similarityFGE1 k f c x y x0) xs ys +similarityLogicsGE k f c x0 _ _ = x0 + +{-| +-} +similarityLogicsG1 + :: Double + -> (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double +similarityLogicsG1 k f = similarityLogicsGE k (Either.Right f) +{-# INLINE similarityLogicsG1 #-} + +{-| +-} +similarityLogicsG12 + :: Double + -> (Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double +similarityLogicsG12 k f = similarityLogicsGE k (Either.Left f) +{-# INLINE similarityLogicsG12 #-} + + +{-| The more straightforward variant of the 'similarityLogicsGE' function. -} +similarityLogicsGE0 + :: Double + -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double +similarityLogicsGE0 k f c x0 (x:xs) (y:ys) = similarityLogicsGE0 k f c (similarityFGE0 k f c x y x0) xs ys +similarityLogicsGE0 k f c x0 _ _ = x0 + +{-| +-} +similarityLogicsG0 + :: Double + -> (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double +similarityLogicsG0 k f = similarityLogicsGE0 k (Either.Right f) +{-# INLINE similarityLogicsG0 #-} + +{-| +-} +similarityLogicsG02 + :: Double + -> (Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ An initial value. + -> [PolyMrks] + -> [PolyMrks] + -> Double +similarityLogicsG02 k f = similarityLogicsGE0 k (Either.Left f) +{-# INLINE similarityLogicsG02 #-} + +{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) +lists of 'PolyMrks'. Uses 'similarityLogics' inside. +-} +similarityPoly + :: Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [[PolyMrks]] + -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. +similarityPoly c z ts + | null ts = z + | otherwise = similarityPoly2 (head ts) c z ts +{-# INLINE similarityPoly #-} + +{-| +-} +similarityPoly2 + :: [PolyMrks] + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [[PolyMrks]] + -> Double +similarityPoly2 ks c z (xs:ys:xss) = similarityPoly2 ks c (z * similarityLogics c z xs ys) (ys:xss) +similarityPoly2 ks c z [ys] = z * similarityLogics c z ys ks +similarityPoly2 _ _ z _ = z + +{-| +-} +similarityPolyGEE + :: (Int,[PolyMrks]) + -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyGEE r f c z ((i,xs):(j,ys):xss) = + similarityPolyGEE r f c (z * similarityLogicsGE (int2Double i) f c z xs ys) ((j,ys):xss) +similarityPolyGEE (_,ts) f c z [(j,ys)] = z * similarityLogicsGE (int2Double j) f c z ys ts +similarityPolyGEE _ _ _ z _ = z + +similarityPolyGE + :: Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyGE f c z ts + | null ts = z + | otherwise = similarityPolyGEE (head ts) f c z ts +{-# INLINE similarityPolyGE #-} + +{-| +-} +similarityPolyG1 + :: (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyG1 f = similarityPolyGE (Either.Right f) +{-# INLINE similarityPolyG1 #-} + +{-| +-} +similarityPolyG12 + :: (Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyG12 f = similarityPolyGE (Either.Left f) +{-# INLINE similarityPolyG12 #-} + +{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) +lists of 'PolyMrks'. Uses 'similarityLogics0' inside. +The more straightforward variant of the 'similarityPoly' function. +-} +similarityPoly0 + :: Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [[PolyMrks]] + -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. +similarityPoly0 c z ts + | null ts = z + | otherwise = similarityPoly20 (head ts) c z ts +{-# INLINE similarityPoly0 #-} + +{-| +-} +similarityPoly20 + :: [PolyMrks] + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [[PolyMrks]] + -> Double +similarityPoly20 ks c z (xs:ys:xss) = similarityPoly20 ks c (z * similarityLogics c z xs ys) (ys:xss) +similarityPoly20 ks c z [ys] = z * similarityLogics c z ys ks +similarityPoly20 _ _ z _ = z + +{-| +-} +similarityPolyGEE0 + :: (Int,[PolyMrks]) + -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyGEE0 r f c z ((i,xs):(j,ys):xss) = + similarityPolyGEE0 r f c (z * similarityLogicsGE0 (int2Double i) f c z xs ys) ((j,ys):xss) +similarityPolyGEE0 (_,ts) f c z [(j,ys)] = z * similarityLogicsGE0 (int2Double j) f c z ys ts +similarityPolyGEE0 _ _ _ z _ = z + +similarityPolyGE0 + :: Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyGE0 f c z ts + | null ts = z + | otherwise = similarityPolyGEE0 (head ts) f c z ts +{-# INLINE similarityPolyGE0 #-} + +{-| +-} +similarityPolyG0 + :: (Int -> Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyG0 f = similarityPolyGE0 (Either.Right f) +{-# INLINE similarityPolyG0 #-} + +{-| +-} +similarityPolyG02 + :: (Double -> Double -> Double) + -> Char -- ^ The start of the counting. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [(Int,[PolyMrks])] + -> Double +similarityPolyG02 f = similarityPolyGE0 (Either.Left f) +{-# INLINE similarityPolyG02 #-} + +{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be +guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. +-} +rhythmicityPoly + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. +rhythmicityPoly x0 r choices rhythm = similarityPoly 'a' x0 . getPolyChRhData 'a' r choices rhythm +{-# INLINE rhythmicityPoly #-} + +{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be +guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. +-} +rhythmicityPolyGE + :: (Ord a) => Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyGE f x0 r choices rhythm = similarityPolyGE f 'a' x0 . zip [0..] . getPolyChRhData 'a' r choices rhythm +{-# INLINE rhythmicityPolyGE #-} + +rhythmicityPolyG1 + :: (Ord a) => (Int -> Double -> Double -> Double) + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyG1 f = rhythmicityPolyGE (Either.Right f) +{-# INLINE rhythmicityPolyG1 #-} + +rhythmicityPolyG12 + :: (Ord a) => (Double -> Double -> Double) + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyG12 f = rhythmicityPolyGE (Either.Left f) +{-# INLINE rhythmicityPolyG12 #-} + +{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be +guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. +-} +rhythmicityPolyGE0 + :: (Ord a) => Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyGE0 f x0 r choices rhythm = similarityPolyGE0 f 'a' x0 . zip [0..] . getPolyChRhData 'a' r choices rhythm +{-# INLINE rhythmicityPolyGE0 #-} + +rhythmicityPolyG01 + :: (Ord a) => (Int -> Double -> Double -> Double) + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyG01 f = rhythmicityPolyGE0 (Either.Right f) +{-# INLINE rhythmicityPolyG01 #-} + +rhythmicityPolyG02 + :: (Ord a) => (Double -> Double -> Double) + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyG02 f = rhythmicityPolyGE0 (Either.Left f) +{-# INLINE rhythmicityPolyG02 #-} + +{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be +guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. +The more straightforward variant of the 'rhythmicityPoly' function. +-} +rhythmicityPoly0 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. +rhythmicityPoly0 x0 r choices rhythm = similarityPoly0 'a' x0 . getPolyChRhData 'a' r choices rhythm +{-# INLINE rhythmicityPoly0 #-} + +------------------------------------------------------------------- + +{-| This function tries to increase the importance of the beginning of the line and decreases the importance +of the ending of the line. It is not a linear one. +-} +simpleF2 :: Double -> Double -> Double +simpleF2 k x = x / (k + 1.0)^2 + +simpleF3 :: Int -> Double -> Double -> Double +simpleF3 n k x + | n <= 2 = x / (k + 1.0)^2 + | otherwise = max x (x ^ n / (k + 1.0)^2) + +{-| This function tries to increase the importance of the ending of the line and decreases the importance +of the beginning of the line. It is not a linear one. +-} +simpleEndF2 :: Double -> Double -> Double +simpleEndF2 k x = x * (k + 1.0)^2 + +simpleEndF3 :: Int -> Double -> Double -> Double +simpleEndF3 n k x + | n <= 2 = x * (k + 1.0)^2 + | otherwise = max x (x ^ n * (k + 1.0)^2) + +------------------------------------------------------------------- + +rhythmicityPolyWeightedF2 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedF2 = rhythmicityPolyG12 (simpleF2) +{-# INLINE rhythmicityPolyWeightedF2 #-} + +rhythmicityPolyWeightedF3 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedF3 = rhythmicityPolyG1 (simpleF3) +{-# INLINE rhythmicityPolyWeightedF3 #-} + +rhythmicityPolyWeightedF20 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedF20 = rhythmicityPolyG02 (simpleF2) +{-# INLINE rhythmicityPolyWeightedF20 #-} + +rhythmicityPolyWeightedF30 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedF30 = rhythmicityPolyG01 (simpleF3) +{-# INLINE rhythmicityPolyWeightedF30 #-} + +rhythmicityPolyWeightedEF2 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedEF2 = rhythmicityPolyG12 (simpleEndF2) +{-# INLINE rhythmicityPolyWeightedEF2 #-} + +rhythmicityPolyWeightedEF3 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedEF3 = rhythmicityPolyG1 (simpleEndF3) +{-# INLINE rhythmicityPolyWeightedEF3 #-} + +rhythmicityPolyWeightedEF20 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedEF20 = rhythmicityPolyG02 (simpleEndF2) +{-# INLINE rhythmicityPolyWeightedEF20 #-} + +rhythmicityPolyWeightedEF30 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedEF30 = rhythmicityPolyG01 (simpleEndF3) +{-# INLINE rhythmicityPolyWeightedEF30 #-} + +------------------------------------------------------------------- + +{-| This function tries to increase the importance of the beginning of the line and decreases the importance +of the ending of the line. It is linear. +-} +linearF2 :: Double -> Double -> Double +linearF2 k x = x / (6.0 * (k + 1.0)) + +linearF3 :: Int -> Double -> Double -> Double +linearF3 n k x = int2Double n * x / (6.0 * (k + 1.0)) + +{-| This function tries to increase the importance of the ending of the line and decreases the importance +of the beginning of the line. It is linear. +-} +linearEndF2 :: Double -> Double -> Double +linearEndF2 k x = x * (6.0 * (k + 1.0)) + +linearEndF3 :: Int -> Double -> Double -> Double +linearEndF3 n k x = int2Double n * x * (6.0 * (k + 1.0)) + +------------------------------------------------------------------- + +rhythmicityPolyWeightedLF2 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLF2 = rhythmicityPolyG12 (linearF2) +{-# INLINE rhythmicityPolyWeightedLF2 #-} + +rhythmicityPolyWeightedLF3 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLF3 = rhythmicityPolyG1 (linearF3) +{-# INLINE rhythmicityPolyWeightedLF3 #-} + +rhythmicityPolyWeightedLF20 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLF20 = rhythmicityPolyG02 (linearF2) +{-# INLINE rhythmicityPolyWeightedLF20 #-} + +rhythmicityPolyWeightedLF30 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLF30 = rhythmicityPolyG01 (linearF3) +{-# INLINE rhythmicityPolyWeightedLF30 #-} + +rhythmicityPolyWeightedLEF2 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLEF2 = rhythmicityPolyG12 (linearEndF2) +{-# INLINE rhythmicityPolyWeightedLEF2 #-} + +rhythmicityPolyWeightedLEF3 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLEF3 = rhythmicityPolyG1 (linearEndF3) +{-# INLINE rhythmicityPolyWeightedLEF3 #-} + +rhythmicityPolyWeightedLEF20 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLEF20 = rhythmicityPolyG02 (linearEndF2) +{-# INLINE rhythmicityPolyWeightedLEF20 #-} + +rhythmicityPolyWeightedLEF30 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. + -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double +rhythmicityPolyWeightedLEF30 = rhythmicityPolyG01 (linearEndF3) +{-# INLINE rhythmicityPolyWeightedLEF30 #-} + +------------------------------------------------------------------- + +{-| Data type that is used to implement some parameter language to encode in the 'String' argument information +that is sufficient to transform the 'String' into 'Double' using the needed additional information provided by +some other means. + +-} +data ParseChRh = + P0 String + | P1 + TF.Choices + TF.RhythmBasis + Int -- ^ The number of the one of the functions to convert the phonetic languages elements into 'Double' values (usually, durations). + | P2 + PolyChoices + PolyRhythmBasis + Int -- ^ The value for the 'Int' parameter in the 'getPolyChRhData' function that uses two previous arguments. + Int -- ^ The number of the one of the functions to convert the phonetic languages elements into 'Double' values (usually, durations). + deriving Eq + +isChRhString :: ParseChRh -> Bool +isChRhString (P0 _) = True +isChRhString _ = False + +isChRh3 :: ParseChRh -> Bool +isChRh3 (P1 _ _ _) = True +isChRh3 _ = False + +isChRhPoly :: ParseChRh -> Bool +isChRhPoly (P2 _ _ _ _) = True +isChRhPoly _ = False + +{-| A parser function to get the 'ParseChRh' data. In case of success returns 'Just' 'ParseChRh' value. +Nevertheless, the further checks (e. g. 'validPolyChRhPair' or 'validChRhPair') is not applied by it, so +they must be applied further during the usage. Examples of the usage: +\"c114+112=2\" returns 'Just' @P1 (Ch 1 1 4) (Rhythm 1 1 2) 2@ +\"Mtttff7+112111=7*3\" returns 'Just' @P2 (PolyCh [True,True,True,False,False] 7) (PolyRhythm [1,1,2,1,1,1]) 7 3@. +-} +readRhythmicity :: String -> Maybe ParseChRh +readRhythmicity ys@(x:xs) + | ((x `elem` "cMN") || (x >= 'A' && x <= 'F')) && not (null xs) = if + | isDigit . head $ xs -> let x = readMaybe (take 1 ts)::Maybe Int + y = readMaybe (drop 1 . take 2 $ ts)::Maybe Int + z = readMaybe (drop 2 ts)::Maybe Int + ch = case (x,y,z) of + (Just x1, Just y1, Just z1) -> Just (TF.Ch x1 y1 z1) + _ -> Nothing + x2 = readMaybe (take 1 ws)::Maybe Int + y2 = readMaybe (drop 1 . take 2 $ ws)::Maybe Int + z2 = readMaybe (drop 2 ws)::Maybe Int + rh = case (x2,y2,z2) of + (Just x3, Just y3, Just z3) -> Just (TF.Rhythm x3 y3 z3) + _ -> Nothing + n = readMaybe ks::Maybe Int in + case (ch,rh,n) of + (Just ch1,Just rh1,Just n1) -> Just . P1 ch1 rh1 $ f n1 + _ -> Just . P0 $ ys + | head xs == 't' || head xs == 'f' -> + let z = readMaybe qs::Maybe Int + ch = case z of + Just z1 -> Just (PolyCh rs z1) + _ -> Nothing + n = readMaybe ps::Maybe Int + m = readMaybe ms::Maybe Int in + case (ch,n,m) of + (Just ch1,Just n1,Just m1) -> Just . P2 ch1 (PolyRhythm vs) n1 $ f m1 + _ -> Just . P0 $ ys + | otherwise -> Just . P0 $ ys + | otherwise = Just . P0 $ ys + where (ts, us) = break (== '+') xs + (ws,zs) = break (== '=') . drop 1 $ us + ks = drop 1 zs + (ps,ns) = break (== '*') ks + ms = drop 1 ns + vs = map (fromMaybe 0 . (\t -> readMaybe t::Maybe Int) . (:[])) ws + (ls,qs) = break isDigit ts + rs = map (\t -> if t == 't' then True else False) ls + f k + | k `rem` 4 < 0 = 5 + (k `rem` 4) + | otherwise = 1 + (k `rem` 4) + diff --git a/Phladiprelio/Rhythmicity/Simple.hs b/Phladiprelio/Rhythmicity/Simple.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/Rhythmicity/Simple.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE BangPatterns, NoImplicitPrelude #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phladiprelio.Rhythmicity.Simple +-- Copyright : (c) Oleksandr Zhabenko 2020-2023 +-- License : MIT +-- Stability : Experimental +-- Maintainer : oleksandr.zhabenko@yahoo.com +-- +-- Allows to evaluate (approximately, so better to say, to estimate) the +-- rhythmicity properties for the text (usually, the poetic one). + +module Phladiprelio.Rhythmicity.Simple where + +import GHC.Base +import GHC.Int +import GHC.Num ((+),(-),(*),abs) +import GHC.Real +import GHC.Float +import GHC.List + +-- | Is well defined just for positive values in the list. +maxPosition2 :: (RealFrac a) => [a] -> a +maxPosition2 xs + | null xs = 0.0 + | otherwise = maxP21 xs 0 + where maxP21 (x:ks@(y:t:ys)) !acc1 + | (x - y) * (t - y) <= 0 = maxP21 ks (acc1::Int16) + | otherwise = maxP21 ks ((acc1 + 1)::Int16) + maxP21 _ !acc1 = fromIntegral acc1 + +posMaxIn3 + :: (Ord a) => a + -> a + -> a + -> Int16 +posMaxIn3 x y z + | x < y = if y < z then 3 else 2 + | x < z = 3 + | otherwise = 1 + +maxPosition3 :: RealFrac a => [a] -> a +maxPosition3 xs + | null xs = 0.0 + | otherwise = fromIntegral (go (h xs) ((0, 0, 0)::(Int16,Int16,Int16))) + where h (x:y:z:ys) = posMaxIn3 x y z:h ys + h _ = [] + go (x:zs) (!acc21,!acc22,!acc23) = go zs (h1 x (acc21,acc22,acc23)) + go _ (!acc21,!acc22,!acc23) + | acc21 > acc22 = if acc21 > acc23 then acc21 else acc23 + | acc22 > acc23 = acc22 + | otherwise = acc23 + h1 !x (!t,!u,!w) + | x == 1 = (t + (1::Int16), u, w) + | x == 2 = (t, u + (1::Int16), w) + | otherwise = (t,u,w + (1::Int16)) + +evalRhythmicity23 :: (RealFrac a, Floating a) => [a] -> a +evalRhythmicity23 xs = maxPosition2 xs + maxPosition3 xs + +evalRhythmicity23K + :: (RealFrac a, Floating a) => a + -> a + -> [a] + -> a +evalRhythmicity23K k2 k3 xs = k2 * maxPosition2 xs + k3 * maxPosition3 xs diff --git a/Phladiprelio/Rhythmicity/TwoFourth.hs b/Phladiprelio/Rhythmicity/TwoFourth.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/Rhythmicity/TwoFourth.hs @@ -0,0 +1,234 @@ +{-# LANGUAGE BangPatterns, NoImplicitPrelude #-} +{-# LANGUAGE MultiWayIf #-} +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Phladiprelio.Rhythmicity.TwoFourth +-- Copyright : (c) Oleksandr Zhabenko 2021-2023 +-- License : MIT +-- Stability : Experimental +-- Maintainer : oleksandr.zhabenko@yahoo.com +-- +-- The module is highly experimental approach to estimate further the rhythmicity of the not very long lists (well, +-- not longer than e. g. 30 elements). Is rather computationally expensive, so must be used with caution. If the period +-- of rhythm is less than 4 it is not effective. + +module Phladiprelio.Rhythmicity.TwoFourth where + +import GHC.Base +import GHC.Num (Num,(+),(-),(*),abs) +import GHC.Real +import GHC.List +import Text.Show +import Data.List (sort) + +{-| The data type that is used to mark the syllables accordingly to +their importance in general rhythm constituting. More important syllables +are marked with the less data constuctors (since the data type has an +instance of the 'Ord' type class). Can be used in case of three levels of +importance for rhythm constituting +with the last, third 'C' level of the syllables which position is thought as +not significant (though it actually, is not, but for simplicity). +-} +data Marker3s = A | B | C deriving (Eq,Ord,Show) + +{-| Data to specify some quantitative information of the structure of rhythmicity. +-} +data RhythmBasis = Rhythm { + eis :: Int, -- ^ the quantity of the most highlighted values + bis :: Int, -- ^ the quantity of some other highlighted values + cis :: Int -- ^ the quantity of the values which influence on the rhythmicity is not highlighted +} deriving (Eq,Show) + +{-| Data to specify (mostly) the qualitative information of the structure of rhythmicity. +-} +data Choices = Ch { + cheis :: Int, -- ^ the value 0 is for minimum values, all other ones -- for maximums. + chbis :: Int, -- ^ the value 0 is for minimum values among the values for 'Rhythm' 'bis' values, all other ones -- for maximum for the ones. + qty :: Int -- ^ general quantity of the elements to be taken as one period. Must be not less than the sum of 'cheis' and 'chbis'. Symbolically, it must be 'Rhythm' 'eis' + 'Rhythm' 'bis' + 'Rhythm' 'cis' = 'Ch' 'qty'. +} deriving (Show) + +instance Eq Choices where + (Ch n1 m1 l1) /= (Ch n2 m2 l2) + | n1 == 0 && n2 /= 0 = True + | n1 /= 0 && n2 == 0 = True + | m1 == 0 && m2 /= 0 = True + | m1 /= 0 && m2 == 0 = True + | l1 /= l2 = True + | otherwise = False + +{-| The predicate to check whether the two given arguments can be used together to get meaningful results. +-} +validChRhPair :: Choices -> RhythmBasis -> Bool +validChRhPair (Ch x y n) (Rhythm p q l) + | p <= 0 = False + | q < 0 = False + | l > 0 = n == p + q + l + | otherwise = False + +{-| The value for the 'Choices' with the two maximum highlighted values and two other ones in the 4-element period. +-} +twoFourthCh = Ch 1 1 4 + +{-| Converts the list into the form where its 'rhythmicity' can be estimated further. Uses integer division and, therefore, +can be not sensible for the last values in the given list. The length of the list must be not less than the first argument +'qty' value though it is not checked. Therefore, the function is not total. +-} +getChRhData + :: (Ord a) => Choices + -> RhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> [[Marker3s]] +getChRhData choice@(Ch n1 m1 l1) rhythm@(Rhythm p q l) xs + | validChRhPair choice rhythm = map (g choice rhythm) . f choice $ xs + | otherwise = error "Phladiprelio.Rhythmicity.TwoFourth.getChRhData: the first two arguments cannot be used together to get some meaningful result. " + where g ch@(Ch n m l) rh@(Rhythm x y z) us = let ws = sort us in case (x,y,n,m) of + (x1,y1,0,0) -> let !k1 = ws !! (x1 - 1) + !k2 = ws !! (x1 + y1 - 1) in + map (\t -> if + | t <= k1 -> A + | y1 == 0 -> C + | t <= k2 -> B + | otherwise -> C) us + (x1,y1,_,0) -> let !k1 = ws !! (length us - x1) + !k2 + | y1 < 2 = head ws + | otherwise = ws !! (y1 - 1) in + map (\t -> if + | t >= k1 -> A + | y1 == 0 -> C + | t <= k2 -> B + | otherwise -> C) us + (x1,y1,0,_) -> let !k1 = ws !! (x1 - 1) + !k2 + | y1 == 0 = last ws + | otherwise = ws !! (length us - y1) in + map (\t -> if + | t <= k1 -> A + | y1 == 0 -> C + | t >= k2 -> B + | otherwise -> C) us + (x1,y1,_,_) -> let !k1 = ws !! (length us - x1) + !k2 = ws !! (length us - x1 - y1) in + map (\t -> if + | t >= k1 -> A + | y1 == 0 -> C + | t >= k2 -> B + | otherwise -> C) us + f ch@(Ch _ _ l1) ys@(_:_) = + let !q = length ys `quot` l1 + rs = take (q * l1) ys in f' ch rs + f' ch@(Ch _ _ l1) qs@(_:_) = let (ts,zs) = splitAt l1 qs in ts : f' ch zs + f' _ [] = [] + +{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) +lists of 'Marker3s'. It emphasises the 'A' similarity and for most values have not so simply defined 'B'-behaviour. Uses 'similarityLogics' inside. +-} +similarityABC + :: Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [[Marker3s]] + -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. +similarityABC k1 k2 z (xs:ys:xss) = similarityABC k1 k2 (z * similarityLogics 1 k1 k2 xs ys) (ys:xss) +similarityABC _ _ z _ = z + +{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) +lists of 'Marker3s'. It emphasises the 'A' and 'B' similarities. Uses 'similarityLogics0' inside. +The more straightforward variant of the 'similarityABC' function. +-} +similarityABC0 + :: Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. + -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> [[Marker3s]] + -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. +similarityABC0 k1 k2 z (xs:ys:xss) = similarityABC0 k1 k2 (z * similarityLogics0 1 k1 k2 xs ys) (ys:xss) +similarityABC0 _ _ z _ = z + +{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) +lists of 'Marker3s'. It emphasises the 'A' similarity and for most values have not so simply defined 'B'-behaviour. +-} +similarityLogics + :: Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). + -> [Marker3s] + -> [Marker3s] + -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. +similarityLogics x0 k1 k2 (x:xs) (y:ys) = similarityLogics (similarityF1 x y k1 k2 x0) k1 k2 xs ys +similarityLogics x0 _ _ _ _ = x0 + +{-| The more straightforward variant of the 'similarityLogics' function. -} +similarityLogics0 + :: Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. + -> [Marker3s] + -> [Marker3s] + -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. +similarityLogics0 x0 k1 k2 (x:xs) (y:ys) = similarityLogics0 (similarityF0 x y k1 k2 x0) k1 k2 xs ys +similarityLogics0 x0 _ _ _ _ = x0 + +similarityF1 + :: Marker3s + -> Marker3s + -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). + -> Double -- ^ The initial value. + -> Double +similarityF1 m1 m2 k1 k2 x0 + | m1 == m2 = case m1 of + A -> x0 * k1 + B -> x0 + k2 + _ -> x0 + | m1 == A || m2 == A = x0 / k1 + | m1 == B || m2 == B = abs (x0 - k2) + | otherwise = x0 +{-# INLINE similarityF1 #-} + +{-| The more straightforward variant of the 'similarityF1' function. -} +similarityF0 + :: Marker3s + -> Marker3s + -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. + -> Double -- ^ The initial value. + -> Double +similarityF0 m1 m2 k1 k2 x0 + | m1 == m2 = case m1 of + A -> x0 * k1 + B -> x0 + k2 + _ -> x0 + | m1 == A || m2 == A = x0 / k1 + | otherwise = x0 +{-# INLINE similarityF0 #-} + +{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be +guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. +-} +rhythmicityABC + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). + -> Choices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> RhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. +rhythmicityABC x0 k1 k2 choices rhythm = similarityABC k1 k2 x0 . getChRhData choices rhythm +{-# INLINE rhythmicityABC #-} + +{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be +guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. +The more straightforward variant of the 'rhythmicityABC' function. +-} +rhythmicityABC0 + :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. + -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). + -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. + -> Choices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. + -> RhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. + -> [a] + -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. +rhythmicityABC0 x0 k1 k2 choices rhythm = similarityABC0 k1 k2 x0 . getChRhData choices rhythm +{-# INLINE rhythmicityABC0 #-} diff --git a/Rhythmicity/PolyRhythm.hs b/Rhythmicity/PolyRhythm.hs deleted file mode 100644 --- a/Rhythmicity/PolyRhythm.hs +++ /dev/null @@ -1,1069 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MultiWayIf #-} -{-# OPTIONS_HADDOCK show-extensions #-} - --- | --- Module : Rhythmicity.PolyRhythm --- Copyright : (c) OleksandrZhabenko 2021 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- The module is highly experimental approach to estimate further the rhythmicity (using some extent of the --- music concept of polyrhythm) of the not very long lists (well, not longer than e. g. 30 elements). --- Is rather computationally expensive, so must be used with caution. If the period --- of rhythm is less than 5 or even 6 it is not effective. - -module Rhythmicity.PolyRhythm where - -import Data.List (sort) -import Data.Maybe (fromJust,fromMaybe) -import Data.Char (toLower,isDigit) -import GHC.Float (int2Double) -import qualified Rhythmicity.TwoFourth as TF -import Text.Read (readMaybe) -import qualified Data.Either as Either (Either(..)) - -{-| The data type that is used to mark the syllables accordingly to -their importance in general rhythm constituting. More important syllables -are marked with the less data constuctors (since the data type has an -instance of the 'Ord' type class). Contrary to 'PolyMarkers' and 'TF.Marker3s', -can be used in case of three levels of importance for rhythm constituting -with the last, fourth 'G' level of the syllables which position is thought as -not significant (though it actually, is not, but for simplicity). --} -data Marker4s = D | E | F | G deriving (Eq,Ord,Show) - -{-| The data type that is used to mark the syllables accordingly to -their importance in general rhythm constituting. More important syllables -are marked with the less data constuctors (since the data type has an -instance of the 'Ord' type class). A generalization of the -'Marker4s' and 'TF.Marker3s' for the cases of multiple (may be 4, or 3, or more) -levels of importance in general rhythm constituting. --} -newtype PolyMarkers = PolyMs Char deriving (Eq,Ord) - -instance Show PolyMarkers where - show (PolyMs c) = 'P':' ':[toLower c] - -{-| A data type is used to allow usage of the 'Marker4s' and 'PolyMarkers' data types in the -functions as just one single (unified) data type. --} -data PolyMrks = R4 Marker4s | RP PolyMarkers deriving (Eq,Ord,Show) - -is4s :: PolyMrks -> Bool -is4s (R4 _) = True -is4s _ = False - -isPoly :: PolyMrks -> Bool -isPoly (RP _) = True -isPoly _ = False - -{-| Data to specify some quantitative information of the structure of rhythmicity. --} -data PolyRhythmBasis = PolyRhythm [Int] deriving (Eq,Show) - -vals :: PolyRhythmBasis -> [Int] -vals (PolyRhythm xs) = xs - -{-| Data to specify (mostly) the qualitative information of the structure of rhythmicity. --} -data PolyChoices = PolyCh { - xn :: [Bool], -- ^ the 'True' corresponds to maximums, 'False' -- to minimums - pqty :: Int -- ^ general quantity of the elements to be taken as one period. Must be not less than the sum of 'cheis' and 'chbis'. Symbolically, it must be 'sum' . 'vals' . 'PolyRhythm' $ ['Int'] = 'PolyCh' 'pqty'. -} deriving Eq - -{-| The predicate to check whether the two given arguments can be used together to get meaningful results. -The 'pqty' of the first argument must be equal to the 'sum' of the 'PolyRhythmBasis' 'Int' values -inside the list. There are also other logical constraints that the function takes into account. --} -validPolyChRhPair :: PolyChoices -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> Bool -validPolyChRhPair (PolyCh xs n) (PolyRhythm ys) - | ks <= [0] = False - | any (<0) rs = False - | length xs < n && drop l ys > [0] && l == length xs = n == sum ys - | otherwise = False - where (ks,rs) = splitAt 1 ys - l = length ys - 1 - -{-| Auxiliary data type that is used internally in the 'getPolyChRhData' function in the module. --} -data Intermediate a = J a | I PolyMarkers deriving (Eq, Ord) - -isJI :: Intermediate a -> Bool -isJI (J _) = True -isJI _ = False - -fromIntermediate :: Intermediate a -> Maybe PolyMrks -fromIntermediate (I k) = Just (RP k) -fromIntermediate _ = Nothing - -getPolyChRhData - :: (Ord a) => Char -- ^ The start of the 'RP' 'PolyMarkers' count in case of 'PolyMrks' with 'Char's. The usual one can be \'a\' or \'h\'. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> [[PolyMrks]] -getPolyChRhData c r choice@(PolyCh ts l1) rhythm@(PolyRhythm ys) xs - | r <= 4 && validPolyChRhPair choice rhythm = map (g4 choice rhythm) . f choice $ xs - | r > 4 && validPolyChRhPair choice rhythm = - map (\ks -> map (fromJust . fromIntermediate) . gPoly [c..] choice rhythm ks . map J $ ks) . f choice $ xs - | otherwise = error "Rhythmicity.PolyRhythm.getPolyChRhData: the first two arguments cannot be used together to get some meaningful result. " - where g4 (PolyCh js l) (PolyRhythm ys) us = let ws = sort us in case (ys,js) of - (x1:x2:x3:zs,[False,False,False]) -> let !k1 = ws !! (x1 - 1) - !k2 = ws !! (x1 + x2 - 1) - !k3 = ws !! (x1 + x2 + x3 - 1) in - map (\t -> if - | t <= k1 -> R4 D - | x2 == 0 -> R4 G - | t <= k2 -> R4 E - | x3 == 0 -> R4 G - | t <= k3 -> R4 F - | otherwise -> R4 G) us - (x1:x2:x3:zs,[True,False,False]) -> let !k1 = ws !! (length ws - x1) - !k2 - | x2 < 2 = head ws - | otherwise = ws !! (x2 - 1) - !k3 - | x2 == 0 = head ws - | otherwise = ws !! (x2 + x3 - 1) in - map (\t -> if - | t >= k1 -> R4 D - | x2 == 0 -> R4 G - | t <= k2 -> R4 E - | x3 == 0 -> R4 G - | t <= k3 -> R4 F - | otherwise -> R4 G) us - (x1:x2:x3:zs,[False,True,False]) -> let !k1 = ws !! (x1 - 1) - !k2 - | x2 == 0 = last ws - | otherwise = ws !! (length ws - x2) - !k3 = ws !! (x1 + x3 - 1) in - map (\t -> if - | t <= k1 -> R4 D - | x2 == 0 -> R4 G - | t >= k2 -> R4 E - | x3 == 0 -> R4 G - | t <= k3 -> R4 F - | otherwise -> R4 G) us - (x1:x2:x3:zs,[False,False,True]) -> let !k1 = ws !! (x1 - 1) - !k2 = ws !! (x1 + x2 - 1) - !k3 - | x3 == 0 = last ws - | otherwise = ws !! (length ws - x3) in - map (\t -> if - | t <= k1 -> R4 D - | x2 == 0 -> R4 G - | t <= k2 -> R4 E - | x3 == 0 -> R4 G - | t >= k3 -> R4 F - | otherwise -> R4 G) us - (x1:x2:x3:zs,[True,True,False]) -> let !k1 = ws !! (length ws - x1) - !k2 = ws !! (length ws - x1 - x2 - 1) - !k3 - | x3 == 0 = head ws - | otherwise = ws !! (x3 - 1) in - map (\t -> if - | t >= k1 -> R4 D - | x2 == 0 -> R4 G - | t >= k2 -> R4 E - | x3 == 0 -> R4 G - | t <= k3 -> R4 F - | otherwise -> R4 G) us - (x1:x2:x3:zs,[True,False,True]) -> let !k1 = ws !! (length ws - x1) - !k2 - | x2 == 0 = head ws - | otherwise = ws !! (x2 - 1) - !k3 = ws !! (length ws - x1 - x3) in - map (\t -> if - | t >= k1 -> R4 D - | x2 == 0 -> R4 G - | t <= k2 -> R4 E - | x3 == 0 -> R4 G - | t >= k3 -> R4 F - | otherwise -> R4 G) us - (x1:x2:x3:zs,[False,True,True]) -> let !k1 = ws !! (x1 - 1) - !k2 - | x2 == 0 = last ws - | otherwise = ws !! (length ws - x2) - !k3 - | x2 == 0 = last ws - | otherwise = ws !! (length ws - x2 - x3) in - map (\t -> if - | t <= k1 -> R4 D - | x2 == 0 -> R4 G - | t >= k2 -> R4 E - | x3 == 0 -> R4 G - | t >= k3 -> R4 F - | otherwise -> R4 G) us - (x1:x2:x3:zs,[_,_,_]) -> let !k1 = ws !! (length ws - x1) - !k2 = ws !! (length ws - x1 - x2) - !k3 = ws !! (length ws - x1 - x2 - x3) in - map (\t -> if - | t >= k1 -> R4 D - | x2 == 0 -> R4 G - | t >= k2 -> R4 E - | x3 == 0 -> R4 G - | t >= k3 -> R4 F - | otherwise -> R4 G) us - gPoly wws (PolyCh (j:js) l) (PolyRhythm (y:ys)) vs us - | null vs = map (\r -> if | isJI r -> (\q@(J rr) -> I (PolyMs (head wws))) r - | otherwise -> r) us - | y == 0 = map (\r -> if | isJI r -> (\q@(J rr) -> I (PolyMs (head wws))) r - | otherwise -> r) us - | otherwise = let ws = sort vs in case j of - False -> let !k = ws !! (y - 1) in - gPoly (drop 1 wws) (PolyCh js l) (PolyRhythm ys) (filter (> k) vs) - (map (\r -> if - | isJI r -> (\q@(J rr) -> if - | rr <= k -> I (PolyMs (head wws)) - | otherwise -> q) r - | otherwise -> r) us) - _ -> let !k = ws !! (length ws - y) in - gPoly (drop 1 wws) (PolyCh js l) (PolyRhythm ys) (filter (< k) vs) - (map (\r -> if - | isJI r -> (\q@(J rr) -> if - | rr >= k -> I (PolyMs (head wws)) - | otherwise -> q) r - | otherwise -> r) us) - gPoly wws (PolyCh [] l) _ vs us = map (\r -> if isJI r then I (PolyMs (head wws)) else r) us - f ch@(PolyCh _ l1) ys@(_:_) = - let !q = length ys `quot` l1 - rs = take (q * l1) ys in f' ch rs - f' ch@(PolyCh _ l1) qs@(_:_) = let (ts,zs) = splitAt l1 qs in ts : f' ch zs - f' _ [] = [] - -increasingF - :: Int - -> Double - -> Double -increasingF n x - | n <= 0 || x < 0 = error $ "Rhythmicity.PolyRhythm.increasingF: not defined for the arguments. " ++ show n ++ " " ++ show x - | x == 0.0 = 0.001 - | n == 1 = x + min (x * 0.25) 0.125 - | x < 1 = x ** (1.0 / int2Double n) - | x <= 1.1 = x + 1.0 / int2Double n - | otherwise = x ^ n -{-# INLINE increasingF #-} - -increasingF1 - :: Int - -> Double - -> Double -increasingF1 n x - | n <= 0 = error $ "Rhythmicity.PolyRhythm.increasingF1: not defined for the argument. " ++ show n - | otherwise = x + int2Double n -{-# INLINE increasingF1 #-} - -increasingFG - :: Int - -> Double - -> (Int -> Double -> Double -> Double) - -> Double - -> Double -increasingFG n k f x - | n <= 0 = error $ "Rhythmicity.PolyRhythm.increasingFG: not defined for the argument. " ++ show n - | otherwise = x + abs (f n k x) -{-# INLINE increasingFG #-} - -decreasingF1 - :: Int - -> Double - -> Double -decreasingF1 n x - | n <= 0 = error $ "Rhythmicity.PolyRhythm.decreasingF1: not defined for the argument. " ++ show n - | otherwise = x - int2Double n -{-# INLINE decreasingF1 #-} - -decreasingFG - :: Int - -> Double - -> (Int -> Double -> Double -> Double) - -> Double - -> Double -decreasingFG n k f x - | n <= 0 = error $ "Rhythmicity.PolyRhythm.decreasingFG: not defined for the argument. " ++ show n - | otherwise = x - abs (f n k x) -{-# INLINE decreasingFG #-} - -decreasingFG2 - :: Int - -> Double - -> (Double -> Double -> Double) - -> Double - -> Double -decreasingFG2 n k f x - | n <= 0 = error $ "Rhythmicity.PolyRhythm.decreasingFG2: not defined for the argument. " ++ show n - | otherwise = x - int2Double n * abs (f k x) -{-# INLINE decreasingFG2 #-} - -increasingFG2 - :: Int - -> Double - -> (Double -> Double -> Double) - -> Double - -> Double -increasingFG2 n k f x - | n <= 0 = error $ "Rhythmicity.PolyRhythm.increasingFG2: not defined for the argument. " ++ show n - | otherwise = x + int2Double n * abs (f k x) -{-# INLINE increasingFG2 #-} - -decreasingF - :: Int - -> Double - -> Double -decreasingF n x - | n <= 0 || x < 0 = error $ "Rhythmicity.PolyRhythm.decreasingF: not defined for the arguments. " ++ show n ++ " " ++ show x - | x == 0.0 = 0.000000000001 - | n == 1 = x - min (x * 0.25) 0.125 - | x < 1 = x ** int2Double n - | x <= 1.1 = 1.0 / (x + 1.0 / int2Double n) - | otherwise = x ** (1.0 / int2Double n) -{-# INLINE decreasingF #-} - -similarityF1 - :: Char -- ^ The start of the counting. - -> PolyMrks - -> PolyMrks - -> Double -- ^ The initial value. - -> Double -similarityF1 = similarityFG12 1.0 (\_ _ -> 1.0) -{-# INLINE similarityF1 #-} - -{-| The more straightforward variant of the 'similarityF1' function. -} -similarityF0 - :: Char -- ^ The start of the counting. - -> PolyMrks - -> PolyMrks - -> Double -- ^ The initial value. - -> Double -similarityF0 = similarityFG02 1.0 (\_ _ -> 1.0) -{-# INLINE similarityF0 #-} - -similarityFGE1 - :: Double - -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char - -> PolyMrks - -> PolyMrks - -> Double - -> Double -similarityFGE1 k f c m1 m2 x - | is4s m1 = let !h = case (\(R4 t0) -> t0) m1 of { D -> 4 ; E -> 3 ; F -> 2 ; ~rrr -> 1 } in case m1 == m2 of - True -> case f of - Either.Left f2 -> increasingFG2 h k f2 x - Either.Right f3 -> increasingFG h k f3 x - _ -> case f of - Either.Left f2 -> decreasingFG2 h k f2 x - Either.Right f3 -> decreasingFG h k f3 x - | otherwise = let l = length [c..(\(RP (PolyMs t0)) -> t0) (min m1 m2)] in - if - | m1 == m2 -> case f of - Either.Left f2 -> increasingFG2 l k f2 x - Either.Right f3 -> increasingFG l k f3 x - | otherwise -> case f of - Either.Left f2 -> decreasingFG2 l k f2 x - Either.Right f3 -> decreasingFG l k f3 x -{-# INLINE similarityFGE1 #-} - -similarityFG1 - :: Double - -> (Int -> Double -> Double -> Double) - -> Char - -> PolyMrks - -> PolyMrks - -> Double - -> Double -similarityFG1 k f = similarityFGE1 k (Right f) -{-# INLINE similarityFG1 #-} - -similarityFG12 - :: Double - -> (Double -> Double -> Double) - -> Char - -> PolyMrks - -> PolyMrks - -> Double - -> Double -similarityFG12 k f = similarityFGE1 k (Left f) -{-# INLINE similarityFG12 #-} - -similarityFGE0 - :: Double - -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char - -> PolyMrks - -> PolyMrks - -> Double - -> Double -similarityFGE0 k f c m1 m2 x - | is4s m1 = let h = case (\(R4 t0) -> t0) m1 of { D -> 4 ; E -> 3 ; F -> 2 ; ~rrr -> 1 } in case m1 == m2 of - True -> case f of - Either.Left f2 -> increasingFG2 h k f2 x - Either.Right f3 -> increasingFG h k f3 x - _ -> x - | otherwise = let l = length [c..(\(RP (PolyMs t0)) -> t0) (min m1 m2)] in - if - | m1 == m2 -> case f of - Either.Left f2 -> increasingFG2 l k f2 x - Either.Right f3 -> increasingFG l k f3 x - | otherwise -> x -{-# INLINE similarityFGE0 #-} - -similarityFG0 - :: Double - -> (Int -> Double -> Double -> Double) - -> Char - -> PolyMrks - -> PolyMrks - -> Double - -> Double -similarityFG0 k f = similarityFGE0 k (Right f) -{-# INLINE similarityFG0 #-} - -similarityFG02 - :: Double - -> (Double -> Double -> Double) - -> Char - -> PolyMrks - -> PolyMrks - -> Double - -> Double -similarityFG02 k f = similarityFGE0 k (Left f) -{-# INLINE similarityFG02 #-} - -{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) -lists of 'PolyMrks'. Uses both increasing and decreasing functions. --} -similarityLogics - :: Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. -similarityLogics c x0 (x:xs) (y:ys) = similarityLogics c (similarityF1 c x y x0) xs ys -similarityLogics c x0 _ _ = x0 - -{-| The more straightforward variant of the 'similarityLogics' function. -} -similarityLogics0 - :: Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. -similarityLogics0 c x0 (x:xs) (y:ys) = similarityLogics0 c (similarityF0 c x y x0) xs ys -similarityLogics0 c x0 _ _ = x0 - -{-| --} -similarityLogicsGE - :: Double - -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -similarityLogicsGE k f c x0 (x:xs) (y:ys) = similarityLogicsGE k f c (similarityFGE1 k f c x y x0) xs ys -similarityLogicsGE k f c x0 _ _ = x0 - -{-| --} -similarityLogicsG1 - :: Double - -> (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -similarityLogicsG1 k f = similarityLogicsGE k (Either.Right f) -{-# INLINE similarityLogicsG1 #-} - -{-| --} -similarityLogicsG12 - :: Double - -> (Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -similarityLogicsG12 k f = similarityLogicsGE k (Either.Left f) -{-# INLINE similarityLogicsG12 #-} - - -{-| The more straightforward variant of the 'similarityLogicsGE' function. -} -similarityLogicsGE0 - :: Double - -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -similarityLogicsGE0 k f c x0 (x:xs) (y:ys) = similarityLogicsGE0 k f c (similarityFGE0 k f c x y x0) xs ys -similarityLogicsGE0 k f c x0 _ _ = x0 - -{-| --} -similarityLogicsG0 - :: Double - -> (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -similarityLogicsG0 k f = similarityLogicsGE0 k (Either.Right f) -{-# INLINE similarityLogicsG0 #-} - -{-| --} -similarityLogicsG02 - :: Double - -> (Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ An initial value. - -> [PolyMrks] - -> [PolyMrks] - -> Double -similarityLogicsG02 k f = similarityLogicsGE0 k (Either.Left f) -{-# INLINE similarityLogicsG02 #-} - -{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) -lists of 'PolyMrks'. Uses 'similarityLogics' inside. --} -similarityPoly - :: Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [[PolyMrks]] - -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. -similarityPoly c z ts - | null ts = z - | otherwise = similarityPoly2 (head ts) c z ts -{-# INLINE similarityPoly #-} - -{-| --} -similarityPoly2 - :: [PolyMrks] - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [[PolyMrks]] - -> Double -similarityPoly2 ks c z (xs:ys:xss) = similarityPoly2 ks c (z * similarityLogics c z xs ys) (ys:xss) -similarityPoly2 ks c z [ys] = z * similarityLogics c z ys ks -similarityPoly2 _ _ z _ = z - -{-| --} -similarityPolyGEE - :: (Int,[PolyMrks]) - -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyGEE r f c z ((i,xs):(j,ys):xss) = - similarityPolyGEE r f c (z * similarityLogicsGE (int2Double i) f c z xs ys) ((j,ys):xss) -similarityPolyGEE (_,ts) f c z [(j,ys)] = z * similarityLogicsGE (int2Double j) f c z ys ts -similarityPolyGEE _ _ _ z _ = z - -similarityPolyGE - :: Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyGE f c z ts - | null ts = z - | otherwise = similarityPolyGEE (head ts) f c z ts -{-# INLINE similarityPolyGE #-} - -{-| --} -similarityPolyG1 - :: (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyG1 f = similarityPolyGE (Either.Right f) -{-# INLINE similarityPolyG1 #-} - -{-| --} -similarityPolyG12 - :: (Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyG12 f = similarityPolyGE (Either.Left f) -{-# INLINE similarityPolyG12 #-} - -{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) -lists of 'PolyMrks'. Uses 'similarityLogics0' inside. -The more straightforward variant of the 'similarityPoly' function. --} -similarityPoly0 - :: Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [[PolyMrks]] - -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. -similarityPoly0 c z ts - | null ts = z - | otherwise = similarityPoly20 (head ts) c z ts -{-# INLINE similarityPoly0 #-} - -{-| --} -similarityPoly20 - :: [PolyMrks] - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [[PolyMrks]] - -> Double -similarityPoly20 ks c z (xs:ys:xss) = similarityPoly20 ks c (z * similarityLogics c z xs ys) (ys:xss) -similarityPoly20 ks c z [ys] = z * similarityLogics c z ys ks -similarityPoly20 _ _ z _ = z - -{-| --} -similarityPolyGEE0 - :: (Int,[PolyMrks]) - -> Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyGEE0 r f c z ((i,xs):(j,ys):xss) = - similarityPolyGEE0 r f c (z * similarityLogicsGE0 (int2Double i) f c z xs ys) ((j,ys):xss) -similarityPolyGEE0 (_,ts) f c z [(j,ys)] = z * similarityLogicsGE0 (int2Double j) f c z ys ts -similarityPolyGEE0 _ _ _ z _ = z - -similarityPolyGE0 - :: Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyGE0 f c z ts - | null ts = z - | otherwise = similarityPolyGEE0 (head ts) f c z ts -{-# INLINE similarityPolyGE0 #-} - -{-| --} -similarityPolyG0 - :: (Int -> Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyG0 f = similarityPolyGE0 (Either.Right f) -{-# INLINE similarityPolyG0 #-} - -{-| --} -similarityPolyG02 - :: (Double -> Double -> Double) - -> Char -- ^ The start of the counting. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [(Int,[PolyMrks])] - -> Double -similarityPolyG02 f = similarityPolyGE0 (Either.Left f) -{-# INLINE similarityPolyG02 #-} - -{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be -guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. --} -rhythmicityPoly - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. -rhythmicityPoly x0 r choices rhythm = similarityPoly 'a' x0 . getPolyChRhData 'a' r choices rhythm -{-# INLINE rhythmicityPoly #-} - -{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be -guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. --} -rhythmicityPolyGE - :: (Ord a) => Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyGE f x0 r choices rhythm = similarityPolyGE f 'a' x0 . zip [0..] . getPolyChRhData 'a' r choices rhythm -{-# INLINE rhythmicityPolyGE #-} - -rhythmicityPolyG1 - :: (Ord a) => (Int -> Double -> Double -> Double) - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyG1 f = rhythmicityPolyGE (Either.Right f) -{-# INLINE rhythmicityPolyG1 #-} - -rhythmicityPolyG12 - :: (Ord a) => (Double -> Double -> Double) - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyG12 f = rhythmicityPolyGE (Either.Left f) -{-# INLINE rhythmicityPolyG12 #-} - -{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be -guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. --} -rhythmicityPolyGE0 - :: (Ord a) => Either.Either (Double -> Double -> Double) (Int -> Double -> Double -> Double) - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyGE0 f x0 r choices rhythm = similarityPolyGE0 f 'a' x0 . zip [0..] . getPolyChRhData 'a' r choices rhythm -{-# INLINE rhythmicityPolyGE0 #-} - -rhythmicityPolyG01 - :: (Ord a) => (Int -> Double -> Double -> Double) - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyG01 f = rhythmicityPolyGE0 (Either.Right f) -{-# INLINE rhythmicityPolyG01 #-} - -rhythmicityPolyG02 - :: (Ord a) => (Double -> Double -> Double) - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyG02 f = rhythmicityPolyGE0 (Either.Left f) -{-# INLINE rhythmicityPolyG02 #-} - -{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be -guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. -The more straightforward variant of the 'rhythmicityPoly' function. --} -rhythmicityPoly0 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -- ^ The greater one corresponds to (probably) more rhythmic list. -rhythmicityPoly0 x0 r choices rhythm = similarityPoly0 'a' x0 . getPolyChRhData 'a' r choices rhythm -{-# INLINE rhythmicityPoly0 #-} - -------------------------------------------------------------------- - -{-| This function tries to increase the importance of the beginning of the line and decreases the importance -of the ending of the line. It is not a linear one. --} -simpleF2 :: Double -> Double -> Double -simpleF2 k x = x / (k + 1.0)^2 - -simpleF3 :: Int -> Double -> Double -> Double -simpleF3 n k x - | n <= 2 = x / (k + 1.0)^2 - | otherwise = max x (x ^ n / (k + 1.0)^2) - -{-| This function tries to increase the importance of the ending of the line and decreases the importance -of the beginning of the line. It is not a linear one. --} -simpleEndF2 :: Double -> Double -> Double -simpleEndF2 k x = x * (k + 1.0)^2 - -simpleEndF3 :: Int -> Double -> Double -> Double -simpleEndF3 n k x - | n <= 2 = x * (k + 1.0)^2 - | otherwise = max x (x ^ n * (k + 1.0)^2) - -------------------------------------------------------------------- - -rhythmicityPolyWeightedF2 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedF2 = rhythmicityPolyG12 (simpleF2) -{-# INLINE rhythmicityPolyWeightedF2 #-} - -rhythmicityPolyWeightedF3 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedF3 = rhythmicityPolyG1 (simpleF3) -{-# INLINE rhythmicityPolyWeightedF3 #-} - -rhythmicityPolyWeightedF20 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedF20 = rhythmicityPolyG02 (simpleF2) -{-# INLINE rhythmicityPolyWeightedF20 #-} - -rhythmicityPolyWeightedF30 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedF30 = rhythmicityPolyG01 (simpleF3) -{-# INLINE rhythmicityPolyWeightedF30 #-} - -rhythmicityPolyWeightedEF2 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedEF2 = rhythmicityPolyG12 (simpleEndF2) -{-# INLINE rhythmicityPolyWeightedEF2 #-} - -rhythmicityPolyWeightedEF3 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedEF3 = rhythmicityPolyG1 (simpleEndF3) -{-# INLINE rhythmicityPolyWeightedEF3 #-} - -rhythmicityPolyWeightedEF20 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedEF20 = rhythmicityPolyG02 (simpleEndF2) -{-# INLINE rhythmicityPolyWeightedEF20 #-} - -rhythmicityPolyWeightedEF30 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedEF30 = rhythmicityPolyG01 (simpleEndF3) -{-# INLINE rhythmicityPolyWeightedEF30 #-} - -------------------------------------------------------------------- - -{-| This function tries to increase the importance of the beginning of the line and decreases the importance -of the ending of the line. It is linear. --} -linearF2 :: Double -> Double -> Double -linearF2 k x = x / (6.0 * (k + 1.0)) - -linearF3 :: Int -> Double -> Double -> Double -linearF3 n k x = int2Double n * x / (6.0 * (k + 1.0)) - -{-| This function tries to increase the importance of the ending of the line and decreases the importance -of the beginning of the line. It is linear. --} -linearEndF2 :: Double -> Double -> Double -linearEndF2 k x = x * (6.0 * (k + 1.0)) - -linearEndF3 :: Int -> Double -> Double -> Double -linearEndF3 n k x = int2Double n * x * (6.0 * (k + 1.0)) - -------------------------------------------------------------------- - -rhythmicityPolyWeightedLF2 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLF2 = rhythmicityPolyG12 (linearF2) -{-# INLINE rhythmicityPolyWeightedLF2 #-} - -rhythmicityPolyWeightedLF3 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLF3 = rhythmicityPolyG1 (linearF3) -{-# INLINE rhythmicityPolyWeightedLF3 #-} - -rhythmicityPolyWeightedLF20 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLF20 = rhythmicityPolyG02 (linearF2) -{-# INLINE rhythmicityPolyWeightedLF20 #-} - -rhythmicityPolyWeightedLF30 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLF30 = rhythmicityPolyG01 (linearF3) -{-# INLINE rhythmicityPolyWeightedLF30 #-} - -rhythmicityPolyWeightedLEF2 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLEF2 = rhythmicityPolyG12 (linearEndF2) -{-# INLINE rhythmicityPolyWeightedLEF2 #-} - -rhythmicityPolyWeightedLEF3 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLEF3 = rhythmicityPolyG1 (linearEndF3) -{-# INLINE rhythmicityPolyWeightedLEF3 #-} - -rhythmicityPolyWeightedLEF20 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLEF20 = rhythmicityPolyG02 (linearEndF2) -{-# INLINE rhythmicityPolyWeightedLEF20 #-} - -rhythmicityPolyWeightedLEF30 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Int -- ^ If the argument is less or equal to 4, then 'Marker4s' is used, if it is greater than 4, then 'PolyMarkers' is used. - -> PolyChoices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> PolyRhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -rhythmicityPolyWeightedLEF30 = rhythmicityPolyG01 (linearEndF3) -{-# INLINE rhythmicityPolyWeightedLEF30 #-} - -------------------------------------------------------------------- - -{-| Data type that is used to implement some parameter language to encode in the 'String' argument information -that is sufficient to transform the 'String' into 'Double' using the needed additional information provided by -some other means. - --} -data ParseChRh = - P0 String - | P1 - TF.Choices - TF.RhythmBasis - Int -- ^ The number of the one of the functions to convert the phonetic languages elements into 'Double' values (usually, durations). - | P2 - PolyChoices - PolyRhythmBasis - Int -- ^ The value for the 'Int' parameter in the 'getPolyChRhData' function that uses two previous arguments. - Int -- ^ The number of the one of the functions to convert the phonetic languages elements into 'Double' values (usually, durations). - deriving Eq - -isChRhString :: ParseChRh -> Bool -isChRhString (P0 _) = True -isChRhString _ = False - -isChRh3 :: ParseChRh -> Bool -isChRh3 (P1 _ _ _) = True -isChRh3 _ = False - -isChRhPoly :: ParseChRh -> Bool -isChRhPoly (P2 _ _ _ _) = True -isChRhPoly _ = False - -{-| A parser function to get the 'ParseChRh' data. In case of success returns 'Just' 'ParseChRh' value. -Nevertheless, the further checks (e. g. 'validPolyChRhPair' or 'validChRhPair') is not applied by it, so -they must be applied further during the usage. Examples of the usage: -\"c114+112=2\" returns 'Just' @P1 (Ch 1 1 4) (Rhythm 1 1 2) 2@ -\"Mtttff7+112111=7*3\" returns 'Just' @P2 (PolyCh [True,True,True,False,False] 7) (PolyRhythm [1,1,2,1,1,1]) 7 3@. --} -readRhythmicity :: String -> Maybe ParseChRh -readRhythmicity ys@(x:xs) - | ((x `elem` "cMN") || (x >= 'A' && x <= 'F')) && not (null xs) = if - | isDigit . head $ xs -> let x = readMaybe (take 1 ts)::Maybe Int - y = readMaybe (drop 1 . take 2 $ ts)::Maybe Int - z = readMaybe (drop 2 ts)::Maybe Int - ch = case (x,y,z) of - (Just x1, Just y1, Just z1) -> Just (TF.Ch x1 y1 z1) - _ -> Nothing - x2 = readMaybe (take 1 ws)::Maybe Int - y2 = readMaybe (drop 1 . take 2 $ ws)::Maybe Int - z2 = readMaybe (drop 2 ws)::Maybe Int - rh = case (x2,y2,z2) of - (Just x3, Just y3, Just z3) -> Just (TF.Rhythm x3 y3 z3) - _ -> Nothing - n = readMaybe ks::Maybe Int in - case (ch,rh,n) of - (Just ch1,Just rh1,Just n1) -> Just . P1 ch1 rh1 $ f n1 - _ -> Just . P0 $ ys - | head xs == 't' || head xs == 'f' -> - let z = readMaybe qs::Maybe Int - ch = case z of - Just z1 -> Just (PolyCh rs z1) - _ -> Nothing - n = readMaybe ps::Maybe Int - m = readMaybe ms::Maybe Int in - case (ch,n,m) of - (Just ch1,Just n1,Just m1) -> Just . P2 ch1 (PolyRhythm vs) n1 $ f m1 - _ -> Just . P0 $ ys - | otherwise -> Just . P0 $ ys - | otherwise = Just . P0 $ ys - where (ts, us) = break (== '+') xs - (ws,zs) = break (== '=') . drop 1 $ us - ks = drop 1 zs - (ps,ns) = break (== '*') ks - ms = drop 1 ns - vs = map (fromMaybe 0 . (\t -> readMaybe t::Maybe Int) . (:[])) ws - (ls,qs) = break isDigit ts - rs = map (\t -> if t == 't' then True else False) ls - f k - | k `rem` 4 < 0 = 5 + (k `rem` 4) - | otherwise = 1 + (k `rem` 4) - diff --git a/Rhythmicity/TwoFourth.hs b/Rhythmicity/TwoFourth.hs deleted file mode 100644 --- a/Rhythmicity/TwoFourth.hs +++ /dev/null @@ -1,229 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MultiWayIf #-} -{-# OPTIONS_HADDOCK show-extensions #-} - --- | --- Module : Rhythmicity.TwoFourth --- Copyright : (c) OleksandrZhabenko 2021 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- The module is highly experimental approach to estimate further the rhythmicity of the not very long lists (well, --- not longer than e. g. 30 elements). Is rather computationally expensive, so must be used with caution. If the period --- of rhythm is less than 4 it is not effective. - -module Rhythmicity.TwoFourth where - -import Data.List (sort) - -{-| The data type that is used to mark the syllables accordingly to -their importance in general rhythm constituting. More important syllables -are marked with the less data constuctors (since the data type has an -instance of the 'Ord' type class). Can be used in case of three levels of -importance for rhythm constituting -with the last, third 'C' level of the syllables which position is thought as -not significant (though it actually, is not, but for simplicity). --} -data Marker3s = A | B | C deriving (Eq,Ord,Show) - -{-| Data to specify some quantitative information of the structure of rhythmicity. --} -data RhythmBasis = Rhythm { - eis :: Int, -- ^ the quantity of the most highlighted values - bis :: Int, -- ^ the quantity of some other highlighted values - cis :: Int -- ^ the quantity of the values which influence on the rhythmicity is not highlighted -} deriving (Eq,Show) - -{-| Data to specify (mostly) the qualitative information of the structure of rhythmicity. --} -data Choices = Ch { - cheis :: Int, -- ^ the value 0 is for minimum values, all other ones -- for maximums. - chbis :: Int, -- ^ the value 0 is for minimum values among the values for 'Rhythm' 'bis' values, all other ones -- for maximum for the ones. - qty :: Int -- ^ general quantity of the elements to be taken as one period. Must be not less than the sum of 'cheis' and 'chbis'. Symbolically, it must be 'Rhythm' 'eis' + 'Rhythm' 'bis' + 'Rhythm' 'cis' = 'Ch' 'qty'. -} deriving (Show) - -instance Eq Choices where - (Ch n1 m1 l1) /= (Ch n2 m2 l2) - | n1 == 0 && n2 /= 0 = True - | n1 /= 0 && n2 == 0 = True - | m1 == 0 && m2 /= 0 = True - | m1 /= 0 && m2 == 0 = True - | l1 /= l2 = True - | otherwise = False - -{-| The predicate to check whether the two given arguments can be used together to get meaningful results. --} -validChRhPair :: Choices -> RhythmBasis -> Bool -validChRhPair (Ch x y n) (Rhythm p q l) - | p <= 0 = False - | q < 0 = False - | l > 0 = n == p + q + l - | otherwise = False - -{-| The value for the 'Choices' with the two maximum highlighted values and two other ones in the 4-element period. --} -twoFourthCh = Ch 1 1 4 - -{-| Converts the list into the form where its 'rhythmicity' can be estimated further. Uses integer division and, therefore, -can be not sensible for the last values in the given list. The length of the list must be not less than the first argument -'qty' value though it is not checked. Therefore, the function is not total. --} -getChRhData - :: (Ord a) => Choices - -> RhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> [[Marker3s]] -getChRhData choice@(Ch n1 m1 l1) rhythm@(Rhythm p q l) xs - | validChRhPair choice rhythm = map (g choice rhythm) . f choice $ xs - | otherwise = error "Rhythmicity.TwoFourth.getChRhData: the first two arguments cannot be used together to get some meaningful result. " - where g ch@(Ch n m l) rh@(Rhythm x y z) us = let ws = sort us in case (x,y,n,m) of - (x1,y1,0,0) -> let !k1 = ws !! (x1 - 1) - !k2 = ws !! (x1 + y1 - 1) in - map (\t -> if - | t <= k1 -> A - | y1 == 0 -> C - | t <= k2 -> B - | otherwise -> C) us - (x1,y1,_,0) -> let !k1 = ws !! (length us - x1) - !k2 - | y1 < 2 = head ws - | otherwise = ws !! (y1 - 1) in - map (\t -> if - | t >= k1 -> A - | y1 == 0 -> C - | t <= k2 -> B - | otherwise -> C) us - (x1,y1,0,_) -> let !k1 = ws !! (x1 - 1) - !k2 - | y1 == 0 = last ws - | otherwise = ws !! (length us - y1) in - map (\t -> if - | t <= k1 -> A - | y1 == 0 -> C - | t >= k2 -> B - | otherwise -> C) us - (x1,y1,_,_) -> let !k1 = ws !! (length us - x1) - !k2 = ws !! (length us - x1 - y1) in - map (\t -> if - | t >= k1 -> A - | y1 == 0 -> C - | t >= k2 -> B - | otherwise -> C) us - f ch@(Ch _ _ l1) ys@(_:_) = - let !q = length ys `quot` l1 - rs = take (q * l1) ys in f' ch rs - f' ch@(Ch _ _ l1) qs@(_:_) = let (ts,zs) = splitAt l1 qs in ts : f' ch zs - f' _ [] = [] - -{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) -lists of 'Marker3s'. It emphasises the 'A' similarity and for most values have not so simply defined 'B'-behaviour. Uses 'similarityLogics' inside. --} -similarityABC - :: Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [[Marker3s]] - -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. -similarityABC k1 k2 z (xs:ys:xss) = similarityABC k1 k2 (z * similarityLogics 1 k1 k2 xs ys) (ys:xss) -similarityABC _ _ z _ = z - -{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) -lists of 'Marker3s'. It emphasises the 'A' and 'B' similarities. Uses 'similarityLogics0' inside. -The more straightforward variant of the 'similarityABC' function. --} -similarityABC0 - :: Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. - -> Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> [[Marker3s]] - -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. -similarityABC0 k1 k2 z (xs:ys:xss) = similarityABC0 k1 k2 (z * similarityLogics0 1 k1 k2 xs ys) (ys:xss) -similarityABC0 _ _ z _ = z - -{-| The function that uses a simple arithmetic logics to calculate the similarity of the two equal by length (if not they are truncated to the least one) -lists of 'Marker3s'. It emphasises the 'A' similarity and for most values have not so simply defined 'B'-behaviour. --} -similarityLogics - :: Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). - -> [Marker3s] - -> [Marker3s] - -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. -similarityLogics x0 k1 k2 (x:xs) (y:ys) = similarityLogics (similarityF1 x y k1 k2 x0) k1 k2 xs ys -similarityLogics x0 _ _ _ _ = x0 - -{-| The more straightforward variant of the 'similarityLogics' function. -} -similarityLogics0 - :: Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. - -> [Marker3s] - -> [Marker3s] - -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. -similarityLogics0 x0 k1 k2 (x:xs) (y:ys) = similarityLogics0 (similarityF0 x y k1 k2 x0) k1 k2 xs ys -similarityLogics0 x0 _ _ _ _ = x0 - -similarityF1 - :: Marker3s - -> Marker3s - -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). - -> Double -- ^ The initial value. - -> Double -similarityF1 m1 m2 k1 k2 x0 - | m1 == m2 = case m1 of - A -> x0 * k1 - B -> x0 + k2 - _ -> x0 - | m1 == A || m2 == A = x0 / k1 - | m1 == B || m2 == B = abs (x0 - k2) - | otherwise = x0 -{-# INLINE similarityF1 #-} - -{-| The more straightforward variant of the 'similarityF1' function. -} -similarityF0 - :: Marker3s - -> Marker3s - -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. - -> Double -- ^ The initial value. - -> Double -similarityF0 m1 m2 k1 k2 x0 - | m1 == m2 = case m1 of - A -> x0 * k1 - B -> x0 + k2 - _ -> x0 - | m1 == A || m2 == A = x0 / k1 - | otherwise = x0 -{-# INLINE similarityF0 #-} - -{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be -guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. --} -rhythmicityABC - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition (positive subtraction) coefficient that increases or decreases (probably) the result in case of 'B' similtaneous presence (absence). - -> Choices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> RhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. -rhythmicityABC x0 k1 k2 choices rhythm = similarityABC k1 k2 x0 . getChRhData choices rhythm -{-# INLINE rhythmicityABC #-} - -{-| General function to estimate the inner rhythmicity of the 'Ord'ered list of values. For many cases its arguments can be -guessed or approximated by some reasonable values. Nevertheless, it is a highly experimental one. -The more straightforward variant of the 'rhythmicityABC' function. --} -rhythmicityABC0 - :: (Ord a) => Double -- ^ The initial value starting from which it counts. Usually, equals to 1.0. - -> Double -- ^ The positive factor (multiplier) coefficient that increases or decreases the result in case of 'A' simultaneous presence (absence). - -> Double -- ^ The addition coefficient that increases the result in case of 'B' similtaneous presence. - -> Choices -- ^ Data specifies the structure of the period of rhythmicity -- whether maximum or minimum elements are considered and how many syllables costitute the period. - -> RhythmBasis -- ^ Data specifies the quantities of the syllables on the corresponding levels of importance. - -> [a] - -> Double -- ^ In case of positive previous 'Double' arguments this is a positive value. The greater one corresponds to (probably) more rhythmic list. -rhythmicityABC0 x0 k1 k2 choices rhythm = similarityABC0 k1 k2 x0 . getChRhData choices rhythm -{-# INLINE rhythmicityABC0 #-} diff --git a/phonetic-languages-rhythmicity.cabal b/phonetic-languages-rhythmicity.cabal --- a/phonetic-languages-rhythmicity.cabal +++ b/phonetic-languages-rhythmicity.cabal @@ -2,7 +2,7 @@ -- For further documentation, see http://haskell.org/cabal/users-guide/ name: phonetic-languages-rhythmicity -version: 0.9.2.0 +version: 0.10.0.0 synopsis: Allows to estimate the rhythmicity properties for the text description: Allows to estimate (somewhat to say, evaluate) the rhythmicity properties for the text. Inspired by the ancient Greek and Latin poetry. @@ -10,7 +10,7 @@ license: MIT license-file: LICENSE author: OleksandrZhabenko -maintainer: olexandr543@yahoo.com +maintainer: oleksandr.zhabenko@yahoo.com copyright: Oleksandr Zhabenko category: Language,Math,Data,Game build-type: Simple @@ -18,10 +18,10 @@ cabal-version: >=1.10 library - exposed-modules: Languages.Rhythmicity, Languages.Rhythmicity.Factor, Rhythmicity.TwoFourth, Rhythmicity.PolyRhythm + exposed-modules: Phladiprelio.Rhythmicity.Simple, Phladiprelio.Rhythmicity.Factor, Phladiprelio.Rhythmicity.TwoFourth, Phladiprelio.Rhythmicity.PolyRhythm -- other-modules: - other-extensions: BangPatterns, MultiWayIf + other-extensions: BangPatterns, MultiWayIf, NoImplicitPrelude ghc-options: -funbox-strict-fields - build-depends: base >=4.7 && <5 + build-depends: base >=4.13 && <5 -- hs-source-dirs: default-language: Haskell2010