-- |
-- Module : Main
-- Copyright : (c) Oleksandr Zhabenko 2020-2023
-- License : MIT
-- Stability : Experimental
-- Maintainer : oleksandr.zhabenko@yahoo.com
--
-- Can be used to calculate the approximations of the Ukrainian 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
-- Ukrainian word and its duration in seconds separated with whitespace.
--
-- The executable 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.
--
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK -show-extensions #-}
module Main where
import GHC.Base
import GHC.Real ((/))
import GHC.Float (sqrt)
import GHC.Num ((*),(-),abs)
import System.IO
import Data.Char (isAlpha)
import Phladiprelio.RGLPK.Ukrainian
import System.Environment (getArgs)
import GHC.Arr
import Text.Read
import Data.List
import Data.Maybe (fromMaybe)
import Phladiprelio.Ukrainian.Melodics
main :: IO ()
main = do
args <- getArgs
if any isAlpha (concat . take 1 $ args) then processMentG args
else do
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
processMentG :: [String] -> IO ()
processMentG ts = do
let file = concat . take 1 $ ts
contents <- readFile file
let coeff = fromMaybe (sqrt 2.0) ((readMaybe (concat . drop 1 . take 2 $ ts))::Maybe Double)
lst0 = createCoeffsObj 32 (drop 2 ts)
ll = length lst0 - 1
lstCfs = listArray (0,ll) lst0
xss = map words . lines $ contents
words2 = map head xss
lengths0 = map ((\ts -> read ts::Double) . last) xss
bss = map (sort . charReplace . map s8toChar . convertToProperUkrainianI8) words2
js = tail . nub . sort . unwords $ bss
putStrLn . answer lstCfs bss (map (*coeff) lengths0) (map (* (1.0 / coeff)) lengths0) $ js