{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG22
-- 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.

module Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG22 (
  -- * Functions with 'Double'
  -- ** Working with generated by r-glpk-phonetic-languages-ukrainian-durations syllable durations
  procBoth2F
  , procBoth2FF
  , procBoth2InvF
  , procBoth2InvFF
) where

import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common
import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2Common
import Phonetic.Languages.Simplified.DataG.Base
import qualified Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 as SD

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

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

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

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