{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK show-extensions #-}

{- |
Module      :  Aftovolio.RGLPK.General
Copyright   :  (c) Oleksandr Zhabenko 2020-2024
License     :  MIT
Stability   :  Experimental
Maintainer  :  oleksandr.zhabenko@yahoo.com

Can be used to calculate the durations of the approximations of the phonemes
using some prepared text with its correct (at least mostly) pronunciation.
The prepared text is located in the same directory and contains lines -the
phonetic language word and its duration in seconds separated with whitespace.
The library is intended to use the functionality of the :

1) R programming language https://www.r-project.org/

2) Rglpk library https://cran.r-project.org/web/packages/Rglpk/index.html

3) GNU GLPK library https://www.gnu.org/software/glpk/glpk.html

For more information, please, see the documentation for them.

For the model correctness the js here refers to sorted list of the 'Char' representations of the phonetic language phenomenae.

The length of the 'String' js is refered to as 'lng'::'Int'. The number of 'pairs'' function elements in the lists is refered to
as 'nn'::'Int'. The number of constraints is refered here as 'nc'::'Int'. @nc == nn `quot` 2@.

Is generalized from the Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations module from
the @r-glpk-phonetic-languages-ukrainian-durations@ package.
-}
module Aftovolio.RGLPK.General where

import CaseBi.Arr (getBFstL')
import Data.Bits (shiftR)
import Data.Foldable (foldl')
import Data.List
import Data.Lists.FLines (newLineEnding)
import Data.Maybe
import GHC.Arr
import GHC.Base
import GHC.Num (abs, (*), (+), (-))
import Numeric
import Text.Read
import Text.Show (Show (..))

createCoeffsObj :: Int -> [String] -> [Double]
createCoeffsObj :: Int -> [String] -> [Double]
createCoeffsObj Int
l [String]
xss
    | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l = [String] -> [Double]
f [String]
xss [Double] -> [Double] -> [Double]
forall a. Monoid a => a -> a -> a
`mappend` Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xss) Double
1.0
    | Bool
otherwise = [String] -> [Double]
f (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
l [String]
xss)
  where
    f :: [String] -> [Double]
f = (String -> Double) -> [String] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\String
ts -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
ts :: Maybe Double))

countCharInWords :: [String] -> Char -> [Int]
countCharInWords :: [String] -> Char -> [Int]
countCharInWords [String]
xss Char
x
    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = []
    | Bool
otherwise = (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x)) [String]
xss

matrix1Column :: PairwiseC -> [String] -> String -> Char -> [Int]
matrix1Column :: PairwiseC -> [String] -> String -> Char -> [Int]
matrix1Column PairwiseC
pw [String]
xss String
js Char
x = Char -> PairwiseC -> [Int] -> [Int]
pairwiseComparings Char
x PairwiseC
pw ([Int] -> [Int]) -> ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> [Int]
forall a. Monoid a => [a] -> a
mconcat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ [[String] -> Char -> [Int]
countCharInWords [String]
xss Char
x, [Int]
rs, [Int]
rs]
  where
    l :: Int
l = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
js
    iX :: Int
