diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. + diff --git a/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs b/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs --- a/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +++ b/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs @@ -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 diff --git a/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs b/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs --- a/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs +++ b/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs @@ -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 diff --git a/ukrainian-phonetics-basic-array.cabal b/ukrainian-phonetics-basic-array.cabal --- a/ukrainian-phonetics-basic-array.cabal +++ b/ukrainian-phonetics-basic-array.cabal @@ -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