r-glpk-phonetic-languages-ukrainian-durations 0.2.2.0 → 0.3.0.0

raw patch · 4 files changed

+49/−34 lines, 4 filesdep +foldable-ixdep +mmsyn2-arraydep +ukrainian-phonetics-basic-arraydep −mmsyn2dep −ukrainian-phonetics-basicdep −vectordep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: foldable-ix, mmsyn2-array, ukrainian-phonetics-basic-array

Dependencies removed: mmsyn2, ukrainian-phonetics-basic, vector

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• Main.hs +5/−4
• Numeric/Wrapper/R/GLPK/Phonetics/Ukrainian/Durations.hs +37/−27
• r-glpk-phonetic-languages-ukrainian-durations.cabal +3/−3

@@ -36,3 +36,7 @@  * Second version revised B. Extended the README.md with some basic examples of the pldUkr usage. +## 0.3.0.0 -- 2021-01-02++* Third version. Removed vector-related functionality and changed it to the array-based. Improved the pairs construction+for the 'ф' -- 'в' pair (It is phonetically, actually, not in Ukraniian, but it is connected for being more defined). Added a lightweight dependency of foldable-ix package.

@@ -26,11 +26,11 @@ import Data.Char (isAlpha) import Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations import System.Environment (getArgs)-import qualified Data.Vector as VB+import GHC.Arr import Text.Read import Data.List import Data.Maybe (fromMaybe)-import Melodics.ByteString.Ukrainian+import Melodics.ByteString.Ukrainian.Arr   main :: IO ()@@ -51,11 +51,12 @@   contents <- readFile file   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+      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 . convertToProperUkrainianS) words2-      js = tail . VB.toList . VB.uniq . VB.fromList . sort . unwords $ bss+      js = tail . nub . sort . unwords $ bss   putStrLn . answer lstCfs bss (map (*coeff) lengths0) (map (* (1.0 / coeff)) lengths0) $ js 

