ukrainian-phonetics-basic-array 0.4.0.0 → 0.4.1.0
raw patch · 9 files changed
+449/−371 lines, 9 files
Files
- CHANGELOG.md +5/−0
- Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs +3/−1
- Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs +1/−1
- Melodics/ByteString/Ukrainian/Arr.hs +1/−1
- Melodics/ByteString/Ukrainian/ArrInt8.hs +0/−333
- Melodics/ByteString/Ukrainian/Common.hs +0/−33
- Melodics/Ukrainian/ArrInt8.hs +404/−0
- Melodics/Ukrainian/Common.hs +33/−0
- ukrainian-phonetics-basic-array.cabal +2/−2
CHANGELOG.md view
@@ -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.
Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs view
@@ -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)
Languages/Phonetic/Ukrainian/Syllable/Double/ArrInt8.hs view
@@ -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
Melodics/ByteString/Ukrainian/Arr.hs view
@@ -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 .
− Melodics/ByteString/Ukrainian/ArrInt8.hs
@@ -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 #-}
− Melodics/ByteString/Ukrainian/Common.hs
@@ -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))
+ Melodics/Ukrainian/ArrInt8.hs view
@@ -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 #-}
+ Melodics/Ukrainian/Common.hs view
@@ -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))
ukrainian-phonetics-basic-array.cabal view
@@ -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