{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2CommonOld
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- 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.PropertiesFuncRepG2CommonOld 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 Phonetic.Languages.Array.Ukrainian.Common
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2CommonOld
import Phonetic.Languages.UniquenessPeriodsG
import Languages.Rhythmicity
import Languages.Rhythmicity.Factor
import Phonetic.Languages.Basis
import GHC.Float (int2Double)
import qualified Languages.Phonetic.Ukrainian.Syllable.ArrInt8 as S
import Melodics.Ukrainian.ArrInt8
import Data.Maybe (fromMaybe)
import GHC.Arr (Array)
import GHC.Int (Int8)

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

procB2FG
  :: (Ord c) => ([Double] -> Double)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2FG :: ([Double] -> Double)
-> (Double -> c)
-> ([[[Sound8]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2FG [Double] -> Double
h1 Double -> c
h [[[Sound8]]] -> [[Double]]
g Coeffs2
coeffs = (String -> Double) -> (Double -> c) -> FuncRep2 String Double c
forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (\String
xs -> let ys :: [Sound8]
ys = String -> [Sound8]
convertToProperUkrainianI8 (String -> [Sound8]) -> (String -> String) -> String -> [Sound8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
' ' else Char
x) (String -> [Sound8]) -> String -> [Sound8]
forall a b. (a -> b) -> a -> b
$ String
xs in  ((Int -> Double
int2Double (Int -> Double) -> ([Sound8] -> Int) -> [Sound8] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall a. Enum a => a -> Int
fromEnum (Int16 -> Int) -> ([Sound8] -> Int16) -> [Sound8] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sound8] -> [Sound8] -> Int16
forall (t :: * -> *). Foldable t => [Sound8] -> t Sound8 -> Int16
diverse2GLInt8 [-Sound8
1,Sound8
0] ([Sound8] -> Double) -> [Sound8] -> Double
forall a b. (a -> b) -> a -> b
$ [Sound8]
ys)Double -> Double -> Double
forall a. Num a => a -> a -> a
*([Double] -> Double
h1 ([Double] -> Double)
-> ([Sound8] -> [Double]) -> [Sound8] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> ([Sound8] -> [[Double]]) -> [Sound8] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[Double]]
g ([[[Sound8]]] -> [[Double]])
-> ([Sound8] -> [[[Sound8]]]) -> [Sound8] -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sound8] -> [[Sound8]]) -> [[Sound8]] -> [[[Sound8]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Sound8]] -> [[Sound8]]
S.divVwls ([[Sound8]] -> [[Sound8]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[Sound8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Sound8]] -> [[Sound8]]
S.reSyllableCntnts ([[Sound8]] -> [[Sound8]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[Sound8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sound8] -> [[Sound8]]
S.groupSnds) ([[Sound8]] -> [[[Sound8]]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[[Sound8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sound8] -> [[Sound8]]
forall a. (Ord a, Num a) => [a] -> [[a]]
words1 ([Sound8] -> Double) -> [Sound8] -> Double
forall a b. (a -> b) -> a -> b
$ [Sound8]
ys))) Double -> c
h
{-# INLINE procB2FG #-}

procB2InvFG
  :: (Ord c) => ([Double] -> Double)
  -> (Double -> c)
  -> ([[[Sound8]]] -> [[Double]])
  -> Coeffs2
  -> FuncRep2 String Double c
procB2InvFG :: ([Double] -> Double)
-> (Double -> c)
-> ([[[Sound8]]] -> [[Double]])
-> Coeffs2
-> FuncRep2 String Double c
procB2InvFG [Double] -> Double
h1 Double -> c
h [[[Sound8]]] -> [[Double]]
g Coeffs2
coeffs = (String -> Double) -> (Double -> c) -> FuncRep2 String Double c
forall a b c. (a -> b) -> (b -> c) -> FuncRep2 a b c
D (\String
xs ->
  let !ys :: [Sound8]
ys = String -> [Sound8]
convertToProperUkrainianI8 (String -> [Sound8]) -> (String -> String) -> String -> [Sound8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
' ' else Char
x) (String -> [Sound8]) -> String -> [Sound8]
forall a b. (a -> b) -> a -> b
$ String
xs
      !z :: Int16
z = [Sound8] -> [Sound8] -> Int16
forall (t :: * -> *). Foldable t => [Sound8] -> t Sound8 -> Int16
diverse2GLInt8 [-Sound8
1,Sound8
0] [Sound8]
ys in if Int16
z Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0 then  ([Double] -> Double
h1 ([Double] -> Double)
-> ([Sound8] -> [Double]) -> [Sound8] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> ([Sound8] -> [[Double]]) -> [Sound8] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[Double]]
g ([[[Sound8]]] -> [[Double]])
-> ([Sound8] -> [[[Sound8]]]) -> [Sound8] -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sound8] -> [[Sound8]]) -> [[Sound8]] -> [[[Sound8]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Sound8]] -> [[Sound8]]
S.divVwls ([[Sound8]] -> [[Sound8]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[Sound8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Sound8]] -> [[Sound8]]
S.reSyllableCntnts ([[Sound8]] -> [[Sound8]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[Sound8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sound8] -> [[Sound8]]
S.groupSnds) ([[Sound8]] -> [[[Sound8]]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[[Sound8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          [Sound8] -> [[Sound8]]
forall a. (Ord a, Num a) => [a] -> [[a]]
words1 ([Sound8] -> Double) -> [Sound8] -> Double
forall a b. (a -> b) -> a -> b
$ [Sound8]
ys) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2.0
        else  (([Double] -> Double
h1 ([Double] -> Double)
-> ([Sound8] -> [Double]) -> [Sound8] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double])
-> ([Sound8] -> [[Double]]) -> [Sound8] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Sound8]]] -> [[Double]]
g ([[[Sound8]]] -> [[Double]])
-> ([Sound8] -> [[[Sound8]]]) -> [Sound8] -> [[Double]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sound8] -> [[Sound8]]) -> [[Sound8]] -> [[[Sound8]]]
forall a b. (a -> b) -> [a] -> [b]
map ([[Sound8]] -> [[Sound8]]
S.divVwls ([[Sound8]] -> [[Sound8]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[Sound8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Sound8]] -> [[Sound8]]
S.reSyllableCntnts ([[Sound8]] -> [[Sound8]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[Sound8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sound8] -> [[Sound8]]
S.groupSnds) ([[Sound8]] -> [[[Sound8]]])
-> ([Sound8] -> [[Sound8]]) -> [Sound8] -> [[[Sound8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sound8] -> [[Sound8]]
forall a. (Ord a, Num a) => [a] -> [[a]]
words1 ([Sound8] -> Double) -> [Sound8] -> Double
forall a b. (a -> b) -> a -> b
$ [Sound8]
ys) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
int2Double (Int -> Double) -> (Int16 -> Int) -> Int16 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall a. Enum a => a -> Int
fromEnum (Int16 -> Double) -> Int16 -> Double
forall a b. (a -> b) -> a -> b
$ Int16
z))) Double -> c
h
{-# INLINE procB2InvFG #-}

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

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

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

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