diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +# Revision history for phladiprelio-rhythmicity-shared + +## 0.1.0.0 -- 2023-03-13 + +* First version. Released on an unsuspecting world. Is a part of the phonetic-languages-rhythmicity-0.10.2.0 package. + 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,86 @@ +{-# 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 = defFactors + 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) + | otherwise = maxP21 ff k ks (acc1 + f ff k s y w) + where (s, w) + | t > x = (x, t) + | otherwise = (t, x) + f ff@(F x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) k s y w + | y > w = if + | y >= k * s && y <= k*w -> x1 -- the default is 5.0 + | y < k*s -> x2 -- the default is 4.0 + | otherwise -> x3 -- the default is 3.0 + | y > s = x4 -- the default is 2.0 + | y < s = x5 -- the default is 1.0 + | y == 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 + | y > w = x8 -- the default is 5.0 + | y < 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 + 14.37 * maxPosition3 xs +{-# INLINE evalRhythmicity23F #-} + +evalRhythmicity23KF + :: Factors + -> Double + -> Double + -> Double + -> [Double] + -> Double +evalRhythmicity23KF ff k k2 k3 xs = k2 * maxPosition2F ff k xs + k3 * 14.37 * maxPosition3 xs +{-# INLINE evalRhythmicity23KF #-} 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 + 1.31 * maxPosition3 xs + +evalRhythmicity23K + :: (RealFrac a, Floating a) => a + -> a + -> [a] + -> a +evalRhythmicity23K k2 k3 xs = k2 * maxPosition2 xs + k3 * 1.31 * maxPosition3 xs diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,18 @@ +The shared between different implementations functionality for some types of rhythmicity +evaluation. Based on the ideas related to PhLADiPreLiO (Phonetic Languages +Approach to Discovering the Preferred Line Options) for Ukrainian language. +Is previously located at: + +https://hackage.haskell.org/package/phonetic-languages-rhythmicity + +[Ukrainian documentation](https://oleksandrzhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Ukr.21.pdf) + +[English documentation](https://oleksandrzhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.pdf) + +P.S.: the author would like to devote this project to support the Foundation GASTROSTARS. +At the 12/03/2023 there was the foundation founder's (this is [Emma Kok](https://www.emmakok.nl)) Birthday. +If you would like to share some financial support, please, contact the foundation +using the URL: + +[Contact Foundation GASTROSTARS](https://gastrostars.nl/hou-mij-op-de-hoogte) + diff --git a/phladiprelio-rhythmicity-shared.cabal b/phladiprelio-rhythmicity-shared.cabal new file mode 100644 --- /dev/null +++ b/phladiprelio-rhythmicity-shared.cabal @@ -0,0 +1,32 @@ +cabal-version: 2.4 +name: phladiprelio-rhythmicity-shared +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: Allows to estimate some kind of the rhythmicity properties for the text + +-- A longer description of the package. +description: The part of the package phonetic-languages-rhythmicity-0.10.2.0. See: [here](https://hackage.haskell.org/package/phonetic-languages-rhythmicity). Inspired by the ancient Greek and Latin poetry. + +-- A URL where users can report bugs. +-- bug-reports: + +-- The license under which the package is released. +license: MIT +author: Oleksandr-Zhabenko +maintainer: oleksandr.zhabenko@yahoo.com + +-- A copyright notice. +copyright: Oleksandr Zhabenko +category: Math, Language, Music +extra-source-files: CHANGELOG.md, README.md + +library + exposed-modules: Phladiprelio.Rhythmicity.Factor, Phladiprelio.Rhythmicity.Simple + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + other-extensions: BangPatterns, MultiWayIf, NoImplicitPrelude + build-depends: base >=4.13 && <5 + hs-source-dirs: . + default-language: Haskell2010