iX = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Maybe Int -> Int) -> (String -> Maybe Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Char
x (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
js
    rs :: [Int]
rs = if Int
iX Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then [] else Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
iX Int
0 [Int] -> [Int] -> [Int]
forall a. Monoid a => a -> a -> a
`mappend` (Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
iX) Int
0)

pairwiseComparings :: Char -> PairwiseC -> [Int] -> [Int]
pairwiseComparings :: Char -> PairwiseC -> [Int] -> [Int]
pairwiseComparings Char
x PairwiseC
y [Int]
zs = [Int]
zs [Int] -> [Int] -> [Int]
forall a. Monoid a => a -> a -> a
`mappend` PairwiseC -> Char -> [Int]
pairs' PairwiseC
y Char
x

{- | A way to encode the pairs of the phonetic language representations that give some additional associations, connections
between elements, usually being caused by some similarity or commonality of the pronunciation act for the phenomenae
corresponding to these elements.
All ['Int'] must be equal in 'length' throughout the same namespace and this length is given as 'Int' argument in
the 'PairwisePL'. This 'Int' parameter is @nn@.
-}
data PairwisePL = PW Char Int [Int] deriving (PairwisePL -> PairwisePL -> Bool
(PairwisePL -> PairwisePL -> Bool)
-> (PairwisePL -> PairwisePL -> Bool) -> Eq PairwisePL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PairwisePL -> PairwisePL -> Bool
== :: PairwisePL -> PairwisePL -> Bool
$c/= :: PairwisePL -> PairwisePL -> Bool
/= :: PairwisePL -> PairwisePL -> Bool
Eq, ReadPrec [PairwisePL]
ReadPrec PairwisePL
Int -> ReadS PairwisePL
ReadS [PairwisePL]
(Int -> ReadS PairwisePL)
-> ReadS [PairwisePL]
-> ReadPrec PairwisePL
-> ReadPrec [PairwisePL]
-> Read PairwisePL
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PairwisePL
readsPrec :: Int -> ReadS PairwisePL
$creadList :: ReadS [PairwisePL]
readList :: ReadS [PairwisePL]
$creadPrec :: ReadPrec PairwisePL
readPrec :: ReadPrec PairwisePL
$creadListPrec :: ReadPrec [PairwisePL]
readListPrec :: ReadPrec [PairwisePL]
Read, Int -> PairwisePL -> String -> String
[PairwisePL] -> String -> String
PairwisePL -> String
(Int -> PairwisePL -> String -> String)
-> (PairwisePL -> String)
-> ([PairwisePL] -> String -> String)
-> Show PairwisePL
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PairwisePL -> String -> String
showsPrec :: Int -> PairwisePL -> String -> String
$cshow :: PairwisePL -> String
show :: PairwisePL -> String
$cshowList :: [PairwisePL] -> String -> String
showList :: [PairwisePL] -> String -> String
Show)

lengthPW :: PairwisePL -> Int
lengthPW :: PairwisePL -> Int
lengthPW (PW Char
_ Int
l [Int]
_) = Int
l

charPW :: PairwisePL -> Char
charPW :: PairwisePL -> Char
charPW (PW Char
c Int
_ [Int]
_) = Char
c

listPW :: PairwisePL -> [Int]
listPW :: PairwisePL -> [Int]
listPW (PW Char
_ Int
_ [Int]
xs) = [Int]
xs

data PairwiseC = LL [PairwisePL] Int deriving (PairwiseC -> PairwiseC -> Bool
(PairwiseC -> PairwiseC -> Bool)
-> (PairwiseC -> PairwiseC -> Bool) -> Eq PairwiseC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PairwiseC -> PairwiseC -> Bool
== :: PairwiseC -> PairwiseC -> Bool
$c/= :: PairwiseC -> PairwiseC -> Bool
/= :: PairwiseC -> PairwiseC -> Bool
Eq, ReadPrec [PairwiseC]
ReadPrec PairwiseC
Int -> ReadS PairwiseC
ReadS [PairwiseC]
(Int -> ReadS PairwiseC)
-> ReadS [PairwiseC]
-> ReadPrec PairwiseC
-> ReadPrec [PairwiseC]
-> Read PairwiseC
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PairwiseC
readsPrec :: Int -> ReadS PairwiseC
$creadList :: ReadS [PairwiseC]
readList :: ReadS [PairwiseC]
$creadPrec :: ReadPrec PairwiseC
readPrec :: ReadPrec PairwiseC
$creadListPrec :: ReadPrec [PairwiseC]
readListPrec :: ReadPrec [PairwiseC]
Read, Int -> PairwiseC -> String -> String
[PairwiseC] -> String -> String
PairwiseC -> String
(Int -> PairwiseC -> String -> String)
-> (PairwiseC -> String)
-> ([PairwiseC] -> String -> String)
-> Show PairwiseC
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PairwiseC -> String -> String
showsPrec :: Int -> PairwiseC -> String -> String
$cshow :: PairwiseC -> String
show :: PairwiseC -> String
$cshowList :: [PairwiseC] -> String -> String
showList :: [PairwiseC] -> String -> String
Show)

isCorrectPWC :: PairwiseC -> Bool
isCorrectPWC :: PairwiseC -> Bool
isCorrectPWC (LL [PairwisePL]
xs Int
n) = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((PairwisePL -> Int) -> [PairwisePL] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PairwisePL -> Int
lengthPW [PairwisePL]
xs)

pwsC :: PairwiseC -> [PairwisePL]
pwsC :: PairwiseC -> [PairwisePL]
pwsC (LL [PairwisePL]
xs Int
n) = (PairwisePL -> PairwisePL) -> [PairwisePL] -> [PairwisePL]
forall a b. (a -> b) -> [a] -> [b]
map (\(PW Char
c Int
m [Int]
ys) -> Char -> Int -> [Int] -> PairwisePL
PW Char
c Int
n ([Int] -> PairwisePL) -> ([Int] -> [Int]) -> [Int] -> PairwisePL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n ([Int] -> PairwisePL) -> [Int] -> PairwisePL
forall a b. (a -> b) -> a -> b
$ [Int]
ys) [PairwisePL]
xs

pairs' :: PairwiseC -> Char -> [Int]
pairs' :: PairwiseC -> Char -> [Int]
pairs' y :: PairwiseC
y@(LL [PairwisePL]
xs Int
n) Char
x
    | PairwiseC -> Bool
isCorrectPWC PairwiseC
y =
        let z :: Maybe PairwisePL
z = (PairwisePL -> Bool) -> [PairwisePL] -> Maybe PairwisePL
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x) (Char -> Bool) -> (PairwisePL -> Char) -> PairwisePL -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PairwisePL -> Char
charPW) ([PairwisePL] -> Maybe PairwisePL)
-> (PairwiseC -> [PairwisePL]) -> PairwiseC -> Maybe PairwisePL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PairwiseC -> [PairwisePL]
pwsC (PairwiseC -> Maybe PairwisePL) -> PairwiseC -> Maybe PairwisePL
forall a b. (a -> b) -> a -> b
$ PairwiseC
y
         in if Maybe PairwisePL -> Bool
