diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -57,3 +57,26 @@ * Fifth version revised C. Updated the dependencies boundaries so that the latest versions of GHC and Cabal are supported. +## 0.6.0.0 -- 2022-08-09 + +* Sixth version. Fixed issues with the syllable segmentation with soft sign consonant sequences. Changed the structure of the non-sound Ukraninian symbols +representation (now they are converted to one of the [100,101,102]). +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. + diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs b/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs deleted file mode 100644 --- a/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +++ /dev/null @@ -1,222 +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 - , sndGroups - , groupSnds - , divCnsnts - , reSyllableCntnts - , divVwls - , createSyllablesUkrS - , notEqC - , representProlonged - -- * With additional data used (probably for speed up) - , notEqCTup - , divCnsntsTup - , reSyllableCntntsTup - , createSyllablesUkrSTup -) where - -import Prelude hiding (mappend) -import GHC.Arr -import Data.Monoid -import Data.Typeable -import qualified Data.List as L (groupBy) -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 > 0 && x < 7 -{-# INLINE isVowel1 #-} - --- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'Sound8' format. -isSonorous1 :: Sound8 -> Bool -isSonorous1 x = x > 26 && x < 38 -{-# INLINE isSonorous1 #-} - --- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'Sound8' format. -isVoicedC1 :: Sound8 -> Bool -isVoicedC1 x = x > 7 && x < 27 -{-# INLINE isVoicedC1 #-} - --- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'Sound8' format. -isVoicelessC1 :: Sound8 -> Bool -isVoicelessC1 x = x > 37 && x < 54 -{-# INLINE isVoicelessC1 #-} - --- | Binary function-predicate 'isNotVowel2' checks whether its arguments are both consonant representations in the 'Sound8' format. -isNotVowel2 :: Sound8 -> Sound8 -> Bool -isNotVowel2 x y = x > 6 && y > 6 -{-# INLINE isNotVowel2 #-} - --- | Function 'sndGroups' converts a Ukrainian word being a list of 'Sound8' to the list of phonetically similar (consonants grouped with consonants and each vowel separately) --- sounds representations in 'Sound8' format. -sndGroups :: FlowSound -> [FlowSound] -sndGroups ys@(_:_) = L.groupBy isNotVowel2 ys -sndGroups _ = [] - -groupSnds :: FlowSound -> [FlowSound] -groupSnds = L.groupBy (\x y -> isVowel1 x == isVowel1 y) - --- | Function 'divCnsnts' is used to divide groups of Ukrainian consonants into two-elements lists that later are made belonging to --- different neighbour syllables if the group is between two vowels in a word. The group must be not empty, but this is not checked. --- The phonetical information for the proper performance is taken from the: --- https://msn.khnu.km.ua/pluginfile.php/302375/mod_resource/content/1/%D0%9B.3.%D0%86%D0%86.%20%D0%A1%D0%BA%D0%BB%D0%B0%D0%B4.%D0%9D%D0%B0%D0%B3%D0%BE%D0%BB%D0%BE%D1%81.pdf -divCnsnts :: FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound) -divCnsnts xs@(x:ys@(_:_:_:_)) - | isSonorous1 x || isVoicedC1 x = ((`mappend` [x]),mappend ys) - | otherwise = (id,mappend xs) -divCnsnts xs@(x:ys@(y:zs@(_:_))) - | isSonorous1 x = ((`mappend` [x]),mappend ys) - | isSonorous1 y = ((`mappend` [x,y]),mappend zs) - | otherwise = (id,mappend xs) -divCnsnts xs@(x:ys@(y:_)) - | (isSonorous1 x && (notEqC x y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys) - | otherwise = (id,mappend xs) -divCnsnts xs = (id,mappend xs) - --- | Function 'divCnsntsTup' is a variant of the 'divCnsts' where you can provide the tuple element for 'getBFst'' inside. -divCnsntsTup :: Array Int (Int8,Bool) -> FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound) -divCnsntsTup !tup17 xs@(x:ys@(_:_:_:_)) - | isSonorous1 x || isVoicedC1 x = ((`mappend` [x]),mappend ys) - | otherwise = (id,mappend xs) -divCnsntsTup !tup17 xs@(x:ys@(y:zs@(_:_))) - | isSonorous1 x = ((`mappend` [x]),mappend ys) - | isSonorous1 y = ((`mappend` [x,y]),mappend zs) - | otherwise = (id,mappend xs) -divCnsntsTup !tup17 xs@(x:ys@(y:_)) - | (isSonorous1 x && (notEqCTup tup17 x y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys) - | otherwise = (id,mappend xs) -divCnsntsTup _ xs = (id,mappend xs) - -reSyllableCntntsTup :: Array Int (Int8,Bool) -> [FlowSound] -> [FlowSound] -reSyllableCntntsTup !tup17 (xs:ys:zs:xss) - | (> 6) . last $ ys = fst (divCnsntsTup tup17 ys) xs:reSyllableCntntsTup tup17 (snd (divCnsntsTup tup17 ys) zs:xss) - | otherwise = reSyllableCntntsTup tup17 ((xs `mappend` ys):zs:xss) -reSyllableCntntsTup !tup17 (xs:ys:_) = [xs `mappend` ys] -reSyllableCntntsTup !tup17 xss = xss - -reSyllableCntnts :: [FlowSound] -> [FlowSound] -reSyllableCntnts (xs:ys:zs:xss) - | (> 6) . last $ ys = fst (divCnsnts ys) xs:reSyllableCntnts (snd (divCnsnts ys) zs:xss) - | otherwise = reSyllableCntnts ((xs `mappend` ys):zs:xss) -reSyllableCntnts (xs:ys:_) = [xs `mappend` ys] -reSyllableCntnts xss = xss - -divVwls :: [FlowSound] -> [FlowSound] -divVwls = mapI (\ws -> (length . filter isVowel1 $ ws) > 1) h3 - where h3 us = [ys `mappend` take 1 zs] `mappend` (L.groupBy (\x y -> isVowel1 x && y > 6) . drop 1 $ zs) - where (ys,zs) = span (>6) us - -createSyllablesUkrS :: String -> [[FlowSound]] -createSyllablesUkrS = map (divVwls . reSyllableCntnts . groupSnds) . words1 . convertToProperUkrainianI8 . - map (\x -> if x == '-' then ' ' else x) - where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude. - where ts = dropWhile (< 1) xs - (w, s'') = span (> 0) ts - {-# NOINLINE words1 #-} -{-# INLINE createSyllablesUkrS #-} - -createSyllablesUkrSTup - :: Array Int (Int8, Bool) - -> Array Int (Int8, Bool) - -> Array Int (Int8, Bool) - -> Array Int (Int8, Bool) - -> Array Int ([Int8], Bool) - -> Array Int ([Int8], Int8) - -> Array Int (Int8, FlowSound -> Sound8) - -> Array Int (Int8, Bool) - -> Array Int ([Int8], Bool) - -> Array Int ([Int8], Bool) - -> Array Int ([Int8], Bool) - -> Array Int (Int8, [Int8]) - -> Array Int (Char,Int8) - -> Array Int (Int8,[Int8]) - -> Array Int (Char, Bool) - -> Array Int (Char, Bool) - -> Array Int (Int8,Bool) - -> String - -> [[FlowSound]] -createSyllablesUkrSTup !tup1 !tup2 !tup3 !tup4 !tup5 !tup6 !tup7 !tup8 !tup9 !tup10 !tup11 !tup12 !tup13 !tup14 !tup15 !tup16 !tup17 = - map (divVwls . reSyllableCntntsTup tup17 . groupSnds) . words1 . - convertToProperUkrainianI8WithTuples tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 . - map (\x -> if x == '-' then ' ' else x) - where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude. - where ts = dropWhile (< 1) xs - (w, s'') = span (> 0) ts - {-# NOINLINE words1 #-} -{-# INLINE createSyllablesUkrSTup #-} - ------------------------------------------------------ - --- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account). -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 diff --git a/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs b/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs deleted file mode 100644 --- a/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs +++ /dev/null @@ -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 diff --git a/Melodics/Ukrainian/ArrInt8.hs b/Melodics/Ukrainian/ArrInt8.hs deleted file mode 100644 --- a/Melodics/Ukrainian/ArrInt8.hs +++ /dev/null @@ -1,437 +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 -@ --} -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) [('\'',-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 - -{-| 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 - | otherwise = x:changeIotated tup16 (y:zs) -changeIotated _ xs = xs - -filterUkr :: Array Int (Char,Int8) -> String -> FlowSound -filterUkr tup13 = let !tup = (0, 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 = [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 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 _ _ = -1 -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 (>0) - -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 < 1) && y == 27 && z == 1 = - if take 2 xs == [39,32] - then x:y:z:41:correctSomeW ys - else x:correctSomeW (y:z:xs) - | otherwise = x:correctSomeW (y:z:xs) -correctSomeW zs = zs - -correctB :: FlowSound -> FlowSound -correctB ys@(x:xs) - | (length . filter (== 0) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t <= 0 then -1 else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys) - | otherwise = (if x < 0 then -1 else x):correctB xs -correctB _ = [] - --- | 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 diff --git a/Phladiprelio/Ukrainian/Melodics.hs b/Phladiprelio/Ukrainian/Melodics.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/Ukrainian/Melodics.hs @@ -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: + + +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 #-} + diff --git a/Phladiprelio/Ukrainian/Syllable.hs b/Phladiprelio/Ukrainian/Syllable.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/Ukrainian/Syllable.hs @@ -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 #-} diff --git a/Phladiprelio/Ukrainian/SyllableWord8.hs b/Phladiprelio/Ukrainian/SyllableWord8.hs new file mode 100644 --- /dev/null +++ b/Phladiprelio/Ukrainian/SyllableWord8.hs @@ -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 #-} + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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) + diff --git a/ukrainian-phonetics-basic-array.cabal b/ukrainian-phonetics-basic-array.cabal --- a/ukrainian-phonetics-basic-array.cabal +++ b/ukrainian-phonetics-basic-array.cabal @@ -2,24 +2,25 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: ukrainian-phonetics-basic-array -version: 0.5.3.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 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 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