packages feed

ukrainian-phonetics-basic-array-0.4.1.0: Languages/Phonetic/Ukrainian/Syllable/ArrInt8.hs

{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}

-- |
-- Module      :  Languages.Phonetic.Ukrainian.Syllable.ArrInt8
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- 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

import Prelude hiding (mappend)
import Data.Monoid
import Data.Typeable
import qualified Data.List as L (groupBy)
import Melodics.Ukrainian.ArrInt8
import CaseBi.Arr
import GHC.Int
import Data.List.InnToOut.Basic (mapI)
import Data.Maybe (mapMaybe)

-- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0

-- | Function-predicate 'isVowel1' checks whether its argument is a vowel representation in the 'Sound8' format.
isVowel1 :: Sound8 -> Bool
isVowel1 x = x > 0 && x < 7
{-# INLINE isVowel1 #-}

-- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'Sound8' format.
isSonorous1 :: Sound8 -> Bool
isSonorous1 x = x > 26 && x < 38
{-# INLINE isSonorous1 #-}

-- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'Sound8' format.
isVoicedC1 :: Sound8 -> Bool
isVoicedC1 x = x > 7 && x < 27
{-# INLINE isVoicedC1 #-}

-- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'Sound8' format.
isVoicelessC1 :: Sound8 -> Bool
isVoicelessC1 x = x > 37 && x < 54
{-# INLINE isVoicelessC1 #-}

-- | Binary function-predicate 'isNotVowel2' checks whether its arguments are both consonant representations in the 'Sound8' format.
isNotVowel2 :: Sound8 -> Sound8 -> Bool
isNotVowel2 x y = x > 6 && y > 6
{-# INLINE isNotVowel2 #-}

-- | Function 'sndGroups' converts a Ukrainian word being a list of 'Sound8' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)
-- sounds representations in 'Sound8' format.
sndGroups :: FlowSound -> [FlowSound]
sndGroups ys@(_:_) = L.groupBy isNotVowel2 ys
sndGroups _ = []

groupSnds :: FlowSound -> [FlowSound]
groupSnds = L.groupBy (\x y -> isVowel1 x == isVowel1 y)

-- | Function 'divCnsnts' is used to divide groups of Ukrainian 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 phonetical information for the proper performance 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
divCnsnts :: FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound)
divCnsnts xs@(x:ys@(_:_:_:_))
  | isSonorous1 x || isVoicedC1 x = ((`mappend` [x]),mappend ys)
  | otherwise = (id,mappend xs)
divCnsnts xs@(x:ys@(y:zs@(_:_)))
  | isSonorous1 x = ((`mappend` [x]),mappend ys)
  | isSonorous1 y = ((`mappend` [x,y]),mappend zs)
  | otherwise = (id,mappend xs)
divCnsnts xs@(x:ys@(y:_))
  | (isSonorous1 x && (x `notEqC` y)) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys)
  | otherwise = (id,mappend xs)
divCnsnts xs = (id,mappend xs)

reSyllableCntnts :: [FlowSound] -> [FlowSound]
reSyllableCntnts (xs:ys:zs:xss)
  | (> 6) . last $ ys = fst (divCnsnts ys) xs:reSyllableCntnts (snd (divCnsnts ys) zs:xss)
  | otherwise = reSyllableCntnts ((xs `mappend` ys):zs:xss)
reSyllableCntnts (xs:ys:_) = [xs `mappend` ys]
reSyllableCntnts xss = xss

divVwls :: [FlowSound] -> [FlowSound]
divVwls = mapI (\ws -> (length . filter isVowel1 $ ws) > 1) h3
  where h3 us = [ys `mappend` take 1 zs] `mappend` (L.groupBy (\x y -> isVowel1 x && y > 6) . drop 1 $ zs)
                  where (ys,zs) = span (>6) us

createSyllablesUkrS :: String -> [[FlowSound]]
createSyllablesUkrS = map (divVwls . reSyllableCntnts . groupSnds) . words1 . convertToProperUkrainianI8 .
 map (\x -> if x == '-' then ' ' else x)
  where words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
          where ts = dropWhile (< 1) xs
                (w, s'') = span (> 0) ts
        {-# NOINLINE words1 #-}
{-# INLINE createSyllablesUkrS #-}

-----------------------------------------------------

-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).
notEqC :: Sound8 -> Sound8 -> Bool
notEqC x y
  | x == 49 || x == 54 =
      case y of
        49 -> False
        54 -> False
        _   -> True
  | x == 66 || x == 38 =
      case y of
        38 -> False
        66 -> False
        _   -> True
  | x == y = False
  | abs (x - y) == 1 =
      getBFstLSorted' True ([(8,False),(10,False),(15,False),(17,False),(19,False),(21,False),(23,False),(25,False),
         (28,False),(30,False),(32,False),(34,False),(36,False),(39,False),(41,False),(43,False),(45,False),(47,False),
           (50,False),(52,False)]) . min x $ y
  | otherwise = True

-- | Function 'representProlonged' converts duplicated consequent in the syllable consonants
-- so that they are represented by just one 'Sound8'. After applying the function to the list of 'Sound8' being a syllable all groups of duplicated consequent consonants
-- in every syllable are represented with only one 'Sound8' respectively.
representProlonged :: FlowSound -> FlowSound
representProlonged (x:y:xs)
  | isVowel1 x = x:representProlonged (y:xs)
  | not . notEqC x $ y = y:representProlonged xs
  | otherwise = x:representProlonged (y:xs)
representProlonged xs = xs