-- |
-- Module : Main
-- Copyright : (c) OleksandrZhabenko 2020-2021
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@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 Main where
import Data.Char (isAlpha)
import Numeric.Wrapper.R.GLPK.Phonetic.Languages.Durations
import System.Environment (getArgs)
import GHC.Arr
import Text.Read
import Data.List
import GHC.Int
import Data.Maybe (fromMaybe,fromJust)
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.SpecificationsRead
main :: IO ()
main = do
args <- getArgs
let min1 = - abs (fromMaybe (-0.003) (readMaybe (concat . take 1 $ args)::Maybe Double))
max1 = abs (fromMaybe 0.003 (readMaybe (concat . drop 1. take 2 $ args)::Maybe Double))
min2 = - abs (fromMaybe (-0.0012) (readMaybe (concat . drop 2 . take 3 $ args)::Maybe Double))
max2 = abs (fromMaybe 0.0012 (readMaybe (concat . drop 3 . take 4 $ args)::Maybe Double))
arGs = dropWhile (all (not . isAlpha)) args
processMentG arGs min1 max1 min2 max2
processMentG :: [String] -> Double -> Double -> Double -> Double -> IO ()
processMentG ts min1 max1 min2 max2 = do
let file = concat . take 1 $ ts
controlFile = concat . drop 1 . take 2 $ ts
gwritingsysFile = concat . drop 2 . take 3 $ ts
contents <- readFile file
controlConts <- readFile controlFile
gwrsCnts <- readFile gwritingsysFile
let [pwHeader, objCfs, xs1sps1s] = groupBetweenChars '~' . lines $ controlConts
gwrs = getGWritingSystem '~' gwrsCnts
nn = fromMaybe 1 (readMaybe (concat . take 1 $ pwHeader)::Maybe Int)
pw = LL (map (\zzs -> read zzs::PairwisePL) . drop 1 $ pwHeader) nn
gs = fromMaybe [] (readMaybe (concat objCfs)::Maybe [(Int,Int)])
xs1 = fromMaybe [] (readMaybe (concat . take 1 $ xs1sps1s)::Maybe [Int])
sps1 = fromMaybe [] (readMaybe (concat . drop 1 . take 2 $ xs1sps1s)::Maybe [Int])
[mx,mn1,mnSpecial,mnG] = map (\s -> fromJust (readMaybe s::Maybe Double)) . drop 3 . take 7 $ ts
coeff = fromMaybe (sqrt 2.0) ((readMaybe (concat . drop 7 . take 8 $ ts))::Maybe Double)
lst0 = createCoeffsObj lng (drop 7 ts)
ll = length lst0 - 1
lstCfs = listArray (0,ll) lst0
xss = map words . lines $ contents
words2 = map head xss
lengths0 = map ((\rs -> read rs::Double) . last) xss
bss = map (sort . map char . stringToXG gwrs) words2
js = tail . nub . sort . unwords $ bss
lng = length js
putStrLn . answer2 lng nn pw mx gs min1 max1 min2 max2 mn1 mnSpecial mnG xs1 sps1 {- <--- new coeffs-} lstCfs bss (map (*coeff) lengths0) (map (* (1.0 / coeff)) lengths0) $ js
-- Example of usage: pldPL 0.001 0.001 0.01 0.02 words.txt controlData.txt gwrsys.txt 0.3 0.2 0.02 0.06 1.8 -1 0.01 0.01 2.5 2.5 2.5 2.5 2.5 2.5