forall a. Maybe a -> Bool
isJust Maybe PairwisePL
z
                then PairwisePL -> [Int]
listPW (PairwisePL -> [Int])
-> (Maybe PairwisePL -> PairwisePL) -> Maybe PairwisePL -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PairwisePL -> PairwisePL
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PairwisePL -> [Int]) -> Maybe PairwisePL -> [Int]
forall a b. (a -> b) -> a -> b
$ Maybe PairwisePL
z
                else Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
n Int
0
    | Bool
otherwise =
        String -> [Int]
forall a. HasCallStack => String -> a
error String
"Aftovolio.RGLPK.General.pairs': Not defined for the arguments. "

-- | Actually @n@ is a 'length' bss.
matrixLine ::
    -- | The number of 'pairs'' function elements in the lists.
    Int ->
    -- | Actually the data type value that sets the behaviour of the 'pairs'' function.
    PairwiseC ->
    [String] ->
    -- | A sorted list of the 'Char' representations of the phonetic language phenomenae.
    String ->
    String
matrixLine :: Int -> PairwiseC -> [String] -> String -> String
matrixLine Int
nn PairwiseC
pw [String]
bss String
js
    | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bss Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
    | Bool
otherwise =
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"mat1 <- matrix(c("
            , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "
                ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show
                ([Int] -> [String]) -> (String -> [Int]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Int]) -> String -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
                    (PairwiseC -> [String] -> String -> Char -> [Int]
matrix1Column PairwiseC
pw ([String]
bss [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` [String]
bss) String
js)
                (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
js
            , String
"), nrow = "
            , Int -> String
forall a. Show a => a -> String
show (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
js Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nn)
            , String
")"
            , String
newLineEnding
            ]
  where
    n :: Int
n = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
bss

objLine ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | List of pairs of indices that shows how the input data is related to the representation
    -- (which coefficients relates to which representation elements).
    [(Int, Int)] ->
    -- | An array of coefficients.
    Array Int Double ->
    String
objLine :: Int -> [(Int, Int)] -> Array Int Double -> String
objLine Int
lng [(Int, Int)]
xs Array Int Double
arr
    | Array Int Double -> Int
forall i e. Array i e -> Int
numElements Array Int Double
arr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lng =
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"obj1 <- c("
            , String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> (Array Int Double -> [String]) -> Array Int Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
t -> Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing Double
t String
"") ([Double] -> [String])
-> (Array Int Double -> [Double]) -> Array Int Double -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, Int)] -> Array Int Double -> [Double]
objCoeffsNew Int
lng [(Int, Int)]
xs (Array Int Double -> String) -> Array Int Double -> String
forall a b. (a -> b) -> a -> b
$
                Array Int Double
arr
            , String
")"
            , String
newLineEnding
            ]
    | Bool
otherwise =
        String -> String
forall a. HasCallStack => String -> a
error String
"Aftovolio.RGLPK.General.objLine: Not defined for the short argument. "

-- | A way to reorder the coefficients of the input and the elements representations related to each other.
objCoeffsNew ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | List of pairs of indices that shows how the input data is related to the representation
    -- (which coefficients relates to which representation elements).
    [(Int, Int)] ->
    -- | An array of coefficients.
    Array Int Double ->
    [Double]
objCoeffsNew :: Int -> [(Int, Int)] -> Array Int Double -> [Double]
objCoeffsNew Int
lng [(Int, Int)]
xs Array Int Double
arr =
    let lst :: [(Int, Double)]
lst = ((Int, Int) -> (Int, Double)) -> [(Int, Int)] -> [(Int, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x, Int
y) -> (Int
x, Array Int Double -> Int -> Double
forall i e. Array i e -> Int -> e
unsafeAt Array Int Double
arr Int
y)) [(Int, Int)]
xs
     in (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> [(Int, Double)] -> Int -> Double
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Double
1.0 [(Int, Double)]
lst) [Int
0 .. Int
lng Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

maxLine :: String
maxLine :: String
maxLine = String
"max1 <- TRUE\n"

dirLine ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | The number of 'pairs'' function elements in the lists.
    Int ->
    -- | An argument of the 'matrixLine' function.
    [String] ->
    -- | A sorted list of the 'Char' representations of the phonetic language phenomenae.
    String ->
    String
dirLine :: Int -> Int -> [String] -> String -> String
dirLine Int
lng Int
nn [String]
bss String
js =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"dir1 <- c(\"<"
        , String -> [String] -> String
forall {t :: * -> *} {a}. Foldable t => String -> t a -> String
g String
"<" [String]
bss
        , String
"\", \">"
        , String -> ([String], [String]) -> String
forall {t :: * -> *} {a}. Foldable t => String -> t a -> String
g String
">" ([String]
bss, (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
: []) String
js)
        , String
"\""
        , Int -> String
h0 Int
lng
        , Int -> String
h (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
nn Int
1)
        , String
")"
        , String
newLineEnding
        ]
  where
    g :: String -> t a -> String
g String
xs t a
ys = (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate (String
"\", \"" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
xs) ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ys) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"=")
    h :: Int -> String
h Int
n = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
", \">=\", \"<=\""
    h0 :: Int -> String
h0 Int
n = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
n (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
", \"<=\""

rhsLineG :: [Double] -> [Double] -> [Double] -> String
rhsLineG :: [Double] -> [Double] -> [Double] -> String
rhsLineG [Double]
zs [Double]
xs [Double]
ys = [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"rhs1 <- c(", [Double] -> String
forall {a}. RealFloat a => [a] -> String
f ([[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat [[Double]
xs, [Double]
ys, [Double]
zs]), String
")", String
newLineEnding]
  where
    f :: [a] -> String
f [a]
ts = (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> ([a] -> [String]) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\a
t -> Maybe Int -> a -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing a
t String
"") ([a] -> String) -> [a] -> String
forall a b. (a -> b) -> a -> b
$ [a]
ts)

rhsLine ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | The number of 'pairs'' function elements in the lists.
    Int ->
    -- | Maximum duration of the phonetic language element representation in seconds.
    Double ->
    -- | A minimum positive duration value for some group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for all other phonetic language representations (usually, some sorts of
    -- phonemes) to set a general (common) behaviour for the set of resulting values.
    Double ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the some group of representations (e. g. vowels).
    [Int] ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the special group of representations (e. g. soft sign).
    [Int] ->
    [Double] ->
    [Double] ->
    String
rhsLine :: Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> [Double]
-> [Double]
-> String
rhsLine Int
lng Int
nn Double
mx Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 =
    [Double] -> [Double] -> [Double] -> String
rhsLineG ([Double] -> [Double] -> [Double] -> String)
-> ([[Double]] -> [Double])
-> [[Double]]
-> [Double]
-> [Double]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double] -> [Double] -> String)
-> [[Double]] -> [Double] -> [Double] -> String
forall a b. (a -> b) -> a -> b
$
        [ Int -> Double -> Double -> Double -> [Int] -> [Int] -> [Double]
minDurations Int
lng Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1
        , Int -> Double -> [Double]
maxDurations Int
lng Double
mx
        , Int -> [Double]
constraintsR1 (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
nn Int
1)
        ]

constraintsR1 :: Int -> [Double]
constraintsR1 :: Int -> [Double]
constraintsR1 Int
n = Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Double
0.0

minDurations ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | A minimum positive duration value for some group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for all other phonetic language representations (usually, some sorts of
    -- phonemes) to set a general (common) behaviour for the set of resulting values.
    Double ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the some group of representations (e. g. vowels).
    [Int] ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the special group of representations (e. g. soft sign).
    [Int] ->
    [Double]
minDurations :: Int -> Double -> Double -> Double -> [Int] -> [Int] -> [Double]
minDurations Int
lng Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Double
h [Int
0 .. Int
lng Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
  where
    xs2 :: [Int]
xs2
        | [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
xs1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lng Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) [Int]
xs1
        | Bool
otherwise =
            String -> [Int]
forall a. HasCallStack => String -> a
error String
"Aftovolio.RGLPK.General.objLine: Not defined for these arguments. "
    sps2 :: [Int]
sps2
        | [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
sps1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
lng Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) [Int]
sps1 [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
xs2
        | Bool
otherwise =
            String -> [Int]
forall a. HasCallStack => String -> a
error String
"Aftovolio.RGLPK.General.objLine: Not defined for these arguments. "
    h :: Int -> Double
h Int
i
        | Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
xs2 = Double
mn1
        | Int
i Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
sps2 = Double
mnSpecial
        | Bool
otherwise = Double
mnG

maxDurations ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | Maximum duration of the phonetic language element representation in seconds.
    Double ->
    [Double]
maxDurations :: Int -> Double -> [Double]
maxDurations Int
lng Double
mx = Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
lng Double
mx

{- | A variant of the more general 'answer2' where the predefined randomization parameters are used to produce every time being run
a new result (e. g. this allows to model accents).
-}
answer ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | The number of 'pairs'' function elements in the lists.
    Int ->
    -- | Actually the data type value that sets the behaviour of the 'pairs'' function.
    PairwiseC ->
    -- | Maximum duration of the phonetic language element representation in seconds.
    Double ->
    -- | List of pairs of indices that shows how the input data is related to the representation
    -- (which coefficients relates to which representation elements).
    [(Int, Int)] ->
    -- | A minimum positive duration value for some group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for all other phonetic language representations (usually, some sorts of
    -- phonemes) to set a general (common) behaviour for the set of resulting values.
    Double ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the some group of representations (e. g. vowels).
    [Int] ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the special group of representations (e. g. soft sign).
    [Int] ->
    -- | An array of coefficients.
    Array Int Double ->
    -- | An argument of the 'matrixLine' function.
    [String] ->
    [Double] ->
    [Double] ->
    -- | A sorted list of the 'Char' representations of the phonetic language phenomenae.
    String ->
    String
answer :: Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> String
-> String
answer Int
lng Int
nn PairwiseC
pw Double
mx [(Int, Int)]
ts = Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> String
-> String
answer2 Int
lng Int
nn PairwiseC
pw Double
mx [(Int, Int)]
ts (-Double
0.003) Double
0.003 (-Double
0.0012) Double
0.0012

answer2 ::
    -- | The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that
    -- appears in the file with test words and their spoken durations.
    Int ->
    -- | The number of 'pairs'' function elements in the lists.
    Int ->
    -- | Actually the data type value that sets the behaviour of the 'pairs'' function.
    PairwiseC ->
    -- | Maximum duration of the phonetic language element representation in seconds.
    Double ->
    -- | List of pairs of indices that shows how the input data is related to the representation
    -- (which coefficients relates to which representation elements).
    [(Int, Int)] ->
    -- | A maximum in absolute value (being, usually, a negative one) possible random deviation from the computed value to be additionally applied to emulate
    -- 'more natural' behaviour and to get every time while running new sets of values.
    Double ->
    -- | A maximum in absolute value (being, usually, a positive one) possible random deviation from the computed value to be additionally applied to emulate
    -- 'more natural' behaviour and to get every time while running new sets of values.
    Double ->
    -- | A minimum in absolute value (being, usually, a negative one) possible random deviation from the computed value to be
    -- additionally applied to emulate 'more natural' behaviour and to get every time while running new sets of values.
    Double ->
    -- | A minimum in absolute value (being, usually, a positive one) possible random deviation from the computed value to be
    -- additionally applied to emulate 'more natural' behaviour and to get every time while running new sets of values.
    Double ->
    -- | A minimum positive duration value for some group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of
    -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.
    Double ->
    -- | A minimum positive duration value for all other phonetic language representations (usually, some sorts of
    -- phonemes) to set a general (common) behaviour for the set of resulting values.
    Double ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the some group of representations (e. g. vowels).
    [Int] ->
    -- | A list of indices of the phonetic languages representations in their sorted in ascending order sequence that
    -- corresponds to the elements from the special group of representations (e. g. soft sign).
    [Int] ->
    -- | An array of coefficients.
    Array Int Double ->
    -- | An argument of the 'matrixLine' function.
    [String] ->
    [Double] ->
    [Double] ->
    -- | A sorted list of the 'Char' representations of the phonetic language phenomenae.
    String ->
    String
answer2 :: Int
-> Int
-> PairwiseC
-> Double
-> [(Int, Int)]
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> Array Int Double
-> [String]
-> [Double]
-> [Double]
-> String
-> String
answer2 Int
lng Int
nn PairwiseC
pw Double
mx [(Int, Int)]
ts Double
min1 Double
max1 Double
min2 Double
max2 Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 Array Int Double
lsts [String]
bss [Double]
xs [Double]
ys String
js =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"library(\"Rglpk\")"
        , String
newLineEnding
        , Int -> [(Int, Int)] -> Array Int Double -> String
objLine Int
lng [(Int, Int)]
ts Array Int Double
lsts
        , Int -> PairwiseC -> [String] -> String -> String
matrixLine Int
nn PairwiseC
pw [String]
bss String
js
        , Int -> Int -> [String] -> String -> String
dirLine Int
lng Int
nn [String]
bss String
js
        , Int
-> Int
-> Double
-> Double
-> Double
-> Double
-> [Int]
-> [Int]
-> [Double]
-> [Double]
-> String
rhsLine Int
lng Int
nn Double
mx Double
mn1 Double
mnSpecial Double
mnG [Int]
xs1 [Int]
sps1 [Double]
xs [Double]
ys
        , String
maxLine
        , String
newLineEnding
        , String
"k <- Rglpk_solve_LP(obj = obj1, mat = mat1, dir = dir1, rhs = rhs1, max = max1)"
        , String
newLineEnding
        , String
"y <- runif("
        , Int -> String
forall a. Show a => a -> String
show Int
lng
        , String
", min = "
        , Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing (-(Double -> Double
forall a. Num a => a -> a
abs Double
min1)) String
", max = "
        , Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat Maybe Int
forall a. Maybe a
Nothing (Double -> Double
forall a. Num a => a -> a
abs Double
max1) String
")"
        , String
newLineEnding
        , String
"if (k$status == 0){k$solution / mean(k$solution)} else {c()}"
        , String
newLineEnding
        , String
"\")}"
        ]

-- read ("SylS {charS=\'k\', phoneType=P 6")::PRS