diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -27,3 +27,8 @@ * Fourth version. Added Int8-based optimized functionality.The modules that do not use Int8 after ugrading the phonetic-languages-simplified-examples-array to the Int8-based functionality are planned to be moved to a new package. + +## 0.4.1.0 -- 2021-11-04 + +* Fourth version revised A. Some documentation improvements. Moved the new modules with Int8 functionality without ByteString +related functionality to the new location path without ByteString folder. diff --git a/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs b/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs --- a/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +++ b/Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs @@ -10,6 +10,8 @@ -- -- 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 where @@ -18,7 +20,7 @@ import Data.Monoid import Data.Typeable import qualified Data.List as L (groupBy) -import Melodics.ByteString.Ukrainian.ArrInt8 +import Melodics.Ukrainian.ArrInt8 import CaseBi.Arr import GHC.Int import Data.List.InnToOut.Basic (mapI) diff --git a/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs b/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs --- a/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs +++ b/Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs @@ -15,7 +15,7 @@ module Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 where import CaseBi.Arr -import Melodics.ByteString.Ukrainian.ArrInt8 (Sound8) +import Melodics.Ukrainian.ArrInt8 (Sound8) import GHC.Int s0DuratD1 :: Sound8 -> Double diff --git a/Melodics/ByteString/Ukrainian/Arr.hs b/Melodics/ByteString/Ukrainian/Arr.hs --- a/Melodics/ByteString/Ukrainian/Arr.hs +++ b/Melodics/ByteString/Ukrainian/Arr.hs @@ -33,7 +33,7 @@ import GHC.Arr import CaseBi.Arr import qualified Data.ByteString.Char8 as B -import Melodics.ByteString.Ukrainian.Common +import Melodics.Ukrainian.Common convertToProperUkrainianS :: String -> String convertToProperUkrainianS = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv . filterUkr . changeIotated . diff --git a/Melodics/ByteString/Ukrainian/ArrInt8.hs b/Melodics/ByteString/Ukrainian/ArrInt8.hs deleted file mode 100644 --- a/Melodics/ByteString/Ukrainian/ArrInt8.hs +++ /dev/null @@ -1,333 +0,0 @@ -{-# OPTIONS_HADDOCK show-extensions #-} - --- | --- Module : Melodics.ByteString.Ukrainian.ArrInt8 --- Copyright : (c) OleksandrZhabenko 2021 --- License : MIT --- Maintainer : olexandr543@yahoo.com --- --- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis --- especially for poets, translators and writers. Is rewritten from the module Melodics.ByteString.Ukrainian.Arr --- for optimization purposes. --- Phonetic material is taken from the : --- --- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of --- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf - -module Melodics.ByteString.Ukrainian.ArrInt8 ( - -- * Basic functions - Sound8 - , FlowSound - , convertToProperUkrainianI8 - , isUkrainianL - , linkFileNameI8 -) where - -import qualified Data.String as S -import Data.Maybe (fromJust) -import Data.Char -import GHC.Arr -import CaseBi.Arr -import Data.List (uncons) -import GHC.Int -import Melodics.ByteString.Ukrainian.Common - -type Sound8 = Int8 - -type FlowSound = [Sound8] - -convertToProperUkrainianI8 :: String -> FlowSound -convertToProperUkrainianI8 = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv . - filterUkr . changeIotated . filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower -{-# INLINE convertToProperUkrainianI8 #-} - -changeIotated :: String -> String -changeIotated (x:y:zs) - | (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJ x = x:'\1100':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated zs - | otherwise = x:changeIotated (y:zs) -changeIotated xs = xs - -filterUkr :: String -> FlowSound -filterUkr = map toBSUkr -{-# INLINE filterUkr #-} - -toBSUkr :: Char -> Sound8 -toBSUkr = getBFstLSorted' 0 (zip "'-\700\1072\1073\1074\1075\1076\1077\1078\1079\1080\1081\1082\1083\1084\1085\1086\1087\1088\1089\1090\1091\1092\1093\1094\1095\1096\1097\1100\1102\1103\1108\1110\1111\1169\8217" [-2,-1,60,1,15,36,21,17,2,10,25,5,27,45,28,30,32,3,47,34,49,50,4,43,52,38,39,41,55,7,56,57,58,6,59,19,61]) -{-# INLINE toBSUkr #-} - -secondConv :: FlowSound -> FlowSound -secondConv = - concatMap (\y -> getBFstLSorted' [y] (zip [-2,-1,55,56,57,58,59,60,61] [[-1],[-1],[41,39],[27,4],[27,1],[27,2],[27,6],[-1],[-1]]) y) -{-# INLINE secondConv #-} - -createTuplesByAnalysis :: FlowSound -> [FlowSound] -createTuplesByAnalysis x - | null x = [] - | getBFstLSorted' False (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat True)) . head $ x = initialA x - | not (null . tail $ x) && (x !! 1 == 27 && isConsNotJ8 (head x)) = take 1 x:[7]:createTuplesByAnalysis (drop 2 x) - | otherwise = take 1 x:createTuplesByAnalysis (tail x) - -isConsNotJ8 :: Int8 -> Bool -isConsNotJ8 = getBFstLSorted' False (zip [10,15,17,19,21,25,28,30,32,34,36,38,39,41,43,45,47,49,50,52] (repeat True)) -{-# INLINE isConsNotJ8 #-} - -initialA :: FlowSound -> [FlowSound] -initialA t1@(t:ts) - | t < 1 = [0]:initialA ts - | getBFstLSorted' True (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat False)) t = [t]:initialA ts - | getBFstLSorted' False (zip [17,32,38,49,50,52] (repeat True)) t = - let (us,vs) = splitAt 2 t1 in - if getBFstLSorted' False (zip [[17,10],[17,25],[32,50],[38,7],[49,7],[49,50],[50,7],[50,49],[52,21]] (repeat True)) us - then us:initialA vs - else [t]:initialA ts - | otherwise = [t]:initialA ts -initialA _ = [] - -bsToCharUkr :: [FlowSound] -> FlowSound -bsToCharUkr zs - | null zs = [] - | otherwise = map g zs - where g ts - | null ts = -1 - | otherwise = getBFstLSorted' (head ts) [([17,10],23),([17,25],8),([32,50],62),([38,7],66),([49,7],54), - ([49,50],63),([50,7],64),([50,49],38),([52,21],21)] ts -{-# INLINE bsToCharUkr #-} - -applyChanges :: FlowSound -> FlowSound -applyChanges [] = [] -applyChanges ys = foldr f v ys - where v = [] - f x xs - | null xs = [x] - | otherwise = getBFstLSorted' x (zip [8,10,17,21,25,38,39,41,43,45,47,49,50,52,54,62,63,64,66] [дзT xs, - жT xs, дT xs, гT xs, зT xs, цT xs, чT xs, шT xs, фT xs, кT xs, пT xs, сT xs, тT xs, хT xs, - сьT xs, нтT xs, стT xs, тьT xs, цьT xs]) x:xs -{-# INLINE applyChanges #-} - -isVoicedObstruent :: FlowSound -> Bool -isVoicedObstruent xs - | null xs = False - | otherwise = (\u -> u > 7 && u < 27) . head $ xs -{-# INLINE isVoicedObstruent #-} - -isVoicedObstruentH :: FlowSound -> Bool -isVoicedObstruentH xs - | null xs = False - | otherwise = getBFstLSorted' False [(8,True),(10,True),(15,True),(17,True),(19,True),(21,True),(23,True),(25, True)] . head $ xs -{-# INLINE isVoicedObstruentH #-} - -isVoicedObstruentS :: FlowSound -> Bool -isVoicedObstruentS xs - | null xs = False - | otherwise = (\u -> u > 11 && u < 15) . head $ xs -{-# INLINE isVoicedObstruentS #-} - -isSoftDOrL :: FlowSound -> Bool -isSoftDOrL xs = getBFstLSorted' False (zip [[15,7],[17,7],[28,7],[30,7],[32,7],[36,7],[38,7],[43,7],[47,7],[49,7],[50,7]] - (repeat True)) (takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True) - (takeFromFT_ 1 xs) -{-# INLINE isSoftDOrL #-} - -isSoftDen :: FlowSound -> Bool -isSoftDen xs = getBFstLSorted' False (zip [[8,7],[17,7],[25,7],[28,7],[32,7],[38,7],[49,7],[50,7]] . repeat $ True) - (takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True) - (takeFromFT_ 1 xs) -{-# INLINE isSoftDen #-} - -гT :: FlowSound -> Sound8 -гT (t:_) | t == 45 || t == 50 = 52 - | otherwise = 21 -гT _ = 21 -{-# INLINE гT #-} - -дT :: FlowSound -> Sound8 -дT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] = 23 -- д дж - | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] = 12 -- д дзь - | takeFromFT_ 1 t1 `elem` [[54],[66]] = 12 -- д дзь - | takeFromFT_ 1 t1 `elem` [[25],[49],[38]] = 8 -- д дз - | otherwise = 17 -дT _ = 17 -{-# INLINE дT #-} - -дзT :: FlowSound -> Sound8 -дзT t1@(_:_) | isSoftDOrL t1 = 12 - | otherwise = 8 -дзT _ = 8 -{-# INLINE дзT #-} - -жT :: FlowSound -> Sound8 -жT t1@(_:_) | takeFromFT 2 t1 `elem` [[49,7],[38,7]] = 13 - | takeFromFT 1 t1 `elem` [[54],[66]] = 13 - | otherwise = 10 -жT _ = 10 -{-# INLINE жT #-} - -зT :: FlowSound -> Sound8 -зT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] || takeFromFT_ 2 t1 == [17,10] || takeFromFT_ 1 t1 == [23] = 10 - | isSoftDOrL t1 = 13 - | takeFromFT 1 t1 `elem` [[39],[41]] = 41 -- з ш - | takeFromFT 1 t1 `elem` [[49],[38]] || takeFromFT_ 1 t1 `elem` [[45],[47],[50],[43],[52]] = 49 -- з с - | otherwise = 25 -зT _ = 25 -{-# INLINE зT #-} - -кT :: FlowSound -> Sound8 -кT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 19 - | otherwise = 45 -кT _ = 45 -{-# INLINE кT #-} - -нтT :: FlowSound -> Sound8 -нтT t1@(_:_) | takeFromFT 2 t1 == [49,50] || takeFromFT 1 t1 == [63] = 32 - | takeFromFT 3 t1 == [49,7,45] || takeFromFT 2 t1 == [54,45] = 65 - | otherwise = 62 -нтT _ = 62 -{-# INLINE нтT #-} - -пT :: FlowSound -> Sound8 -пT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 15 - | otherwise = 47 -пT _ = 47 -{-# INLINE пT #-} - -сT :: FlowSound -> Sound8 -сT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || - isVoicedObstruentS (takeFromFT_ 1 t1) = 13 - | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 25 - | isSoftDOrL t1 = 54 - | takeFromFT_ 1 t1 == [41] = 41 - | otherwise = 49 -сT _ = 49 -{-# INLINE сT #-} - -стT :: FlowSound -> Sound8 -стT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 25 - | takeFromFT_ 3 t1 == [49,7,45] || (takeFromFT_ 2 t1 `elem` [[54,45],[38,7]]) || - takeFromFT_ 1 t1 == [66] = 54 - | takeFromFT_ 1 t1 `elem` [[49],[32]] = 49 - | takeFromFT_ 1 t1 == [39] = 41 - | otherwise = 63 -стT _ = 63 -{-# INLINE стT #-} - -сьT :: FlowSound -> Sound8 -сьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 13 - | otherwise = 54 -сьT _ = 54 -{-# INLINE сьT #-} - -тT :: FlowSound -> Sound8 -тT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || - isVoicedObstruentS (takeFromFT_ 1 t1) = 14 - | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 17 - | takeFromFT_ 2 t1 == [38,7] || takeFromFT_ 1 t1 == [66] = 66 - | takeFromFT_ 1 t1 == [38] = 38 - | isSoftDen t1 = 64 - | takeFromFT_ 1 t1 `elem` [[39],[41]] = 39 - | otherwise = 50 -тT _ = 50 -{-# INLINE тT #-} - -тьT :: FlowSound -> Sound8 -тьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 14 - | takeFromFT_ 3 t1 == [49,7,1] || takeFromFT_ 2 t1 == [54,1] = 66 - | otherwise = 64 -тьT _ = 64 -{-# INLINE тьT #-} - -фT :: FlowSound -> Sound8 -фT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 36 - | otherwise = 43 -фT _ = 43 -{-# INLINE фT #-} - -хT :: FlowSound -> Sound8 -хT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 21 - | otherwise = 52 -хT _ = 52 -{-# INLINE хT #-} - -цT :: FlowSound -> Sound8 -цT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || - isVoicedObstruentS (takeFromFT_ 1 t1) = 12 - | isSoftDOrL t1 = 66 - | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 8 - | otherwise = 38 -цT _ = 38 -{-# INLINE цT #-} - -цьT :: FlowSound -> Sound8 -цьT t1@(_:_) | (isVoicedObstruent . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7] = 12 - | otherwise = 66 -цьT _ = 66 -{-# INLINE цьT #-} - -чT :: FlowSound -> Sound8 -чT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 66 - | isVoicedObstruent . takeFromFT_ 1 $ t1 = 23 - | otherwise = 39 -чT _ = 39 -{-# INLINE чT #-} - -шT :: FlowSound -> Sound8 -шT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 54 - | isVoicedObstruent . takeFromFT_ 1 $ t1 = 10 - | otherwise = 41 -шT _ = 41 -{-# INLINE шT #-} - -takeFromFT :: Int -> FlowSound -> FlowSound -takeFromFT n ts | if n < 1 then True else null ts = [] - | n < 2 = [k] - | otherwise = k : takeFromFT (n - 1) (take (n - 1) ts) - where k = head ts - -takeFromFT2 :: Int -> FlowSound -> FlowSound -takeFromFT2 n ts | if n < 1 then True else null ts = [] - | n < 2 = [ks] - | otherwise = ks:takeFromFT2 (n - 1) (tail ts) - where ks = head ts - -dropFromFT2 :: Int -> FlowSound -> FlowSound -dropFromFT2 n ts | if n < 1 then True else null ts = [] - | n < 2 = tail ts - | otherwise = dropFromFT2 (n - 1) (tail ts) - -takeFromFT_ :: Int -> FlowSound -> FlowSound -takeFromFT_ n = takeFromFT n . filter (>0) -{-# INLINE takeFromFT_ #-} - -correctA :: FlowSound -> FlowSound -correctA = correctSomeW . separateSoftS -{-# INLINE correctA #-} - -separateSoftS :: FlowSound -> FlowSound -separateSoftS = concatMap divideToParts -{-# INLINE separateSoftS #-} - -correctSomeW :: FlowSound -> FlowSound -correctSomeW (x:y:z:xs@(t:ys)) - | x == 50 && y == 7 && z == 54 && t == 1 = 66:66:1:correctSomeW ys - | (x < 1) && y == 27 && z == 1 = - if take 2 xs == [39,32] - then x:y:z:41:correctSomeW ys - else x:correctSomeW (y:z:xs) - | otherwise = x:correctSomeW (y:z:xs) -correctSomeW zs = zs - -divideToParts :: Sound8 -> FlowSound -divideToParts x = - getBFstLSorted' [x] [(12,[8,7]),(13,[25,7]),(14,[17,7]),(62,[32,50]),(63,[49,50]),(64,[50,7]), (65,[32,7])] x -{-# INLINE divideToParts #-} - -correctB :: FlowSound -> FlowSound -correctB ys@(x:xs) - | (length . filter (== 0) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t <= 0 then -1 else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys) - | otherwise = (if x < 0 then -1 else x):correctB xs -correctB _ = [] - -linkFileNameI8 :: Sound8 -> Char -linkFileNameI8 x = getBFstLSorted' '0' ([(1,'A'),(2,'H'),(3,'Q'),(4,'W'),(5,'K'),(6,'e'),(7,'d'),(8,'G'),(10,'I'),(15,'B'), - (17,'E'),(19,'f'),(21,'D'),(23,'F'),(25,'J'),(27,'L'),(28,'N'),(30,'O'),(32,'P'),(34,'S'),(36,'C'),(38,'Z'),(39,'b'), - (41,'c'),(43,'X'),(45,'M'),(47,'R'),(49,'T'),(50,'V'),(52,'Y'),(54,'U'),(60,'0'),(61,'0'),(66,'a')]) x -{-# INLINE linkFileNameI8 #-} diff --git a/Melodics/ByteString/Ukrainian/Common.hs b/Melodics/ByteString/Ukrainian/Common.hs deleted file mode 100644 --- a/Melodics/ByteString/Ukrainian/Common.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# OPTIONS_HADDOCK show-extensions #-} - --- | --- Module : Melodics.ByteString.Ukrainian.Common --- Copyright : (c) OleksandrZhabenko 2021 --- License : MIT --- Maintainer : olexandr543@yahoo.com --- --- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis --- especially for poets, translators and writers. Is rewritten from the module Melodics.ByteString.Ukrainian.Arr --- for optimization purposes. Contains the common for two modules definitions. --- Phonetic material is taken from the : --- --- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of --- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf - -module Melodics.ByteString.Ukrainian.Common where - -import CaseBi.Arr - -{- --- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html --} - -data Triple = Z | O | T - deriving (Eq,Ord,Show) - -isUkrainianL :: Char -> Bool -isUkrainianL y | (y >= '\1070' && y <= '\1097') = True - | otherwise = getBFstLSorted' False (map (\x -> (x, True)) "'-\700\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") y - -isConsNotJ :: Char -> Bool -isConsNotJ = getBFstLSorted' False (zip "\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1097\1169" (repeat True)) diff --git a/Melodics/Ukrainian/ArrInt8.hs b/Melodics/Ukrainian/ArrInt8.hs new file mode 100644 --- /dev/null +++ b/Melodics/Ukrainian/ArrInt8.hs @@ -0,0 +1,404 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Melodics.Ukrainian.ArrInt8 +-- Copyright : (c) OleksandrZhabenko 2021 +-- License : MIT +-- Maintainer : olexandr543@yahoo.com +-- +-- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis +-- especially for poets, translators and writers. Is rewritten from the module Melodics.ByteString.Ukrainian.Arr +-- for optimization purposes. +-- Phonetic material is taken from the : +-- +-- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of +-- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf + +module Melodics.Ukrainian.ArrInt8 ( + -- * Basic functions + Sound8 + , FlowSound + , convertToProperUkrainianI8 + , isUkrainianL + , linkFileNameI8 +) where + +import Data.Maybe (fromJust) +import Data.Char +import GHC.Arr +import CaseBi.Arr +import Data.List (uncons) +import GHC.Int +import Melodics.Ukrainian.Common + +-- | 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 = correctB . correctA . applyChanges . bsToCharUkr . createTuplesByAnalysis . secondConv . + filterUkr . changeIotated . filter (\x -> isUkrainianL x || isSpace x || isControl x || isPunctuation x) . map toLower +{-# INLINE convertToProperUkrainianI8 #-} + +changeIotated :: String -> String +changeIotated (x:y:zs) + | (y `elem` ("\1102\1103\1108\1110"::String)) && isConsNotJ x = x:'\1100':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated zs + | otherwise = x:changeIotated (y:zs) +changeIotated xs = xs + +filterUkr :: String -> FlowSound +filterUkr = map toBSUkr +{-# INLINE filterUkr #-} + +toBSUkr :: Char -> Sound8 +toBSUkr = getBFstLSorted' 0 (zip "'-\700\1072\1073\1074\1075\1076\1077\1078\1079\1080\1081\1082\1083\1084\1085\1086\1087\1088\1089\1090\1091\1092\1093\1094\1095\1096\1097\1100\1102\1103\1108\1110\1111\1169\8217" [-2,-1,60,1,15,36,21,17,2,10,25,5,27,45,28,30,32,3,47,34,49,50,4,43,52,38,39,41,55,7,56,57,58,6,59,19,61]) +{-# INLINE toBSUkr #-} + +secondConv :: FlowSound -> FlowSound +secondConv = + concatMap (\y -> getBFstLSorted' [y] (zip [-2,-1,55,56,57,58,59,60,61] [[-1],[-1],[41,39],[27,4],[27,1],[27,2],[27,6],[-1],[-1]]) y) +{-# INLINE secondConv #-} + +createTuplesByAnalysis :: FlowSound -> [FlowSound] +createTuplesByAnalysis x + | null x = [] + | getBFstLSorted' False (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat True)) . head $ x = initialA x + | not (null . tail $ x) && (x !! 1 == 27 && isConsNotJ8 (head x)) = take 1 x:[7]:createTuplesByAnalysis (drop 2 x) + | otherwise = take 1 x:createTuplesByAnalysis (tail x) + +isConsNotJ8 :: Int8 -> Bool +isConsNotJ8 = getBFstLSorted' False (zip [10,15,17,19,21,25,28,30,32,34,36,38,39,41,43,45,47,49,50,52] (repeat True)) +{-# INLINE isConsNotJ8 #-} + +initialA :: FlowSound -> [FlowSound] +initialA t1@(t:ts) + | t < 1 = [0]:initialA ts + | getBFstLSorted' True (zip [10,17,21,25,32,38,39,41,43,45,47,49,50,52] (repeat False)) t = [t]:initialA ts + | getBFstLSorted' False (zip [17,32,38,49,50,52] (repeat True)) t = + let (us,vs) = splitAt 2 t1 in + if getBFstLSorted' False (zip [[17,10],[17,25],[32,50],[38,7],[49,7],[49,50],[50,7],[50,49],[52,21]] (repeat True)) us + then us:initialA vs + else [t]:initialA ts + | otherwise = [t]:initialA ts +initialA _ = [] + +bsToCharUkr :: [FlowSound] -> FlowSound +bsToCharUkr zs + | null zs = [] + | otherwise = map g zs + where g ts + | null ts = -1 + | otherwise = getBFstLSorted' (head ts) [([17,10],23),([17,25],8),([32,50],62),([38,7],66),([49,7],54), + ([49,50],63),([50,7],64),([50,49],38),([52,21],21)] ts +{-# INLINE bsToCharUkr #-} + +applyChanges :: FlowSound -> FlowSound +applyChanges [] = [] +applyChanges ys = foldr f v ys + where v = [] + f x xs + | null xs = [x] + | otherwise = getBFstLSorted' x (zip [8,10,17,21,25,38,39,41,43,45,47,49,50,52,54,62,63,64,66] [дзT xs, + жT xs, дT xs, гT xs, зT xs, цT xs, чT xs, шT xs, фT xs, кT xs, пT xs, сT xs, тT xs, хT xs, + сьT xs, нтT xs, стT xs, тьT xs, цьT xs]) x:xs +{-# INLINE applyChanges #-} + +isVoicedObstruent :: FlowSound -> Bool +isVoicedObstruent xs + | null xs = False + | otherwise = (\u -> u > 7 && u < 27) . head $ xs +{-# INLINE isVoicedObstruent #-} + +isVoicedObstruentH :: FlowSound -> Bool +isVoicedObstruentH xs + | null xs = False + | otherwise = getBFstLSorted' False [(8,True),(10,True),(15,True),(17,True),(19,True),(21,True),(23,True),(25, True)] . head $ xs +{-# INLINE isVoicedObstruentH #-} + +isVoicedObstruentS :: FlowSound -> Bool +isVoicedObstruentS xs + | null xs = False + | otherwise = (\u -> u > 11 && u < 15) . head $ xs +{-# INLINE isVoicedObstruentS #-} + +isSoftDOrL :: FlowSound -> Bool +isSoftDOrL xs = getBFstLSorted' False (zip [[15,7],[17,7],[28,7],[30,7],[32,7],[36,7],[38,7],[43,7],[47,7],[49,7],[50,7]] + (repeat True)) (takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True) + (takeFromFT_ 1 xs) +{-# INLINE isSoftDOrL #-} + +isSoftDen :: FlowSound -> Bool +isSoftDen xs = getBFstLSorted' False (zip [[8,7],[17,7],[25,7],[28,7],[32,7],[38,7],[49,7],[50,7]] . repeat $ True) + (takeFromFT_ 2 xs) || getBFstLSorted' False (zip [[12],[13],[14],[64],[65]] . repeat $ True) + (takeFromFT_ 1 xs) +{-# INLINE isSoftDen #-} + +гT :: FlowSound -> Sound8 +гT (t:_) | t == 45 || t == 50 = 52 -- г х + | otherwise = 21 +гT _ = 21 +{-# INLINE гT #-} + +дT :: FlowSound -> Sound8 +дT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] = 23 -- д дж + | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] = 12 -- д дзь + | takeFromFT_ 1 t1 `elem` [[54],[66]] = 12 -- д дзь + | takeFromFT_ 1 t1 `elem` [[25],[49],[38]] = 8 -- д дз + | otherwise = 17 +дT _ = 17 +{-# INLINE дT #-} + +дзT :: FlowSound -> Sound8 +дзT t1@(_:_) | isSoftDOrL t1 = 12 -- дз дзь + | otherwise = 8 +дзT _ = 8 +{-# INLINE дзT #-} + +жT :: FlowSound -> Sound8 +жT t1@(_:_) | takeFromFT 2 t1 `elem` [[49,7],[38,7]] = 13 -- ж зь + | takeFromFT 1 t1 `elem` [[54],[66]] = 13 + | otherwise = 10 +жT _ = 10 +{-# INLINE жT #-} + +зT :: FlowSound -> Sound8 +зT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] || takeFromFT_ 2 t1 == [17,10] || takeFromFT_ 1 t1 == [23] = 10 -- з ж + | isSoftDOrL t1 = 13 -- з зь + | takeFromFT 1 t1 `elem` [[39],[41]] = 41 -- з ш + | takeFromFT 1 t1 `elem` [[49],[38]] || takeFromFT_ 1 t1 `elem` [[45],[47],[50],[43],[52]] = 49 -- з с + | otherwise = 25 +зT _ = 25 +{-# INLINE зT #-} + +кT :: FlowSound -> Sound8 +кT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 19 + | otherwise = 45 +кT _ = 45 +{-# INLINE кT #-} + +нтT :: FlowSound -> Sound8 +нтT t1@(_:_) | takeFromFT 2 t1 == [49,50] || takeFromFT 1 t1 == [63] = 32 + | takeFromFT 3 t1 == [49,7,45] || takeFromFT 2 t1 == [54,45] = 65 + | otherwise = 62 +нтT _ = 62 +{-# INLINE нтT #-} + +пT :: FlowSound -> Sound8 +пT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 15 + | otherwise = 47 +пT _ = 47 +{-# INLINE пT #-} + +сT :: FlowSound -> Sound8 +сT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || + isVoicedObstruentS (takeFromFT_ 1 t1) = 13 + | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 25 + | isSoftDOrL t1 = 54 + | takeFromFT_ 1 t1 == [41] = 41 + | otherwise = 49 +сT _ = 49 +{-# INLINE сT #-} + +стT :: FlowSound -> Sound8 +стT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 25 + | takeFromFT_ 3 t1 == [49,7,45] || (takeFromFT_ 2 t1 `elem` [[54,45],[38,7]]) || + takeFromFT_ 1 t1 == [66] = 54 + | takeFromFT_ 1 t1 `elem` [[49],[32]] = 49 + | takeFromFT_ 1 t1 == [39] = 41 + | otherwise = 63 +стT _ = 63 +{-# INLINE стT #-} + +сьT :: FlowSound -> Sound8 +сьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 13 + | otherwise = 54 +сьT _ = 54 +{-# INLINE сьT #-} + +тT :: FlowSound -> Sound8 +тT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || + isVoicedObstruentS (takeFromFT_ 1 t1) = 14 + | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 17 + | takeFromFT_ 2 t1 == [38,7] || takeFromFT_ 1 t1 == [66] = 66 + | takeFromFT_ 1 t1 == [38] = 38 + | isSoftDen t1 = 64 + | takeFromFT_ 1 t1 `elem` [[39],[41]] = 39 + | otherwise = 50 +тT _ = 50 +{-# INLINE тT #-} + +тьT :: FlowSound -> Sound8 +тьT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 14 + | takeFromFT_ 3 t1 == [49,7,1] || takeFromFT_ 2 t1 == [54,1] = 66 + | otherwise = 64 +тьT _ = 64 +{-# INLINE тьT #-} + +фT :: FlowSound -> Sound8 +фT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 36 + | otherwise = 43 +фT _ = 43 +{-# INLINE фT #-} + +хT :: FlowSound -> Sound8 +хT t1@(_:_) | isVoicedObstruent . takeFromFT_ 1 $ t1 = 21 + | otherwise = 52 +хT _ = 52 +{-# INLINE хT #-} + +цT :: FlowSound -> Sound8 +цT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || + isVoicedObstruentS (takeFromFT_ 1 t1) = 12 + | isSoftDOrL t1 = 66 + | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 8 + | otherwise = 38 +цT _ = 38 +{-# INLINE цT #-} + +цьT :: FlowSound -> Sound8 +цьT t1@(_:_) | (isVoicedObstruent . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7] = 12 + | otherwise = 66 +цьT _ = 66 +{-# INLINE цьT #-} + +чT :: FlowSound -> Sound8 +чT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 66 + | isVoicedObstruent . takeFromFT_ 1 $ t1 = 23 + | otherwise = 39 +чT _ = 39 +{-# INLINE чT #-} + +шT :: FlowSound -> Sound8 +шT t1@(_:_) | takeFromFT_ 2 t1 `elem` [[49,7],[38,7]] || takeFromFT_ 1 t1 `elem` [[54],[66]] = 54 + | isVoicedObstruent . takeFromFT_ 1 $ t1 = 10 + | otherwise = 41 +шT _ = 41 +{-# INLINE шT #-} + +takeFromFT :: Int -> FlowSound -> FlowSound +takeFromFT n ts | if n < 1 then True else null ts = [] + | n < 2 = [k] + | otherwise = k : takeFromFT (n - 1) (take (n - 1) ts) + where k = head ts + +takeFromFT2 :: Int -> FlowSound -> FlowSound +takeFromFT2 n ts | if n < 1 then True else null ts = [] + | n < 2 = [ks] + | otherwise = ks:takeFromFT2 (n - 1) (tail ts) + where ks = head ts + +dropFromFT2 :: Int -> FlowSound -> FlowSound +dropFromFT2 n ts | if n < 1 then True else null ts = [] + | n < 2 = tail ts + | otherwise = dropFromFT2 (n - 1) (tail ts) + +takeFromFT_ :: Int -> FlowSound -> FlowSound +takeFromFT_ n = takeFromFT n . filter (>0) +{-# INLINE takeFromFT_ #-} + +correctA :: FlowSound -> FlowSound +correctA = correctSomeW . separateSoftS +{-# INLINE correctA #-} + +separateSoftS :: FlowSound -> FlowSound +separateSoftS = concatMap divideToParts +{-# INLINE separateSoftS #-} + +correctSomeW :: FlowSound -> FlowSound +correctSomeW (x:y:z:xs@(t:ys)) + | x == 50 && y == 7 && z == 54 && t == 1 = 66:66:1:correctSomeW ys + | (x < 1) && y == 27 && z == 1 = + if take 2 xs == [39,32] + then x:y:z:41:correctSomeW ys + else x:correctSomeW (y:z:xs) + | otherwise = x:correctSomeW (y:z:xs) +correctSomeW zs = zs + +divideToParts :: Sound8 -> FlowSound +divideToParts x = + getBFstLSorted' [x] [(12,[8,7]),(13,[25,7]),(14,[17,7]),(62,[32,50]),(63,[49,50]),(64,[50,7]), (65,[32,7])] x +{-# INLINE divideToParts #-} + +correctB :: FlowSound -> FlowSound +correctB ys@(x:xs) + | (length . filter (== 0) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t <= 0 then -1 else t) (takeFromFT2 6 ys) ++ correctB (dropFromFT2 6 ys) + | otherwise = (if x < 0 then -1 else x):correctB xs +correctB _ = [] + +-- | 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 +{-# INLINE linkFileNameI8 #-} diff --git a/Melodics/Ukrainian/Common.hs b/Melodics/Ukrainian/Common.hs new file mode 100644 --- /dev/null +++ b/Melodics/Ukrainian/Common.hs @@ -0,0 +1,33 @@ +{-# OPTIONS_HADDOCK show-extensions #-} + +-- | +-- Module : Melodics.Ukrainian.Common +-- Copyright : (c) OleksandrZhabenko 2021 +-- License : MIT +-- Maintainer : olexandr543@yahoo.com +-- +-- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis +-- especially for poets, translators and writers. Is rewritten from the module Melodics.ByteString.Ukrainian.Arr +-- for optimization purposes. Contains the common for two modules definitions. +-- Phonetic material is taken from the : +-- +-- Solomija Buk, Ján Mačutek, Andrij Rovenchak. Some properties of +-- the Ukrainian writing system. [Electronic resource] https://arxiv.org/ftp/arxiv/papers/0802/0802.4198.pdf + +module Melodics.Ukrainian.Common where + +import CaseBi.Arr + +{- +-- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html +-} + +data Triple = Z | O | T + deriving (Eq,Ord,Show) + +isUkrainianL :: Char -> Bool +isUkrainianL y | (y >= '\1070' && y <= '\1097') = True + | otherwise = getBFstLSorted' False (map (\x -> (x, True)) "'-\700\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") y + +isConsNotJ :: Char -> Bool +isConsNotJ = getBFstLSorted' False (zip "\1073\1074\1075\1076\1078\1079\1082\1083\1084\1085\1087\1088\1089\1090\1092\1093\1094\1095\1096\1097\1169" (repeat True)) diff --git a/ukrainian-phonetics-basic-array.cabal b/ukrainian-phonetics-basic-array.cabal --- a/ukrainian-phonetics-basic-array.cabal +++ b/ukrainian-phonetics-basic-array.cabal @@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/ name: ukrainian-phonetics-basic-array -version: 0.4.0.0 +version: 0.4.1.0 synopsis: A library to work with the basic Ukrainian phonetics and syllable segmentation. description: A library to work with the basic Ukrainian phonetics and syllable segmentation. Rewritten from the mmsyn6ukr and mmsyn7s packages. Comparing to the ukrainian-phonetics-basic package, all the vector-related functionality removed, it also removed from the dependencies and the mmsyn2 is changed to mmsyn2-array. Since 0.4.0.0 version switched to the more optimized Int8-based functionality. The modules that do not use Int8 after ugrading the phonetic-languages-simplified-examples-array to the Int8-based functionality are planned to be moved to the new package. homepage: https://hackage.haskell.org/package/ukrainian-phonetics-basic-array @@ -17,7 +17,7 @@ cabal-version: >=1.10 library - exposed-modules: Languages.Phonetic.Ukrainian.Syllable.Arr, Melodics.ByteString.Ukrainian.Arr, Melodics.ByteString.Ukrainian.Common, Languages.Phonetic.Ukrainian.Syllable.Double.Arr, Languages.Phonetic.Ukrainian.Syllable.ArrInt8, Melodics.ByteString.Ukrainian.ArrInt8, Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 + exposed-modules: Languages.Phonetic.Ukrainian.Syllable.Arr, Melodics.ByteString.Ukrainian.Arr, Melodics.Ukrainian.Common, Languages.Phonetic.Ukrainian.Syllable.Double.Arr, Languages.Phonetic.Ukrainian.Syllable.ArrInt8, Melodics.Ukrainian.ArrInt8, Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8 -- other-modules: other-extensions: DeriveDataTypeable, FlexibleInstances, OverloadedStrings, TypeSynonymInstances build-depends: base >=4.8 && <4.15, mmsyn2-array >=0.3 && <1, bytestring >=0.10 && <0.13, mmsyn5 >=0.5 && <1