@@ -1,3 +1,6 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK show-extensions #-}+ -- | -- Module      :  Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations -- Copyright   :  (c) OleksandrZhabenko 2020@@ -23,8 +26,6 @@ -- To get such js some of the Ukrainian words in the abovementioned file must contain an apostrophe and there should be -- somewhat like \"їх_друг\". -{-# LANGUAGE CPP #-}- module Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations where  #ifdef __GLASGOW_HASKELL__@@ -36,11 +37,13 @@ import Data.Monoid hiding (mconcat) import Text.Read import Data.Maybe-import CaseBi (getBFst')-import qualified Data.Vector as VB+import CaseBi.Arr (getBFstL')+import Data.Foldable (foldl')+import GHC.Arr import Numeric import Data.List (intercalate) import Data.Lists.FLines (newLineEnding)+import Data.Foldable.Ix (findIdx1) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__==708 /* code that applies only to GHC 7.8.* */@@ -48,7 +51,6 @@ #endif #endif - createCoeffsObj :: Int -> [String] -> [Double] createCoeffsObj l xss   | length xss < l = f (xss  `mappend`  replicate (l - length xss) "1.0")@@ -63,16 +65,20 @@ matrix1Column :: [String] -> String -> Char -> [Int] matrix1Column xss js x = pairwiseComparings x (countCharInWords xss x  `mappend`  rs  `mappend`  rs)   where l =  length js-        iX = fromMaybe (-l - 1) (VB.findIndex (== x) . VB.fromList $ js)+        iX = fromMaybe (-l - 1) . findIdx1 x $ js         rs = if iX < 0 then [] else replicate iX 0  `mappend`  [1]  `mappend`  replicate (l - 1 - iX) 0  pairwiseComparings :: Char -> [Int] -> [Int] pairwiseComparings x ys = ys `mappend` pairs' x +{-| @since 0.3.0.0+Changed the \'f\' -- \'v\' (\'ф\' -- \'в\') proportions. The Ukrainian \'в\' is almost always shorter than+\'ф\'.+-} pairs' :: Char -> [Int] pairs' x   | x == 'f' =  [10,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]-  | x == 'v' =  [-5,-20,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]+  | x == 'v' =  [-9,-20,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]   | x == 'x' =  [0,0,10,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]   | x == 'h' =  [0,0,-7,-13,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]   | x == 'g' =  [0,0,0,0,10,10,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]@@ -97,21 +103,28 @@   | 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`  ")" `mappend` newLineEnding -objLine :: VB.Vector Double -> String+{-| @since 0.3.0.0+Switched to the array representation as the cheaper one.+-}+objLine :: Array Int Double -> String objLine v- | VB.length v >= 32 = "obj1 <- c("  `mappend`  (intercalate ", " . map (\t -> showFFloat Nothing t "") $ objCoeffs v)  `mappend`  ")" `mappend` newLineEnding+ | 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]-objCoeffs v =-  let tuple = (1.0,VB.fromList [(0, VB.unsafeIndex v 14), (1, VB.unsafeIndex v 16), (2, VB.unsafeIndex v 9), (3, VB.unsafeIndex v 17),-        (4, VB.unsafeIndex v 18), (5, VB.unsafeIndex v 1), (6, VB.unsafeIndex v 2), (7, VB.unsafeIndex v 3), (8, VB.unsafeIndex v 19),-          (9, VB.unsafeIndex v 20), (10, VB.unsafeIndex v 21), (11, VB.unsafeIndex v 4), (12, VB.unsafeIndex v 22), (13, VB.unsafeIndex v 23),-            (14, VB.unsafeIndex v 24), (15, VB.unsafeIndex v 5), (16, VB.unsafeIndex v 25), (17, VB.unsafeIndex v 26), (18, VB.unsafeIndex v 10),-              (19, VB.unsafeIndex v 11), (20, VB.unsafeIndex v 12), (21, VB.unsafeIndex v 6), (22, VB.unsafeIndex v 27), (23, VB.unsafeIndex v 0),-                (24, VB.unsafeIndex v 13), (25, VB.unsafeIndex v 28), (26, VB.unsafeIndex v 29), (27, VB.unsafeIndex v 7), (28, VB.unsafeIndex v 14),-                  (29, VB.unsafeIndex v 30), (30, VB.unsafeIndex v 8), (31, VB.unsafeIndex v 31)]) in-                     VB.toList . VB.take 32 . VB.map (getBFst' tuple) . VB.enumFromTo 0 $ 31+{-| @since 0.3.0.0+Switched to the array representation as the cheaper one.+-}+objCoeffs :: Array Int Double -> [Double]+objCoeffs arr =+  let lst = [(0, unsafeAt arr 14), (1, unsafeAt arr 16), (2, unsafeAt arr 9), (3, unsafeAt arr 17),+        (4, unsafeAt arr 18), (5, unsafeAt arr 1), (6, unsafeAt arr 2), (7, unsafeAt arr 3), (8, unsafeAt arr 19),+          (9, unsafeAt arr 20), (10, unsafeAt arr 21), (11, unsafeAt arr 4), (12, unsafeAt arr 22),+           (13, unsafeAt arr 23), (14, unsafeAt arr 24), (15, unsafeAt arr 5), (16, unsafeAt arr 25),+            (17, unsafeAt arr 26), (18, unsafeAt arr 10), (19, unsafeAt arr 11), (20, unsafeAt arr 12),+             (21, unsafeAt arr 6), (22, unsafeAt arr 27), (23, unsafeAt arr 0), (24, unsafeAt arr 13),+              (25, unsafeAt arr 28), (26, unsafeAt arr 29), (27, unsafeAt arr 7), (28, unsafeAt arr 14),+                (29, unsafeAt arr 30), (30, unsafeAt arr 8), (31, unsafeAt arr 31)] in+                  take 32 . map (getBFstL' 1.0 lst) $ [0..31]  maxLine :: String maxLine = "max1 <- TRUE\n"@@ -132,22 +145,19 @@ constraintsR1 :: Int -> [Double] constraintsR1 n = replicate (2 * n) 0.0 -minDurations ::[Double]-minDurations = VB.toList v-  where v = VB.generate 32 (\i -> h i)-        h i-          | i == 23 = 0.02-          | otherwise = getBFst' (0.06,VB.fromList . zip [7,11,15,21,27,30] $ replicate 6 0.2) i+minDurations :: [Double]+minDurations = map h [0..31]+  where h i = if i == 23 then 0.02 else getBFstL' 0.06 (zip [7,11,15,21,27,30] . replicate 6 $ 0.2) i  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 :: Array Int Double -> [String] -> [Double] -> [Double] -> String -> String answer = answer2 (-0.003) 0.003 (-0.0012) 0.0012 -answer2 :: Double -> Double -> Double -> Double -> VB.Vector Double -> [String] -> [Double] -> [Double] -> String -> String+answer2 :: Double -> Double -> Double -> Double -> Array Int 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,

@@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/  name:                r-glpk-phonetic-languages-ukrainian-durations-version:             0.2.2.0+version:             0.3.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@@ -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.2 && <1, lists-flines >=0.1.1 && <1+  build-depends:       base >=4.8 && <4.15, mmsyn2-array >=0.1.1 && <1, ukrainian-phonetics-basic-array >=0.1.1 && <1, lists-flines >=0.1.1 && <1, foldable-ix >=0.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.2 && <1, lists-flines >=0.1.1 && <1+  build-depends:       base >=4.8 && <4.15, mmsyn2-array >=0.1.1 && <1, ukrainian-phonetics-basic-array >=0.1.1 && <1, lists-flines >=0.1.1 && <1, foldable-ix >=0.1 && <1   -- hs-source-dirs:   default-language:    Haskell2010