phonetic-languages-simplified-properties-array-0.9.1.0: Phonetic/Languages/Array/Ukrainian/PropertiesFuncRepG2.hs

{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Generalization of the functionality of the DobutokO.Poetry.Norms
-- and DobutokO.Poetry.Norms.Extended modules
-- from the @dobutokO-poetry@ package. Instead of vectors, uses arrays.

{-# LANGUAGE CPP, BangPatterns #-}

module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2 (
  -- * Functions with 'Int16'
  procDiverse2I
  -- * Functions with 'Double'
  -- ** More general
  , procB2FG
  , procB2InvFG
  -- ** Usual ones
  , procDiverse2F
  , procBothF
  , procBothFF
  , procBothInvF
  , procBothInvFF
  -- ** Working with generated by r-glpk-phonetic-languages-ukrainian-durations syllable durations
  , procBoth2F
  , procBoth2FF
  , procBoth2InvF
  , procBoth2InvFF
  -- ** NEW Working with generated by r-glpk-phonetic-languages-ukrainian-durations syllable durations
  , procBoth3F
  , procBoth3FF
  , procBoth3InvF
  , procBoth3InvFF
  , procBoth4F
  , procBoth4FF
  , procBoth4InvF
  , procBoth4InvFF
  -- * Working with rhythmicity
  , procRhythmicity23F
  -- ** Working with rhythmicity that can be defined by the user (using 'rhythmicityH')
  , procRhythmicity23FH
) where

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__>=710
/* code that applies only to GHC 7.10.* and higher versions */
import GHC.Base (mconcat)
#endif
#endif
import GHC.Int
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG.Base
import Languages.Rhythmicity
import Languages.Rhythmicity.Factor
import Phonetic.Languages.Simplified.DataG.Base
import GHC.Float (int2Double)
import Melodics.ByteString.Ukrainian.Arr
import qualified Languages.Phonetic.Ukrainian.Syllable.Double.Arr as SD
import qualified Languages.Phonetic.Ukrainian.Syllable.Arr as S
import Data.Maybe (isNothing,fromMaybe,mapMaybe)
import Text.Read (readMaybe)

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__==708
/* code that applies only to GHC 7.8.* */
mconcat = concat
#endif
#endif

procDiverse2I
  :: (Ord c) => (Int16 -> c)
  -> FuncRep2 String Int16 c
procDiverse2I g = D (diverse2GL " 01-" . convertToProperUkrainianS) g
{-# INLINE procDiverse2I #-}

procDiverse2F
  :: (Ord c) => (Double -> c)
  -> FuncRep2 String Double c
procDiverse2F g = D (int2Double . fromEnum . diverse2GL " 01-" . convertToProperUkrainianS) g
{-# INLINE procDiverse2F #-}

--------------------------------------------------------------------------------------------

eval23Coeffs :: Coeffs2 -> [Double] -> Double
eval23Coeffs (CF2 x y) = evalRhythmicity23K (fromMaybe 1.0 x) (fromMaybe 1.0 y)
eval23Coeffs CF0 = evalRhythmicity23
{-# INLINE eval23Coeffs #-}

eval23CoeffsF :: Double -> Coeffs2 -> [Double] -> Double
eval23CoeffsF k (CF2 x y) = evalRhythmicity23KF k (fromMaybe 1.0 x) (fromMaybe 1.0 y)
eval23CoeffsF k CF0 = evalRhythmicity23F k
{-# INLINE eval23CoeffsF #-}

procB2FG
  :: (Ord c) => ([Double] -> Double)
  -> (Double -> c)
  -> ([[[S.UZPP2]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FG h1 h g coeffs = D (\xs -> let ys = convertToProperUkrainianS . map (\x -> if x == '-' then ' ' else x) $ xs in  ((int2Double . fromEnum . diverse2GL " 01-" $ ys)*(h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . S.str2UZPP2s) . words1 . mapMaybe f $ ys))) h
{-# INLINE procB2FG #-}

procB2F
  :: (Ord c) => (Double -> c)
  -> ([[[S.UZPP2]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2F h g coeffs = procB2FG (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2F #-}

procB2FF
  :: (Ord c) => Double
  -> (Double -> c)
  -> ([[[S.UZPP2]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FF k h g coeffs = procB2FG (eval23CoeffsF k coeffs) h g coeffs
{-# INLINE procB2FF #-}

procB2InvFG
  :: (Ord c) => ([Double] -> Double)
  -> (Double -> c)
  -> ([[[S.UZPP2]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFG h1 h g coeffs = D (\xs ->
  let !ys = convertToProperUkrainianS . map (\x -> if x == '-' then ' ' else x) $ xs
      !z = diverse2GL " 01-" ys in if z == 0 then  (h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds .
         S.str2UZPP2s) . words1 . mapMaybe f $ ys) ** 2.0
        else  ((h1 . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . S.str2UZPP2s) . words1 . mapMaybe f $ ys) / (int2Double . fromEnum $ z))) h
{-# INLINE procB2InvFG #-}

procB2InvF
  :: (Ord c) => (Double -> c)
  -> ([[[S.UZPP2]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvF h g coeffs = procB2InvFG (eval23Coeffs coeffs) h g coeffs
{-# INLINE procB2InvF #-}

procB2InvFF
  :: (Ord c) => Double
  -> (Double -> c)
  -> ([[[S.UZPP2]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFF k h g coeffs = procB2InvFG (eval23CoeffsF k coeffs) h g coeffs
{-# INLINE procB2InvFF #-}

---------------------------------------------------------------------

procRhythm23F
  :: (Ord c) => (Double -> c)
  -> String
  -> (String -> Coeffs2 -> String -> Double)
  -> Coeffs2
  -> FuncRep2 String Double c
procRhythm23F h choice g coeffs = D (g choice coeffs) h
{-# INLINE procRhythm23F #-}

procRhythmicity23F
  :: (Ord c) => Double
  -> (Double -> c)
  -> String
  -> Coeffs2
  -> FuncRep2 String Double c
procRhythmicity23F k g choice coeffs = procRhythm23F g choice (rhythmicity k) coeffs
{-# INLINE procRhythmicity23F #-}

procRhythmicity23FH
  :: (Ord c) => Double
  -> (Double -> c)
  -> [[[[S.UZPP2]]] -> [[Double]]]
  -> String
  -> Coeffs2
  -> FuncRep2 String Double c
procRhythmicity23FH k g syllableDurationsDs choice coeffs = D (rhythmicityH k choice syllableDurationsDs coeffs) g
{-# INLINE procRhythmicity23FH #-}

procBothF
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBothF g coeffs  = procB2F g SD.syllableDurationsD coeffs
{-# INLINE procBothF #-}

procBothFF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBothFF k g coeffs  = procB2FF k g SD.syllableDurationsD coeffs
{-# INLINE procBothFF #-}

procBothInvF
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBothInvF g coeffs  = procB2InvF g SD.syllableDurationsD coeffs
{-# INLINE procBothInvF #-}

procBothInvFF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBothInvFF k g coeffs  = procB2InvFF k g SD.syllableDurationsD coeffs
{-# INLINE procBothInvFF #-}

-------------------------------------------------------------------------------

procBoth2F
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth2F g coeffs  = procB2F g SD.syllableDurationsD2 coeffs
{-# INLINE procBoth2F #-}

procBoth2InvF
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth2InvF g coeffs  = procB2InvF g SD.syllableDurationsD2 coeffs
{-# INLINE procBoth2InvF #-}

procBoth2FF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth2FF k g coeffs  = procB2FF k g SD.syllableDurationsD2 coeffs
{-# INLINE procBoth2FF #-}

procBoth2InvFF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth2InvFF k g coeffs  = procB2InvFF k g SD.syllableDurationsD2 coeffs
{-# INLINE procBoth2InvFF #-}

-------------------------------------------------------------

procBoth3F
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth3F g coeffs  = procB2F g SD.syllableDurationsD3 coeffs
{-# INLINE procBoth3F #-}

procBoth3InvF
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth3InvF g coeffs  = procB2InvF g SD.syllableDurationsD3 coeffs
{-# INLINE procBoth3InvF #-}

procBoth3FF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth3FF k g coeffs  = procB2FF k g SD.syllableDurationsD3 coeffs
{-# INLINE procBoth3FF #-}

procBoth3InvFF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth3InvFF k g coeffs  = procB2InvFF k g SD.syllableDurationsD3 coeffs
{-# INLINE procBoth3InvFF #-}

-------------------------------------------------------------

procBoth4F
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth4F g coeffs  = procB2F g SD.syllableDurationsD4 coeffs
{-# INLINE procBoth4F #-}

procBoth4InvF
  :: (Ord c) => (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth4InvF g coeffs  = procB2InvF g SD.syllableDurationsD4 coeffs
{-# INLINE procBoth4InvF #-}

procBoth4FF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth4FF k g coeffs  = procB2FF k g SD.syllableDurationsD4 coeffs
{-# INLINE procBoth4FF #-}

procBoth4InvFF
  :: (Ord c) => Double
  -> (Double -> c)
  -> Coeffs2
  -> FuncRep2 String Double c
procBoth4InvFF k g coeffs  = procB2InvFF k g SD.syllableDurationsD4 coeffs
{-# INLINE procBoth4InvFF #-}

-------------------------------------------------------------

f x
  | x == '0' = Nothing
  | x /= '1' && x /= '-' = Just x
  | otherwise = Just ' '
{-# INLINE f #-}

words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
  where ts = dropWhile (== ' ') xs
        (w, s'') = span (/= ' ') ts
{-# NOINLINE words1 #-}