r-glpk-phonetic-languages-ukrainian-durations 0.1.4.0 → 0.2.0.0

raw patch · 4 files changed

+36/−9 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• Main.hs +16/−4
• Numeric/Wrapper/R/GLPK/Phonetics/Ukrainian/Durations.hs +11/−4
• r-glpk-phonetic-languages-ukrainian-durations.cabal +1/−1

@@ -20,3 +20,11 @@  * First version revised D. Added printing for the ready inner in the getBFst' function tuple. Fixed issue with inexact documentation. Added lists-flines as a new leightweight dependency. Improved printing system for various OSes.++## 0.2.0.0 -- 2020-11-10++* Second version. Added a new function answer2 that allows to change the randomization boundaries for the model (this allows, e. g. to research accents). Added the possibility to +specify up to 4 randomization boundaries as the 4 first command line arguments (otherwise, the default values are used). Please, be aware of possible violating the dependencies +between durations of the sounds because of inappropriately chosen randomization parameters (sometimes the dependencies can violate also for the appropriately chosen durations +though it less common in such a case). +

@@ -23,6 +23,7 @@  module Main where +import Data.Char (isAlpha) import Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations import System.Environment (getArgs) import qualified Data.Vector as VB@@ -34,11 +35,22 @@  main :: IO () main = do-  args <- getArgs-  let file = concat . take 1 $ args+ 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.012) (readMaybe (concat . drop 2 . take 3 $ args)::Maybe Double))+      max2 = abs (fromMaybe 0.012 (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 1.2 ((readMaybe (concat . drop 1 . take 2 $ args))::Maybe Double)-      lst0 = createCoeffsObj 32 (drop 2 args)+  let coeff = fromMaybe (sqrt 2.0) ((readMaybe (concat . drop 1 . take 2 $ ts))::Maybe Double)+      lst0 = createCoeffsObj 32 (drop 2 ts)       lstCfs = VB.fromList lst0       xss = map words . lines $ contents       words2 = map head xss

@@ -142,11 +142,18 @@ maxDurations :: [Double] maxDurations = replicate 32 0.3 +-- | A variant of the more general 'answer2' where the randomization parameters are used to produce every time being run a new result (e. g. this+-- allows to model accents). answer :: VB.Vector Double -> [String] -> [Double] -> [Double] -> String -> String-answer lsts bss xs ys js = mconcat ["library(\"Rglpk\")",newLineEnding,objLine lsts,matrixLine bss js (length bss),dirLine bss js,rhsLine xs ys,maxLine,-  newLineEnding,"k <- Rglpk_solve_LP(obj = obj1, mat = mat1, dir = dir1, rhs = rhs1, max = max1)",newLineEnding,"y <- runif(32, min = -0.012, max = 0.012)",-   newLineEnding,"if (k$status == 0){k$solution / mean(k$solution)} else {c()}",newLineEnding,-    "if (k$status == 0){z<- k$solution * 0.02 / k$solution[24] + y; z[24] <- 0.02 + runif(1, min = -0.003, max = 0.003); z;} else {c()}",newLineEnding,+answer = answer2 (-0.003) 0.003 (-0.012) 0.012++answer2 :: Double -> Double -> Double -> Double -> VB.Vector Double -> [String] -> [Double] -> [Double] -> String -> String+answer2 min1 max1 min2 max2 lsts bss xs ys js = mconcat ["library(\"Rglpk\")",newLineEnding,objLine lsts,matrixLine bss js (length bss),dirLine bss js,+ rhsLine xs ys,maxLine,newLineEnding,"k <- Rglpk_solve_LP(obj = obj1, mat = mat1, dir = dir1, rhs = rhs1, max = max1)",newLineEnding,+  "y <- runif(32, min = ",showFFloat Nothing (-(abs min1)) ", max = ", showFFloat Nothing (abs max1) ")", newLineEnding,+   "if (k$status == 0){k$solution / mean(k$solution)} else {c()}", newLineEnding,+    "if (k$status == 0){z<- k$solution * 0.02 / k$solution[24] + y; z[24] <- 0.02 + runif(1, min = ", showFFloat Nothing (- (abs min2)) ", max = ",+     showFFloat Nothing (abs max2) "); z;} else {c()}",newLineEnding,       "if (k$status == 0){sprintf(\"uzpp2DurationN = X.getBFst\' (%.8f, VB.fromList [(UZ \'A\' D, %.8f), (UZ \'A\' K, %.8f), (UZ \'B\' D, %.8f), ",        "(UZ \'B\' K, %.8f), (UZ \'C\' S, %.8f), (UZ \'D\' N, %.8f), (UZ \'E\' L, %.8f), (UZ \'E\' M, %.8f), (UZ \'F\' L, %.8f), (UZ \'F\' M, %.8f), ",         "(UZ \'a\' W, %.8f), ",

@@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/  name:                r-glpk-phonetic-languages-ukrainian-durations-version:             0.1.4.0+version:             0.2.0.0 synopsis:            Can be used to calculate the durations of the approximations of the Ukrainian phonemes. description:         Can be used to calculate the durations of 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. homepage:            https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations