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