ukrainian-phonetics-basic-array 0.3.0.0 → 0.4.0.0
raw patch · 7 files changed
+584/−19 lines, 7 files
Files
- CHANGELOG.md +5/−0
- Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +131/−0
- Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs +73/−0
- Melodics/ByteString/Ukrainian/Arr.hs +5/−15
- Melodics/ByteString/Ukrainian/ArrInt8.hs +333/−0
- Melodics/ByteString/Ukrainian/Common.hs +33/−0
- ukrainian-phonetics-basic-array.cabal +4/−4
CHANGELOG.md view
@@ -22,3 +22,8 @@ ## 0.3.0.0 -- 2021-10-31 * Third version. Switched back to the CaseBi.Arr.getBFstLSorted' functionality.++## 0.4.0.0 -- 2021-11-03++* Fourth version. Added Int8-based optimized 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 a new package.
+ Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs view
@@ -0,0 +1,131 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}++-- |+-- Module : Languages.Phonetic.Ukrainian.Syllable.ArrInt8+-- Copyright : (c) OleksandrZhabenko 2021+-- License : MIT+-- Stability : Experimental+-- Maintainer : olexandr543@yahoo.com+--+-- This module works with syllable segmentation in Ukrainian. It is rewritten+-- module MMSyn7.Syllable from the @mmsyn7s@ package : https://hackage.haskell.org/package/mmsyn7s+--++module Languages.Phonetic.Ukrainian.Syllable.ArrInt8 where++import Prelude hiding (mappend)+import Data.Monoid+import Data.Typeable+import qualified Data.List as L (groupBy)+import Melodics.ByteString.Ukrainian.ArrInt8+import CaseBi.Arr+import GHC.Int+import Data.List.InnToOut.Basic (mapI)+import Data.Maybe (mapMaybe)++-- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0++-- | Function-predicate 'isVowel1' checks whether its argument is a vowel representation in the 'Sound8' format.+isVowel1 :: Sound8 -> Bool+isVowel1 x = x > 0 && x < 7+{-# INLINE isVowel1 #-}++-- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'Sound8' format.+isSonorous1 :: Sound8 -> Bool+isSonorous1 x = x > 26 && x < 38+{-# INLINE isSonorous1 #-}++-- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'Sound8' format.+isVoicedC1 :: Sound8 -> Bool+isVoicedC1 x = x > 7 && x < 27+{-# INLINE isVoicedC1 #-}++-- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'Sound8' format.+isVoicelessC1 :: Sound8 -> Bool+isVoicelessC1 x = x > 37 && x < 54+{-# INLINE isVoicelessC1 #-}++-- | Binary function-predicate 'isNotVowel2' checks whether its arguments are both consonant representations in the 'Sound8' format.+isNotVowel2 :: Sound8 -> Sound8 -> Bool+isNotVowel2 x y = x > 6 && y > 6+{-# INLINE isNotVowel2 #-}++-- | Function 'sndGroups' converts a Ukrainian word being a list of 'Sound8' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)+-- sounds representations in 'Sound8' format.+sndGroups :: FlowSound -> [FlowSound]+sndGroups ys@(_:_) = L.groupBy isNotVowel2 ys+sndGroups _ = []++groupSnds :: FlowSound -> [FlowSound]+groupSnds = L.groupBy (\x y -> isVowel1 x == isVowel1 y)++-- | Function 'divCnsnts' is used to divide groups of Ukrainian consonants into two-elements lists that later are made belonging to+-- different neighbour syllables if the group is between two vowels in a word. The group must be not empty, but this is not checked.+-- The phonetical information for the proper performance is taken from the:+-- 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+divCnsnts :: FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound)+divCnsnts xs@(x:ys@(_:_:_:_))+ | isSonorous1 x || isVoicedC1 x = ((`mappend` [x]),mappend ys)+ | otherwise = (id,mappend xs)+divCnsnts xs@(x:ys@(y:zs@(_:_)))+ | isSonorous1 x = ((`mappend` [x]),mappend ys)+ | 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)+ | otherwise = (id,mappend xs)+divCnsnts xs = (id,mappend xs)++reSyllableCntnts :: [FlowSound] -> [FlowSound]+reSyllableCntnts (xs:ys:zs:xss)+ | (> 6) . last $ ys = fst (divCnsnts ys) xs:reSyllableCntnts (snd (divCnsnts ys) zs:xss)+ | otherwise = reSyllableCntnts ((xs `mappend` ys):zs:xss)+reSyllableCntnts (xs:ys:_) = [xs `mappend` ys]+reSyllableCntnts xss = xss++divVwls :: [FlowSound] -> [FlowSound]+divVwls = mapI (\ws -> (length . filter isVowel1 $ ws) > 1) h3+ where h3 us = [ys `mappend` take 1 zs] `mappend` (L.groupBy (\x y -> isVowel1 x && y > 6) . drop 1 $ zs)+ where (ys,zs) = span (>6) us++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 #-}+{-# INLINE createSyllablesUkrS #-}++-----------------------------------------------------++-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).+notEqC :: Sound8 -> Sound8 -> Bool+notEqC 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 =+ 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++-- | Function 'representProlonged' converts duplicated consequent in the syllable consonants+-- so that they are represented by just one 'Sound8'. After applying the function to the list of 'Sound8' being a syllable all groups of duplicated consequent consonants+-- in every syllable are represented with only one 'Sound8' respectively.+representProlonged :: FlowSound -> FlowSound+representProlonged (x:y:xs)+ | isVowel1 x = x:representProlonged (y:xs)+ | not . notEqC x $ y = y:representProlonged xs+ | otherwise = x:representProlonged (y:xs)+representProlonged xs = xs
+ Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_HADDOCK show-extensions #-}+-- |+-- Module : Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8+-- Copyright : (c) OleksandrZhabenko 2021-2021+-- License : MIT+-- Stability : Experimental+-- Maintainer : olexandr543@yahoo.com+--+-- This module works with syllable segmentation in Ukrainian. Uses 'Double' whenever possible.+-- Is inspired by the DobutokO.Sound.DIS5G6G module from @dobutokO2@ package.+-- See: 'https://hackage.haskell.org/package/dobutokO2-0.43.0.0/docs/DobutokO-Sound-DIS5G6G.html'.+-- The initial 'Double' data are gotten from there.++module Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 where++import CaseBi.Arr+import Melodics.ByteString.Ukrainian.ArrInt8 (Sound8)+import GHC.Int++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)]+{-# INLINE s0DuratD1 #-}++-- |+s0DuratD2 :: Sound8 -> Double+s0DuratD2 = getBFstLSorted' 0.06408817 [(1,0.27161466),(2,0.27192511),(3,0.28539351),(4,0.25250039),(5,0.2050935),(6,0.20026538),(7,2.218624e-2),(8,7.729654e-2),(9,7.729654e-2),(10,8.048113e-2),(11,8.048113e-2),(15,0.10977617),(16,0.10977617),(17,6.58655e-2),(18,6.58655e-2),(19,7.751571e-2),(20,7.751571e-2),(21,5.392745e-2),(22,5.392745e-2),(23,8.900757e-2),(24,8.900757e-2),(25,6.099951e-2),(26,6.099951e-2),(27,8.226452e-2),(28,0.11159399),(29,0.11159399),(30,0.14303837),(31,0.14303837),(32,5.639178e-2),(33,5.639178e-2),(34,6.354637e-2),(35,6.354637e-2),(36,8.404524e-2),(37,8.404524e-2),(38,5.616409e-2),(39,0.12541547),(40,0.12541547),(41,0.12838476),(42,0.12838476),(43,0.15776219),(44,0.15776219),(45,4.91782e-2),(46,4.91782e-2),(47,9.603085e-2),(48,9.603085e-2),(49,5.294375e-2),(50,5.047358e-2),(51,5.047358e-2),(52,7.905155e-2),(53,7.905155e-2),(54,7.512999e-2),(66,7.835033e-2)]+{-# INLINE s0DuratD2 #-}++s0DuratD3 :: Sound8 -> Double+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)]+{-# INLINE s0DuratD3 #-}++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)]+{-# INLINE s0DuratD4 #-}+++class (Eq a) => SyllableDurations4 a where+ sDuratsD :: a -> Double+ sDuratsD2 :: a -> Double+ sDuratsD3 :: a -> Double+ sDuratsD4 :: a -> Double+ syllableDurationsGDc :: (a -> Double) -> [[[a]]] -> [[Double]]+ syllableDurationsGDc g = fmap (fmap (sum . fmap g))+ {-# INLINABLE syllableDurationsGDc #-}++instance SyllableDurations4 Sound8 where+ sDuratsD = s0DuratD1+ sDuratsD2 = s0DuratD2+ sDuratsD3 = s0DuratD3+ sDuratsD4 = s0DuratD4++-- | General variant of the 'syllableDurationsD' function.+syllableDurationsGD :: (Sound8 -> Double) -> [[[Sound8]]] -> [[Double]]+syllableDurationsGD g = syllableDurationsGDc g+{-# INLINABLE syllableDurationsGD #-}++syllableDurationsD :: [[[Sound8]]] -> [[Double]]+syllableDurationsD = syllableDurationsGDc s0DuratD1+{-# INLINE syllableDurationsD #-}++syllableDurationsD2 :: [[[Sound8]]] -> [[Double]]+syllableDurationsD2 = syllableDurationsGDc s0DuratD2+{-# INLINE syllableDurationsD2 #-}++syllableDurationsD3 :: [[[Sound8]]] -> [[Double]]+syllableDurationsD3 = syllableDurationsGDc s0DuratD3+{-# INLINE syllableDurationsD3 #-}++syllableDurationsD4 :: [[[Sound8]]] -> [[Double]]+syllableDurationsD4 = syllableDurationsGDc s0DuratD4+{-# INLINE syllableDurationsD4 #-}
Melodics/ByteString/Ukrainian/Arr.hs view
@@ -14,6 +14,9 @@ -- -- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of -- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf+-- The code here is less optimized in time then in the new corresponding module Melodics.ByteString.Ukrainian.ArrInt8.+-- It will be moved to the new package after the upgrading the phonetic-languages-simplified-examples-array to the+-- new optimized modules. module Melodics.ByteString.Ukrainian.Arr ( -- * Basic functions@@ -30,31 +33,18 @@ import GHC.Arr import CaseBi.Arr import qualified Data.ByteString.Char8 as B--{---- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html--}--data Triple = Z | O | T- deriving (Eq,Ord,Show)+import Melodics.ByteString.Ukrainian.Common convertToProperUkrainianS :: String -> String convertToProperUkrainianS = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv . filterUkr . changeIotated . filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower -isUkrainianL :: Char -> Bool-isUkrainianL y | (y >= '\1070' && y <= '\1097') = True- | otherwise = getBFstLSorted' False (map (\x -> (x, True)) "'-\700\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") y- changeIotated :: String -> String changeIotated (x:y:zs) | (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJ x = x:'\1100':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated zs | otherwise = x:changeIotated (y:zs) changeIotated xs = xs -isConsNotJ :: Char -> Bool-isConsNotJ = getBFstLSorted' False (zip "\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1097\1169" (repeat True))- filterUkr :: String -> B.ByteString filterUkr = B.pack . map toBSUkr @@ -290,7 +280,7 @@ correctSomeW zs = zs divideToParts :: (Char, Triple) -> [Char]-divideToParts (x, z) = getBFstLSorted' [x] (zip "NOPQRST" ["nt", "st", "tq", "Aq", "zq", "nq", "dq"]) . fst $ (x, z)+divideToParts (x, _) = getBFstLSorted' [x] (zip "NOPQRST" ["nt", "st", "tq", "Aq", "zq", "nq", "dq"]) x correctB :: [Char] -> [Char] correctB ys@(x:xs)
+ Melodics/ByteString/Ukrainian/ArrInt8.hs view
@@ -0,0 +1,333 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Melodics.ByteString.Ukrainian.ArrInt8+-- Copyright : (c) OleksandrZhabenko 2021+-- License : MIT+-- Maintainer : olexandr543@yahoo.com+--+-- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis+-- especially for poets, translators and writers. Is rewritten from the module Melodics.ByteString.Ukrainian.Arr+-- for optimization purposes.+-- Phonetic material is taken from the :+--+-- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of+-- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf++module Melodics.ByteString.Ukrainian.ArrInt8 (+ -- * Basic functions+ Sound8+ , FlowSound+ , convertToProperUkrainianI8+ , isUkrainianL+ , linkFileNameI8+) where++import qualified Data.String as S+import Data.Maybe (fromJust)+import Data.Char+import GHC.Arr+import CaseBi.Arr+import Data.List (uncons)+import GHC.Int+import Melodics.ByteString.Ukrainian.Common++type Sound8 = Int8++type FlowSound = [Sound8]++convertToProperUkrainianI8 :: String -> FlowSound+convertToProperUkrainianI8 = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv .+ filterUkr . changeIotated . filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower+{-# INLINE convertToProperUkrainianI8 #-}++changeIotated :: String -> String+changeIotated (x:y:zs)+ | (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJ x = x:'\1100':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated zs+ | otherwise = x:changeIotated (y:zs)+changeIotated xs = xs++filterUkr :: String -> FlowSound+filterUkr = map toBSUkr+{-# INLINE filterUkr #-}++toBSUkr :: Char -> Sound8+toBSUkr = getBFstLSorted' 0 (zip "'-\700\1072\1073\1074\1075\1076\1077\1078\1079\1080\1081\1082\1083\1084\1085\1086\1087\1088\1089\1090\1091\1092\1093\1094\1095\1096\1097\1100\1102\1103\1108\1110\1111\1169\8217" [-2,-1,60,1,15,36,21,17,2,10,25,5,27,45,28,30,32,3,47,34,49,50,4,43,52,38,39,41,55,7,56,57,58,6,59,19,61])+{-# INLINE toBSUkr #-}++secondConv :: FlowSound -> FlowSound+secondConv =+ concatMap (\y -> getBFstLSorted' [y] (zip [-2,-1,55,56,57,58,59,60,61] [[-1],[-1],[41,39],[27,4],[27,1],[27,2],[27,6],[-1],[-1]]) y)+{-# INLINE secondConv #-}++createTuplesByAnalysis :: FlowSound -> [FlowSound]+createTuplesByAnalysis x+ | null x = []+ | getBFstLSorted' False (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat True)) . head $ x = initialA x+ | not (null . tail $ x) && (x !! 1 == 27 && isConsNotJ8 (head x)) = take 1 x:[7]:createTuplesByAnalysis (drop 2 x)+ | otherwise = take 1 x:createTuplesByAnalysis (tail x)++isConsNotJ8 :: Int8 -> Bool+isConsNotJ8 = getBFstLSorted' False (zip [10,15,17,19,21,25,28,30,32,34,36,38,39,41,43,45,47,49,50,52] (repeat True))+{-# INLINE isConsNotJ8 #-}++initialA :: FlowSound -> [FlowSound]+initialA t1@(t:ts)+ | t < 1 = [0]:initialA ts+ | getBFstLSorted' True (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat False)) t = [t]:initialA ts+ | getBFstLSorted' False (zip [17,32,38,49,50,52] (repeat True)) t =+ let (us,vs) = splitAt 2 t1 in+ if getBFstLSorted' False (zip [[17,10],[17,25],[32,50],[38,7],[49,7],[49,50],[50,7],[50,49],[52,21]] (repeat True)) us+ then us:initialA vs+ else [t]:initialA ts+ | otherwise = [t]:initialA ts+initialA _ = []++bsToCharUkr :: [FlowSound] -> FlowSound+bsToCharUkr zs+ | null zs = []+ | otherwise = map g zs+ where g ts+ | null ts = -1+ | otherwise = getBFstLSorted' (head ts) [([17,10],23),([17,25],8),([32,50],62),([38,7],66),([49,7],54),+ ([49,50],63),([50,7],64),([50,49],38),([52,21],21)] ts+{-# INLINE bsToCharUkr #-}++applyChanges :: FlowSound -> FlowSound+applyChanges [] = []+applyChanges ys = foldr f v ys+ where v = []+ f x xs+ | null xs = [x]+ | otherwise = getBFstLSorted' x (zip [8,10,17,21,25,38,39,41,43,45,47,49,50,52,54,62,63,64,66] [дзT xs,+ жT xs, дT xs, гT xs, зT xs, цT xs, чT xs, шT xs, фT xs, кT xs, пT xs, сT xs, тT xs, хT xs,+ сьT xs, нтT xs, стT xs, тьT xs, цьT xs]) x:xs+{-# INLINE applyChanges #-}++isVoicedObstruent :: FlowSound -> Bool+isVoicedObstruent xs+ | null xs = False+ | otherwise = (\u -> u > 7 && u < 27) . head $ xs+{-# INLINE isVoicedObstruent #-}++isVoicedObstruentH :: FlowSound -> Bool+isVoicedObstruentH xs+ | null xs = False+ | otherwise = getBFstLSorted' False [(8,True),(10,True),(15,True),(17,True),(19,True),(21,True),(23,True),(25, True)] . head $ xs+{-# INLINE isVoicedObstruentH #-}++isVoicedObstruentS :: FlowSound -> Bool+isVoicedObstruentS xs+ | null xs = False+ | otherwise = (\u -> u > 11 && u < 15) . head $ xs+{-# INLINE isVoicedObstruentS #-}++isSoftDOrL :: FlowSound -> Bool+isSoftDOrL xs = getBFstLSorted' False (zip [[15,7],[17,7],[28,7],[30,7],[32,7],[36,7],[38,7],[43,7],[47,7],[49,7],[50,7]]+ (repeat True)) (takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True)+ (takeFromFT_ 1 xs)+{-# INLINE isSoftDOrL #-}++isSoftDen :: FlowSound -> Bool+isSoftDen xs = getBFstLSorted' False (zip [[8,7],[17,7],[25,7],[28,7],[32,7],[38,7],[49,7],[50,7]] . repeat $ True)+ (takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True)+ (takeFromFT_ 1 xs)+{-# INLINE isSoftDen #-}++гT :: FlowSound -> Sound8+гT (t:_) | t == 45 || t == 50 = 52+ | otherwise = 21+гT _ = 21+{-# INLINE гT #-}++дT :: FlowSound -> Sound8+дT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] = 23 -- д дж+ | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] = 12 -- д дзь+ | takeFromFT_ 1 t1 `elem` [[54],[66]] = 12 -- д дзь+ | takeFromFT_ 1 t1 `elem` [[25],[49],[38]] = 8 -- д дз+ | otherwise = 17+дT _ = 17+{-# INLINE дT #-}++дзT :: FlowSound -> Sound8+дзT t1@(_:_) | isSoftDOrL t1 = 12+ | otherwise = 8+дзT _ = 8+{-# INLINE дзT #-}++жT :: FlowSound -> Sound8+жT t1@(_:_) | takeFromFT 2 t1 `elem` [[49,7],[38,7]] = 13+ | takeFromFT 1 t1 `elem` [[54],[66]] = 13+ | otherwise = 10+жT _ = 10+{-# INLINE жT #-}++зT :: FlowSound -> Sound8+зT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] || takeFromFT_ 2 t1 == [17,10] || takeFromFT_ 1 t1 == [23] = 10+ | isSoftDOrL t1 = 13+ | takeFromFT 1 t1 `elem` [[39],[41]] = 41 -- з ш+ | takeFromFT 1 t1 `elem` [[49],[38]] || takeFromFT_ 1 t1 `elem` [[45],[47],[50],[43],[52]] = 49 -- з с+ | otherwise = 25+зT _ = 25+{-# INLINE зT #-}++кT :: FlowSound -> Sound8+кT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 19+ | otherwise = 45+кT _ = 45+{-# INLINE кT #-}++нтT :: FlowSound -> Sound8+нтT t1@(_:_) | takeFromFT 2 t1 == [49,50] || takeFromFT 1 t1 == [63] = 32+ | takeFromFT 3 t1 == [49,7,45] || takeFromFT 2 t1 == [54,45] = 65+ | otherwise = 62+нтT _ = 62+{-# INLINE нтT #-}++пT :: FlowSound -> Sound8+пT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 15+ | otherwise = 47+пT _ = 47+{-# INLINE пT #-}++сT :: FlowSound -> Sound8+сT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||+ isVoicedObstruentS (takeFromFT_ 1 t1) = 13+ | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 25+ | isSoftDOrL t1 = 54+ | takeFromFT_ 1 t1 == [41] = 41+ | otherwise = 49+сT _ = 49+{-# INLINE сT #-}++стT :: FlowSound -> Sound8+стT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 25+ | takeFromFT_ 3 t1 == [49,7,45] || (takeFromFT_ 2 t1 `elem` [[54,45],[38,7]]) ||+ takeFromFT_ 1 t1 == [66] = 54+ | takeFromFT_ 1 t1 `elem` [[49],[32]] = 49+ | takeFromFT_ 1 t1 == [39] = 41+ | otherwise = 63+стT _ = 63+{-# INLINE стT #-}++сьT :: FlowSound -> Sound8+сьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 13+ | otherwise = 54+сьT _ = 54+{-# INLINE сьT #-}++тT :: FlowSound -> Sound8+тT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||+ isVoicedObstruentS (takeFromFT_ 1 t1) = 14+ | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 17+ | takeFromFT_ 2 t1 == [38,7] || takeFromFT_ 1 t1 == [66] = 66+ | takeFromFT_ 1 t1 == [38] = 38+ | isSoftDen t1 = 64+ | takeFromFT_ 1 t1 `elem` [[39],[41]] = 39+ | otherwise = 50+тT _ = 50+{-# INLINE тT #-}++тьT :: FlowSound -> Sound8+тьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 14+ | takeFromFT_ 3 t1 == [49,7,1] || takeFromFT_ 2 t1 == [54,1] = 66+ | otherwise = 64+тьT _ = 64+{-# INLINE тьT #-}++фT :: FlowSound -> Sound8+фT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 36+ | otherwise = 43+фT _ = 43+{-# INLINE фT #-}++хT :: FlowSound -> Sound8+хT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 21+ | otherwise = 52+хT _ = 52+{-# INLINE хT #-}++цT :: FlowSound -> Sound8+цT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||+ isVoicedObstruentS (takeFromFT_ 1 t1) = 12+ | isSoftDOrL t1 = 66+ | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 8+ | otherwise = 38+цT _ = 38+{-# INLINE цT #-}++цьT :: FlowSound -> Sound8+цьT t1@(_:_) | (isVoicedObstruent . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7] = 12+ | otherwise = 66+цьT _ = 66+{-# INLINE цьT #-}++чT :: FlowSound -> Sound8+чT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 66+ | isVoicedObstruent . takeFromFT_ 1 $ t1 = 23+ | otherwise = 39+чT _ = 39+{-# INLINE чT #-}++шT :: FlowSound -> Sound8+шT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 54+ | isVoicedObstruent . takeFromFT_ 1 $ t1 = 10+ | otherwise = 41+шT _ = 41+{-# INLINE шT #-}++takeFromFT :: Int -> FlowSound -> FlowSound+takeFromFT n ts | if n < 1 then True else null ts = []+ | n < 2 = [k]+ | otherwise = k : takeFromFT (n - 1) (take (n - 1) ts)+ where k = head ts++takeFromFT2 :: Int -> FlowSound -> FlowSound+takeFromFT2 n ts | if n < 1 then True else null ts = []+ | n < 2 = [ks]+ | otherwise = ks:takeFromFT2 (n - 1) (tail ts)+ where ks = head ts++dropFromFT2 :: Int -> FlowSound -> FlowSound+dropFromFT2 n ts | if n < 1 then True else null ts = []+ | n < 2 = tail ts+ | otherwise = dropFromFT2 (n - 1) (tail ts)++takeFromFT_ :: Int -> FlowSound -> FlowSound+takeFromFT_ n = takeFromFT n . filter (>0)+{-# INLINE takeFromFT_ #-}++correctA :: FlowSound -> FlowSound+correctA = correctSomeW . separateSoftS+{-# INLINE correctA #-}++separateSoftS :: FlowSound -> FlowSound+separateSoftS = concatMap divideToParts+{-# INLINE separateSoftS #-}++correctSomeW :: FlowSound -> FlowSound+correctSomeW (x:y:z:xs@(t:ys))+ | x == 50 && y == 7 && z == 54 && t == 1 = 66:66:1:correctSomeW ys+ | (x < 1) && y == 27 && z == 1 =+ if take 2 xs == [39,32]+ then x:y:z:41:correctSomeW ys+ else x:correctSomeW (y:z:xs)+ | otherwise = x:correctSomeW (y:z:xs)+correctSomeW zs = zs++divideToParts :: Sound8 -> FlowSound+divideToParts x =+ getBFstLSorted' [x] [(12,[8,7]),(13,[25,7]),(14,[17,7]),(62,[32,50]),(63,[49,50]),(64,[50,7]), (65,[32,7])] x+{-# INLINE divideToParts #-}++correctB :: FlowSound -> FlowSound+correctB ys@(x:xs)+ | (length . filter (== 0) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t <= 0 then -1 else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys)+ | otherwise = (if x < 0 then -1 else x):correctB xs+correctB _ = []++linkFileNameI8 :: Sound8 -> Char+linkFileNameI8 x = getBFstLSorted' '0' ([(1,'A'),(2,'H'),(3,'Q'),(4,'W'),(5,'K'),(6,'e'),(7,'d'),(8,'G'),(10,'I'),(15,'B'),+ (17,'E'),(19,'f'),(21,'D'),(23,'F'),(25,'J'),(27,'L'),(28,'N'),(30,'O'),(32,'P'),(34,'S'),(36,'C'),(38,'Z'),(39,'b'),+ (41,'c'),(43,'X'),(45,'M'),(47,'R'),(49,'T'),(50,'V'),(52,'Y'),(54,'U'),(60,'0'),(61,'0'),(66,'a')]) x+{-# INLINE linkFileNameI8 #-}
+ Melodics/ByteString/Ukrainian/Common.hs view
@@ -0,0 +1,33 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Melodics.ByteString.Ukrainian.Common+-- Copyright : (c) OleksandrZhabenko 2021+-- License : MIT+-- Maintainer : olexandr543@yahoo.com+--+-- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis+-- especially for poets, translators and writers. Is rewritten from the module Melodics.ByteString.Ukrainian.Arr+-- for optimization purposes. Contains the common for two modules definitions.+-- Phonetic material is taken from the :+--+-- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of+-- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf++module Melodics.ByteString.Ukrainian.Common where++import CaseBi.Arr++{-+-- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html+-}++data Triple = Z | O | T+ deriving (Eq,Ord,Show)++isUkrainianL :: Char -> Bool+isUkrainianL y | (y >= '\1070' && y <= '\1097') = True+ | otherwise = getBFstLSorted' False (map (\x -> (x, True)) "'-\700\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") y++isConsNotJ :: Char -> Bool+isConsNotJ = getBFstLSorted' False (zip "\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1097\1169" (repeat True))
ukrainian-phonetics-basic-array.cabal view
@@ -2,9 +2,9 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: ukrainian-phonetics-basic-array-version: 0.3.0.0+version: 0.4.0.0 synopsis: A library to work with the basic Ukrainian phonetics and syllable segmentation.-description: A library to work with the basic Ukrainian phonetics and syllable segmentation. 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.+description: A library to work with the basic Ukrainian phonetics and syllable segmentation. 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 license: MIT license-file: LICENSE@@ -17,9 +17,9 @@ cabal-version: >=1.10 library- exposed-modules: Languages.Phonetic.Ukrainian.Syllable.Arr, Melodics.ByteString.Ukrainian.Arr, Languages.Phonetic.Ukrainian.Syllable.Double.Arr+ exposed-modules: Languages.Phonetic.Ukrainian.Syllable.Arr, Melodics.ByteString.Ukrainian.Arr, Melodics.ByteString.Ukrainian.Common, Languages.Phonetic.Ukrainian.Syllable.Double.Arr, Languages.Phonetic.Ukrainian.Syllable.ArrInt8, Melodics.ByteString.Ukrainian.ArrInt8, Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 -- other-modules:- other-extensions: DeriveDataTypeable, FlexibleInstances, OverloadedStrings+ other-extensions: DeriveDataTypeable, FlexibleInstances, OverloadedStrings, TypeSynonymInstances build-depends: base >=4.8 && <4.15, mmsyn2-array >=0.3 && <1, bytestring >=0.10 && <0.13, mmsyn5 >=0.5 && <1 -- hs-source-dirs: default-language: Haskell2010