r-glpk-phonetic-languages-ukrainian-durations 0.1.3.0 → 0.1.4.0
raw patch · 3 files changed
+32/−11 lines, 3 filesdep +lists-flinesdep ~ukrainian-phonetics-basicPVP ok
version bump matches the API change (PVP)
Dependencies added: lists-flines
Dependency ranges changed: ukrainian-phonetics-basic
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- Numeric/Wrapper/R/GLPK/Phonetics/Ukrainian/Durations.hs +24/−8
- r-glpk-phonetic-languages-ukrainian-durations.cabal +3/−3
CHANGELOG.md view
@@ -15,3 +15,8 @@ ## 0.1.3.0 -- 2020-11-09 * First version revised C. Some code improvements. Some documentation improvements.++## 0.1.4.0 -- 2020-11-10++* 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.
Numeric/Wrapper/R/GLPK/Phonetics/Ukrainian/Durations.hs view
@@ -19,7 +19,7 @@ -- -- For more information, please, see the documentation for them. ----- For the model correctness the js here refers to \"ABCEFXYabcdefghijklmnopqrstuvwxyz\".+-- For the model correctness the js here refers to \"ABCEFXYabcdefghijklmnopqrstuvxyz\". -- To get such js some of the Ukrainian words in the abovementioned file must contain an apostrophe and there should be -- somewhat like \"їх_друг\". @@ -40,6 +40,7 @@ import qualified Data.Vector as VB import Numeric import Data.List (intercalate)+import Data.Lists.FLines (newLineEnding) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__==708 /* code that applies only to GHC 7.8.* */@@ -47,6 +48,7 @@ #endif #endif + createCoeffsObj :: Int -> [String] -> [Double] createCoeffsObj l xss | length xss < l = f (xss `mappend` replicate (l - length xss) "1.0")@@ -93,11 +95,11 @@ matrixLine :: [String] -> String -> Int -> String matrixLine bss js n | null bss || n <=0 = []- | otherwise = "mat1 <- matrix(c(" `mappend` (intercalate ", " . map show $ (concatMap (matrix1Column (bss `mappend` bss) js) js)) `mappend` "), nrow = " `mappend` show (2 * n + 2 * length js + 24) `mappend` ")\n"+ | otherwise = "mat1 <- matrix(c(" `mappend` (intercalate ", " . map show $ (concatMap (matrix1Column (bss `mappend` bss) js) js)) `mappend` "), nrow = " `mappend` show (2 * n + 2 * length js + 24) `mappend` ")" `mappend` newLineEnding objLine :: VB.Vector Double -> String objLine v- | VB.length v >= 32 = "obj1 <- c(" `mappend` (intercalate ", " . map (\t -> showFFloat Nothing t "") $ objCoeffs v) `mappend` ")\n"+ | VB.length v >= 32 = "obj1 <- c(" `mappend` (intercalate ", " . map (\t -> showFFloat Nothing t "") $ objCoeffs v) `mappend` ")" `mappend` newLineEnding | otherwise = error "Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations.objLine: Not defined for the short argument. " objCoeffs :: VB.Vector Double -> [Double]@@ -115,13 +117,13 @@ maxLine = "max1 <- TRUE\n" dirLine :: [String] -> String -> String-dirLine bss js = "dir1 <- c(\"<" `mappend` g "<" bss `mappend` "\", \">" `mappend` g ">" (bss `mappend` map (:[]) js) `mappend` "\"" `mappend` h0 32 `mappend` h 12 `mappend` ")\n"+dirLine bss js = "dir1 <- c(\"<" `mappend` g "<" bss `mappend` "\", \">" `mappend` g ">" (bss `mappend` map (:[]) js) `mappend` "\"" `mappend` h0 32 `mappend` h 12 `mappend` ")" `mappend` newLineEnding where g xs ys = (intercalate ("\", \"" `mappend` xs) . replicate (length ys) $ "=") h n = concat . replicate n $ ", \">=\", \"<=\"" h0 n = concat . replicate n $ ", \"<=\"" rhsLineG :: [Double] -> [Double] -> [Double] -> String-rhsLineG zs xs ys = "rhs1 <- c(" `mappend` f (xs `mappend` ys `mappend` zs) `mappend` ")\n"+rhsLineG zs xs ys = "rhs1 <- c(" `mappend` f (xs `mappend` ys `mappend` zs) `mappend` ")" `mappend` newLineEnding where f ts = (intercalate ", " . map (\t -> showFFloat Nothing t "") $ ts) rhsLine :: [Double] -> [Double] -> String@@ -141,9 +143,23 @@ maxDurations = replicate 32 0.3 answer :: VB.Vector Double -> [String] -> [Double] -> [Double] -> String -> String-answer lsts bss xs ys js = mconcat ["library(\"Rglpk\")\n",objLine lsts,matrixLine bss js (length bss),dirLine bss js,rhsLine xs ys,maxLine,- "\nk <- Rglpk_solve_LP(obj = obj1, mat = mat1, dir = dir1, rhs = rhs1, max = max1)\ny <- runif(32, min = -0.012, max = 0.012)\nif (k$status == 0){k$solution / mean(k$solution)} else {c()}",- "\nif (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()}\n"]+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,+ "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), ",+ "(UZ \'b\' D, %.8f), (UZ \'b\' K, %.8f), (UZ \'c\' D, %.8f), (UZ \'d\' D, %.8f), (UZ \'d\' K, %.8f), (UZ \'e\' W, %.8f), (UZ \'f\' L, %.8f), ",+ "(UZ \'f\' M, %.8f), (UZ \'g\' D, %.8f), (UZ \'g\' K, %.8f), (UZ \'h\' D, %.8f), (UZ \'h\' K, %.8f), (UZ \'i\' W, %.8f), (UZ \'j\' D, %.8f),",+ " (UZ \'j\' K, %.8f), (UZ \'k\' L, %.8f), (UZ \'k\' M, %.8f), (UZ \'l\' S, %.8f), (UZ \'l\' O, %.8f), (UZ \'m\' S, %.8f), ",+ "(UZ \'m\' O, %.8f), (UZ \'n\' S, %.8f), (UZ \'n\' O, %.8f), (UZ \'o\' W, %.8f), (UZ \'p\' L, %.8f), (UZ \'p\' M, %.8f), ",+ "(UZ \'q\' E, %.8f), (UZ \'r\' S, %.8f), (UZ \'r\' O, %.8f), (UZ \'s\' L, %.8f), (UZ \'t\' L, %.8f), (UZ \'t\' M, %.8f), ",+ "(UZ \'u\' W, %.8f), (UZ \'v\' S, %.8f), (UZ \'v\' O, %.8f), (UZ \'w\' N, %.8f), (UZ \'x\' L, %.8f), (UZ \'x\' M, %.8f), ",+ "(UZ \'y\' W, %.8f), (UZ \'z\' D, %.8f), (UZ \'z\' K, %.8f)])\",(z[6] + z[7]) / 2,z[1],z[1],z[2],z[2],z[3],z[26]+z[24],",+ "z[4],z[4],z[5],z[5],z[8],z[9],z[9],z[10],z[11],z[11],z[12],z[13],z[13],z[14],z[14],z[15],z[15],z[16],z[17],z[17],z[18],",+ "z[18],z[19],z[19],z[20],z[20],z[21],z[21],z[22],z[23],z[23],z[24],z[25],z[25],z[26],z[27],z[27],z[28],z[29],z[29],",+ "z[10]+z[24],z[30],z[30],z[31],z[32],z[32])} else {print(\"", newLineEnding, "\")}"] charReplace :: [Char] -> [Char] charReplace = concatMap g
r-glpk-phonetic-languages-ukrainian-durations.cabal view
@@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/ name: r-glpk-phonetic-languages-ukrainian-durations-version: 0.1.3.0+version: 0.1.4.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@@ -21,7 +21,7 @@ exposed-modules: Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations other-modules: Main other-extensions: CPP- build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn2 >=0.3 && <1, ukrainian-phonetics-basic >=0.2.0.1 && <1+ build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn2 >=0.3 && <1, ukrainian-phonetics-basic >=0.2.0.2 && <1, lists-flines >=0.1.1 && <1 -- hs-source-dirs: default-language: Haskell2010 @@ -29,6 +29,6 @@ main-is: Main.hs other-modules: Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations -- other-extensions:- build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn2 >=0.3 && <1, ukrainian-phonetics-basic >=0.2.0.1 && <1+ build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn2 >=0.3 && <1, ukrainian-phonetics-basic >=0.2.0.2 && <1, lists-flines >=0.1.1 && <1 -- hs-source-dirs: default-language: Haskell2010