{-# 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