{-# 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 (Factors -> Factors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Factors -> Factors -> Bool
$c/= :: Factors -> Factors -> Bool
== :: Factors -> Factors -> Bool
$c== :: Factors -> Factors -> Bool
Eq, Int -> Factors -> ShowS
[Factors] -> ShowS
Factors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Factors] -> ShowS
$cshowList :: [Factors] -> ShowS
show :: Factors -> String
$cshow :: Factors -> String
showsPrec :: Int -> Factors -> ShowS
$cshowsPrec :: Int -> Factors -> ShowS
Show)

readFactors :: String -> Factors
readFactors :: String -> Factors
readFactors String
xs 
 | forall a. [a] -> Int
length String
xs forall a. Eq a => a -> a -> Bool
== Int
10 = let (Double
x1:Double
x2:Double
x3:Double
x4:Double
x5:Double
x6:Double
x7:Double
x8:Double
x9:[Double
x10]) = forall a b. (a -> b) -> [a] -> [b]
map Char -> Double
f2 String
xs in Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Factors
F Double
x1 Double
x2 Double
x3 Double
x4 Double
x5 Double
x6 Double
x7 Double
x8 Double
x9  Double
x10
 | Bool
otherwise = forall a. HasCallStack => a
undefined
    where f2 :: Char -> Double
f2 Char
x 
            | Char -> Bool
isDigit Char
x = forall a. Read a => String -> a
read [Char
x]::Double
            | Bool
otherwise = case Char
x of { Char
'p' -> Double
4.743; Char
'i' -> Double
4.153; ~Char
rrr -> Double
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 :: Factors -> Double -> [Double] -> Double
maxPosition2F Factors
ff !Double
k [Double]
xs
 | forall a. [a] -> Bool
null [Double]
xs = Double
0.0
 | Bool
otherwise = forall {p}.
(Fractional p, Ord p) =>
Factors -> p -> [p] -> Double -> Double
maxP21 Factors
ff Double
k [Double]
xs Double
0
     where maxP21 :: Factors -> p -> [p] -> Double -> Double
maxP21 Factors
ff p
k (p
x:ks :: [p]
ks@(p
y:p
t:[p]
ys)) !Double
acc1 
             | forall a. Num a => a -> a
abs (p
x forall a. Num a => a -> a -> a
- p
t) forall a. Fractional a => a -> a -> a
/ forall a. Ord a => a -> a -> a
max p
x p
t forall a. Ord a => a -> a -> Bool
< p
0.05 = Factors -> p -> [p] -> Double -> Double
maxP21 Factors
ff p
k [p]
ks (Double
acc1 forall a. Num a => a -> a -> a
+ forall {p} {p} {p}. Factors -> p -> p -> p -> p -> p -> Double
f1 Factors
ff p
k p
s p
y p
w Double
acc1)
             | Bool
otherwise = Factors -> p -> [p] -> Double -> Double
maxP21 Factors
ff p
k [p]
ks (Double
acc1 forall a. Num a => a -> a -> a
+ forall {p} {p}. Factors -> p -> p -> p -> p -> p -> Double
f Factors
ff p
k p
s p
y p
w Double
acc1)
                 where s :: p
s = forall a. Ord a => a -> a -> a
min p
x p
t
                       w :: p
w = forall a. Ord a => a -> a -> a
max p
x p
t
                       f :: Factors -> p -> p -> p -> p -> p -> Double
f ff :: Factors
ff@(F Double
x1 Double
x2 Double
x3 Double
x4 Double
x5 Double
x6 Double
x7 Double
x8 Double
x9 Double
x10) p
k p
s p
y p
w p
acc 
                         | p
t forall a. Ord a => a -> a -> Bool
> p
w = if 
                            | p
t forall a. Ord a => a -> a -> Bool
>= p
k forall a. Num a => a -> a -> a
* p
s Bool -> Bool -> Bool
&& p
t forall a. Ord a => a -> a -> Bool
<= p
kforall a. Num a => a -> a -> a
*p
w -> Double
x1 -- the default is 5.0
                            | p
t forall a. Ord a => a -> a -> Bool
< p
kforall a. Num a => a -> a -> a
*p
s -> Double
x2  -- the default is 4.0
                            | p
t forall a. Ord a => a -> a -> Bool
> p
kforall a. Num a => a -> a -> a
*p
w -> Double
x3  -- the default is 3.0
                         | p
t forall a. Ord a => a -> a -> Bool
> p
s = Double
x4  -- the default is 2.0
                         | p
t forall a. Ord a => a -> a -> Bool
< p
s = Double
x5  -- the default is 1.0
                         | p
t forall a. Eq a => a -> a -> Bool
== p
w = Double
x6  -- the default is 4.743
                         | Bool
otherwise = Double
x7  -- the default is 4.153
                       f1 :: Factors -> p -> p -> p -> p -> p -> Double
f1 ff :: Factors
ff@(F Double
x1 Double
x2 Double
x3 Double
x4 Double
x5 Double
x6 Double
x7 Double
x8 Double
x9 Double
x10) p
k p
s p
y p
w p
acc 
                         | p
t forall a. Ord a => a -> a -> Bool
> p
w = Double
x8  -- the default is 5.0
                         | p
t forall a. Ord a => a -> a -> Bool
< p
s = Double
x9  -- the default is 4.0
                         | Bool
otherwise = Double
x10  -- the default is 3.0
           maxP21 Factors
_ p
_ [p]
_ !Double
acc1 = Double
acc1

defFactors :: Factors
defFactors :: Factors
defFactors = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Factors
F Double
5 Double
4 Double
3 Double
2 Double
1 Double
4.743 Double
4.153 Double
5 Double
4 Double
3

-- | 
-- > readFactors defFactorsStr == defFactors
defFactorsStr :: String
defFactorsStr :: String
defFactorsStr = String
"54321pi543"

evalRhythmicity23F :: Factors -> Double -> [Double] -> Double
evalRhythmicity23F :: Factors -> Double -> [Double] -> Double
evalRhythmicity23F Factors
ff Double
k [Double]
xs = Factors -> Double -> [Double] -> Double
maxPosition2F Factors
ff Double
k [Double]
xs forall a. Num a => a -> a -> a
+ forall a. RealFrac a => [a] -> a
maxPosition3 [Double]
xs
{-# INLINE evalRhythmicity23F #-}

evalRhythmicity23KF
  :: Factors
  -> Double
  -> Double
  -> Double
  -> [Double]
  -> Double
evalRhythmicity23KF :: Factors -> Double -> Double -> Double -> [Double] -> Double
evalRhythmicity23KF Factors
ff Double
k Double
k2 Double
k3 [Double]
xs = Double
k2 forall a. Num a => a -> a -> a
* Factors -> Double -> [Double] -> Double
maxPosition2F Factors
ff Double
k [Double]
xs forall a. Num a => a -> a -> a
+ Double
k3 forall a. Num a => a -> a -> a
* forall a. RealFrac a => [a] -> a
maxPosition3 [Double]
xs
{-# INLINE evalRhythmicity23KF #-}