ukrainian-phonetics-basic-array 0.6.0.0 → 0.10.0.0
raw patch · 10 files changed
Files
- CHANGELOG.md +16/−0
- LICENSE +1/−1
- Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +0/−269
- Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs +0/−65
- Melodics/Ukrainian/ArrInt8.hs +0/−444
- Phladiprelio/Ukrainian/Melodics.hs +415/−0
- Phladiprelio/Ukrainian/Syllable.hs +275/−0
- Phladiprelio/Ukrainian/SyllableWord8.hs +89/−0
- README.md +22/−0
- ukrainian-phonetics-basic-array.cabal +7/−6
CHANGELOG.md view
@@ -64,3 +64,19 @@ Fixed some issues with the dash '-' and apostrophe signs in word and syllable segmentation. These changes affect the general results of the package functions work. +## 0.7.0.0 -- 2023-02-02++* Seventh version. Switched to NoImplicitPrelude and Strict extensions. Updated the metadata and dependencies boundaries. Changed the names of the modules.++## 0.7.1.0 -- 2024-02-22++* Seventh version revised A. Some code improvements related to inlining. Switched to intermediate-structures instead of mmsyn5 as a dependency. Added README.md, devotion and Github repository with bug-tracker.++## 0.7.1.1 -- 2024-02-22++* Seventh version revised B. Fixed issue with documentation link.++## 0.10.0.0 -- 2024-04-07++* Tenth version. Made a window for possible new subtle modifications to the versions before 0.10.0.0. Switched from Double to Word8 in durations module. Therefore, changed the name to Phladiprelio.Ukrainian.SyllableWord8. +
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2020 Oleksandr Zhabenko+Copyright (c) 2020-2024 Oleksandr Zhabenko Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
− Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs
@@ -1,269 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}-{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, BangPatterns #-}---- |--- Module : Languages.Phonetic.Ukrainian.Syllable.ArrInt8--- Copyright : (c) OleksandrZhabenko 2021-2022--- 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--- The information on Ukrainian syllable segmentation 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-----module Languages.Phonetic.Ukrainian.Syllable.ArrInt8 (- -- * Basic functionality- isVowel1- , isSonorous1- , isVoicedC1- , isVoicelessC1- , isNotVowel2- , isNotVowel2'- , sndGroups- , groupSnds- , divCnsnts- , reSyllableCntnts- , divVwls- , createSyllablesUkrS- , notEqC- , representProlonged- , showS8- , showFS- -- * 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)-import Melodics.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 < 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.--- Starting from the version 0.6.0.0 variants of either of arguments is greater than 99 is also included.-isNotVowel2 :: Sound8 -> Sound8 -> Bool-isNotVowel2 x y = x > 6 && y > 6-{-# INLINE isNotVowel2 #-}---- | Binary function-predicate 'isNotVowel2'' checks whether its arguments are both consonant representations in the 'Sound8' format.--- Starting from the version 0.6.0.0 variants of either of arguments is greater than 99 are not included (so its behaviour is equivalent to the--- 'isNotVowel2' till the 0.5.3.0 version).-isNotVowel2' :: Sound8 -> Sound8 -> Bool-isNotVowel2' x y = x < 100 && y < 100 && 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@(y:zs@(z:ts@(_:_))))- | isSonorous1 x || isVoicedC1 x =- case y of- 7 -> ((`mappend` [x,7]),mappend zs) -- "рибаль-ство"- _ -> ((`mappend` [x]),mappend ys)- | isSonorous1 y =- case z of- 7 -> ((`mappend` [x,y,7]),mappend ts) -- "рокль-ський" (?), "супрасль-ський"- _ -> ((`mappend` [x,y]),mappend zs) -- "дофр-ський" (?)- | otherwise = (id,mappend xs)-divCnsnts xs@(x:ys@(y:zs@(z:ts)))- | isSonorous1 x =- case y of- 7 -> ((`mappend` [x,7]),mappend zs) -- "поль-ка", "каль-ка"- _ -> ((`mappend` [x]),mappend ys)- | isSonorous1 y =- case z of- 7 -> (id,mappend xs) -- "сього-дні"- _ -> ((`mappend` [x,y]),mappend zs)- | otherwise = (id,mappend xs)-divCnsnts xs@(x:ys@(y:zs))- | (isSonorous1 x && notEqC x y && y /= 7) || (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@(y:zs@(z:ts@(_:_))))- | isSonorous1 x || isVoicedC1 x =- case y of- 7 -> ((`mappend` [x,7]),mappend zs) -- "рибаль-ство"- _ -> ((`mappend` [x]),mappend ys)- | isSonorous1 y =- case z of- 7 -> ((`mappend` [x,y,7]),mappend ts) -- "рокль-ський" (?), "супрасль-ський"- _ -> ((`mappend` [x,y]),mappend zs) -- "дофр-ський" (?)- | otherwise = (id,mappend xs)-divCnsntsTup !tup17 xs@(x:ys@(y:zs@(z:ts)))- | isSonorous1 x =- case y of- 7 -> ((`mappend` [x,7]),mappend zs) -- "поль-ка", "каль-ка"- _ -> ((`mappend` [x]),mappend ys)- | isSonorous1 y =- case z of- 7 -> (id,mappend xs) -- "сього-дні"- _ -> ((`mappend` [x,y]),mappend zs) - | otherwise = (id,mappend xs)-divCnsntsTup !tup17 xs@(x:ys@(y:_))- | (isSonorous1 x && (notEqCTup tup17 x y) && y /= 7) || (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)- | 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-{-# 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-{-# INLINE createSyllablesUkrSTup #-}---- | Practically this is an optimized version for this case 'words' function from Prelude.-words1 :: FlowSound -> [FlowSound]-words1 xs = if null ts then [] else w : words1 s'' - where ts = dropWhile (> 99) xs- (w, s'') = span (< 100) ts-{-# NOINLINE words1 #-}----------------------------------------------------------- | 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---- | 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--- 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--showS8 :: Sound8 -> String-showS8 = getBFstLSorted' " " [(1,"\1072"),(2,"\1077"),(3,"\1086"),(4,"\1091"),(5,"\1080"),(6,"\1110"),(7,"\1100"),(8,"\1076\1079"),- (9,"\1076\1079"),(10,"\1078"),(11,"\1078"),(15,"\1073"),(16,"\1073"),(17,"\1076"),(18,"\1076"),(19,"\1169"),(20,"\1169"),- (21,"\1075"),(22,"\1075"),(23,"\1076\1078"),(24,"\1076\1078"),(25,"\1079"),(26,"\1079"),(27,"\1081"),(28,"\1083"),(29,"\1083"),- (30,"\1084"),(31,"\1084"),(32,"\1085"),(33,"\1085"),(34,"\1088"),(35,"\1088"),(36,"\1074"),(37,"\1074"),(38,"\1094"),- (39,"\1095"),(40,"\1095"),(41,"\1096"),(42,"\1096"),(43,"\1092"),(44,"\1092"),(45,"\1082"),(46,"\1082"),(47,"\1087"),- (48,"\1087"),(49,"\1089"),(50,"\1090"),(51,"\1090"),(52,"\1093"),(53,"\1093"),(54,"\1089\1100"),(66,"\1094\1100")]-{-# INLINABLE showS8 #-}--showFS :: FlowSound -> String-showFS = concatMap showS8 -- Probably, it is better to transform several consequent spaces into the combination smth like \", \" (but not in this version)-{-# INLINE showFS #-}
− Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs
@@ -1,65 +0,0 @@-{-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_HADDOCK show-extensions #-}--- |--- Module : Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8--- Copyright : (c) OleksandrZhabenko 2021-2022--- 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.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)]---- |-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)]--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)]--s0DuratD4 :: Sound8 -> Double-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- sDuratsD2 :: a -> Double- sDuratsD3 :: a -> Double- sDuratsD4 :: a -> Double- syllableDurationsGDc :: (a -> Double) -> [[[a]]] -> [[Double]]- syllableDurationsGDc g = map (map (k g))- where k f = foldl' (\y x -> f x + y) 0- {-# 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--syllableDurationsD :: [[[Sound8]]] -> [[Double]]-syllableDurationsD = syllableDurationsGDc s0DuratD1--syllableDurationsD2 :: [[[Sound8]]] -> [[Double]]-syllableDurationsD2 = syllableDurationsGDc s0DuratD2--syllableDurationsD3 :: [[[Sound8]]] -> [[Double]]-syllableDurationsD3 = syllableDurationsGDc s0DuratD3--syllableDurationsD4 :: [[[Sound8]]] -> [[Double]]-syllableDurationsD4 = syllableDurationsGDc s0DuratD4
− Melodics/Ukrainian/ArrInt8.hs
@@ -1,444 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}-{-# LANGUAGE BangPatterns #-}---- |--- Module : Melodics.Ukrainian.ArrInt8--- Copyright : (c) OleksandrZhabenko 2021-2022--- 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.Ukrainian.ArrInt8 (- -- * Basic functions- Sound8- , FlowSound- , convertToProperUkrainianI8WithTuples- , convertToProperUkrainianI8- , isUkrainianL- , linkFileNameI8- -- * Transformation functions- , дзT- , жT- , дT- , гT- , зT- , цT- , чT- , шT- , фT- , кT- , пT- , сT- , тT- , хT- , сьT- , нтT- , стT- , тьT- , цьT-) where--import Data.Maybe (fromJust)-import Data.Char-import GHC.Arr-import CaseBi.Arr-import Data.List (uncons)-import GHC.Int-import Melodics.Ukrainian.Common2---- | Is used to signify the optimization data type of 'Int8'.-type Sound8 = Int8--type FlowSound = [Sound8]--{-| The function that uses the following correspondence between the previous data type UZPP2 and the 'Sound8'.-@-UZ \'A\' D дз (plain) 8-UZ \'A\' K дз (palatalized) 9-UZ \'B\' D ж (plain) 10-UZ \'B\' K ж (semi-palatalized) 11-UZ \'C\' S й 27-UZ \'D\' N сь 54-UZ \'E\' L ч (plain) 39-UZ \'E\' M ч (semi-palatalized) 40-UZ \'F\' L ш (plain) 41-UZ \'F\' M ш (semi-palatalized) 42- G 55- H 56- I 57- J 58- K 59- L 60- M 61- N нт 62- O ст 63- P ть 64- Q дзь 12- R зь 13- S нь 65- T дь 14-UZ \'a\' W а 1-UZ \'b\' D б (plain) 15-UZ \'b\' K б (semi-palatalized) 16-UZ \'c\' D ц (plain) 38-UZ \'d\' D д (plain) 17-UZ \'d\' K д (palatalized) 18-UZ \'e\' W е 2-UZ \'f\' L ф (plain) 43-UZ \'f\' M ф (semi-palatalized) 44-UZ \'g\' D ґ (plain) 19-UZ \'g\' K ґ (semi-palatalized) 20-UZ \'h\' D г (plain) 21-UZ \'h\' K г (semi-palatalized) 22-UZ \'i\' W і 6-UZ \'j\' D дж (plain) 23-UZ \'j\' K дж (palatalized) 24-UZ \'k\' L к (plain) 45-UZ \'k\' M к (semi-palatalized) 46-UZ \'l\' S л (plain) 28-UZ \'l\' O л (palatalized) 29-UZ \'m\' S м (plain) 30-UZ \'m\' O м (semi-palatalized) 31-UZ \'n\' S н (plain) 32-UZ \'n\' O н (palatalized) 33-UZ \'o\' W о 3-UZ \'p\' L п (plain) 47-UZ \'p\' M п (semi-palatalized) 48-UZ \'q\' E ь 7-UZ \'r\' S р (plain) 34-UZ \'r\' O р (palatalized) 35-UZ \'s\' L с (plain) 49-UZ \'t\' L т (plain) 50-UZ \'t\' M т (palatalized) 51-UZ \'u\' W у 4-UZ \'v\' S в (plain) 36-UZ \'v\' O в (semi-palatalized) 37-UZ \'w\' N ць 66-UZ \'x\' L х (plain) 52-UZ \'x\' M х (semi-palatalized) 53-UZ \'y\' W и 5-UZ \'z\' D з (plain) 25-UZ \'z\' K з (palatalized) 26-@--Starting from the version 0.6.0.0:---2 -> 102--1 -> 101-0 -> 100--}-convertToProperUkrainianI8 :: String -> FlowSound-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) [('\'',102),('-',101),('\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) [(55,[41,39]),(56,[27,4]),(57,[27,1]),(58,[27,2]),(59,[27,6]),- (60,[101]),(61,[101]),(101,[101]),(102,[101])]- !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--{-| 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--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- | x == '\'' || x == '\x2019' || x == '\x02BC' || x == '-' = if (y `elem` ("\1102\1103\1108\1110"::String)) then '\1081':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated tup16 zs else changeIotated tup16 (y:zs)- | otherwise = x:changeIotated tup16 (y:zs)-changeIotated _ xs = xs--filterUkr :: Array Int (Char,Int8) -> String -> FlowSound-filterUkr tup13 = let !tup = (100, tup13) in map (getBFst' tup)--secondConv :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound-secondConv tup14 = concatMap (\y -> getBFst' ([y], tup14) y)--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 :: Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> FlowSound -> [FlowSound]-initialA tup3 tup4 tup5 t1@(t:ts)- | t < 1 || t > 99 = [100]: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 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 :: Array Int ([Int8],Int8) -> [FlowSound] -> FlowSound-bsToCharUkr tup6 zs@(_:_) = map (g tup6) zs- where g tup6 ts@(t:_) = getBFst' (t, tup6) ts- g _ _ = 101-bsToCharUkr _ _ = []--applyChanges- :: Array Int (Int8,FlowSound -> Sound8)- -> FlowSound- -> FlowSound-applyChanges tup7 ys = foldr f v ys- where v = []- f x xs@(_:_) = getBFst' (\_ -> x, tup7) x xs:xs- f x _ = [x]--isVoicedObstruent :: FlowSound -> Bool-isVoicedObstruent (x:_) = x > 7 && x < 27-isVoicedObstruent _ = False--isVoicedObstruentH :: Array Int (Int8,Bool) -> FlowSound -> Bool-isVoicedObstruentH tup8 (x:_) = getBFst' (False, tup8) x-isVoicedObstruentH _ _ = False--isVoicedObstruentS :: FlowSound -> Bool-isVoicedObstruentS (x:_) = x > 11 && x < 15-isVoicedObstruentS _ = False--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 :: 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 -- г х- | otherwise = 21-гT _ = 21--д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--дз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 -- ж зь- | takeFromFT 1 t1 `elem` [[54],[66]] = 13- | otherwise = 10-жT _ = 10--з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- | otherwise = 45-кT _ = 45--нт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--пT :: FlowSound -> Sound8-пT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 15- | otherwise = 47-пT _ = 47--с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 _ = 63--сьT :: FlowSound -> Sound8-сьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 13- | otherwise = 54-сьT _ = 54--т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- | takeFromFT_ 3 t1 == [49,7,1] || takeFromFT_ 2 t1 == [54,1] = 66- | otherwise = 64-тьT _ = 64--фT :: FlowSound -> Sound8-фT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 36- | otherwise = 43-фT _ = 43--хT :: FlowSound -> Sound8-хT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 21- | otherwise = 52-хT _ = 52--ц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- | otherwise = 66-цьT _ = 66--ч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--ш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--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 (\t -> t > 0 && t < 100)--correctA :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound-correctA tup12 = correctSomeW . separateSoftS tup12--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))- | x == 50 && y == 7 && z == 54 && t == 1 = 66:66:1:correctSomeW ys- | (x > 99) && 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--correctB :: FlowSound -> FlowSound-correctB ys@(x:xs)- | (length . filter (== 100) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t >= 100 then 101 else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys)- | otherwise = (if x > 100 then 101 else x):correctB xs-correctB _ = []---- | Can be used to map the 'Sound8' representation and the mmsyn6ukr-array files with some recordings.-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
+ Phladiprelio/Ukrainian/Melodics.hs view
@@ -0,0 +1,415 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}++-- |+-- Module : Phladiprelio.Ukrainian.Melodics+-- Copyright : (c) OleksandrZhabenko 2021-2024+-- License : MIT+-- Maintainer : oleksandr.zhabenko@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 Phladiprelio.Ukrainian.Melodics (+ -- * Basic functions+ Sound8+ , FlowSound+ , convertToProperUkrainianI8WithTuples+ , convertToProperUkrainianI8+ , isUkrainianL+ , linkFileNameI8+ -- * Transformation functions+ , дзT+ , жT+ , дT+ , гT+ , зT+ , цT+ , чT+ , шT+ , фT+ , кT+ , пT+ , сT+ , тT+ , хT+ , сьT+ , нтT+ , стT+ , тьT+ , цьT+) where++import GHC.Base+import GHC.List+import GHC.Num ((-))+import Data.Maybe (fromJust)+import Data.Char+import GHC.Arr+import CaseBi.Arr+import Data.List (uncons)+import GHC.Int+import Phladiprelio.Ukrainian.Common2++-- | Is used to signify the optimization data type of 'Int8'.+type Sound8 = Int8++type FlowSound = [Sound8]++{-| The function that uses the following correspondence between the previous data type UZPP2 and the 'Sound8'.+See for more implementation information:+<https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#ability-to-use-your-own-durations-of-representations-of-sounds-or-phonetic-phenomena>++Starting from the version 0.6.0.0:++-2 -> 102+-1 -> 101+0 -> 100+-}+convertToProperUkrainianI8 :: String -> FlowSound+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) [('\'',102),('-',101),('\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) [(55,[41,39]),(56,[27,4]),(57,[27,1]),(58,[27,2]),(59,[27,6]),+ (60,[101]),(61,[101]),(101,[101]),(102,[101])]+ !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+{-# INLINE convertToProperUkrainianI8 #-}++{-| 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+{-# INLINE convertToProperUkrainianI8WithTuples #-}++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+ | x == '\'' || x == '\x2019' || x == '\x02BC' || x == '-' = if (y `elem` ("\1102\1103\1108\1110"::String)) then '\1081':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated tup16 zs else changeIotated tup16 (y:zs)+ | otherwise = x:changeIotated tup16 (y:zs)+changeIotated _ xs = xs++filterUkr :: Array Int (Char,Int8) -> String -> FlowSound+filterUkr tup13 = let !tup = (100, tup13) in map (getBFst' tup)+{-# INLINE filterUkr #-}++secondConv :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+secondConv tup14 = concatMap (\y -> getBFst' ([y], tup14) y)+{-# INLINE secondConv #-}++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 :: Array Int (Int8,Bool) -> Array Int (Int8,Bool) -> Array Int ([Int8],Bool) -> FlowSound -> [FlowSound]+initialA tup3 tup4 tup5 t1@(t:ts)+ | t < 1 || t > 99 = [100]: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 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 :: Array Int ([Int8],Int8) -> [FlowSound] -> FlowSound+bsToCharUkr tup6 zs@(_:_) = map (g tup6) zs+ where g tup6 ts@(t:_) = getBFst' (t, tup6) ts+ g _ _ = 101+bsToCharUkr _ _ = []+{-# INLINE bsToCharUkr #-}++applyChanges+ :: Array Int (Int8,FlowSound -> Sound8)+ -> FlowSound+ -> FlowSound+applyChanges tup7 ys = foldr f v ys+ where v = []+ f x xs@(_:_) = getBFst' (\_ -> x, tup7) x xs:xs+ f x _ = [x]+{-# INLINE applyChanges #-}++isVoicedObstruent :: FlowSound -> Bool+isVoicedObstruent (x:_) = x > 7 && x < 27+isVoicedObstruent _ = False+{-# INLINE isVoicedObstruent #-}++isVoicedObstruentH :: Array Int (Int8,Bool) -> FlowSound -> Bool+isVoicedObstruentH tup8 (x:_) = getBFst' (False, tup8) x+isVoicedObstruentH _ _ = False+{-# INLINE isVoicedObstruentH #-}++isVoicedObstruentS :: FlowSound -> Bool+isVoicedObstruentS (x:_) = x > 11 && x < 15+isVoicedObstruentS _ = False+{-# INLINE isVoicedObstruentS #-}++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)+{-# INLINE isSoftDOrL #-}++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)+{-# 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 :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8+дзT tup9 tup10 t1@(_:_) | isSoftDOrL tup9 tup10 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 :: 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+{-# 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 :: 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+{-# 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 :: 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+{-# 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 :: 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+{-# 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 (\t -> t > 0 && t < 100)+{-# INLINE takeFromFT_ #-}++correctA :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+correctA tup12 = correctSomeW . separateSoftS tup12+{-# INLINE correctA #-}++separateSoftS :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+separateSoftS tup12 = concatMap (\x -> getBFst' ([x], tup12) x)+{-# 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 > 99) && 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++correctB :: FlowSound -> FlowSound+correctB ys@(x:xs)+ | (length . filter (== 100) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t >= 100 then 101 else t) (takeFromFT2 6 ys) `mappend` correctB (dropFromFT2 6 ys)+ | otherwise = (if x > 100 then 101 else x):correctB xs+correctB _ = []++-- | Can be used to map the 'Sound8' representation and the mmsyn6ukr-array files with some recordings.+linkFileNameI8 :: Sound8 -> Char+linkFileNameI8 = 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')]) +{-# INLINE linkFileNameI8 #-}+
+ Phladiprelio/Ukrainian/Syllable.hs view
@@ -0,0 +1,275 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}++-- |+-- Module : Phladiprelio.Ukrainian.Syllable+-- Copyright : (c) Oleksandr Zhabenko 2021-2024+-- License : MIT+-- Stability : Experimental+-- Maintainer : oleksandr.zhabenko@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+-- The information on Ukrainian syllable segmentation 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+--++module Phladiprelio.Ukrainian.Syllable (+ -- * Basic functionality+ isVowel1+ , isSonorous1+ , isVoicedC1+ , isVoicelessC1+ , isNotVowel2+ , isNotVowel2'+ , sndGroups+ , groupSnds+ , divCnsnts+ , reSyllableCntnts+ , divVwls+ , createSyllablesUkrS+ , notEqC+ , representProlonged+ , showS8+ , showFS+ -- * With additional data used (probably for speed up)+ , notEqCTup+ , divCnsntsTup+ , reSyllableCntntsTup+ , createSyllablesUkrSTup+) where++import GHC.Base+import GHC.List+import Data.Tuple +import GHC.Num (abs,(-))+import GHC.Arr+import Data.Typeable+import qualified Data.List as L (groupBy)+import Phladiprelio.Ukrainian.Melodics+import CaseBi.Arr+import GHC.Int+import Data.IntermediateStructures1 (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 < 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.+-- Starting from the version 0.6.0.0 variants of either of arguments is greater than 99 is also included.+isNotVowel2 :: Sound8 -> Sound8 -> Bool+isNotVowel2 x y = x > 6 && y > 6+{-# INLINE isNotVowel2 #-}++-- | Binary function-predicate 'isNotVowel2'' checks whether its arguments are both consonant representations in the 'Sound8' format.+-- Starting from the version 0.6.0.0 variants of either of arguments is greater than 99 are not included (so its behaviour is equivalent to the+-- 'isNotVowel2' till the 0.5.3.0 version).+isNotVowel2' :: Sound8 -> Sound8 -> Bool+isNotVowel2' x y = x < 100 && y < 100 && 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@(y:zs@(z:ts@(_:_))))+ | isSonorous1 x || isVoicedC1 x =+ case y of+ 7 -> ((`mappend` [x,7]),mappend zs) -- "рибаль-ство"+ _ -> ((`mappend` [x]),mappend ys)+ | isSonorous1 y =+ case z of+ 7 -> ((`mappend` [x,y,7]),mappend ts) -- "рокль-ський" (?), "супрасль-ський"+ _ -> ((`mappend` [x,y]),mappend zs) -- "дофр-ський" (?)+ | otherwise = (id,mappend xs)+divCnsnts xs@(x:ys@(y:zs@(z:ts)))+ | isSonorous1 x =+ case y of+ 7 -> ((`mappend` [x,7]),mappend zs) -- "поль-ка", "каль-ка"+ _ -> ((`mappend` [x]),mappend ys)+ | isSonorous1 y =+ case z of+ 7 -> (id,mappend xs) -- "сього-дні"+ _ -> ((`mappend` [x,y]),mappend zs)+ | otherwise = (id,mappend xs)+divCnsnts xs@(x:ys@(y:zs))+ | (isSonorous1 x && notEqC x y && y /= 7) || (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@(y:zs@(z:ts@(_:_))))+ | isSonorous1 x || isVoicedC1 x =+ case y of+ 7 -> ((`mappend` [x,7]),mappend zs) -- "рибаль-ство"+ _ -> ((`mappend` [x]),mappend ys)+ | isSonorous1 y =+ case z of+ 7 -> ((`mappend` [x,y,7]),mappend ts) -- "рокль-ський" (?), "супрасль-ський"+ _ -> ((`mappend` [x,y]),mappend zs) -- "дофр-ський" (?)+ | otherwise = (id,mappend xs)+divCnsntsTup !tup17 xs@(x:ys@(y:zs@(z:ts)))+ | isSonorous1 x =+ case y of+ 7 -> ((`mappend` [x,7]),mappend zs) -- "поль-ка", "каль-ка"+ _ -> ((`mappend` [x]),mappend ys)+ | isSonorous1 y =+ case z of+ 7 -> (id,mappend xs) -- "сього-дні"+ _ -> ((`mappend` [x,y]),mappend zs) + | otherwise = (id,mappend xs)+divCnsntsTup !tup17 xs@(x:ys@(y:_))+ | (isSonorous1 x && (notEqCTup tup17 x y) && y /= 7) || (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)+ | 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+{-# 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+{-# INLINE createSyllablesUkrSTup #-}++-- | Practically this is an optimized version for this case 'words' function from Prelude.+words1 :: FlowSound -> [FlowSound]+words1 xs = if null ts then [] else w : words1 s'' + where ts = dropWhile (> 99) xs+ (w, s'') = span (< 100) ts+{-# NOINLINE words1 #-}++-----------------------------------------------------++-- | 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+{-# INLINE notEqC #-}++-- | 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+{-# INLINE notEqCTup #-}++-- | 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++showS8 :: Sound8 -> String+showS8 = getBFstLSorted' " " [(1,"\1072"),(2,"\1077"),(3,"\1086"),(4,"\1091"),(5,"\1080"),(6,"\1110"),(7,"\1100"),(8,"\1076\1079"),+ (9,"\1076\1079"),(10,"\1078"),(11,"\1078"),(15,"\1073"),(16,"\1073"),(17,"\1076"),(18,"\1076"),(19,"\1169"),(20,"\1169"),+ (21,"\1075"),(22,"\1075"),(23,"\1076\1078"),(24,"\1076\1078"),(25,"\1079"),(26,"\1079"),(27,"\1081"),(28,"\1083"),(29,"\1083"),+ (30,"\1084"),(31,"\1084"),(32,"\1085"),(33,"\1085"),(34,"\1088"),(35,"\1088"),(36,"\1074"),(37,"\1074"),(38,"\1094"),+ (39,"\1095"),(40,"\1095"),(41,"\1096"),(42,"\1096"),(43,"\1092"),(44,"\1092"),(45,"\1082"),(46,"\1082"),(47,"\1087"),+ (48,"\1087"),(49,"\1089"),(50,"\1090"),(51,"\1090"),(52,"\1093"),(53,"\1093"),(54,"\1089\1100"),(66,"\1094\1100")]+{-# INLINE showS8 #-}++showFS :: FlowSound -> String+showFS = concatMap showS8 -- Probably, it is better to transform several consequent spaces into the combination smth like \", \" (but not in this version)+{-# INLINE showFS #-}
+ Phladiprelio/Ukrainian/SyllableWord8.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE TypeSynonymInstances, NoImplicitPrelude, Strict, BangPatterns #-}+{-# OPTIONS_HADDOCK show-extensions #-}+-- |+-- Module : Phladiprelio.Ukrainian.SyllableWord8+-- Copyright : (c) Oleksandr Zhabenko 2021-2024+-- License : MIT+-- Stability : Experimental+-- Maintainer : oleksandr.zhabenko@yahoo.com+--+-- This module works with syllable segmentation in Ukrainian. Uses 'Word8' 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 'Word8' data are gotten from there.++module Phladiprelio.Ukrainian.SyllableWord8 where++import GHC.Base+import GHC.Num ((+))+import CaseBi.Arr+import Phladiprelio.Ukrainian.Melodics (Sound8)+import GHC.Int+import Data.Foldable (foldl')+import GHC.Word++s0DuratD1 :: Sound8 -> Word8+s0DuratD1 = getBFstLSorted' 5 [(1,15),(2,10),(3,13),(4,12),(5,11),(6,10),(7,1),(8,6),(9,6),(10,7),(11,7),(15,6),(16,6),(17,8),(18,8),(19,7),(20,7),(21,8),(22,8),(23,5),(24,5),(25,6),(26,6),(27,6),(28,7),(29,7),(30,8),(31,8),(32,8),(33,8),(34,5),(35,5),(36,9),(37,9),(38,5),(39,6),(40,6),(41,7),(42,7),(43,6),(44,6),(45,4),(46,4),(47,15),(48,15),(49,8),(50,12),(51,12),(52,8),(53,8),(54,8),(66,10)]+{-# INLINE s0DuratD1 #-}++-- |+s0DuratD2 :: Sound8 -> Word8+s0DuratD2 = getBFstLSorted' 5 [(1,15),(2,15),(3,15),(4,14),(5,11),(6,11),(7,1),(8,4),(9,4),(10,5),(11,5),(15,6),(16,6),(17,4),(18,4),(19,4),(20,4),(21,3),(22,3),(23,5),(24,5),(25,4),(26,4),(27,5),(28,6),(29,6),(30,8),(31,8),(32,3),(33,3),(34,4),(35,4),(36,5),(37,5),(38,3),(39,7),(40,7),(41,7),(42,7),(43,9),(44,9),(45,3),(46,3),(47,5),(48,5),(49,3),(50,3),(51,3),(52,5),(53,5),(54,4),(66,4)] +{-# INLINE s0DuratD2 #-}++s0DuratD3 :: Sound8 -> Word8+s0DuratD3 = getBFstLSorted' 5 [(1,15),(2,14),(3,15),(4,12),(5,12),(6,12),(7,1),(8,5),(9,5),(10,6),(11,6),(15,8),(16,8),(17,5),(18,5),(19,5),(20,5),(21,6),(22,6),(23,6),(24,6),(25,4),(26,4),(27,7),(28,7),(29,7),(30,9),(31,9),(32,4),(33,4),(34,4),(35,4),(36,5),(37,5),(38,4),(39,7),(40,7),(41,9),(42,9),(43,10),(44,10),(45,4),(46,4),(47,7),(48,7),(49,4),(50,4),(51,4),(52,8),(53,8),(54,5),(66,5)]+{-# INLINE s0DuratD3 #-}++s0DuratD4 :: Sound8 -> Word8+s0DuratD4 = getBFstLSorted' 5 [(1,12),(2,12),(3,12),(4,12),(5,12),(6,12),(7,1),(8,5),(9,5),(10,10),(11,10),(15,5),(16,5),(17,8),(18,8),(19,8),(20,8),(21,13),(22,13),(23,10),(24,10),(25,5),(26,5),(27,4),(28,10),(29,10),(30,15),(31,15),(32,8),(33,8),(34,4),(35,4),(36,6),(37,6),(38,4),(39,12),(40,12),(41,14),(42,14),(43,11),(44,11),(45,6),(46,6),(47,4),(48,4),(49,6),(50,11),(51,11),(52,15),(53,15),(54,7),(66,5)]+{-# INLINE s0DuratD4 #-}++{-+help1 xs = map (\(t, u) -> (t,fromMaybe 15 . hh $ u)) xs + where !h = snd . head $ xs+ !lt = snd . last $ xs+ !del = (lt - h)/14.0+ !ys = take 15 . iterate (+del) $ h+ !zs = zip [1..15] ys+ gg !u = fromMaybe lt . round2GL True (\_ _ -> EQ) ys $ u+ hh !u = fmap fst . find ((== gg u) . snd) $ zs+-}++class (Eq a) => SyllableDurations4 a where+ sDuratsD :: a -> Word8+ sDuratsD2 :: a -> Word8+ sDuratsD3 :: a -> Word8+ sDuratsD4 :: a -> Word8+ syllableDurationsGDc :: (a -> Word8) -> [[[a]]] -> [[Word8]]+ syllableDurationsGDc g = map (map (k g))+ where k f = foldl' (\y x -> f x + y) 0+ {-# INLINE syllableDurationsGDc #-}++instance SyllableDurations4 Sound8 where+ sDuratsD = s0DuratD1+ sDuratsD2 = s0DuratD2+ sDuratsD3 = s0DuratD3+ sDuratsD4 = s0DuratD4++-- | General variant of the 'syllableDurationsD' function.+syllableDurationsGD :: (Sound8 -> Word8) -> [[[Sound8]]] -> [[Word8]]+syllableDurationsGD g = syllableDurationsGDc g+{-# INLINE syllableDurationsGD #-}++syllableDurationsD :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD = syllableDurationsGDc s0DuratD1+{-# INLINE syllableDurationsD #-}++syllableDurationsD2 :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD2 = syllableDurationsGDc s0DuratD2+{-# INLINE syllableDurationsD2 #-}++syllableDurationsD3 :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD3 = syllableDurationsGDc s0DuratD3+{-# INLINE syllableDurationsD3 #-}++syllableDurationsD4 :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD4 = syllableDurationsGDc s0DuratD4+{-# INLINE syllableDurationsD4 #-}+
+ README.md view
@@ -0,0 +1,22 @@+ Devotion+ ========++The author would like to devote this project to support the [Foundation Gastrostars](https://gastrostars.nl).++On the 21/02/2024 there is an International Mother Tongue Day — that is Ukrainian for the author of the package. ++On the 12/032024 there was a Birthday of Emma Kok, the foundation founder. She turned 16. Therefore, the release 0.10.0.0 is additionally devoted i.e. tributed to her.++Besides, you can support Ukrainian people in various forms.++All support is welcome, including donations for the needs of the Ukrainian army, IDPs and refugees. ++If you would like to share some financial support with the Foundation Gastrostars, please, contact the mentioned foundation+using the URL:++[Contact Foundation GASTROSTARS](https://gastrostars.nl/hou-mij-op-de-hoogte)++or ++[Donation Page](https://gastrostars.nl/doneren)+
ukrainian-phonetics-basic-array.cabal view
@@ -2,24 +2,25 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: ukrainian-phonetics-basic-array-version: 0.6.0.0+version: 0.10.0.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 old modules with bytestring dependencies since the 0.6.0.0 version moved to the other package ukrainian-phonetics-basic-array-bytestring to reduce the actual dependencies for the phonetic languages concerning packages. homepage: https://hackage.haskell.org/package/ukrainian-phonetics-basic-array+bug-reports: https://github.com/Oleksandr-Zhabenko/ukrainian-phonetics-basic-array/issues license: MIT license-file: LICENSE author: OleksandrZhabenko-maintainer: olexandr543@yahoo.com+maintainer: oleksandr.zhabenko@yahoo.com copyright: Oleksandr Zhabenko category: Language build-type: Simple-extra-source-files: CHANGELOG.md+extra-source-files: CHANGELOG.md, README.md cabal-version: >=1.10 library- exposed-modules: Languages.Phonetic.Ukrainian.Syllable.ArrInt8, Melodics.Ukrainian.ArrInt8, Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8+ exposed-modules: Phladiprelio.Ukrainian.Syllable, Phladiprelio.Ukrainian.Melodics, Phladiprelio.Ukrainian.SyllableWord8 -- other-modules:- other-extensions: DeriveDataTypeable, FlexibleInstances, OverloadedStrings, TypeSynonymInstances, BangPatterns- build-depends: base >=4.8 && <5, mmsyn2-array ==0.3.0.0, mmsyn5 ==0.5.1.0, ukrainian-phonetics-common ==0.1.1.0+ other-extensions: BangPatterns, DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances, NoImplicitPrelude, Strict+ build-depends: base >=4.13 && <5, mmsyn2-array ==0.3.1.1, intermediate-structures == 0.1.1.0, ukrainian-phonetics-common ==0.2.0.0 -- hs-source-dirs: default-language: Haskell2010