Copyright | (c) Oleksandr Zhabenko 2021-2024 |
---|---|
License | MIT |
Maintainer | oleksandr.zhabenko@yahoo.com |
Stability | Experimental |
Safe Haskell | None |
Language | Haskell2010 |
Extensions |
|
Aftovolio.General.Syllables
Description
This module works with syllable segmentation. The generalized version for the module
Syllable
.
Synopsis
- data PRS = SylS {
- charS :: !Char
- phoneType :: !PhoneticType
- type PhoneticPhenomenonRep = PRS
- data PhoneticType = P !Int8
- type CharPhoneticClassification = Array Int PhoneticPhenomenonRep
- type StringRepresentation = [PhoneticPhenomenonRep]
- data SegmentationInfo1 = SI {
- fieldN :: !Int8
- predicateN :: Int8
- data SegmentationPredFunction = PF (SegmentationInfo1 -> [(Char, Char)] -> [PhoneticPhenomenonRep] -> Bool)
- data SegmentationPredFData a b
- = L Int [Int] (Array Int a)
- | NEC Int Int (Array Int a) [b]
- | C (SegmentationPredFData a b) (SegmentationPredFData a b)
- | D (SegmentationPredFData a b) (SegmentationPredFData a b)
- type SegmentationFDP = SegmentationPredFData PhoneticPhenomenonRep (Char, Char)
- class Eval2Bool a where
- type DListFunctionResult = ([PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep], [PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep])
- data SegmentationLineFunction = LFS {}
- data SegmentationRules1 = SR1 {}
- type SegmentRulesG = [SegmentationRules1]
- class DListRepresentation a b where
- toDLR :: b -> [a] -> ([a] -> [a], [a] -> [a])
- type BasicSpaces = String
- type AdditionalDelimiters = String
- str2PRSs :: CharPhoneticClassification -> String -> StringRepresentation
- sndGroups :: [PhoneticPhenomenonRep] -> [[PhoneticPhenomenonRep]]
- groupSnds :: [PhoneticPhenomenonRep] -> [[PhoneticPhenomenonRep]]
- divCnsnts :: [(Char, Char)] -> SegmentRulesG -> [PhoneticPhenomenonRep] -> DListFunctionResult
- reSyllableCntnts :: [(Char, Char)] -> SegmentRulesG -> [[PhoneticPhenomenonRep]] -> [[PhoneticPhenomenonRep]]
- divSylls :: [[PhoneticPhenomenonRep]] -> [[PhoneticPhenomenonRep]]
- createSyllablesPL :: GWritingSystemPRPLX -> [(Char, Char)] -> CharPhoneticClassification -> SegmentRulesG -> BasicSpaces -> AdditionalDelimiters -> String -> [[[PhoneticPhenomenonRep]]]
- gBF4 :: Ix i => (# Int#, PhoneticPhenomenonRep #) -> (# Int#, PhoneticPhenomenonRep #) -> Char -> Array i PhoneticPhenomenonRep -> Maybe PhoneticPhenomenonRep
- findC :: Char -> Array Int PhoneticPhenomenonRep -> Maybe PhoneticPhenomenonRep
- createsSyllable :: PhoneticPhenomenonRep -> Bool
- isSonorous1 :: PhoneticPhenomenonRep -> Bool
- isVoicedC1 :: PhoneticPhenomenonRep -> Bool
- isVoicelessC1 :: PhoneticPhenomenonRep -> Bool
- notCreatesSyllable2 :: PhoneticPhenomenonRep -> PhoneticPhenomenonRep -> Bool
- notEqC :: [(Char, Char)] -> PhoneticPhenomenonRep -> PhoneticPhenomenonRep -> Bool
- fromPhoneticType :: PhoneticType -> Int
Data types and type synonyms
The AFTOVolio phonetic phenomenon representation.
Constructors
SylS | |
Fields
|
Instances
Read PRS Source # | |
Show PRS Source # | |
Eq PRS Source # | |
Ord PRS Source # | |
DListRepresentation PhoneticPhenomenonRep Int8 Source # | |
Defined in Aftovolio.General.Syllables Methods toDLR :: Int8 -> [PhoneticPhenomenonRep] -> ([PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep], [PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep]) Source # | |
Eval2Bool (SegmentationPredFData PhoneticPhenomenonRep (Char, Char)) Source # | |
Defined in Aftovolio.General.Syllables Methods eval2Bool :: SegmentationPredFData PhoneticPhenomenonRep (Char, Char) -> Bool Source # |
type PhoneticPhenomenonRep = PRS Source #
Type synonym to be used for clarity and better code readability.
data PhoneticType Source #
Instances
Read PhoneticType Source # | |
Defined in Aftovolio.General.Syllables Methods readsPrec :: Int -> ReadS PhoneticType # readList :: ReadS [PhoneticType] # | |
Show PhoneticType Source # | |
Defined in Aftovolio.General.Syllables Methods showsPrec :: Int -> PhoneticType -> ShowS # show :: PhoneticType -> String # showList :: [PhoneticType] -> ShowS # | |
Eq PhoneticType Source # | |
Defined in Aftovolio.General.Syllables | |
Ord PhoneticType Source # | |
Defined in Aftovolio.General.Syllables Methods compare :: PhoneticType -> PhoneticType -> Ordering # (<) :: PhoneticType -> PhoneticType -> Bool # (<=) :: PhoneticType -> PhoneticType -> Bool # (>) :: PhoneticType -> PhoneticType -> Bool # (>=) :: PhoneticType -> PhoneticType -> Bool # max :: PhoneticType -> PhoneticType -> PhoneticType # min :: PhoneticType -> PhoneticType -> PhoneticType # |
type StringRepresentation = [PhoneticPhenomenonRep] Source #
data SegmentationInfo1 Source #
Constructors
SI | |
Fields
|
Instances
PhoneticElement SegmentationInfo1 Source # | |
Defined in Aftovolio.General.Syllables Methods | |
Read SegmentationInfo1 Source # | |
Defined in Aftovolio.General.Syllables Methods readsPrec :: Int -> ReadS SegmentationInfo1 # readList :: ReadS [SegmentationInfo1] # | |
Show SegmentationInfo1 Source # | |
Defined in Aftovolio.General.Syllables Methods showsPrec :: Int -> SegmentationInfo1 -> ShowS # show :: SegmentationInfo1 -> String # showList :: [SegmentationInfo1] -> ShowS # | |
Eq SegmentationInfo1 Source # | |
Defined in Aftovolio.General.Syllables Methods (==) :: SegmentationInfo1 -> SegmentationInfo1 -> Bool # (/=) :: SegmentationInfo1 -> SegmentationInfo1 -> Bool # |
data SegmentationPredFunction Source #
We can think of SegmentationPredFunction
in terms of f (
. Comparing with
SI
fN pN) ks [x_{1},x_{2},...,x_{i},...,x_{fN}]divCnsnts
from the Syllable
we can postulate that it consists of the following logical terms in
the symbolic form:
1) phoneType
x_{i} `elem
` (X{...} = map
P
[Int8
])
2) notEqC
ks x_{i} x_{j} (j /= i)
combined with the standard logic Boolean operations of (&&)
, (||)
and not
. Further, the not
can be transformed into the
positive (affirmative) form using the notion of the universal set for the task. This transformation needs that the similar
phonetic phenomenae (e. g. the double sounds -- the prolonged ones) belong to the one syllable and not to the different ones
(so they are not related to different syllables, but just to the one and the same). Since such assumption has been used,
we can further represent the function by the following data type and operations with it, see SegmentationPredFData
.
Constructors
PF (SegmentationInfo1 -> [(Char, Char)] -> [PhoneticPhenomenonRep] -> Bool) |
data SegmentationPredFData a b Source #
Constructors
L Int [Int] (Array Int a) | |
NEC Int Int (Array Int a) [b] | |
C (SegmentationPredFData a b) (SegmentationPredFData a b) | |
D (SegmentationPredFData a b) (SegmentationPredFData a b) |
Instances
class Eval2Bool a where Source #
Instances
Eval2Bool (SegmentationPredFData PhoneticPhenomenonRep (Char, Char)) Source # | |
Defined in Aftovolio.General.Syllables Methods eval2Bool :: SegmentationPredFData PhoneticPhenomenonRep (Char, Char) -> Bool Source # |
type DListFunctionResult = ([PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep], [PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep]) Source #
data SegmentationLineFunction Source #
Constructors
LFS | |
Fields
|
Instances
Read SegmentationLineFunction Source # | |
Defined in Aftovolio.General.Syllables | |
Show SegmentationLineFunction Source # | |
Defined in Aftovolio.General.Syllables Methods showsPrec :: Int -> SegmentationLineFunction -> ShowS # show :: SegmentationLineFunction -> String # showList :: [SegmentationLineFunction] -> ShowS # |
data SegmentationRules1 Source #
Constructors
SR1 | |
Fields
|
Instances
Read SegmentationRules1 Source # | |
Defined in Aftovolio.General.Syllables Methods readsPrec :: Int -> ReadS SegmentationRules1 # readList :: ReadS [SegmentationRules1] # | |
Show SegmentationRules1 Source # | |
Defined in Aftovolio.General.Syllables Methods showsPrec :: Int -> SegmentationRules1 -> ShowS # show :: SegmentationRules1 -> String # showList :: [SegmentationRules1] -> ShowS # |
type SegmentRulesG = [SegmentationRules1] Source #
List of the SegmentationRules1
sorted in the descending order by the fieldN
SegmentationInfo1
data and where the
length of all the SegmentationPredFunction
lists of PhoneticPhenomenonRep
are equal to the fieldN
SegmentationInfo1
data by definition.
class DListRepresentation a b where Source #
Instances
DListRepresentation PhoneticPhenomenonRep Int8 Source # | |
Defined in Aftovolio.General.Syllables Methods toDLR :: Int8 -> [PhoneticPhenomenonRep] -> ([PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep], [PhoneticPhenomenonRep] -> [PhoneticPhenomenonRep]) Source # |
type BasicSpaces = String Source #
Basic group of delimiters in the String
that are not converted to the phonemes or not silent sounds. Silent sounds or their absense, e. g. word gaps.
type AdditionalDelimiters = String Source #
Is used for additional delimiters that are not included in the BasicSpaces
group for some reason.
Basic functions
sndGroups :: [PhoneticPhenomenonRep] -> [[PhoneticPhenomenonRep]] Source #
Function sndGroups
converts a word being a list of PhoneticPhenomenonRep
to the list of phonetically similar (consonants grouped with consonants and each vowel separately)
sounds representations in PhoneticPhenomenonRep
format.
groupSnds :: [PhoneticPhenomenonRep] -> [[PhoneticPhenomenonRep]] Source #
Arguments
:: [(Char, Char)] | The pairs of the |
-> SegmentRulesG | |
-> [PhoneticPhenomenonRep] | |
-> DListFunctionResult |
Function divCnsnts
is used to divide groups of consonants into two-elements lists that later are made belonging to
different neighbour syllables if the group is between two vowels in a word. The group must be not empty, but this is not checked.
The example phonetical information for the proper performance in Ukrainian can be found from the:
https:/msn.khnu.km.uapluginfile.php302375mod_resourcecontent1/%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
The example of the divCnsnts
can be found at: https://hackage.haskell.org/package/aftovolio-0.6.2.0/docs/Aftovolio-Ukrainian-Syllable.html#v:divCnsnts
Arguments
:: [(Char, Char)] | The pairs of the |
-> SegmentRulesG | |
-> [[PhoneticPhenomenonRep]] | |
-> [[PhoneticPhenomenonRep]] |
divSylls :: [[PhoneticPhenomenonRep]] -> [[PhoneticPhenomenonRep]] Source #
Arguments
:: GWritingSystemPRPLX | Data used to obtain the phonetic language representation of the text. |
-> [(Char, Char)] | The pairs of the |
-> CharPhoneticClassification | |
-> SegmentRulesG | |
-> BasicSpaces | Corresponds to the 100 delimiter in the |
-> AdditionalDelimiters | Corresponds to the 101 delimiter in the |
-> String | Actually the converted |
-> [[[PhoneticPhenomenonRep]]] |
The function actually creates syllables using the provided data. Each resulting inner-most list is a phonetic language representation of the syllable according to the rules provided.
Auxiliary functions
gBF4 :: Ix i => (# Int#, PhoneticPhenomenonRep #) -> (# Int#, PhoneticPhenomenonRep #) -> Char -> Array i PhoneticPhenomenonRep -> Maybe PhoneticPhenomenonRep Source #
Is somewhat rewritten from the gBF3
function (not exported) from the mmsyn2-array
package.
createsSyllable :: PhoneticPhenomenonRep -> Bool Source #
Function-predicate createsSyllable
checks whether its argument is a phoneme representation that
every time being presented in the text leads to the creation of the new syllable (in the PhoneticPhenomenonRep
format).
Usually it is a vowel, but in some languages there can be syllabic phonemes that are not considered to be
vowels.
isSonorous1 :: PhoneticPhenomenonRep -> Bool Source #
Function-predicate isSonorous1
checks whether its argument is a sonorous consonant representation in the PhoneticPhenomenonRep
format.
isVoicedC1 :: PhoneticPhenomenonRep -> Bool Source #
Function-predicate isVoicedC1
checks whether its argument is a voiced consonant representation in the PhoneticPhenomenonRep
format.
isVoicelessC1 :: PhoneticPhenomenonRep -> Bool Source #
Function-predicate isVoiceless1
checks whether its argument is a voiceless consonant representation in the PhoneticPhenomenonRep
format.
notCreatesSyllable2 :: PhoneticPhenomenonRep -> PhoneticPhenomenonRep -> Bool Source #
Binary function-predicate notCreatesSyllable2
checks whether its arguments are both consonant representations in the PhoneticPhenomenonRep
format.
Arguments
:: [(Char, Char)] | The pairs of the |
-> PhoneticPhenomenonRep | |
-> PhoneticPhenomenonRep | |
-> Bool |
Binary function-predicate notEqC
checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).
fromPhoneticType :: PhoneticType -> Int Source #