ukrainian-phonetics-basic-array 0.5.0.0 → 0.5.1.0
raw patch · 4 files changed
+108/−13 lines, 4 files
Files
- CHANGELOG.md +5/−0
- Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +97/−8
- Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs +5/−4
- ukrainian-phonetics-basic-array.cabal +1/−1
CHANGELOG.md view
@@ -43,3 +43,8 @@ * Fifth version. Some code optimizations and improvements (mostly) in speed. Moved the functionality to the 2 new packages: ukrainian-phonetics-common and ukranian-phonetics-basic-array-bytestring. Added new tuples-based functionality. +## 0.5.1.0 -- 2022-02-21++* Fifth version revised A. Fixed issues with the similarly defined sDurat4 and sDurat3 functions. Some code improvements. +Added extended versions of the functions to the Languages.Phonetic.Ukrainian.Syllable.ArrInt8 module.+
Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs view
@@ -1,5 +1,5 @@ {-# OPTIONS_HADDOCK show-extensions #-}-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, BangPatterns #-} -- | -- Module : Languages.Phonetic.Ukrainian.Syllable.ArrInt8@@ -14,9 +14,30 @@ -- https://msn.khnu.km.ua/pluginfile.php/302375/mod_resource/content/1/%D0%9B.3.%D0%86%D0%86.%20%D0%A1%D0%BA%D0%BB%D0%B0%D0%B4.%D0%9D%D0%B0%D0%B3%D0%BE%D0%BB%D0%BE%D1%81.pdf -- -module Languages.Phonetic.Ukrainian.Syllable.ArrInt8 where+module Languages.Phonetic.Ukrainian.Syllable.ArrInt8 (+ -- * Basic functionality+ isVowel1+ , isSonorous1+ , isVoicedC1+ , isVoicelessC1+ , isNotVowel2+ , sndGroups+ , groupSnds+ , divCnsnts+ , reSyllableCntnts+ , divVwls+ , createSyllablesUkrS+ , notEqC+ , representProlonged+ -- * With additional data used (probably for speed up)+ , notEqCTup+ , divCnsntsTup+ , reSyllableCntntsTup+ , createSyllablesUkrSTup+) where import Prelude hiding (mappend)+import GHC.Arr import Data.Monoid import Data.Typeable import qualified Data.List as L (groupBy)@@ -75,10 +96,31 @@ | isSonorous1 y = ((`mappend` [x,y]),mappend zs) | otherwise = (id,mappend xs) divCnsnts xs@(x:ys@(y:_))- | (isSonorous1 x && (x `notEqC` y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys)+ | (isSonorous1 x && (notEqC x y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys) | otherwise = (id,mappend xs) divCnsnts xs = (id,mappend xs) +-- | Function 'divCnsntsTup' is a variant of the 'divCnsts' where you can provide the tuple element for 'getBFst'' inside.+divCnsntsTup :: Array Int (Int8,Bool) -> FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound)+divCnsntsTup !tup17 xs@(x:ys@(_:_:_:_))+ | isSonorous1 x || isVoicedC1 x = ((`mappend` [x]),mappend ys)+ | otherwise = (id,mappend xs)+divCnsntsTup !tup17 xs@(x:ys@(y:zs@(_:_)))+ | isSonorous1 x = ((`mappend` [x]),mappend ys)+ | isSonorous1 y = ((`mappend` [x,y]),mappend zs)+ | otherwise = (id,mappend xs)+divCnsntsTup !tup17 xs@(x:ys@(y:_))+ | (isSonorous1 x && (notEqCTup tup17 x y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys)+ | otherwise = (id,mappend xs)+divCnsntsTup _ xs = (id,mappend xs)++reSyllableCntntsTup :: Array Int (Int8,Bool) -> [FlowSound] -> [FlowSound]+reSyllableCntntsTup !tup17 (xs:ys:zs:xss)+ | (> 6) . last $ ys = fst (divCnsntsTup tup17 ys) xs:reSyllableCntntsTup tup17 (snd (divCnsntsTup tup17 ys) zs:xss)+ | otherwise = reSyllableCntntsTup tup17 ((xs `mappend` ys):zs:xss)+reSyllableCntntsTup !tup17 (xs:ys:_) = [xs `mappend` ys]+reSyllableCntntsTup !tup17 xss = xss+ reSyllableCntnts :: [FlowSound] -> [FlowSound] reSyllableCntnts (xs:ys:zs:xss) | (> 6) . last $ ys = fst (divCnsnts ys) xs:reSyllableCntnts (snd (divCnsnts ys) zs:xss)@@ -93,13 +135,43 @@ createSyllablesUkrS :: String -> [[FlowSound]] createSyllablesUkrS = map (divVwls . reSyllableCntnts . groupSnds) . words1 . convertToProperUkrainianI8 .- map (\x -> if x == '-' then ' ' else x)- where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.- where ts = dropWhile (< 1) xs- (w, s'') = span (> 0) ts- {-# NOINLINE words1 #-}+ map (\x -> if x == '-' then ' ' else x)+ where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.+ where ts = dropWhile (< 1) xs+ (w, s'') = span (> 0) ts+ {-# NOINLINE words1 #-} {-# INLINE createSyllablesUkrS #-} +createSyllablesUkrSTup+ :: Array Int (Int8, Bool)+ -> Array Int (Int8, Bool)+ -> Array Int (Int8, Bool)+ -> Array Int (Int8, Bool)+ -> Array Int ([Int8], Bool)+ -> Array Int ([Int8], Int8)+ -> Array Int (Int8, FlowSound -> Sound8)+ -> Array Int (Int8, Bool)+ -> Array Int ([Int8], Bool)+ -> Array Int ([Int8], Bool)+ -> Array Int ([Int8], Bool)+ -> Array Int (Int8, [Int8])+ -> Array Int (Char,Int8)+ -> Array Int (Int8,[Int8])+ -> Array Int (Char, Bool)+ -> Array Int (Char, Bool)+ -> Array Int (Int8,Bool)+ -> String+ -> [[FlowSound]]+createSyllablesUkrSTup !tup1 !tup2 !tup3 !tup4 !tup5 !tup6 !tup7 !tup8 !tup9 !tup10 !tup11 !tup12 !tup13 !tup14 !tup15 !tup16 !tup17 =+ map (divVwls . reSyllableCntntsTup tup17 . groupSnds) . words1 .+ convertToProperUkrainianI8WithTuples tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 .+ map (\x -> if x == '-' then ' ' else x)+ where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.+ where ts = dropWhile (< 1) xs+ (w, s'') = span (> 0) ts+ {-# NOINLINE words1 #-}+{-# INLINE createSyllablesUkrSTup #-}+ ----------------------------------------------------- -- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).@@ -120,6 +192,23 @@ getBFstLSorted' True ([(8,False),(10,False),(15,False),(17,False),(19,False),(21,False),(23,False),(25,False), (28,False),(30,False),(32,False),(34,False),(36,False),(39,False),(41,False),(43,False),(45,False),(47,False), (50,False),(52,False)]) . min x $ y+ | otherwise = True++-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).+notEqCTup :: Array Int (Int8,Bool) -> Sound8 -> Sound8 -> Bool+notEqCTup !tup17 x y+ | x == 49 || x == 54 =+ case y of+ 49 -> False+ 54 -> False+ _ -> True+ | x == 66 || x == 38 =+ case y of+ 38 -> False+ 66 -> False+ _ -> True+ | x == y = False+ | abs (x - y) == 1 = getBFst' (True, tup17) . min x $ y | otherwise = True -- | Function 'representProlonged' converts duplicated consequent in the syllable consonants
Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs view
@@ -2,7 +2,7 @@ {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8--- Copyright : (c) OleksandrZhabenko 2021-2021+-- Copyright : (c) OleksandrZhabenko 2021-2022 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com@@ -17,6 +17,7 @@ import CaseBi.Arr import Melodics.Ukrainian.ArrInt8 (Sound8) import GHC.Int+import Data.Foldable (foldl') s0DuratD1 :: Sound8 -> Double s0DuratD1 = getBFstLSorted' 0.051020 [(1,0.138231),(2,9.3605e-2),(3,0.116463),(4,0.10907),(5,9.9955e-2),(6,9.415e-2),(7,2.0227e-2),(8,5.5601e-2),(9,5.5601e-2),(10,7.0658e-2),(11,7.0658e-2),(15,5.7143e-2),(16,5.7143e-2),(17,7.2063e-2),(18,7.2063e-2),(19,6.2948e-2),(20,6.2948e-2),(21,7.6825e-2),(22,7.6825e-2),(23,4.8934e-2),(24,4.8934e-2),(25,5.6054e-2),(26,5.6054e-2),(27,5.7143e-2),(28,6.4036e-2),(29,6.4036e-2),(30,7.737e-2),(31,7.737e-2),(32,7.424e-2),(33,7.424e-2),(34,4.9206e-2),(35,4.9206e-2),(36,8.2268e-2),(37,8.2268e-2),(38,5.3061e-2),(39,5.7596e-2),(40,5.7596e-2),(41,6.6077e-2),(42,6.6077e-2),(43,6.2268e-2),(44,6.2268e-2),(45,4.5351e-2),(46,4.5351e-2),(47,0.13483),(48,0.13483),(49,7.4603e-2),(50,0.110658),(51,0.110658),(52,7.7188e-2),(53,7.7188e-2),(54,7.4558e-2),(66,8.9342e-2)]@@ -29,8 +30,7 @@ s0DuratD3 = getBFstLSorted' 0.05779993 [(1,0.25872483),(2,0.22876537),(3,0.25423777),(4,0.20243791),(5,0.19849003),(6,0.19777405),(7,1.943042e-2),(8,8.453724e-2),(9,8.453724e-2),(10,9.996042e-2),(11,9.996042e-2),(15,0.13787716),(16,0.13787716),(17,7.437409e-2),(18,7.437409e-2),(19,7.985903e-2),(20,7.985903e-2),(21,0.10289067),(22,0.10289067),(23,0.10039843),(24,0.10039843),(25,6.643842e-2),(26,6.643842e-2),(27,0.10975353),(28,0.1090645),(29,0.1090645),(30,0.14576594),(31,0.14576594),(32,6.084464e-2),(33,6.084464e-2),(34,5.937718e-2),(35,5.937718e-2),(36,7.798724e-2),(37,7.798724e-2),(38,5.901357e-2),(39,0.11906522),(40,0.11906522),(41,0.13985258),(42,0.13985258),(43,0.15880087),(44,0.15880087),(45,5.893304e-2),(46,5.893304e-2),(47,0.10765654),(48,0.10765654),(49,6.247632e-2),(50,6.03912e-2),(51,6.03912e-2),(52,0.13526622),(53,0.13526622),(54,8.190674e-2),(66,7.8444e-2)] s0DuratD4 :: Sound8 -> Double-s0DuratD4 = getBFstLSorted' 0.14160713 [(1,0.25872483),(2,0.22876537),(3,0.25423777),(4,0.20243791),(5,0.19849003),(6,0.19777405),(7,1.943042e-2),(8,8.453724e-2),(9,8.453724e-2),(10,9.996042e-2),(11,9.996042e-2),(15,0.13787716),(16,0.13787716),(17,7.437409e-2),(18,7.437409e-2),(19,7.985903e-2),(20,7.985903e-2),(21,0.10289067),(22,0.10289067),(23,0.10039843),(24,0.10039843),(25,6.643842e-2),(26,6.643842e-2),(27,0.10975353),(28,0.1090645),(29,0.1090645),(30,0.14576594),(31,0.14576594),(32,6.084464e-2),(33,6.084464e-2),(34,5.937718e-2),(35,5.937718e-2),(36,7.798724e-2),(37,7.798724e-2),(38,5.901357e-2),(39,0.11906522),(40,0.11906522),(41,0.13985258),(42,0.13985258),(43,0.15880087),(44,0.15880087),(45,5.893304e-2),(46,5.893304e-2),(47,0.10765654),(48,0.10765654),(49,6.247632e-2),(50,6.03912e-2),(51,6.03912e-2),(52,0.13526622),(53,0.13526622),(54,8.190674e-2),(66,7.8444e-2)]-+s0DuratD4 = getBFstLSorted' 0.14160713 [(1,0.20859653),(2,0.21194045),(3,0.2089092),(4,0.19826109),(5,0.20249813),(6,0.20167924),(7,1.957491e-2),(8,8.508446e-2),(9,8.508446e-2),(10,0.17053331),(11,0.17053331),(15,7.768941e-2),(16,7.768941e-2),(17,0.12987485),(18,0.12987485),(19,0.14343568),(20,0.14343568),(21,0.22822145),(22,0.22822145),(23,0.16712392),(24,0.16712392),(25,8.566847e-2),(26,8.566847e-2),(27,6.241711e-2),(28,0.16563571),(29,0.16563571),(30,0.2694089),(31,0.2694089),(32,0.13174949),(33,0.13174949),(34,5.978079e-2),(35,5.978079e-2),(36,9.572877e-2),(37,9.572877e-2),(38,5.705798e-2),(39,0.21173804),(40,0.21173804),(41,0.24441358),(42,0.24441358),(43,0.19044721),(44,0.19044721),(45,0.10747824),(46,0.10747824),(47,5.737927e-2),(48,5.737927e-2),(49,0.10201693),(50,0.18138075),(51,0.18138075),(52,0.26765448),(53,0.26765448),(54,0.12159184),(66,7.663289e-2)] class (Eq a) => SyllableDurations4 a where sDuratsD :: a -> Double@@ -38,7 +38,8 @@ sDuratsD3 :: a -> Double sDuratsD4 :: a -> Double syllableDurationsGDc :: (a -> Double) -> [[[a]]] -> [[Double]]- syllableDurationsGDc g = fmap (fmap (sum . fmap g))+ syllableDurationsGDc g = map (map (k g))+ where k f = foldl' (\y x -> f x + y) 0 {-# INLINABLE syllableDurationsGDc #-} instance SyllableDurations4 Sound8 where
ukrainian-phonetics-basic-array.cabal view
@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: ukrainian-phonetics-basic-array-version: 0.5.0.0+version: 0.5.1.0 synopsis: A library to work with the basic Ukrainian phonetics and syllable segmentation. description: Rewritten from the mmsyn6ukr and mmsyn7s packages. Comparing to the ukrainian-phonetics-basic package, all the vector-related functionality removed, it also removed from the dependencies and the mmsyn2 is changed to mmsyn2-array. Since 0.4.0.0 version switched to the more optimized Int8-based functionality. The modules that do not use Int8 after ugrading the phonetic-languages-simplified-examples-array to the Int8-based functionality are planned to be moved to the new package. homepage: https://hackage.haskell.org/package/ukrainian-phonetics-basic-array