{-# 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 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 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]) 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) 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)) 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 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 isVoicedObstruent :: FlowSound -> Bool isVoicedObstruent xs | null xs = False | otherwise = (\u -> u > 7 && u < 27) . head $ xs 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 isVoicedObstruentS :: FlowSound -> Bool isVoicedObstruentS xs | null xs = False | otherwise = (\u -> u > 11 && u < 15) . head $ xs 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) 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) г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 :: FlowSound -> Sound8 дзT t1@(_:_) | isSoftDOrL 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 :: FlowSound -> Sound8 зT t1@(_:_) | takeFromFT_ 1 t1 `elem` [[10],[39],[41]] || takeFromFT_ 2 t1 == [17,10] || takeFromFT_ 1 t1 == [23] = 10 -- з ж | isSoftDOrL t1 = 13 -- з зь | takeFromFT 1 t1 `elem` [[39],[41]] = 41 -- з ш | takeFromFT 1 t1 `elem` [[49],[38]] || takeFromFT_ 1 t1 `elem` [[45],[47],[50],[43],[52]] = 49 -- з с | otherwise = 25 зT _ = 25 кT :: 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 :: FlowSound -> Sound8 сT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || isVoicedObstruentS (takeFromFT_ 1 t1) = 13 | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 25 | isSoftDOrL t1 = 54 | takeFromFT_ 1 t1 == [41] = 41 | otherwise = 49 сT _ = 49 стT :: 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 :: FlowSound -> Sound8 тT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || isVoicedObstruentS (takeFromFT_ 1 t1) = 14 | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 17 | takeFromFT_ 2 t1 == [38,7] || takeFromFT_ 1 t1 == [66] = 66 | takeFromFT_ 1 t1 == [38] = 38 | isSoftDen t1 = 64 | takeFromFT_ 1 t1 `elem` [[39],[41]] = 39 | otherwise = 50 тT _ = 50 тьT :: 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 :: FlowSound -> Sound8 цT t1@(_:_) | ((isVoicedObstruentH . takeFromFT_ 1 $ t1) && drop 1 (takeFromFT_ 2 t1) == [7]) || isVoicedObstruentS (takeFromFT_ 1 t1) = 12 | isSoftDOrL t1 = 66 | isVoicedObstruentH . takeFromFT_ 1 $ t1 = 8 | otherwise = 38 цT _ = 38 цьT :: 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 :: FlowSound -> FlowSound correctA = correctSomeW . separateSoftS separateSoftS :: FlowSound -> FlowSound separateSoftS = concatMap divideToParts 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 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