phonetic-languages-simplified-properties-lists-0.1.3.1: Phonetic/Languages/Lists/Ukrainian/PropertiesFuncRepG.hs

-- |
-- Module      :  Phonetic.Languages.Lists.Ukrainian.PropertiesFuncRepG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- 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.

{-# LANGUAGE CPP, BangPatterns #-}

module Phonetic.Languages.Lists.Ukrainian.PropertiesFuncRepG (
  -- * Functions with 'Int16'
  procDiverse2I
  , procDiverse2Ineg
  -- * Functions with 'Float'
  , procDiverse2F
  , procDiverse2Fneg
  , procRhythmicity23F
  , procRhythmicity23Fneg
  , procBothF
  , procBothFneg
  , procBothInvF
  , procBothInvFneg
  -- ** Working with generated by r-glpk-phonetic-languages-ukrainian-durations syllable durations
  , procRhythmicity232F
  , procRhythmicity232Fneg
  , procBoth2F
  , procBoth2Fneg
  , procBoth2InvF
  , procBoth2InvFneg
) 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 qualified Data.Vector as VB
import qualified Data.Vector.Unboxed as V
import Phonetic.Languages.Lists.Ukrainian.PropertiesSyllablesG
import Phonetic.Languages.Simplified.Lists.UniquenessPeriodsG
import Languages.Rhythmicity
import Phonetic.Languages.Simplified.DataG
import GHC.Float (int2Float)
import Melodics.ByteString.Ukrainian
import qualified Languages.Phonetic.Ukrainian.Syllable 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 #-}

-- | Can be used to find out the minimum element.
procDiverse2Ineg
  :: (Ord c) => (Int16 -> c)
  -> FuncRep2 String Int16 c
procDiverse2Ineg g = D (negate . diverse2GL " 01-" . convertToProperUkrainianS) g
{-# INLINE procDiverse2Ineg #-}

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

procDiverse2Fneg
  :: (Ord c) => (Float -> c)
  -> FuncRep2 String Float c
procDiverse2Fneg g = D (int2Float . negate . fromEnum . diverse2GL " 01-" . convertToProperUkrainianS) g
{-# INLINE procDiverse2Fneg #-}

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

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

-- | Can be used to find out the minimum element.
procRhythmicity23Fneg
  :: (Ord c) => (Float -> c)
  -> String
  -> Coeffs2
  -> FuncRep2 String Float c
procRhythmicity23Fneg g choice coeffs  = procRhythm23Fneg g choice rhythmicity coeffs
{-# INLINE procRhythmicity23Fneg #-}

procBothF
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBothF g coeffs  = procB2F g S.syllableDurations coeffs
{-# INLINE procBothF #-}

-- | Can be used to find out the minimum element.
procBothFneg
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBothFneg g coeffs  = procB2Fneg g S.syllableDurations coeffs
{-# INLINE procBothFneg #-}

procBothInvF
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBothInvF g coeffs  = procB2InvF g S.syllableDurations coeffs
{-# INLINE procBothInvF #-}

-- | Can be used to find out the minimum element.
procBothInvFneg
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBothInvFneg g coeffs  = procB2InvFneg g S.syllableDurations coeffs
{-# INLINE procBothInvFneg #-}

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

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

-- | Can be used to find out the minimum element.
procRhythmicity232Fneg
  :: (Ord c) => (Float -> c)
  -> String
  -> Coeffs2
  -> FuncRep2 String Float c
procRhythmicity232Fneg g choice coeffs  = procRhythm23Fneg g choice rhythmicity coeffs
{-# INLINE procRhythmicity232Fneg #-}

procBoth2F
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBoth2F g coeffs  = procB2F g S.syllableDurations2 coeffs
{-# INLINE procBoth2F #-}

-- | Can be used to find out the minimum element.
procBoth2Fneg
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBoth2Fneg g coeffs  = procB2Fneg g S.syllableDurations2 coeffs
{-# INLINE procBoth2Fneg #-}

procBoth2InvF
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBoth2InvF g coeffs  = procB2InvF g S.syllableDurations2 coeffs
{-# INLINE procBoth2InvF #-}

-- | Can be used to find out the minimum element.
procBoth2InvFneg
  :: (Ord c) => (Float -> c)
  -> Coeffs2
  -> FuncRep2 String Float c
procBoth2InvFneg g coeffs  = procB2InvFneg g S.syllableDurations2 coeffs
{-# INLINE procBoth2InvFneg #-}

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

eval23Coeffs :: Coeffs2 -> [Float] -> Float
eval23Coeffs (CF2 x y) = evalRhythmicity23K (fromMaybe 1.0 x) (fromMaybe 1.0 y)
eval23Coeffs CF0 = evalRhythmicity23

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

procRhythm23Fneg
  :: (Ord c) => (Float -> c)
  -> String
  -> (String -> Coeffs2 -> String -> Float)
  -> Coeffs2
  -> FuncRep2 String Float c
procRhythm23Fneg h choice g coeffs = D (negate . g choice coeffs) h
{-# INLINE procRhythm23Fneg #-}

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

-- | Can be used to find out the minimum element.
procB2Fneg
  :: (Ord c) => (Float -> c)
  -> ([[[S.UZPP2]]] -> [[Float]])
  -> Coeffs2
  -> FuncRep2 String Float c
procB2Fneg h g coeffs = D (\xs -> let ys = convertToProperUkrainianS . map (\x -> if x == '-' then ' ' else x) $ xs in  ((int2Float . negate . fromEnum . diverse2GL " 01-" $ ys)*(eval23Coeffs coeffs . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . S.str2UZPP2s) . words1 . mapMaybe f $ ys))) h
{-# INLINE procB2Fneg #-}

procB2InvF
  :: (Ord c) => (Float -> c)
  -> ([[[S.UZPP2]]] -> [[Float]])
  -> Coeffs2
  -> FuncRep2 String Float c
procB2InvF 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  (eval23Coeffs coeffs . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds .
         S.str2UZPP2s) . words1 . mapMaybe f $ ys) ** 2.0
        else  ((eval23Coeffs coeffs . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . S.str2UZPP2s) . words1 . mapMaybe f $ ys) / (int2Float . fromEnum $ z))) h
{-# INLINE procB2InvF #-}

-- | Can be used to find out the minimum element.
procB2InvFneg
  :: (Ord c) => (Float -> c)
  -> ([[[S.UZPP2]]] -> [[Float]])
  -> Coeffs2
  -> FuncRep2 String Float c
procB2InvFneg 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  (negate (eval23Coeffs coeffs . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds .
         S.str2UZPP2s) . words1 . mapMaybe f $ ys) ** 2.0)
        else  ((eval23Coeffs coeffs . mconcat . g . map (S.divVwls . S.reSyllableCntnts . S.groupSnds . S.str2UZPP2s) . words1 . mapMaybe f $ ys) /
          (int2Float . negate . fromEnum $ z))) h
{-# INLINE procB2InvFneg #-}

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 #-}