ukrainian-phonetics-basic-array 0.4.2.0 → 0.5.0.0
raw patch · 8 files changed
+180/−834 lines, 8 filesdep +ukrainian-phonetics-commondep −bytestringdep ~base
Dependencies added: ukrainian-phonetics-common
Dependencies removed: bytestring
Dependency ranges changed: base
Files
- CHANGELOG.md +6/−0
- Languages/Phonetic/Ukrainian/Syllable/Arr.hs +0/−276
- Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +1/−1
- Languages/Phonetic/Ukrainian/Syllable/Double/Arr.hs +0/−101
- Melodics/ByteString/Ukrainian/Arr.hs +0/−299
- Melodics/Ukrainian/ArrInt8.hs +168/−119
- Melodics/Ukrainian/Common.hs +0/−33
- ukrainian-phonetics-basic-array.cabal +5/−5
CHANGELOG.md view
@@ -37,3 +37,9 @@ * Fourth version revised B. Removed the inlining in the new modules to make them similar to the previous ones. Probably it led to not optimized compiling of the further code using this ones.++## 0.5.0.0 -- 2022-02-19++* 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.+
− Languages/Phonetic/Ukrainian/Syllable/Arr.hs
@@ -1,276 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}---- |--- Module : Languages.Phonetic.Ukrainian.Syllable.Arr--- Copyright : (c) OleksandrZhabenko 2020-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.Arr where--import Prelude hiding (mappend)-import Data.Monoid-import Data.Typeable-import qualified Data.List as L (groupBy)-import Melodics.ByteString.Ukrainian.Arr-import CaseBi.Arr-import Data.List.InnToOut.Basic (mapI)-import Data.Maybe (mapMaybe)---- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0---- CAUTION: Please, do not mix with the show7s functions, they are not interoperable.--data UZPP a b = UZ a b deriving ( Eq, Typeable )--instance (Ord a, Ord b) => Ord (UZPP a b) where- compare (UZ x1 y1) (UZ x2 y2) =- case compare x1 x2 of- EQ -> compare y1 y2- ~z -> z--data PhoneticType = W | S | O | D | K | L | M | N | E deriving ( Eq, Ord, Typeable )--type UZPP2 = UZPP Char PhoneticType--instance Show (UZPP Char PhoneticType) where- show (UZ x y)- | y `notElem` [O,K,M] =- getBFstLSorted' "" [('-'," "),('0'," "),('1'," "),('A',"дз"),('B',"ж"),('C',"й"),('D',"сь"),('E',"ч"),('F',"ш"),('G',"щ"),('L',"\700"),('M',"\8217"),- ('a',"а"),('b',"б"),('c',"ц"),('d',"д"),('e',"е"),('f',"ф"),('g',"ґ"),('h',"г"),('i',"і"),('j',"дж"),('k',"к"),('l',"л"),('m',"м"),('n',"н"),('o',"о"),('p',"п"),('q',"ь"),- ('r',"р"),('s',"с"),('t',"т"),('u',"у"),('v',"в"),('w',"ць"),('x',"х"),('y',"и"),('z',"з")] x- | otherwise =- getBFstLSorted' "" [('-'," "),('0'," "),('1'," "),('A',"дзь"),('B',"жь"),('E',"чь"),('F',"шь"),('G',"щь"),('b',"бь"),('d',"дь"),('f',"фь"),('g',"ґь"),- ('h',"гь"),('j',"джь"),('k',"кь"),('l',"ль"),('m',"мь"),('n',"нь"),('p',"пь"),('q',"ь"),('r',"рь"),('t',"ть"),('v',"вь"),('x',"хь"),('z',"зь")] x--phoneType :: UZPP2 -> PhoneticType-phoneType (UZ _ y) = y-{-# INLINE phoneType #-}--charUkr :: UZPP2 -> Char-charUkr (UZ x _) = x-{-# INLINE charUkr #-}--str2UZPP2s :: String -> [UZPP2]-str2UZPP2s (y:ys)- | getBFstLSorted' False [('a',True),('e',True),('i',True),('o',True),('u',True),('y',True)] y = UZ y W:str2UZPP2s ys- | y == 'D' || y == 'w' = UZ y N:str2UZPP2s ys- | (null ys || head ys /= 'q') && getBFstLSorted' False [('C',True),('l',True),('m',True),('n',True),('r',True),('v',True)] y = UZ y S:str2UZPP2s ys- | (null ys || head ys /= 'q') &&- getBFstLSorted' False [('A',True),('B',True),('b',True),('d',True),('g',True),('h',True),('j',True),('z',True)] y = UZ y D:str2UZPP2s ys- | (null ys || head ys /= 'q') = UZ y L:str2UZPP2s ys- | getBFstLSorted' False [('l',True),('m',True),('n',True),('r',True),('v',True)] y = UZ y O:str2UZPP2s (drop 1 ys)- | getBFstLSorted' False [('A',True),('B',True),('b',True),('d',True),('g',True),('h',True),('j',True),('z',True)] y =- UZ y K:str2UZPP2s (drop 1 ys)- | otherwise = UZ y M:str2UZPP2s (drop 1 ys)-str2UZPP2s _ = []---- | Function-predicate 'isVowel1' checks whether its argument is a vowel representation in the 'UZPP2' format.-isVowel1 :: UZPP2 -> Bool-isVowel1 = (== W) . phoneType-{-# INLINE isVowel1 #-}---- | Function-predicate 'isVwl' checks whether its argument is a vowel representation in the 'Char' format.-isVwl :: Char -> Bool-isVwl = getBFstLSorted' False [('a',True),('e',True),('i',True),('o',True),('u',True),('y',True)]-{-# INLINE isVwl #-}---- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'UZPP2' format.-isSonorous1 :: UZPP2 -> Bool-isSonorous1 = (`elem` [S,O]) . phoneType-{-# INLINE isSonorous1 #-}---- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'UZPP2' format.-isVoicedC1 :: UZPP2 -> Bool-isVoicedC1 = (`elem` [D,K]) . phoneType-{-# INLINE isVoicedC1 #-}---- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'UZPP2' format.-isVoicelessC1 :: UZPP2 -> Bool-isVoicelessC1 = (`elem` [L,M]) . phoneType-{-# INLINE isVoicelessC1 #-}---- | Binary function-predicate 'isNotVowel2' checks whether its arguments are both consonant representations in the 'UZPP2' format.-isNotVowel2 :: UZPP2 -> UZPP2 -> Bool-isNotVowel2 x y- | phoneType x == W || phoneType y == W = False- | otherwise = True-{-# INLINE isNotVowel2 #-}---- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).-notEqC :: UZPP2 -> UZPP2 -> Bool-notEqC x y- | charUkr x == 's' || charUkr x == 'D' =- case charUkr y of- 's' -> False- 'D' -> False- _ -> True- | charUkr x == 'w' || charUkr x == 'c' =- case charUkr y of- 'w' -> False- 'c' -> False- _ -> True- | otherwise = charUkr x /= charUkr y---- | Function 'sndGroups' converts a Ukrainian word being a list of 'UZPP2' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)--- sounds representations in 'UZPP2' format.-sndGroups :: [UZPP2] -> [[UZPP2]]-sndGroups ys@(_:_) = L.groupBy isNotVowel2 ys-sndGroups _ = []--groupSnds :: [UZPP2] -> [[UZPP2]]-groupSnds = L.groupBy (\x y -> ((== W) . phoneType $ x) == ((== W) . phoneType $ 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 :: [UZPP2] -> ([UZPP2] -> [UZPP2],[UZPP2] -> [UZPP2])-divCnsnts xs@(x:ys@(_:_:_:_))- | (isSonorous1 x) || (isVoicedC1 x) = ((`mappend` [x]),(ys `mappend`))- | otherwise = ((id),(xs `mappend`))-divCnsnts xs@(x:ys@(y:zs@(_:_)))- | isSonorous1 x = ((`mappend` [x]),(ys `mappend`))- | isSonorous1 y = ((`mappend` [x,y]),(zs `mappend`))- | otherwise = ((id),(xs `mappend`))-divCnsnts xs@(x:ys@(y:_))- | ((isSonorous1 x) && (x `notEqC` y)) || ((isVoicedC1 x) && (isVoicelessC1 y)) = ((`mappend` [x]),(ys `mappend`))- | otherwise = ((id),(xs `mappend`))-divCnsnts xs = ((id),(xs `mappend`))--reSyllableCntnts :: [[UZPP2]] -> [[UZPP2]]-reSyllableCntnts (xs:ys:zs:xss)- | (/= W) . phoneType . 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 :: [[UZPP2]] -> [[UZPP2]]-divVwls = mapI (\ws -> (length . filter ((== W) . phoneType) $ ws) > 1) h3- where h3 us = [ys `mappend` take 1 zs] `mappend` (L.groupBy (\x y -> phoneType x == W && phoneType y /= W) . drop 1 $ zs)- where (ys,zs) = span (\t -> phoneType t /= W) us--createSyllablesUkrS :: String -> [[[UZPP2]]]-createSyllablesUkrS = map (divVwls . reSyllableCntnts . groupSnds . str2UZPP2s) . words1 . mapMaybe g . convertToProperUkrainianS . map (\x -> if x == '-' then ' ' else x)- where g x- | x == '0' = Nothing- | x /= '1' && x /= '-' = Just x- | otherwise = Just ' '- 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 (== ' ') xs- (w, s'') = span (/= ' ') ts- {-# NOINLINE words1 #-}-{-# INLINE createSyllablesUkrS #-}---- | Function 'representProlonged' converts duplicated consequent in the syllable consonants--- so that they are represented by just one 'UZPP2'. After applying the function to the list of 'UZPP2' being a syllable all groups of duplicated consequent consonants--- in every syllable are represented with only one 'UZPP2' respectively.-representProlonged :: [UZPP2] -> [UZPP2]-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---- | 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 'Float' data are gotten from there.-str2Durat1 :: String -> Float-str2Durat1 = getBFstLSorted' 0.153016 [("-", (0.101995)), ("0", (0.051020)), ("1", (0.153016)), ("а", 0.138231), ("б", 0.057143),- ("в", 0.082268), ("г", 0.076825), ("д", 0.072063), ("дж", 0.048934), ("дз", 0.055601), ("е", 0.093605), ("ж", 0.070658), ("з", 0.056054),- ("и", 0.099955), ("й", 0.057143), ("к", 0.045351), ("л", 0.064036), ("м", 0.077370), ("н", 0.074240), ("о", 0.116463), ("п", 0.134830),- ("р", 0.049206), ("с", 0.074603), ("сь", 0.074558), ("т", 0.110658), ("у", 0.109070), ("ф", 0.062268), ("х", 0.077188), ("ц", 0.053061),- ("ць", 0.089342), ("ч", 0.057596), ("ш", 0.066077), ("ь", 0.020227), ("і", 0.094150), ("ґ", 0.062948)]-{-# DEPRECATED str2Durat1 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}---- | Just another possible duration approximation obtained by usage of the @r-glpk-phonetic-languages-ukrainian-durations@ package--- https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations.--- It is generated for the set of the words-durations pairs that the words contents ('Char') converts to the elements of the--- \"ABCEFXYabcdefghijklmnopqrstuvxyz\" (for more information, pleas, refer to the--- https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations).-uzpp2Durat2 :: UZPP2 -> Float-uzpp2Durat2 = getBFstLSorted' 0.06408817 [(UZ 'A' D, 0.07729654), (UZ 'A' K, 0.07729654), (UZ 'B' D, 0.08048113), (UZ 'B' K, 0.08048113),- (UZ 'C' S, 0.08226452), (UZ 'D' N, 0.07512999), (UZ 'E' L, 0.12541547), (UZ 'E' M, 0.12541547), (UZ 'F' L, 0.12838476), (UZ 'F' M, 0.12838476),- (UZ 'a' W, 0.27161466), (UZ 'b' D, 0.10977617), (UZ 'b' K, 0.10977617), (UZ 'c' D, 0.05616409), (UZ 'd' D, 0.06586550), (UZ 'd' K, 0.06586550),- (UZ 'e' W, 0.27192511), (UZ 'f' L, 0.15776219), (UZ 'f' M, 0.15776219), (UZ 'g' D, 0.07751571), (UZ 'g' K, 0.07751571), (UZ 'h' D, 0.05392745),- (UZ 'h' K, 0.05392745), (UZ 'i' W, 0.20026538), (UZ 'j' D, 0.08900757), (UZ 'j' K, 0.08900757), (UZ 'k' L, 0.04917820), (UZ 'k' M, 0.04917820),- (UZ 'l' S, 0.11159399), (UZ 'l' O, 0.11159399), (UZ 'm' S, 0.14303837), (UZ 'm' O, 0.14303837), (UZ 'n' S, 0.05639178),- (UZ 'n' O, 0.05639178), (UZ 'o' W, 0.28539351), (UZ 'p' L, 0.09603085), (UZ 'p' M, 0.09603085), (UZ 'q' E, 0.02218624), (UZ 'r' S, 0.06354637),- (UZ 'r' O, 0.06354637), (UZ 's' L, 0.05294375), (UZ 't' L, 0.05047358), (UZ 't' M, 0.05047358), (UZ 'u' W, 0.25250039),- (UZ 'v' S, 0.08404524), (UZ 'v' O, 0.08404524), (UZ 'w' N, 0.07835033), (UZ 'x' L, 0.07905155), (UZ 'x' M, 0.07905155),- (UZ 'y' W, 0.20509350), (UZ 'z' D, 0.06099951), (UZ 'z' K, 0.06099951)]-{-# DEPRECATED uzpp2Durat2 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}--uzpp2Durat1 :: UZPP2 -> Float-uzpp2Durat1 = getBFstLSorted' 0.051020 [(UZ 'A' D, 0.055601), (UZ 'A' K, 0.055601), (UZ 'B' D, 0.070658), (UZ 'B' K, 0.070658), (UZ 'C' S, 0.057143), (UZ 'D' N, 0.074558),- (UZ 'E' L, 0.057596), (UZ 'E' M, 0.057596), (UZ 'F' L, 0.066077), (UZ 'F' M, 0.066077), (UZ 'a' W, 0.138231), (UZ 'b' D, 0.057143), (UZ 'b' K, 0.057143), (UZ 'c' D, 0.053061),- (UZ 'd' D, 0.072063), (UZ 'd' K, 0.072063), (UZ 'e' W, 0.093605), (UZ 'f' L, 0.062268), (UZ 'f' M, 0.062268), (UZ 'g' D, 0.062948), (UZ 'g' K, 0.062948), (UZ 'h' D, 0.076825),- (UZ 'h' K, 0.076825), (UZ 'i' W, 0.094150), (UZ 'j' D, 0.048934), (UZ 'j' K, 0.048934), (UZ 'k' L, 0.045351), (UZ 'k' M, 0.045351), (UZ 'l' S, 0.064036), (UZ 'l' O, 0.064036),- (UZ 'm' S, 0.077370), (UZ 'm' O, 0.077370), (UZ 'n' S, 0.074240), (UZ 'n' O, 0.074240), (UZ 'o' W, 0.116463), (UZ 'p' L, 0.134830), (UZ 'p' M, 0.134830),- (UZ 'q' E, 0.020227), (UZ 'r' S, 0.049206), (UZ 'r' O, 0.049206), (UZ 's' L, 0.074603), (UZ 't' L, 0.110658), (UZ 't' M, 0.110658), (UZ 'u' W, 0.109070), (UZ 'v' S, 0.082268),- (UZ 'v' O, 0.082268), (UZ 'w' N, 0.089342), (UZ 'x' L, 0.077188), (UZ 'x' M, 0.077188), (UZ 'y' W, 0.099955), (UZ 'z' D, 0.056054), (UZ 'z' K, 0.056054)]-{-# DEPRECATED uzpp2Durat1 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}--uzpp2Durat3 :: UZPP2 -> Float-uzpp2Durat3 = getBFstLSorted' 0.05779993 [(UZ 'A' D, 0.08453724), (UZ 'A' K, 0.08453724),- (UZ 'B' D, 0.09996042), (UZ 'B' K, 0.09996042), (UZ 'C' S, 0.10975353), (UZ 'D' N, 0.08190674),- (UZ 'E' L, 0.11906522), (UZ 'E' M, 0.11906522), (UZ 'F' L, 0.13985258), (UZ 'F' M, 0.13985258),- (UZ 'a' W, 0.25872483), (UZ 'b' D, 0.13787716), (UZ 'b' K, 0.13787716), (UZ 'c' D, 0.05901357),- (UZ 'd' D, 0.07437409), (UZ 'd' K, 0.07437409), (UZ 'e' W, 0.22876537), (UZ 'f' L, 0.15880087),- (UZ 'f' M, 0.15880087), (UZ 'g' D, 0.07985903), (UZ 'g' K, 0.07985903), (UZ 'h' D, 0.10289067),- (UZ 'h' K, 0.10289067), (UZ 'i' W, 0.19777405), (UZ 'j' D, 0.10039843), (UZ 'j' K, 0.10039843),- (UZ 'k' L, 0.05893304), (UZ 'k' M, 0.05893304), (UZ 'l' S, 0.10906450), (UZ 'l' O, 0.10906450),- (UZ 'm' S, 0.14576594), (UZ 'm' O, 0.14576594), (UZ 'n' S, 0.06084464), (UZ 'n' O, 0.06084464),- (UZ 'o' W, 0.25423777), (UZ 'p' L, 0.10765654), (UZ 'p' M, 0.10765654), (UZ 'q' E, 0.01943042),- (UZ 'r' S, 0.05937718), (UZ 'r' O, 0.05937718), (UZ 's' L, 0.06247632), (UZ 't' L, 0.06039120),- (UZ 't' M, 0.06039120), (UZ 'u' W, 0.20243791), (UZ 'v' S, 0.07798724), (UZ 'v' O, 0.07798724),- (UZ 'w' N, 0.07844400), (UZ 'x' L, 0.13526622), (UZ 'x' M, 0.13526622), (UZ 'y' W, 0.19849003),- (UZ 'z' D, 0.06643842), (UZ 'z' K, 0.06643842)]-{-# DEPRECATED uzpp2Durat3 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}--uzpp2Durat4 :: UZPP2 -> Float-uzpp2Durat4 = getBFstLSorted' 0.14160713 [(UZ 'A' D, 0.08508446), (UZ 'A' K, 0.08508446), (UZ 'B' D, 0.17053331),- (UZ 'B' K, 0.17053331), (UZ 'C' S, 0.06241711), (UZ 'D' N, 0.12159184), (UZ 'E' L, 0.21173804), (UZ 'E' M, 0.21173804),- (UZ 'F' L, 0.24441358), (UZ 'F' M, 0.24441358), (UZ 'a' W, 0.20859653), (UZ 'b' D, 0.07768941),- (UZ 'b' K, 0.07768941), (UZ 'c' D, 0.05705798), (UZ 'd' D, 0.12987485), (UZ 'd' K, 0.12987485),- (UZ 'e' W, 0.21194045), (UZ 'f' L, 0.19044721), (UZ 'f' M, 0.19044721), (UZ 'g' D, 0.14343568),- (UZ 'g' K, 0.14343568), (UZ 'h' D, 0.22822145), (UZ 'h' K, 0.22822145), (UZ 'i' W, 0.20167924),- (UZ 'j' D, 0.16712392), (UZ 'j' K, 0.16712392), (UZ 'k' L, 0.10747824), (UZ 'k' M, 0.10747824),- (UZ 'l' S, 0.16563571), (UZ 'l' O, 0.16563571), (UZ 'm' S, 0.26940890), (UZ 'm' O, 0.26940890),- (UZ 'n' S, 0.13174949), (UZ 'n' O, 0.13174949), (UZ 'o' W, 0.20890920), (UZ 'p' L, 0.05737927),- (UZ 'p' M, 0.05737927), (UZ 'q' E, 0.01957491), (UZ 'r' S, 0.05978079), (UZ 'r' O, 0.05978079),- (UZ 's' L, 0.10201693), (UZ 't' L, 0.18138075), (UZ 't' M, 0.18138075), (UZ 'u' W, 0.19826109),- (UZ 'v' S, 0.09572877), (UZ 'v' O, 0.09572877), (UZ 'w' N, 0.07663289), (UZ 'x' L, 0.26765448),- (UZ 'x' M, 0.26765448), (UZ 'y' W, 0.20249813), (UZ 'z' D, 0.08566847), (UZ 'z' K, 0.08566847)]-{-# DEPRECATED uzpp2Durat4 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}---- | General variant of the 'syllableDurations' function with the arbitrary 'uzpp2Durat1'-like function.-syllableDurationsG :: (UZPP2 -> Float) -> [[[UZPP2]]] -> [[Float]]-syllableDurationsG g = fmap (fmap (sum . fmap g))-{-# INLINABLE syllableDurationsG #-}-{-# DEPRECATED syllableDurationsG "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}---- | Returns list of lists, every inner one of which contains approximate durations of the Ukrainian syllables.-syllableDurations :: [[[UZPP2]]] -> [[Float]]-syllableDurations = syllableDurationsG uzpp2Durat1-{-# DEPRECATED syllableDurations "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}---- | Likewise 'syllableDurations', but uses 'uzpp2Durat2' instead of 'uzpp2Durat1'.-syllableDurations2 :: [[[UZPP2]]] -> [[Float]]-syllableDurations2 = syllableDurationsG uzpp2Durat2-{-# DEPRECATED syllableDurations2 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}---- | Likewise 'syllableDurations', but uses 'uzpp2Durat3' instead of 'uzpp2Durat1'.-syllableDurations3 :: [[[UZPP2]]] -> [[Float]]-syllableDurations3 = syllableDurationsG uzpp2Durat3-{-# DEPRECATED syllableDurations3 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}---- | Likewise 'syllableDurations', but uses 'uzpp2Durat4' instead of 'uzpp2Durat1'.-syllableDurations4 :: [[[UZPP2]]] -> [[Float]]-syllableDurations4 = syllableDurationsG uzpp2Durat4-{-# DEPRECATED syllableDurations4 "Please, if possible, use the corresponding functions from the Languages.Phonetic.Ukrainian.Syllable.Double.Arr module." #-}
Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Languages.Phonetic.Ukrainian.Syllable.ArrInt8--- Copyright : (c) OleksandrZhabenko 2021+-- Copyright : (c) OleksandrZhabenko 2021-2022 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com
− Languages/Phonetic/Ukrainian/Syllable/Double/Arr.hs
@@ -1,101 +0,0 @@--- |--- Module : Languages.Phonetic.Ukrainian.Syllable.Double.Arr--- Copyright : (c) OleksandrZhabenko 2020-2021--- License : MIT--- Stability : Experimental--- Maintainer : olexandr543@yahoo.com------ This module works with syllable segmentation in Ukrainian. Uses 'Double' whenever possible.-----module Languages.Phonetic.Ukrainian.Syllable.Double.Arr where--import CaseBi.Arr-import Languages.Phonetic.Ukrainian.Syllable.Arr (UZPP(..),UZPP2,PhoneticType(..))---- | 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 'Double' data are gotten from there.-str2DuratD1 :: String -> Double-str2DuratD1 = getBFstLSorted' 0.153016 [("-", (0.101995)), ("0", (0.051020)), ("1", (0.153016)), ("а", 0.138231), ("б", 0.057143),- ("в", 0.082268), ("г", 0.076825), ("д", 0.072063), ("дж", 0.048934), ("дз", 0.055601), ("е", 0.093605), ("ж", 0.070658), ("з", 0.056054),- ("и", 0.099955), ("й", 0.057143), ("к", 0.045351), ("л", 0.064036), ("м", 0.077370), ("н", 0.074240), ("о", 0.116463), ("п", 0.134830),- ("р", 0.049206), ("с", 0.074603), ("сь", 0.074558), ("т", 0.110658), ("у", 0.109070), ("ф", 0.062268), ("х", 0.077188), ("ц", 0.053061),- ("ць", 0.089342), ("ч", 0.057596), ("ш", 0.066077), ("ь", 0.020227), ("і", 0.094150), ("ґ", 0.062948)]---- | Just another possible duration approximation obtained by usage of the @r-glpk-phonetic-languages-ukrainian-durations@ package--- https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations.--- It is generated for the set of the words-durations pairs that the words contents ('Char') converts to the elements of the--- \"ABCEFXYabcdefghijklmnopqrstuvxyz\" (for more information, pleas, refer to the--- https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations).-uzpp2DuratD2 :: UZPP2 -> Double-uzpp2DuratD2 = getBFstLSorted' 0.06408817 [(UZ 'A' D, 0.07729654), (UZ 'A' K, 0.07729654), (UZ 'B' D, 0.08048113), (UZ 'B' K, 0.08048113),- (UZ 'C' S, 0.08226452), (UZ 'D' N, 0.07512999), (UZ 'E' L, 0.12541547), (UZ 'E' M, 0.12541547), (UZ 'F' L, 0.12838476), (UZ 'F' M, 0.12838476),- (UZ 'a' W, 0.27161466), (UZ 'b' D, 0.10977617), (UZ 'b' K, 0.10977617), (UZ 'c' D, 0.05616409), (UZ 'd' D, 0.06586550), (UZ 'd' K, 0.06586550),- (UZ 'e' W, 0.27192511), (UZ 'f' L, 0.15776219), (UZ 'f' M, 0.15776219), (UZ 'g' D, 0.07751571), (UZ 'g' K, 0.07751571), (UZ 'h' D, 0.05392745),- (UZ 'h' K, 0.05392745), (UZ 'i' W, 0.20026538), (UZ 'j' D, 0.08900757), (UZ 'j' K, 0.08900757), (UZ 'k' L, 0.04917820), (UZ 'k' M, 0.04917820),- (UZ 'l' S, 0.11159399), (UZ 'l' O, 0.11159399), (UZ 'm' S, 0.14303837), (UZ 'm' O, 0.14303837), (UZ 'n' S, 0.05639178),- (UZ 'n' O, 0.05639178), (UZ 'o' W, 0.28539351), (UZ 'p' L, 0.09603085), (UZ 'p' M, 0.09603085), (UZ 'q' E, 0.02218624), (UZ 'r' S, 0.06354637),- (UZ 'r' O, 0.06354637), (UZ 's' L, 0.05294375), (UZ 't' L, 0.05047358), (UZ 't' M, 0.05047358), (UZ 'u' W, 0.25250039),- (UZ 'v' S, 0.08404524), (UZ 'v' O, 0.08404524), (UZ 'w' N, 0.07835033), (UZ 'x' L, 0.07905155), (UZ 'x' M, 0.07905155),- (UZ 'y' W, 0.20509350), (UZ 'z' D, 0.06099951), (UZ 'z' K, 0.06099951)]--uzpp2DuratD1 :: UZPP2 -> Double-uzpp2DuratD1 = getBFstLSorted' 0.051020 [(UZ 'A' D, 0.055601), (UZ 'A' K, 0.055601), (UZ 'B' D, 0.070658), (UZ 'B' K, 0.070658), (UZ 'C' S, 0.057143), (UZ 'D' N, 0.074558),- (UZ 'E' L, 0.057596), (UZ 'E' M, 0.057596), (UZ 'F' L, 0.066077), (UZ 'F' M, 0.066077), (UZ 'a' W, 0.138231), (UZ 'b' D, 0.057143), (UZ 'b' K, 0.057143), (UZ 'c' D, 0.053061),- (UZ 'd' D, 0.072063), (UZ 'd' K, 0.072063), (UZ 'e' W, 0.093605), (UZ 'f' L, 0.062268), (UZ 'f' M, 0.062268), (UZ 'g' D, 0.062948), (UZ 'g' K, 0.062948), (UZ 'h' D, 0.076825),- (UZ 'h' K, 0.076825), (UZ 'i' W, 0.094150), (UZ 'j' D, 0.048934), (UZ 'j' K, 0.048934), (UZ 'k' L, 0.045351), (UZ 'k' M, 0.045351), (UZ 'l' S, 0.064036), (UZ 'l' O, 0.064036),- (UZ 'm' S, 0.077370), (UZ 'm' O, 0.077370), (UZ 'n' S, 0.074240), (UZ 'n' O, 0.074240), (UZ 'o' W, 0.116463), (UZ 'p' L, 0.134830), (UZ 'p' M, 0.134830),- (UZ 'q' E, 0.020227), (UZ 'r' S, 0.049206), (UZ 'r' O, 0.049206), (UZ 's' L, 0.074603), (UZ 't' L, 0.110658), (UZ 't' M, 0.110658), (UZ 'u' W, 0.109070), (UZ 'v' S, 0.082268),- (UZ 'v' O, 0.082268), (UZ 'w' N, 0.089342), (UZ 'x' L, 0.077188), (UZ 'x' M, 0.077188), (UZ 'y' W, 0.099955), (UZ 'z' D, 0.056054), (UZ 'z' K, 0.056054)]--uzpp2DuratD3 :: UZPP2 -> Double-uzpp2DuratD3 = getBFstLSorted' 0.05779993 [(UZ 'A' D, 0.08453724), (UZ 'A' K, 0.08453724),- (UZ 'B' D, 0.09996042), (UZ 'B' K, 0.09996042), (UZ 'C' S, 0.10975353), (UZ 'D' N, 0.08190674),- (UZ 'E' L, 0.11906522), (UZ 'E' M, 0.11906522), (UZ 'F' L, 0.13985258), (UZ 'F' M, 0.13985258),- (UZ 'a' W, 0.25872483), (UZ 'b' D, 0.13787716), (UZ 'b' K, 0.13787716), (UZ 'c' D, 0.05901357),- (UZ 'd' D, 0.07437409), (UZ 'd' K, 0.07437409), (UZ 'e' W, 0.22876537), (UZ 'f' L, 0.15880087),- (UZ 'f' M, 0.15880087), (UZ 'g' D, 0.07985903), (UZ 'g' K, 0.07985903), (UZ 'h' D, 0.10289067),- (UZ 'h' K, 0.10289067), (UZ 'i' W, 0.19777405), (UZ 'j' D, 0.10039843), (UZ 'j' K, 0.10039843),- (UZ 'k' L, 0.05893304), (UZ 'k' M, 0.05893304), (UZ 'l' S, 0.10906450), (UZ 'l' O, 0.10906450),- (UZ 'm' S, 0.14576594), (UZ 'm' O, 0.14576594), (UZ 'n' S, 0.06084464), (UZ 'n' O, 0.06084464),- (UZ 'o' W, 0.25423777), (UZ 'p' L, 0.10765654), (UZ 'p' M, 0.10765654), (UZ 'q' E, 0.01943042),- (UZ 'r' S, 0.05937718), (UZ 'r' O, 0.05937718), (UZ 's' L, 0.06247632), (UZ 't' L, 0.06039120),- (UZ 't' M, 0.06039120), (UZ 'u' W, 0.20243791), (UZ 'v' S, 0.07798724), (UZ 'v' O, 0.07798724),- (UZ 'w' N, 0.07844400), (UZ 'x' L, 0.13526622), (UZ 'x' M, 0.13526622), (UZ 'y' W, 0.19849003),- (UZ 'z' D, 0.06643842), (UZ 'z' K, 0.06643842)]--uzpp2DuratD4 :: UZPP2 -> Double-uzpp2DuratD4 = getBFstLSorted' 0.14160713 [(UZ 'A' D, 0.08508446), (UZ 'A' K, 0.08508446), (UZ 'B' D, 0.17053331),- (UZ 'B' K, 0.17053331), (UZ 'C' S, 0.06241711), (UZ 'D' N, 0.12159184), (UZ 'E' L, 0.21173804), (UZ 'E' M, 0.21173804),- (UZ 'F' L, 0.24441358), (UZ 'F' M, 0.24441358), (UZ 'a' W, 0.20859653), (UZ 'b' D, 0.07768941),- (UZ 'b' K, 0.07768941), (UZ 'c' D, 0.05705798), (UZ 'd' D, 0.12987485), (UZ 'd' K, 0.12987485),- (UZ 'e' W, 0.21194045), (UZ 'f' L, 0.19044721), (UZ 'f' M, 0.19044721), (UZ 'g' D, 0.14343568),- (UZ 'g' K, 0.14343568), (UZ 'h' D, 0.22822145), (UZ 'h' K, 0.22822145), (UZ 'i' W, 0.20167924),- (UZ 'j' D, 0.16712392), (UZ 'j' K, 0.16712392), (UZ 'k' L, 0.10747824), (UZ 'k' M, 0.10747824),- (UZ 'l' S, 0.16563571), (UZ 'l' O, 0.16563571), (UZ 'm' S, 0.26940890), (UZ 'm' O, 0.26940890),- (UZ 'n' S, 0.13174949), (UZ 'n' O, 0.13174949), (UZ 'o' W, 0.20890920), (UZ 'p' L, 0.05737927),- (UZ 'p' M, 0.05737927), (UZ 'q' E, 0.01957491), (UZ 'r' S, 0.05978079), (UZ 'r' O, 0.05978079),- (UZ 's' L, 0.10201693), (UZ 't' L, 0.18138075), (UZ 't' M, 0.18138075), (UZ 'u' W, 0.19826109),- (UZ 'v' S, 0.09572877), (UZ 'v' O, 0.09572877), (UZ 'w' N, 0.07663289), (UZ 'x' L, 0.26765448),- (UZ 'x' M, 0.26765448), (UZ 'y' W, 0.20249813), (UZ 'z' D, 0.08566847), (UZ 'z' K, 0.08566847)]---- | General variant of the 'syllableDurationsD' function with the arbitrary 'uzpp2DuratD1'-like function.-syllableDurationsGD :: (UZPP2 -> Double) -> [[[UZPP2]]] -> [[Double]]-syllableDurationsGD g = fmap (fmap (sum . fmap g))-{-# INLINABLE syllableDurationsGD #-}---- | Returns list of lists, every inner one of which contains approximate durations of the Ukrainian syllables.-syllableDurationsD :: [[[UZPP2]]] -> [[Double]]-syllableDurationsD = syllableDurationsGD uzpp2DuratD1---- | Likewise 'syllableDurations', but uses 'uzpp2DuratD2' instead of 'uzpp2DuratD1'.-syllableDurationsD2 :: [[[UZPP2]]] -> [[Double]]-syllableDurationsD2 = syllableDurationsGD uzpp2DuratD2---- | Likewise 'syllableDurations', but uses 'uzpp2DuratD3' instead of 'uzpp2DuratD1'.-syllableDurationsD3 :: [[[UZPP2]]] -> [[Double]]-syllableDurationsD3 = syllableDurationsGD uzpp2DuratD3---- | Likewise 'syllableDurations', but uses 'uzpp2DuratD4' instead of 'uzpp2DuratD1'.-syllableDurationsD4 :: [[[UZPP2]]] -> [[Double]]-syllableDurationsD4 = syllableDurationsGD uzpp2DuratD4
− Melodics/ByteString/Ukrainian/Arr.hs
@@ -1,299 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module : Melodics.ByteString.Ukrainian.Arr--- Copyright : (c) OleksandrZhabenko 2019-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.Ukrainian from the--- @mmsyn6ukr@ package : 'https://hackage.haskell.org/package/mmsyn6ukr'--- 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--- 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- convertToProperUkrainianS- , convertToProperUkrainianB- , isUkrainianL- , linkFileName- , showInteresting-) where--import qualified Data.String as S-import Data.Maybe (fromJust)-import Data.Char-import GHC.Arr-import CaseBi.Arr-import qualified Data.ByteString.Char8 as B-import Melodics.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--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 -> B.ByteString-filterUkr = B.pack . map toBSUkr--toBSUkr :: Char -> Char-toBSUkr x = getBFstLSorted' x (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" "LabvhdeBzyCklmnoprstufxcEFGqHIJiKgM") x--secondConv :: B.ByteString -> B.ByteString-secondConv = B.concatMap f- where f y- | isSpace y || isControl y = B.singleton '1'- | otherwise = getBFstLSorted' (B.singleton y) (zip "'-GHIJKLM" [B.singleton '0',B.singleton '0',"FE","Cu","Ca","Ce","Ci",B.singleton '0',B.singleton '0']) y--createTuplesByAnalysis :: B.ByteString -> [(B.ByteString, Triple)]-createTuplesByAnalysis x- | B.null x = []- | getBFstLSorted' False (zip "BEFcdfhknpstxz" (repeat True)) . B.head $ x = initialA x- | not (B.null . B.tail $ x) && (B.index x 1 == 'C' && isConsNotJ (B.head x)) = (B.copy . B.singleton . B.head $ x, T):(B.singleton 'q', Z):createTuplesByAnalysis (B.drop 2 x)- | otherwise = (B.copy . B.singleton . B.head $ x, Z):createTuplesByAnalysis (B.tail x)---initialA :: B.ByteString -> [(B.ByteString, Triple)]-initialA t1- | B.null t1 = []- | canChange t == O = (B.singleton '1', Z):initialA ts- | canChange t == Z = (B.singleton t, Z):initialA ts- | getBFstLSorted' False (zip "cdnstx" (repeat True)) t =- let (us,vs) = B.splitAt 2 t1 in- if getBFstLSorted' False (zip ["cq","dB","dz","nt","sq","st","tq","ts","xh"] (repeat True)) us- then (B.copy us, T):initialA vs- else (B.singleton t, T):initialA ts- | otherwise = (B.singleton t, T):initialA ts- where (t,ts) = fromJust . B.uncons $ t1--canChange :: Char -> Triple-canChange x- | isSpace x || isControl x || x == '-' = O- | getBFstLSorted' False (zip "BEFcdfhknpstxz" (repeat True)) x = T- | otherwise = Z--bsToCharUkr :: [(B.ByteString,Triple)] -> [(Char,Triple)]-bsToCharUkr zs- | null zs = []- | otherwise = map g zs- where g (ts,k)- | B.null ts = ('0',Z)- | otherwise = (getBFstLSorted' (B.head ts) (zip ["cq","dB","dz","nt","sq","st","tq","ts","xh"] "wjANDOPch") ts,k)--applyChanges :: [(Char, Triple)] -> [(Char, Triple)]-applyChanges [] = []-applyChanges ys = foldr f v ys- where v = []- f x xs- | null xs = (:[]) . (\(y,_) -> (y, Z)) $ x- | snd x == T =- getBFstLSorted' (fst x, Z) (zip "ABDEFNOPcdfhkpstwxz" [дз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]) (fst x):xs- | otherwise = x:xs--isVoicedObstruent :: B.ByteString -> Bool-isVoicedObstruent = getBFstLSorted' False [("A",True),("B",True),("Q",True),("R",True),("T",True),("b",True),("d",True),("g",True),("h",True),- ("j",True),("z", True)] . B.take 1--isVoicedObstruentH :: B.ByteString -> Bool-isVoicedObstruentH = getBFstLSorted' False [("A",True),("B",True),("b",True),("d",True),("g",True),("h",True),("j",True),("z", True)] . B.take 1--isVoicedObstruentS :: B.ByteString -> Bool-isVoicedObstruentS = (\u -> any (== u) ["Q","R","T"]) . B.take 1--isSoftDOrL :: [(Char, Triple)] -> Bool-isSoftDOrL xs = getBFstLSorted' False (zip ["bq","cq","dq","fq","lq","mq","nq","pq","sq","tq","vq"] (repeat True)) (takeFromFT_ 2 xs) ||- getBFstLSorted' False (zip ["P","Q","R","S","T"] . repeat $ True) (takeFromFT_ 1 xs)--isSoftDen :: [(Char, Triple)] -> Bool-isSoftDen xs = getBFstLSorted' False (zip ["Aq","cq","dq","lq","nq","sq","tq","zq"] . repeat $ True) (takeFromFT_ 2 xs) ||- getBFstLSorted' False (zip ["P","Q","R","S","T"] . repeat $ True) (takeFromFT_ 1 xs)---- in the further ??T functions the last (, T) means that it must be afterwards be separated with the soft sign into two tuples (1 additional function in the composition)--- need further processing means that there should be additional checks and may be transformations. May be they can be omitted--гT :: [(Char, Triple)] -> (Char, Triple)-гT (t:_) | fst t == 'k' || fst t == 't' = ('x', Z)- | otherwise = ('h', Z)-гT _ = ('h', Z)--дT :: [(Char, Triple)] -> (Char, Triple)-дT t1@(_:_) | takeFromFT_ 1 t1 `elem` ["B","E","F"] = ('j', Z) -- need further processing д дж- | takeFromFT_ 2 t1 `elem` ["sq","cq"] = ('Q', T) -- need further processing д дзь- | takeFromFT_ 1 t1 `elem` ["D","w"] = ('Q', T) -- need further processing д дзь- | takeFromFT_ 1 t1 `elem` ["z","s","c"] = ('A', Z) -- need further processing д дз- | otherwise = ('d', Z)-дT _ = ('d', Z)--дзT :: [(Char, Triple)] -> (Char, Triple)-дзT t1@(_:_) | isSoftDOrL t1 = ('Q', T)- | otherwise = ('A', Z)-дзT _ = ('A', Z)--жT :: [(Char, Triple)] -> (Char, Triple)-жT t1@(_:_) | takeFromFT 2 t1 `elem` ["sq","cq"] = ('R', T)- | takeFromFT 1 t1 `elem` ["D","w"] = ('R', T)- | otherwise = ('B', Z)-жT _ = ('B', Z)--зT :: [(Char, Triple)] -> (Char, Triple)-зT t1@(_:_) | takeFromFT_ 1 t1 `elem` ["B","E","F"] || takeFromFT_ 2 t1 == "dB" || takeFromFT_ 1 t1 == "j" = ('B', Z)- | isSoftDOrL t1 = ('R', T)- | takeFromFT 1 t1 `elem` ["E","F"] = ('F', Z) -- need further processing з ш- | takeFromFT 1 t1 `elem` ["s","c"] || takeFromFT_ 1 t1 `elem` ["k","p","t","f","x"] = ('s', Z) -- need further processing з с- | otherwise = ('z', Z)-зT _ = ('z', Z)--кT :: [(Char, Triple)] -> (Char, Triple)-кT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('g', Z)- | otherwise = ('k', Z)-кT _ = ('k', Z)--нтT :: [(Char, Triple)] -> (Char, Triple)-нтT t1@(_:_) | takeFromFT 2 t1 == "st" || takeFromFT 1 t1 == "O" = ('n', Z)- | takeFromFT 3 t1 == "sqk" || takeFromFT 2 t1 == "Dk" = ('S', T)- | otherwise = ('N', T)-нтT _ = ('N', T)--пT :: [(Char, Triple)] -> (Char, Triple)-пT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('b', Z)- | otherwise = ('p', Z)-пT _ = ('p', Z)--сT :: [(Char, Triple)] -> (Char, Triple)-сT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q") || isVoicedObstruentS (takeFromFT_ 1 t1) = ('R', T)- | isVoicedObstruentH . takeFromFT_ 1 $ t1 = ('z', Z)- | isSoftDOrL t1 = ('D', Z)- | takeFromFT_ 1 t1 == "F" = ('F', Z)- | otherwise = ('s', Z)-сT _ = ('s', Z)--стT :: [(Char, Triple)] -> (Char, Triple)-стT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('z', Z)- | takeFromFT_ 3 t1 == "sqk" || (takeFromFT_ 2 t1 `elem` ["Dk","cq"]) || takeFromFT_ 1 t1 == "w" = ('D', Z)- | takeFromFT_ 1 t1 `elem` ["s","n"] = ('s', Z)- | takeFromFT_ 1 t1 == "E" = ('F', Z)- | otherwise = ('O', T)-стT _ = ('O', T)--сьT :: [(Char, Triple)] -> (Char, Triple)-сьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('R', T)- | otherwise = ('D', Z)-сьT _ = ('D', Z)--тT :: [(Char, Triple)] -> (Char, Triple)-тT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q") || isVoicedObstruentS (takeFromFT_ 1 t1) = ('T', T)- | isVoicedObstruentH . takeFromFT_ 1 $ t1 = ('d', Z)- | takeFromFT_ 2 t1 == "cq" || takeFromFT_ 1 t1 == "w" = ('w', Z)- | takeFromFT_ 1 t1 == "c" = ('c', Z)- | isSoftDen t1 = ('P', T)- | takeFromFT_ 1 t1 `elem` ["E","F"] = ('E', Z)- | otherwise = ('t', Z)-тT _ = ('t', Z)--тьT :: [(Char, Triple)] -> (Char, Triple)-тьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('T', T)- | takeFromFT_ 3 t1 == "sqa" || takeFromFT_ 2 t1 == "Da" = ('w', Z)- | otherwise = ('P', T)-тьT _ = ('P', T)--фT :: [(Char, Triple)] -> (Char, Triple)-фT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('v', Z)- | otherwise = ('f', Z)-фT _ = ('f', Z)--хT :: [(Char, Triple)] -> (Char, Triple)-хT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('h', Z)- | otherwise = ('x', Z)-хT _ = ('х', Z)--цT :: [(Char, Triple)] -> (Char, Triple)-цT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q") || isVoicedObstruentS (takeFromFT_ 1 t1) = ('Q', T)- | isSoftDOrL t1 = ('w', Z)- | isVoicedObstruentH . takeFromFT_ 1 $ t1 = ('A', Z)- | otherwise = ('c', Z)-цT _ = ('c', Z)--цьT :: [(Char, Triple)] -> (Char, Triple)-цьT t1@(_:_) | (isVoicedObstruent . takeFromFT_ 1 $ t1) && B.drop 1 (takeFromFT_ 2 t1) == "q" = ('Q', T)- | otherwise = ('w', Z)-цьT _ = ('w', Z)--чT :: [(Char, Triple)] -> (Char, Triple)-чT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["sq","cq"] || takeFromFT_ 1 t1 `elem` ["D","w"] = ('w', Z)- | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('j', Z)- | otherwise = ('E', Z)-чT _ = ('E', Z)--шT :: [(Char, Triple)] -> (Char, Triple)-шT t1@(_:_) | takeFromFT_ 2 t1 `elem` ["sq","cq"] || takeFromFT_ 1 t1 `elem` ["D","w"] = ('D', Z)- | isVoicedObstruent . takeFromFT_ 1 $ t1 = ('B', Z)- | otherwise = ('F', Z)-шT _ = ('F', Z)--takeFromFT :: Int -> [(Char, Triple)] -> B.ByteString-takeFromFT n ts | if compare 0 n /= LT then True else null ts = B.empty- | compare 1 n /= LT = B.singleton k- | otherwise = k `B.cons` takeFromFT (n - 1) (take (n - 1) ts)- where k = fst (head ts)--takeFromFT2 :: Int -> [Char] -> [Char]-takeFromFT2 n ts | if compare 0 n /= LT then True else null ts = []- | compare 1 n /= LT = [ks]- | otherwise = ks:takeFromFT2 (n - 1) (tail ts)- where ks = head ts--dropFromFT2 :: Int -> [Char] -> [Char]-dropFromFT2 n ts | if compare 0 n /= LT then True else null ts = []- | compare 1 n /= LT = tail ts- | otherwise = dropFromFT2 (n - 1) (tail ts)--takeFromFT_ :: Int -> [(Char, Triple)] -> B.ByteString-takeFromFT_ n = takeFromFT n . filter (\(x, _) -> x /= '1' && x /= '0')--correctA :: [(Char, Triple)] -> [Char]-correctA = correctSomeW . separateSoftS--separateSoftS :: [(Char, Triple)] -> [Char]-separateSoftS = concatMap divideToParts--correctSomeW :: [Char] -> [Char]-correctSomeW (x:y:z:xs@(t:ys))- | x == 't' && y == 'q' && z == 'D' && t == 'a' = 'w':'w':'a':correctSomeW ys- | (x == '1' || x == '0') && y == 'C' && z == 'a' =- if take 2 xs == "En"- then x:y:z:'F':correctSomeW ys- else x:correctSomeW (y:z:xs)- | otherwise = x:correctSomeW (y:z:xs)-correctSomeW zs = zs--divideToParts :: (Char, Triple) -> [Char]-divideToParts (x, _) = getBFstLSorted' [x] (zip "NOPQRST" ["nt", "st", "tq", "Aq", "zq", "nq", "dq"]) x--correctB :: [Char] -> [Char]-correctB ys@(x:xs)- | compare (length . filter (== '1') . takeFromFT2 6 $ ys) 1 == GT = map (\t -> if t == '1' || isPunctuation t then '-' else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys)- | otherwise = (if isPunctuation x then '-' else x):correctB xs-correctB _ = []---- | A variant of the 'convertToProperUkrainian' with the 'B.ByteString' result.-convertToProperUkrainianB :: String -> B.ByteString-convertToProperUkrainianB = B.pack . convertToProperUkrainianS--linkFileName :: Char -> Char-linkFileName x = getBFstLSorted' x (zip "ABCDEFLMabcdefghijklmnopqrstuvwxyz" "GILUbc00ABZEHXfDeFMNOPQRdSTVWCaYKJ") x--showInteresting :: String -> B.ByteString-showInteresting = S.fromString . convertToProperUkrainianS
Melodics/Ukrainian/ArrInt8.hs view
@@ -1,8 +1,9 @@ {-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-} -- | -- Module : Melodics.Ukrainian.ArrInt8--- Copyright : (c) OleksandrZhabenko 2021+-- Copyright : (c) OleksandrZhabenko 2021-2022 -- License : MIT -- Maintainer : olexandr543@yahoo.com --@@ -18,6 +19,7 @@ -- * Basic functions Sound8 , FlowSound+ , convertToProperUkrainianI8WithTuples , convertToProperUkrainianI8 , isUkrainianL , linkFileNameI8@@ -29,7 +31,7 @@ import CaseBi.Arr import Data.List (uncons) import GHC.Int-import Melodics.Ukrainian.Common+import Melodics.Ukrainian.Common2 -- | Is used to signify the optimization data type of 'Int8'. type Sound8 = Int8@@ -107,90 +109,138 @@ @ -} convertToProperUkrainianI8 :: String -> FlowSound-convertToProperUkrainianI8 = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv .- filterUkr . changeIotated . filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower--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+convertToProperUkrainianI8 =+ let !tup1 = listArray (0,13) [(10,True),(17,True),(21,True),(25,True),(32,True),(38,True),(39,True),+ (41,True),(43,True),(45,True),(47,True),(49,True),(50,True),(52,True)]+ !tup2 = listArray (0,19) [(10,True),(15,True),(17,True),(19,True),(21,True),(25,True),(28,True),+ (30,True),(32,True),(34,True),(36,True),(38,True),(39,True),(41,True),(43,True),(45,True),(47,True),+ (49,True),(50,True),(52,True)]+ !tup3 = listArray (0,13) [(10,False),(17,False),(21,False),(25,False),(32,False),(38,False),(39,False),+ (41,False),(43,False),(45,False),(47,False),(49,False),(50,False),(52,False)]+ !tup4 = listArray (0,5) [(17,True),(32,True),(38,True),(49,True),(50,True),(52,True)]+ !tup5 = listArray (0,8) [([17,10],True),([17,25],True),([32,50],True),([38,7],True),([49,7],True),+ ([49,50],True),([50,7],True),([50,49],True),([52,21],True)]+ !tup6 = listArray (0,8) [([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)]+ !tup8 = listArray (0,7) [(8,True),(10,True),(15,True),(17,True),(19,True),(21,True),(23,True),(25, True)]+ !tup9 = listArray (0,10) [([15,7],True),([17,7],True),([28,7],True),([30,7],True),([32,7],True),([36,7],True),+ ([38,7],True),([43,7],True),([47,7],True),([49,7],True),([50,7],True)]+ !tup10 = listArray (0,4) [([12],True),([13],True),([14],True),([64],True),([65],True)]+ !tup11 = listArray (0,7) [([8,7],True),([17,7],True),([25,7],True),([28,7],True),([32,7],True),([38,7],True),+ ([49,7],True),([50,7],True)]+ tup7 = listArray (0,18) [(8, дзT tup9 tup10),(10, жT),(17, дT),(21, гT),(25, зT tup9 tup10),(38, цT tup8 tup9 tup10),+ (39, чT),(41, шT),(43, фT), (45, кT),(47, пT),(49, сT tup8 tup9 tup10),(50, тT tup8 tup11 tup10),+ (52, хT),(54, сьT),(62, нтT),(63, стT),(64, тьT),(66, цьT)]+ !tup12 = listArray (0,6) [(12,[8,7]),(13,[25,7]),(14,[17,7]),(62,[32,50]),(63,[49,50]),(64,[50,7]), (65,[32,7])]+ !tup13 = listArray (0,36) [('\'',-2),('-',-1),('\700',60),('\1072',1),('\1073',15),('\1074',36),('\1075',21),+ ('\1076',17),('\1077',2),('\1078',10),('\1079',25),('\1080',5),('\1081',27),('\1082',45),('\1083',28),+ ('\1084',30),('\1085',32),('\1086',3),('\1087',47),('\1088',34),('\1089',49),('\1090',50),('\1091',4),+ ('\1092',43),('\1093',52),('\1094',38),('\1095',39),('\1096',41),('\1097',55),('\1100',7),('\1102',56),+ ('\1103',57),('\1108',58),('\1110',6),('\1111',59),('\1169',19),('\8217',61)]+ !tup14 = listArray (0,8) [(-2,[-1]),(-1,[-1]),(55,[41,39]),(56,[27,4]),(57,[27,1]),(58,[27,2]),(59,[27,6]),+ (60,[-1]),(61,[-1])]+ !tup15 = listArray (0,15) [('\'',True),('-',True),('\700',True),('\1028',True),('\1030',True),('\1031',True),+ ('\1068',True),('\1100',True),('\1102',True),('\1103',True),('\1108',True),('\1110',True),('\1111',True),+ ('\1168',True),('\1169',True),('\8217',True)]+ !tup16 = listArray (0,20) [('\1073',True),('\1074',True),('\1075',True),('\1076',True),('\1078',True),+ ('\1079',True),('\1082',True),('\1083',True),('\1084',True),('\1085',True),('\1087',True),('\1088',True),+ ('\1089',True),('\1090',True),('\1092',True),('\1093',True),('\1094',True),('\1095',True),('\1096',True),+ ('\1097',True),('\1169',True)] in+ correctB . correctA tup12 . applyChanges tup7 . bsToCharUkr tup6 . createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 .+ secondConv tup14 . filterUkr tup13 . changeIotated tup16 .+ filter (\x -> isUkrainianLTup tup15 x || isSpace x || isControl x || isPunctuation x) . map toLower -filterUkr :: String -> FlowSound-filterUkr = map toBSUkr+{-| A full variant of the 'convertToProperUkrainianI8' function with all the elements for the 'getBFst'' function being+provided as 'Array' 'Int' (data tuple). Can be useful to reduce number of calculations in the complex usage scenarios.+-}+convertToProperUkrainianI8WithTuples+ :: 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)+ -> [Char]+ -> FlowSound+convertToProperUkrainianI8WithTuples !tup1 !tup2 !tup3 !tup4 !tup5 !tup6 tup7 !tup8 !tup9 !tup10 !tup11 !tup12 !tup13 !tup14 !tup15 !tup16 =+ correctB . correctA tup12 . applyChanges tup7 . bsToCharUkr tup6 . createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 .+ secondConv tup14 . filterUkr tup13 . changeIotated tup16 .+ filter (\x -> isUkrainianLTup tup15 x || isSpace x || isControl x || isPunctuation x) . map toLower -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])+changeIotated :: Array Int (Char,Bool) -> String -> String+changeIotated !tup16 (x:y:zs)+ | (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJTup tup16 x = x:'\1100':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated tup16 zs+ | otherwise = x:changeIotated tup16 (y:zs)+changeIotated _ xs = xs -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)+filterUkr :: Array Int (Char,Int8) -> String -> FlowSound+filterUkr tup13 = let !tup = (0, tup13) in map (getBFst' tup) -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)+secondConv :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+secondConv tup14 = concatMap (\y -> getBFst' ([y], tup14) y) -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))+createTuplesByAnalysis :: Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> FlowSound -> [FlowSound]+createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 x@(h:ta)+ | getBFst' (False, tup1) h = initialA tup3 tup4 tup5 x+ | not (null ta) && (head ta == 27 && getBFst' (False, tup2) h) = [h]:[7]:createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 (drop 1 ta)+ | otherwise = [h]:createTuplesByAnalysis tup1 tup2 tup3 tup4 tup5 ta+createTuplesByAnalysis _ _ _ _ _ _ = [] -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 =+initialA :: Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> FlowSound -> [FlowSound]+initialA tup3 tup4 tup5 t1@(t:ts)+ | t < 1 = [0]:initialA tup3 tup4 tup5 ts+ | getBFst' (True, tup3) t = [t]:initialA tup3 tup4 tup5 ts+ | getBFst' (False, tup4) 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 _ = []+ if getBFst' (False, tup5) us+ then us:initialA tup3 tup4 tup5 vs+ else [t]:initialA tup3 tup4 tup5 ts+ | otherwise = [t]:initialA tup3 tup4 tup5 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 -applyChanges :: FlowSound -> FlowSound-applyChanges [] = []-applyChanges ys = foldr f v ys+bsToCharUkr :: Array Int ([Int8],Int8) -> [FlowSound] -> FlowSound+bsToCharUkr tup6 zs@(_:_) = map (g tup6) zs+ where g tup6 ts@(t:_) = getBFst' (t, tup6) ts+ g _ _ = -1+bsToCharUkr _ _ = []++applyChanges+ :: Array Int (Int8,FlowSound -> Sound8)+ -> FlowSound+ -> FlowSound+applyChanges tup7 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+ f x xs@(_:_) = getBFst' (\_ -> x, tup7) x xs:xs+ f x _ = [x] isVoicedObstruent :: FlowSound -> Bool-isVoicedObstruent xs- | null xs = False- | otherwise = (\u -> u > 7 && u < 27) . head $ xs+isVoicedObstruent (x:_) = x > 7 && x < 27+isVoicedObstruent _ = False -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+isVoicedObstruentH :: Array Int (Int8,Bool) -> FlowSound -> Bool+isVoicedObstruentH tup8 (x:_) = getBFst' (False, tup8) x+isVoicedObstruentH _ _ = False isVoicedObstruentS :: FlowSound -> Bool-isVoicedObstruentS xs- | null xs = False- | otherwise = (\u -> u > 11 && u < 15) . head $ xs+isVoicedObstruentS (x:_) = x > 11 && x < 15+isVoicedObstruentS _ = False -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)+isSoftDOrL :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Bool+isSoftDOrL tup9 tup10 xs = getBFst' (False, tup9) (takeFromFT_ 2 xs) || getBFst' (False, tup10) (takeFromFT_ 1 xs) -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)+isSoftDen :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Bool+isSoftDen tup11 tup10 xs = getBFst' (False, tup11) (takeFromFT_ 2 xs) || getBFst' (False, tup10) (takeFromFT_ 1 xs) гT :: FlowSound -> Sound8 гT (t:_) | t == 45 || t == 50 = 52 -- г х@@ -205,10 +255,10 @@ | otherwise = 17 дT _ = 17 -дзT :: FlowSound -> Sound8-дзT t1@(_:_) | isSoftDOrL t1 = 12 -- дз дзь- | otherwise = 8-дзT _ = 8+дзT :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8+дзT tup9 tup10 t1@(_:_) | isSoftDOrL tup9 tup10 t1 = 12 -- дз дзь+ | otherwise = 8+дзT _ _ _ = 8 жT :: FlowSound -> Sound8 жT t1@(_:_) | takeFromFT 2 t1 `elem` [[49,7],[38,7]] = 13 -- ж зь@@ -216,13 +266,13 @@ | otherwise = 10 жT _ = 10 -з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+зT :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8+зT tup9 tup10 t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] || takeFromFT_ 2 t1 == [17,10] || takeFromFT_ 1 t1 == [23] = 10 -- з ж+ | isSoftDOrL tup9 tup10 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 кT :: FlowSound -> Sound8 кT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 19@@ -240,22 +290,23 @@ | otherwise = 47 пT _ = 47 -с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+сT :: Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8+сT tup8 tup9 tup10 t1@(_:_)+ | ((isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||+ isVoicedObstruentS (takeFromFT_ 1 t1) = 13+ | isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1 = 25+ | isSoftDOrL tup9 tup10 t1 = 54+ | takeFromFT_ 1 t1 == [41] = 41+ | otherwise = 49+сT _ _ _ _ = 49 ст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 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 сьT :: FlowSound -> Sound8@@ -263,16 +314,17 @@ | otherwise = 54 сьT _ = 54 -т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+тT :: Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8+тT tup8 tup11 tup10 t1@(_:_)+ | ((isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||+ isVoicedObstruentS (takeFromFT_ 1 t1) = 14+ | isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1 = 17+ | takeFromFT_ 2 t1 == [38,7] || takeFromFT_ 1 t1 == [66] = 66+ | takeFromFT_ 1 t1 == [38] = 38+ | isSoftDen tup11 tup10 t1 = 64+ | takeFromFT_ 1 t1 `elem` [[39],[41]] = 39+ | otherwise = 50+тT _ _ _ _ = 50 тьT :: FlowSound -> Sound8 тьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 14@@ -290,13 +342,14 @@ | otherwise = 52 хT _ = 52 -ц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+цT :: Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8+цT tup8 tup9 tup10 t1@(_:_)+ | ((isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) ||+ isVoicedObstruentS (takeFromFT_ 1 t1) = 12+ | isSoftDOrL tup9 tup10 t1 = 66+ | isVoicedObstruentH tup8 . takeFromFT_ 1 $ t1 = 8+ | otherwise = 38+цT _ _ _ _ = 38 цьT :: FlowSound -> Sound8 цьT t1@(_:_) | (isVoicedObstruent . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7] = 12@@ -335,11 +388,11 @@ takeFromFT_ :: Int -> FlowSound -> FlowSound takeFromFT_ n = takeFromFT n . filter (>0) -correctA :: FlowSound -> FlowSound-correctA = correctSomeW . separateSoftS+correctA :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+correctA tup12 = correctSomeW . separateSoftS tup12 -separateSoftS :: FlowSound -> FlowSound-separateSoftS = concatMap divideToParts+separateSoftS :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+separateSoftS tup12 = concatMap (\x -> getBFst' ([x], tup12) x) correctSomeW :: FlowSound -> FlowSound correctSomeW (x:y:z:xs@(t:ys))@@ -350,10 +403,6 @@ 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 correctB :: FlowSound -> FlowSound correctB ys@(x:xs)
− Melodics/Ukrainian/Common.hs
@@ -1,33 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module : Melodics.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.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.4.2.0+version: 0.5.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. 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.+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 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, Melodics.Ukrainian.Common, Languages.Phonetic.Ukrainian.Syllable.Double.Arr, Languages.Phonetic.Ukrainian.Syllable.ArrInt8, Melodics.Ukrainian.ArrInt8, Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8+ exposed-modules: Languages.Phonetic.Ukrainian.Syllable.ArrInt8, Melodics.Ukrainian.ArrInt8, Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 -- other-modules:- 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+ other-extensions: DeriveDataTypeable, FlexibleInstances, OverloadedStrings, TypeSynonymInstances, BangPatterns+ build-depends: base >=4.8 && <5, mmsyn2-array >=0.3 && <1, mmsyn5 >=0.5 && <1, ukrainian-phonetics-common >=0.1.1 && <1 -- hs-source-dirs: default-language: Haskell2010