packages feed

aftovolio (empty) → 0.1.0.0

raw patch · 41 files changed

+7302/−0 lines, 41 filesdep +asyncdep +basedep +cli-arguments

Dependencies added: async, base, cli-arguments, containers, deepseq, directory, intermediate-structures, lists-flines, minmax, mmsyn2-array, monoid-insertleft, quantizer, rev-scientific, rhythmic-sequences

Files

+ Aftovolio/Basis.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module      :  Aftovolio.Basis+-- Copyright   :  (c) OleksandrZhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Simplified version of the @phonetic-languages-common@ and @phonetic-languages-general@ packages.+-- Uses less dependencies.++{-# LANGUAGE BangPatterns, FlexibleContexts #-}++module Aftovolio.Basis where++import GHC.Base++data Result t a b c = R {line :: !(t a), propertiesF :: !b,  transPropertiesF :: !c} deriving Eq++instance (Ord (t a), Ord b, Ord c) => Ord (Result t a b c) where+  compare x y+    = case compare (transPropertiesF x) (transPropertiesF y) of+       !EQ -> case compare (propertiesF x) (propertiesF y) of+              !EQ -> compare (line x) (line y)+              !z -> z+       !z0 -> z0+  {-# INLINE compare #-}++data FuncRep2 a b c = D { getAB :: (a -> b), getBC :: (b -> c) }++getAC :: FuncRep2 a b c -> (a -> c)+getAC (D f g) = g . f+{-# INLINE getAC #-}++data Result2 a b c = R2 {line2 :: !a, propertiesF2 :: !b,  transPropertiesF2 :: !c} deriving Eq++instance (Ord a, Ord b, Ord c) => Ord (Result2 a b c) where+  compare x y+    = case compare (transPropertiesF2 x) (transPropertiesF2 y) of+       !EQ -> case compare (propertiesF2 x) (propertiesF2 y) of+              !EQ -> compare (line2 x) (line2 y)+              !z -> z+       !z0 -> z0+  {-# INLINE compare #-}++
+ Aftovolio/Coeffs.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module      :  Aftovolio.Coeffs+-- Copyright   :  (c) OleksandrZhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- The coefficients functionality common for both phonetic-languages-simplified-examples-array and phonetic-languages-simplified-generalized-examples-array lines of AFTOVolio.++{-# LANGUAGE BangPatterns #-}++module Aftovolio.Coeffs (+    -- * Newtype to work with+  CoeffTwo(..)+  , Coeffs2+  , isEmpty+  , isPair+  , fstCF+  , sndCF+  , readCF+) where++import GHC.Base+import GHC.List+import Data.Maybe (isNothing,fromMaybe,fromJust)+import Text.Read (readMaybe)++data CoeffTwo a = CF0 | CF2 (Maybe a) (Maybe a) deriving (Eq)++isEmpty :: CoeffTwo a -> Bool+isEmpty CF0 = True+isEmpty _ = False++isPair :: CoeffTwo a -> Bool+isPair CF0 = False+isPair _ = True++fstCF :: CoeffTwo a -> Maybe a+fstCF (CF2 x _) = x+fstCF _ = Nothing++sndCF :: CoeffTwo a -> Maybe a+sndCF (CF2 _ y) = y+sndCF _ = Nothing++readCF :: String -> Coeffs2+readCF xs+  | any (== '_') xs = let (!ys,!zs) = (\(ks,ts) -> (readMaybe ks::Maybe Double,readMaybe (drop 1 ts)::Maybe Double)) . break (== '_') $ xs in+     if (isNothing ys && isNothing zs) then CF0 else CF2 ys zs+  | otherwise = CF0++-- | A data type that is used to represent the coefficients of the rhythmicity functions as a one argument value.+type Coeffs2 = CoeffTwo Double
+ Aftovolio/Constraints.hs view
@@ -0,0 +1,363 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Aftovolio.Constraints+-- Copyright   :  (c) OleksandrZhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Provides several the most important variants of constraints for the+-- permutations. All the 'Array'+-- here must consists of unique 'Int' starting from 0 to n-1 and the 'Int'+-- arguments must be in the range [0..n-1] though these inner constraints are+-- not checked. It is up to user to check them.+-- Uses arrays instead of vectors.+-- The word \"unsafe\" in the names means that there is no checking whether the arguments are +-- within the elements of the arrays, this checking is intended to be done elsewhere before applying +-- the functions here. Without such a checking the result are meaningless.++{-# LANGUAGE BangPatterns, FlexibleContexts, NoImplicitPrelude #-}++module Aftovolio.Constraints (+  -- * Predicates+  unsafeOrderIJ+  , unsafeSignDistanceIJ+  , unsafeUnsignDistanceIJ+  , isSignDistIJK3+  , isUnsignDistIJK3+  , isMixedDistIJK3+  , isTripleOrdered+  , isQuadrupleOrdered+  , isQuintupleOrdered+  , isSeveralAOrdered+  , isSeveralBOrdered+  , isFixedPointTup+  , isFixedPoint+  , notSignDistIJK3 +  , notUnsignDistIJK3+  , notMixedDistIJK3 +  , notTripleOrdered +  , notQuadrupleOrdered+  , notQuintupleOrdered+  , notSeveralAOrdered +  , notSeveralBOrdered +  , notFixedPointTup +  , notFixedPoint +  -- * Functions to work with permutations with basic constraints ('Array'-based)+  , filterOrderIJ+  , unsafeTriples+  , unsafeQuadruples+  , unsafeQuintuples+  -- ** With multiple elements specified+  , unsafeSeveralA+  , unsafeSeveralB+  -- ** With fixed points+  , fixedPointsG+  , fixedPointsS+  -- * Distances between elements+  , filterSignDistanceIJ+  , filterUnsignDistanceIJ+  , filterSignDistanceIJK3+  , filterUnsignDistanceIJK3+  , filterMixedDistanceIJK3+) where++import GHC.Base hiding (foldr)+import GHC.Num (Num, (-),(+))+import Data.InsertLeft (InsertLeft(..),filterG)+import GHC.Arr+import GHC.Int (Int8(..))+import Data.Bits ((.&.),testBit, shiftR, setBit, clearBit)+import Data.Foldable (Foldable, all, foldr, any)++f2 :: (Foldable t, Eq p) => p -> p -> t p -> Int8+f2 i j = foldr g (0::Int8) -- (== 3)+  where g x y+          | y == 3 = 3+          | x == j = bitChange (shiftR y 1 == 0) y 0+          | x == i = bitChange (testBit y 0) y 1+          | otherwise = y+{-# INLINE f2 #-}+{-# SPECIALIZE f2 :: Int -> Int -> Array Int Int -> Int8 #-}++f3 :: (Foldable t, Eq p) => p -> p -> p -> t p -> Int8+f3 i j k = foldr g (0::Int8) -- (== 7)+  where g x y+          | y == 7 = 7+          | x == k = bitChange (shiftR y 1 == 0) y 0  -- u, not (t && u))+          | x == j = bitChange (not (testBit y 2) && testBit y 0) y 1  -- (t, w && not t, w)+          | x == i = bitChange (clearBit y 2 == 3) y 2  -- (u && w, u, w)+          | otherwise = y+{-# INLINE f3 #-}+{-# SPECIALIZE f3 :: Int -> Int -> Int -> Array Int Int -> Int8 #-}++f4 :: (Foldable t, Eq p) => p -> p -> p -> p -> t p -> Int8+f4 i j k l = foldr g (0::Int8) -- (== 15)+  where g x y+          | y == 15 = 15+          | x == l = bitChange (shiftR y 1 == 0) y 0 +          | x == k = bitChange (shiftR y 2 == 0 && testBit y 0) y 1 +          | x == j = bitChange (not (testBit y 3) && y .&. 3 == 3) y 2  +          | x == i = bitChange (clearBit y 3 == 7) y 3 +          | otherwise = y+{-# INLINE f4 #-}+{-# SPECIALIZE f4 :: Int -> Int -> Int -> Int -> Array Int Int -> Int8 #-}++f5 :: (Foldable t, Eq p) => p -> p -> p -> p -> p -> t p -> Int8+f5 i j k l m = foldr g (0::Int8) -- (== 31)+  where g x y+          | y == 31 = 31+          | x == m = bitChange (shiftR y 1 == 0) y 0 +          | x == l = bitChange (testBit y 0 && shiftR y 2 == 0) y 1+          | x == k = bitChange (shiftR y 3 == 0 && y .&. 3 == 3) y 2 +          | x == j = bitChange (not (testBit y 4) && y .&. 7 == 7) y 3  +          | x == i = bitChange (clearBit y 4 == 15) y 4 +          | otherwise = y+{-# INLINE f5 #-}+{-# SPECIALIZE f5 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Int8 #-}+++-- | @n@ must be in the range [0..7] though it is not checked here.+bitChange + :: Bool + -> Int8 + -> Int + -> Int8+bitChange bool = (if bool then setBit else clearBit)+{-# INLINE bitChange #-}++-- | Being given the data satisfying the constraints in the module header checks whether in the 'Array' the first argument stands before the second one.+unsafeOrderIJ :: Int -> Int -> Array Int Int -> Bool+unsafeOrderIJ i j = (== 3) . f2 i j+{-# INLINE unsafeOrderIJ #-}++-- | Being given the data satisfying the constraints in the module header checks whether in the+-- 'Array' the distance between positions of the first two arguments values is equal to the signed+-- third argument.+unsafeSignDistanceIJ+  :: Int+  -> Int+  -> Int -- ^ Can be of both signs, but not equal to 0. The positive value gives 'True' for the first argument being find earlier in the 'Array' than the second and the distance between their positions are equal to 'abs' @d@ (this argument). The negative value gives 'True' for the second argument  being earlier in the 'Array' than the first one and the distance between their positions are equal to 'abs' @d@ (this argument).+  -> Array Int Int+  -> Bool+unsafeSignDistanceIJ i j d = (\(_,_,r) -> if r > 100 then (100 - r) == d else r == d) . foldr helpG2 (j, i, -1)+{-# INLINE unsafeSignDistanceIJ #-}+++helpG2 :: (Ord a1, Ord a2, Num a1, Num a2) => a2 -> (a2, a2, a1) -> (a2, a2, a1)+helpG2 z (t, u, n)+  | n < 0 = if (z /= t && z /= u) then (t, u, n) else (t, u, if z == t then 1 else 101)+  | z /= u && z /= t && t >= 0 = (t, u, n + 1)+  | otherwise = (-1, u, n)+{-# INLINE helpG2 #-}+{-# SPECIALIZE helpG2 :: Int -> (Int, Int, Int) -> (Int, Int, Int)  #-}++-- | Being given the data satisfying the constraints in the module header checks whether in the+-- 'Array' the distance between positions of the first two arguments values is equal to the unsigned +-- third argument. The following is true: if 'unsafeSignDistanceIJ' @i@ @j@ @d@ @array@ == 'True' then+-- 'unsafeUnsignDistanceIJ' @i@ @j@ @d@ @array@ == 'True', but not necessarily vice versa. +unsafeUnsignDistanceIJ +  :: Int +  -> Int +  -> Int -- ^ Only for positive values can give 'True', if the distance between the positions of the elements equal to the first two arguments are equal to this argument. Otherwise, 'False'.+  -> Array Int Int +  -> Bool+unsafeUnsignDistanceIJ i j d = (\(_,_,r) -> r == d) . foldr helpG3 (j, i, -1)+{-# INLINE unsafeUnsignDistanceIJ #-}++helpG3 :: (Ord a1, Ord a2, Num a1, Num a2) => a2 -> (a2, a2, a1) -> (a2, a2, a1)+helpG3 z (t, u, n)+  | n < 0 = if (z /= t && z /= u) then (t, u, n) else (t, u, 1)+  | z /= u && z /= t && t >= 0 = (t, u, n + 1)+  | otherwise = (-1, u, n)+{-# INLINE helpG3 #-}+{-# SPECIALIZE helpG3 :: Int -> (Int, Int, Int) -> (Int, Int, Int) #-}++-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeOrderIJ' as a predicate.+filterOrderIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> t (Array Int Int) -> t (Array Int Int)+filterOrderIJ i j = filterG (unsafeOrderIJ i j)+{-# INLINE filterOrderIJ #-}+{-# SPECIALIZE filterOrderIJ :: Int -> Int -> [Array Int Int] -> [Array Int Int] #-}++-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeSignDistanceIJ' as a predicate.+filterSignDistanceIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)+filterSignDistanceIJ i j d = filterG (unsafeSignDistanceIJ i j d)+{-# INLINE filterSignDistanceIJ #-}+{-# SPECIALIZE filterSignDistanceIJ :: Int -> Int -> Int -> [Array Int Int] -> [Array Int Int] #-}++-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeUnsignDistanceIJ' as a predicate.+filterUnsignDistanceIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)+filterUnsignDistanceIJ i j d = filterG (unsafeUnsignDistanceIJ i j d)+{-# INLINE filterUnsignDistanceIJ #-}+{-# SPECIALIZE filterUnsignDistanceIJ :: Int -> Int -> Int -> [Array Int Int] -> [Array Int Int] #-}++-- | Being given the data satisfying the constraints in the module header returns the elements that pairwisely (1 and 2, 2 and 3) satisfy 'unsafeSignDistanceIJ' as a predicate.+filterSignDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)+filterSignDistanceIJK3 i j k d1 d2 = filterG (isSignDistIJK3 i j k d1 d2)+{-# INLINE filterSignDistanceIJK3 #-}+{-# SPECIALIZE filterSignDistanceIJK3 :: Int -> Int -> Int -> Int -> Int -> [Array Int Int] -> [Array Int Int]  #-}++-- | Being given the data satisfying the constraints in the module header returns the elements that pairwisely (1 and 2, 2 and 3) satisfy 'unsafeUnsignDistanceIJ' as a predicate.+filterUnsignDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)+filterUnsignDistanceIJK3 i j k d1 d2 = filterG (isUnsignDistIJK3 i j k d1 d2)+{-# INLINE filterUnsignDistanceIJK3 #-}+{-# SPECIALIZE filterUnsignDistanceIJK3 :: Int -> Int -> Int -> Int -> Int -> [Array Int Int] -> [Array Int Int]  #-}++-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy both 'unsafeSignDistanceIJ' with the 1st, 2nd and 4th arguments and 'unsafeUnsignDistanceIJ' with the 2nd, 3rd and 5th arguments as predicates.+filterMixedDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)+filterMixedDistanceIJK3 i j k d1 d2 = filterG (isMixedDistIJK3 i j k d1 d2)+{-# INLINE filterMixedDistanceIJK3 #-}+{-# SPECIALIZE filterMixedDistanceIJK3 :: Int -> Int -> Int -> Int -> Int -> [Array Int Int] -> [Array Int Int] #-}++-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication if the+-- arguments are the indices of the duplicated words or their concatenated combinations in the corresponding line.+-- The first three arguments+-- can be the indices of the the triple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).+unsafeTriples :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)+unsafeTriples i j k = filterG (isTripleOrdered i j k)+{-# INLINE unsafeTriples #-}+{-# SPECIALIZE unsafeTriples :: Int -> Int -> Int -> [Array Int Int] -> [Array Int Int]  #-}++-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication if the+-- arguments are the indices of the duplicated words or their concatenated combinations in the corresponding line.+-- The first four arguments+-- can the indices of the the quadruple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).+unsafeQuadruples :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)+unsafeQuadruples i j k l = filterG (isQuadrupleOrdered i j k l)+{-# INLINE unsafeQuadruples #-}+{-# SPECIALIZE unsafeQuadruples :: Int -> Int -> Int -> Int -> [Array Int Int] -> [Array Int Int]  #-}++-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication if the+-- arguments are the indices of the duplicated words or their concatenated combinations in the corresponding line.+-- The first five arguments+-- can be the indices of the the quintuple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).+unsafeQuintuples :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int ->  t (Array Int Int) -> t (Array Int Int)+unsafeQuintuples i j k l m = filterG (isQuintupleOrdered i j k l m)+{-# INLINE unsafeQuintuples #-}+{-# SPECIALIZE unsafeQuintuples :: Int -> Int -> Int -> Int -> Int ->  [Array Int Int] -> [Array Int Int]  #-}++-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication.+-- The first argument+-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument+-- is 'Array' 'Int' of indices that are in the range [0..n-1]. Filters (and reduces further complex computations) the permutations so that only the+-- variants with the indices in the second argument all stand AFTER the element with the index equal to the first argument.+unsafeSeveralA :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)+unsafeSeveralA !i0 arr = filterG (isSeveralAOrdered i0 arr)+{-# INLINE unsafeSeveralA #-}+{-# SPECIALIZE unsafeSeveralA :: Int -> Array Int Int -> [Array Int Int] -> [Array Int Int]  #-}++-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of+-- the permutations each one being represented as 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n-1] without duplication.+-- The first argument+-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument+-- is 'Array' of indices that are in the range [0..n-1]. Filters (and reduces further complex computations) the permutations so that only the+-- variants with the indices in the second argument all stand BEFORE the element with the index equal to the first argument.+unsafeSeveralB :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)+unsafeSeveralB !i0 arr = filterG (isSeveralBOrdered i0 arr)+{-# INLINE unsafeSeveralB #-}+{-# SPECIALIZE unsafeSeveralB :: Int -> Array Int Int -> [Array Int Int] -> [Array Int Int]  #-}++--------------------------------------------------------------------------------++-- | Reduces the number of permutations using filtering leaving just those ones permutations where elements on the+-- first elements in the tuples in the first argument 'Array' places are moved to the places indexed with the second+-- elements in the tuples respectively.+fixedPointsG :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int (Int,Int) -> t (Array Int Int) -> t (Array Int Int)+fixedPointsG arr = filterG (isFixedPointTup arr)+{-# INLINE fixedPointsG #-}+{-# SPECIALIZE fixedPointsG :: Array Int (Int,Int) -> [Array Int Int] -> [Array Int Int]  #-}++-- | A simplified variant of the 'fixedPointsG' function where the specified elements stay on their place and that is+-- why are 'fixed points' in the permutation specified.+fixedPointsS :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int Int -> t (Array Int Int) -> t (Array Int Int)+fixedPointsS arr = filterG (isFixedPoint arr)+{-# INLINE fixedPointsS #-}+{-# SPECIALIZE fixedPointsS :: Array Int Int -> [Array Int Int] -> [Array Int Int]  #-}++------------------------------------------++isSignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+isSignDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ i j d1 arr && unsafeSignDistanceIJ j k d2 arr+{-# INLINE isSignDistIJK3 #-}++isUnsignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+isUnsignDistIJK3 i j k d1 d2 arr = unsafeUnsignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr+{-# INLINE isUnsignDistIJK3 #-}++isMixedDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+isMixedDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr+{-# INLINE isMixedDistIJK3 #-}++isTripleOrdered :: Int -> Int -> Int -> Array Int Int -> Bool+isTripleOrdered i j k = (== 7) . f3 i j k+{-# INLINE isTripleOrdered #-}++isQuadrupleOrdered :: Int -> Int -> Int -> Int -> Array Int Int -> Bool+isQuadrupleOrdered i j k l = (== 15) . f4 i j k l+{-# INLINE isQuadrupleOrdered #-}++isQuintupleOrdered :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+isQuintupleOrdered i j k l m = (== 31) . f5 i j k l m+{-# INLINE isQuintupleOrdered #-}++isSeveralAOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+isSeveralAOrdered !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ i0 k arr2) arr1+{-# INLINE isSeveralAOrdered #-}++isSeveralBOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+isSeveralBOrdered !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ k i0 arr2) arr1+{-# INLINE isSeveralBOrdered #-}++isFixedPointTup :: Array Int (Int, Int) -> Array Int Int -> Bool+isFixedPointTup arr1 arr2 = all (\(k,j) -> unsafeAt arr2 k == j) arr1+{-# INLINE isFixedPointTup #-}++isFixedPoint :: Array Int Int -> Array Int Int -> Bool+isFixedPoint arr1 arr2 = all (\k -> unsafeAt arr2 k == k) arr1+{-# INLINE isFixedPoint #-}++notSignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+notSignDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ j i d1 arr || unsafeSignDistanceIJ k j d2 arr+{-# INLINE notSignDistIJK3 #-}++notUnsignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+notUnsignDistIJK3 i j k d1 d2 = not . isUnsignDistIJK3 i j k d1 d2+{-# INLINE notUnsignDistIJK3 #-}++notMixedDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+notMixedDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ j i d1 arr || not (unsafeUnsignDistanceIJ j k d2 arr)+{-# INLINE notMixedDistIJK3 #-}++notTripleOrdered :: Int -> Int -> Int -> Array Int Int -> Bool+notTripleOrdered i j k = (/= 7) . f3 i j k+{-# INLINE notTripleOrdered #-}++notQuadrupleOrdered :: Int -> Int -> Int -> Int -> Array Int Int -> Bool+notQuadrupleOrdered i j k l = (/= 15) . f4 i j k l+{-# INLINE notQuadrupleOrdered #-}++notQuintupleOrdered ::  Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+notQuintupleOrdered i j k l m = (/= 31) . f5 i j k l m+{-# INLINE notQuintupleOrdered #-}++notSeveralAOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+notSeveralAOrdered !i0 !arr1 = not . isSeveralAOrdered i0 arr1+{-# INLINE notSeveralAOrdered #-}++notSeveralBOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+notSeveralBOrdered !i0 !arr1 = not . isSeveralBOrdered i0 arr1+{-# INLINE notSeveralBOrdered #-}++notFixedPointTup :: Array Int (Int, Int) -> Array Int Int -> Bool+notFixedPointTup arr1 arr2 = any (\(k,j) -> unsafeAt arr2 k /= j) arr1+{-# INLINE notFixedPointTup #-}++notFixedPoint :: Array Int Int -> Array Int Int -> Bool+notFixedPoint arr1 arr2 = any (\k -> unsafeAt arr2 k /= k) arr1+{-# INLINE notFixedPoint #-}+
+ Aftovolio/ConstraintsEncoded.hs view
@@ -0,0 +1,456 @@+{-# OPTIONS_HADDOCK show-extensions #-}+++++-- |+-- Module      :  Aftovolio.ConstraintsEncoded+-- Copyright   :  (c) OleksandrZhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Provides a way to encode the needed constraint with possibly less symbols.+-- Uses arrays instead of vectors.++{-# LANGUAGE FlexibleInstances, FlexibleContexts, NoImplicitPrelude, BangPatterns #-}++module Aftovolio.ConstraintsEncoded (+  -- * Data types+  EncodedContraints(..)+  , EncodedCnstrs+  -- * Functions to work with them+  -- ** Read functions+ , readMaybeECG+  -- ** Process-encoding functions+  , decodeConstraint1+  , decodeLConstraints+  , isConstraint1+  -- ** Modifiers and getters+  , getIEl+  , setIEl+  -- ** Predicates+  , isE+  , isP+  , isF+  , isQ+  , isT+  , isSA+  , isSB+  , isV+  , isW+  , isH+  , isR+  , isM+  , isN+  , isD+  , isI+  , isU+  -- * Algebraic general conversion+  , validOrdStr+  , generalConversion+  , filterGeneralConv+) where++import GHC.Base+import GHC.List+import GHC.Num ((+),(-),abs)+import Text.Show (show, Show(..))+import Text.Read (readMaybe)+import Data.Maybe+import Data.List (nub, words, groupBy)+import GHC.Arr+import Data.Char (isDigit, isLetter)+import Aftovolio.Constraints+import Data.InsertLeft (InsertLeft(..), splitAtEndG)+import Data.Tuple (fst)++data EncodedContraints a b d +  = E  -- ^ Represents no additional constraint, corresponds to the whole set of theoretically possible permutations.+  | P a b  -- ^ Represents the set of permutations with the fixed positions of some elements.+  | Q a a a a a  -- ^ Represents the set of permutations with the preserved pairwise order between first and second, second and third, third and fourth elements.+  | T a a a a   -- ^ Represents the set of permutations with the preserved pairwise order between first and second, second and third elements.+  | SA a a b   -- ^ Represents the set of permutations with the preserved position of the elements AFTER the another selected one.+  | SB a a b -- ^ Represents the set of permutations with the preserved position of the elements BEFORE the another selected one.+  | F a a a  -- ^ Represents the set of permutations with the preserved order between first and second elements.+  | V a a a  -- ^ Represents the set of permutations with the preserved both distance between and order of the two elements.+  | W a a a   -- ^ Represents the set of permutations with the preserved distance between the two elements.+  | H a a a a   -- ^ Represents the set of permutations with the preserved both distances between and order of the three elements.+  | R a a a a   -- ^ Represents the set of permutations with the preserved pairwise distances between the first and second, second and third elements.+  | M a a a a   -- ^ Represents the set of permutations with the preserved pairwise distances between the first and second, second and third elements, and additionally the order of the first and second elements.+  | N a d  -- ^ Represents the set of permutations with the moved fixed positions of some elements (at least one).+  | D a a a a  -- ^ Pepresents the set of permutations with the specified order and distance between the two elements.+  | I a a a a -- ^ Pepresents the set of permutations with the specified distance between the two elements.+  | U a a a a a a -- ^ Represents the set of permutations with the preserved order of the 5 elements+  deriving (Eq, Ord, Show)++validOrdStr0 +  :: String +  -> Int -- ^ Number of seen so far \'(\' parentheses+  -> Int -- ^ Number of seen so far \')\' parentheses+  -> Bool+validOrdStr0 ('E':ys) n m = validOrdStr0 ys n m+validOrdStr0 (' ':y:t:ys) n m+  | y `elem` "ABDFHIMNPQRTUVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) n m+  | y `elem` "-(E" = validOrdStr0 (y:t:ys) n m+  | otherwise = False  +validOrdStr0 ('(':y:t:ys) n m+  | y `elem` "ABDFHIMNPQRTUVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) (n + 1) m+  | y `elem` "-(E" = validOrdStr0 (y:t:ys) (n + 1) m+  | otherwise = False  +validOrdStr0 (')':y:t:ys) n m+  | y `elem` "ABDFHIMNPQRTUVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) n (m + 1)+  | y `elem` "-()E" = validOrdStr0 (y:t:ys) n (m + 1)+  | otherwise = False  +validOrdStr0 ('-':y:t:ys) n m+  | y `elem` "ABDFHIMNPQRTUVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) n m +  | y `elem` "-)" || isDigit y = False+  | otherwise = validOrdStr0 (y:t:ys) n m +validOrdStr0 (x:y:t:ys) n m +  | x `elem` "ABDFHIMNPQRTUVW" && isDigit y = validOrdStr0 (dropWhile isDigit (t:ys)) n m +  | x `elem` "ABDFHIMNPQRTUVW" = False+  | otherwise = validOrdStr0 (y:t:ys) n (m + 1) +validOrdStr0 (x:')':ys) n m +  | isDigit x = validOrdStr0 ys n (m + 1)+  | x == ')' = validOrdStr0 ys n (m + 2) +  | otherwise = False+validOrdStr0 (x:y:_) n m +  | x `elem` "(ABDFHIMNQRTUVW" = False+  | y `elem` " -(ABDFHIMNPQRTUVW" = False+  | x == 'P' && not (isDigit y) = False+  | x == ')' && y /= 'E' = False+  | x == 'P' && n == m = True+  | x == ')' && y == 'E' = n == (m + 1)+  | (x `elem` "E -") && y == 'E' = n == m +  | otherwise = False+validOrdStr0 (x:_) n m +  | isDigit x || (x `elem` ")E") = if x == ')' then n == (m + 1) else n == m +  | otherwise = False+validOrdStr0 _ n m  = n == m++-- | An extended predicate to check whether the 'String' is a probably correct representation of the+-- constraints algebraic expression for 'generalConversion' evaluation.+validOrdStr :: String -> Bool+validOrdStr xs = validOrdStr0 xs 0 0 +{-# INLINE validOrdStr #-}++stage1Parsing :: String -> [String]+stage1Parsing =  groupBy (\x y -> x == '(' && y == '(' || isLetter x && isDigit y || x == ')' && y == ')')+{-# INLINE stage1Parsing #-}++-- | At the moment is used only for the list of 'String' without any parentheses in each of them.+convertToBools +  :: Int +  -> Array Int Int +  -> [String] +  -> String -- ^ The result is a 'String' that Haskell can evaluate to 'Bool' (some logical expression).+convertToBools n arr ("-":yss) = "not " `mappend` (convertToBools n arr yss)+convertToBools n arr (" ":yss) = " || " `mappend` (convertToBools n arr yss)+convertToBools n arr (xs:yss@(ys:_))+  | xs `elem` ["True","False"] = xs `mappend` (case ys of +                                                 " "   -> " "+                                                 _     -> " && ") `mappend` convertToBools n arr yss +  | otherwise = let cnstrs = fromMaybe E . readMaybeECG n $ xs in +                      show (isConstraint1 True arr cnstrs) +                      `mappend` (case ys of +                                   " "   -> " "+                                   _     -> " && ") `mappend` convertToBools n arr yss +convertToBools n arr (xs:_) +  | xs `elem` ["True","False"] = xs+  | otherwise = (show . isConstraint1 True arr . fromMaybe E . readMaybeECG n $ xs) +convertToBools _ _ _ = []++splitNoParenAtDisjunction :: [String] -> [[String]]+splitNoParenAtDisjunction xss@(_:_) +  | null tss = []+  | otherwise = tss : splitNoParenAtDisjunction wss +      where (tss,uss) = break (== "||") xss+            wss = drop 1 uss +splitNoParenAtDisjunction _ = []++noParenString0 :: [String] -> Bool +noParenString0 (xs:ys:ts:yss) +  | xs == "not" = +      case ys of +        "True" -> False +        _ -> noParenString0 yss +  | otherwise = +      case xs of+        "True" -> noParenString0 (ts:yss)+        _ -> False +noParenString0 ("not":ys:_) = if ys == "True" then False else True +noParenString0 (xs:_) +  | xs == "True" = True +  | otherwise = False +noParenString0 _ = True++noParenString :: [String] -> Bool+noParenString = or . map noParenString0 . splitNoParenAtDisjunction+{-# INLINE noParenString #-}++oneStep :: Int -> Array Int Int -> [String] -> Bool+oneStep m arr = noParenString . words . convertToBools m arr+{-# INLINE oneStep #-}++oneChange :: Int -> Array Int Int -> [String] -> [String]+oneChange m arr xss +  | null wss = [show . oneStep m arr $ xss]+  | otherwise = ((\(jss, _, qss) -> jss `mappend` [show . oneStep m arr $ qss]) . +                  foldr (\xs (tss, n, rss) -> if xs == "(" && n == 0 +                                                      then (tss, 1, rss) +                                                      else if any (== '(') xs && n == 0+                                                               then (drop 1 xs:tss, 1, rss)+                                                               else case n of +                                                                      0 -> (tss, 0, xs:rss)+                                                                      _ -> (xs:tss, 1, rss)) ([], 0, []) $ yss) `mappend` kss+  where (yss,wss) = break (any (== ')')) xss+        kss = case wss of+                ")":vss -> vss +                ws:vss -> drop 1 ws : vss+                _      -> []++generalConversion :: Int -> String -> Array Int Int -> Bool+generalConversion m xs arr+  | validOrdStr xs =  (\ks -> if ks == "True" || ks == "E" then True else False) . +      head . head . dropWhile ((/= 1) . length)  . drop 1 . iterate (oneChange m arr) . stage1Parsing $ xs +  | otherwise = False+{-# INLINE generalConversion #-}++-- | Can be thought of as 'filter' ('generalConversion' ... ) @<arrays>@ but is somewhat more efficient.+filterGeneralConv :: Int -> String -> [Array Int Int] -> [Array Int Int]+filterGeneralConv m cnstrns xs +  | validOrdStr cnstrns = let !xss = stage1Parsing cnstrns in  +    filter (\arr -> (\ks -> if ks == "True" || ks == "E" then True else False) . head . head . dropWhile ((/= 1) . length) . drop 1 . iterate (oneChange m arr) $ xss) xs+  | otherwise = []+{-# INLINE filterGeneralConv #-}++-- | Inspired by the: https://hackage.haskell.org/package/base-4.14.0.0/docs/Data-Maybe.html+-- Is provided here as a more general way to read the 'String' into a 'EncodedCnstrs'. +-- It is up to user to check whether the parameters are in the correct form, the function does+-- not do the full checking.+readMaybeECG :: Int -> String -> Maybe EncodedCnstrs+readMaybeECG n xs+ | null xs = Nothing+ | n >=0 && n <= 9 =+     let h = head xs+         ts = filter (\x -> x >= '0' && [x] <= show n) . tail $ xs in+      case h of+       'E' -> Just E+       _   -> f n h ts+ | otherwise = Nothing+         where f n c ts +                 | c `elem` "DFHIMQRQTUVW" = +                       let ys0 =catMaybes . map (\t -> readMaybe [t]::Maybe Int) $ ts+                           ys = nub ys0+                           (jjs, ps) = splitAtEndG 1 ys0+                           res +                             | length ys0 >= 3 && (c `elem` "DI") = let qs = take 2 . nub $ jjs+                                                                        [y,z] = map (\rr ->  if rr == 0 then 9 else rr - 1) qs in if length qs /= 2 || ps == [0] || ps > [n] then Nothing else Just ((if c == 'D' then D else I) n y z (head ps))+                             | length ys /= g c = Nothing+                             | c == 'Q' = let [y,z,u,w] = map (\rr -> if rr  == 0 then 9 else rr - 1) ys in Just (Q n y z u w)+                             | c == 'U' = let [y,z,t,u,w] = map (\rr -> if rr  == 0 then 9 else rr - 1) ys in Just (U n y z t u w)+                             | c `elem` "FVW" = let [y,z] = map (\rr -> if rr  == 0 then 9 else rr - 1) ys in Just ((case c of {'F' -> F; 'V'-> V; _ -> W}) n y z)+                             | c `elem` "HMT" = let [y,z,u] = map (\rr -> if rr  == 0 then 9 else rr - 1) ys in Just ((case c of {'T' -> T; 'H' -> H; 'M' -> M; _ -> R}) n y z u)+                             | otherwise = Nothing in res+                 | c `elem` "AB" = let y = readMaybe (take 1 ts)::Maybe Int in+                                     if isJust y then+                                         let y0 = fromJust y+                                             zs = map (\rr -> if rr  == 0 then 9 else rr - 1) . filter (/= y0) . nub . catMaybes . map (\t -> readMaybe [t]::Maybe Int) . drop 1 $ ts in+                                               case zs of+                                                 [] -> Nothing+                                                 ~x2 -> Just ((if c == 'A' then SA else SB) n (if y0 == 0 then 9 else y0 - 1) (listArray (0,length x2 - 1) x2))+                                     else Nothing +                 | c == 'P' = if null ts then Just E else Just . P n . listArray (0,length ts - 1) . map (\r -> case (fromJust (readMaybe [r]::Maybe Int)) of {0 -> 9; q -> q-1}) $ ts+                 | c == 'N' = if tl == 0 then Just E else Just . N n . listArray (0, tl - 1) . map ((\[s,w] -> (w, s)) . map (\r -> case (fromJust (readMaybe [r]::Maybe Int)) of {0 -> 9; q -> q-1})) $ h3+                 | otherwise = Nothing+                        where h1 (b:d:ds) = [b,d]:h1 ds+                              h1 _ = [] +                              h2 = h1 ts+                              qqs = map head h2+                              pps = map last h2+                              h3 +                               | length (nub qqs) == length qqs && length (nub pps) == length pps = h2+                               | otherwise = []+                              tl = length h3+               g c +                 | c `elem` "FVW" = 2+                 | c == 'Q' = 4+                 | c == 'U' = 5+                 | otherwise = 3+++type EncodedCnstrs = EncodedContraints Int (Array Int Int) (Array Int (Int, Int))++-- | Must be applied to the correct array of permutation indeces. Otherwise, it gives runtime error (exception). All the integers inside the+-- 'EncodedCnstrs' must be in the range [0..n-1] where @n@ corresponds to the maximum element in the permutation 'Array' 'Int' 'Int'. +decodeConstraint1 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)+decodeConstraint1 E = id+decodeConstraint1 (P _ v) = fixedPointsS v+decodeConstraint1 (Q _ i j k l) = unsafeQuadruples i j k l+decodeConstraint1 (T _ i j k) = unsafeTriples i j k+decodeConstraint1 (SA _ i v) = unsafeSeveralA i v+decodeConstraint1 (SB _ i v) = unsafeSeveralB i v+decodeConstraint1 (F _ i j) = filterOrderIJ i j+decodeConstraint1 (V _ i j) = filterSignDistanceIJ i j (abs $ j - i)+decodeConstraint1 (W _ i j) = filterUnsignDistanceIJ i j (abs $ j - i)+decodeConstraint1 (H _ i j k) = filterSignDistanceIJK3 i j k (abs $ j - i) (abs $ k - j)+decodeConstraint1 (R _ i j k) = filterUnsignDistanceIJK3 i j k (abs $ j - i) (abs $ k - j)+decodeConstraint1 (M _ i j k) = filterMixedDistanceIJK3 i j k (abs $ j - i) (abs $ k - j)+decodeConstraint1 (N _ v) = fixedPointsG v+decodeConstraint1 (D _ i j d) = filterSignDistanceIJ i j (abs d)+decodeConstraint1 (I _ i j d) = filterUnsignDistanceIJ i j (abs d)+decodeConstraint1 (U _ i j k l m) = unsafeQuintuples i j k l m+{-# SPECIALIZE decodeConstraint1 :: EncodedCnstrs -> [Array Int Int] -> [Array Int Int]  #-}++-- | Must be applied to the correct array of permutation indeces. Otherwise, it gives runtime error (exception). All the integers inside the+-- 'EncodedCnstrs' must be in the range [0..n-1] where @n@ corresponds to the maximum element in the permutation 'Array' 'Int' 'Int'.+decodeLConstraints :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => [EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)+decodeLConstraints (x:xs) = decodeLConstraints' ys . decodeConstraint1 y+  where y = minimum (x:xs)+        ys = filter (/= y) . g $ (x:xs)+        g (E:zs) = g zs+        g (z:zs) = z : g zs+        g _ = []+        decodeLConstraints' (z:zs) = decodeLConstraints' zs . decodeConstraint1 z+        decodeLConstraints' _ = id+decodeLConstraints _ = id+{-# SPECIALIZE decodeLConstraints :: [EncodedCnstrs] -> [Array Int Int] -> [Array Int Int]  #-}++isConstraint1 :: Bool -> Array Int Int -> EncodedCnstrs -> Bool+isConstraint1 bool _ E = bool+isConstraint1 True arr (F _ i j) = unsafeOrderIJ i j arr +isConstraint1 True arr (T _ i j k) = isTripleOrdered i j k arr +isConstraint1 True arr (Q _ i j k l) = isQuadrupleOrdered i j k l arr +isConstraint1 True arr (SA _ i arr2) = isSeveralAOrdered i arr2 arr +isConstraint1 True arr (SB _ i arr2) = isSeveralBOrdered i arr2 arr +isConstraint1 True arr (P _ arr2) = isFixedPoint arr2 arr +isConstraint1 True arr (H _ i j k) = isSignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 True arr (M _ i j k) = isMixedDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 True arr (R _ i j k) = isUnsignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 True arr (V _ i j) = unsafeSignDistanceIJ i j (abs $ j - i) arr +isConstraint1 True arr (W _ i j) = unsafeUnsignDistanceIJ i j (abs $ j - i) arr +isConstraint1 True arr (N _ arr2) = isFixedPointTup arr2 arr +isConstraint1 True arr (D _ i j d) = unsafeSignDistanceIJ i j (abs d) arr +isConstraint1 True arr (I _ i j d) = unsafeUnsignDistanceIJ i j (abs d) arr +isConstraint1 True arr (U _ i j k l m) = isQuintupleOrdered i j k l m arr +isConstraint1 False arr (F _ i j) = unsafeOrderIJ j i arr +isConstraint1 False arr (T _ i j k) = notTripleOrdered i j k arr +isConstraint1 False arr (Q _ i j k l) = notQuadrupleOrdered i j k l arr +isConstraint1 False arr (SA _ i arr2) = notSeveralAOrdered i arr2 arr +isConstraint1 False arr (SB _ i arr2) = notSeveralBOrdered i arr2 arr +isConstraint1 False arr (P _ arr2) = notFixedPoint arr2 arr +isConstraint1 False arr (H _ i j k) = notSignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 False arr (M _ i j k) = notMixedDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 False arr (R _ i j k) = notUnsignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 False arr (V _ i j) = unsafeSignDistanceIJ j i (abs $ j - i) arr +isConstraint1 False arr (W _ i j) = not . unsafeUnsignDistanceIJ i j (abs $ j - i) $ arr +isConstraint1 False arr (N _ arr2) = notFixedPointTup arr2 arr +isConstraint1 False arr (D _ i j d) = unsafeSignDistanceIJ j i (abs d) arr +isConstraint1 False arr (I _ i j d) = not . unsafeUnsignDistanceIJ i j (abs d) $ arr +isConstraint1 False arr (U _ i j k l m) = notQuintupleOrdered i j k l m arr ++isE :: EncodedCnstrs -> Bool+isE E = True+isE _ = False++isP :: EncodedCnstrs -> Bool+isP (P _ _) = True+isP _ = False++isF :: EncodedCnstrs -> Bool+isF (F _ _ _) = True+isF _ = False++isT :: EncodedCnstrs -> Bool+isT (T _ _ _ _) = True+isT _ = False++isQ :: EncodedCnstrs -> Bool+isQ (Q _ _ _ _ _) = True+isQ _ = False++isSA :: EncodedCnstrs -> Bool+isSA (SA _ _ _) = True+isSA _ = False++isSB :: EncodedCnstrs -> Bool+isSB (SB _ _ _) = True+isSB _ = False++isV :: EncodedCnstrs -> Bool+isV (V _ _ _) = True+isV _ = False++isW :: EncodedCnstrs -> Bool+isW (W _ _ _) = True+isW _ = False++isH :: EncodedCnstrs -> Bool+isH (H _ _ _ _) = True+isH _ = False++isR :: EncodedCnstrs -> Bool+isR (R _ _ _ _) = True+isR _ = False++isM :: EncodedCnstrs -> Bool+isM (M _ _ _ _) = True+isM _ = False++isN :: EncodedCnstrs -> Bool+isN (N _ _) = True+isN _ = False++isD :: EncodedCnstrs -> Bool+isD (D _ _ _ _) = True+isD _ = False++isI :: EncodedCnstrs -> Bool+isI (I _ _ _ _) = True+isI _ = False++isU :: EncodedCnstrs -> Bool+isU (U _ _ _ _ _ _) = True+isU _ = False+++{-| Works only with the correctly defined argument though it is not checked. Use with this caution.+-}+getIEl :: EncodedCnstrs -> Int+getIEl E = -1+getIEl (P _ arr) = unsafeAt arr 0+getIEl (Q _ i _ _ _) = i+getIEl (T _ i _ _) = i+getIEl (SA _ i _) = i+getIEl (SB _ i _) = i+getIEl (F _ i _) = i+getIEl (V _ i _) = i+getIEl (W _ i _) = i+getIEl (H _ i _ _) = i+getIEl (R _ i _ _) = i+getIEl (M _ i _ _) = i+getIEl (N _ arr) = fst . unsafeAt arr $ 0 +getIEl (D _ i _ _) = i+getIEl (I _ i _ _) = i+getIEl (U _ i _ _ _ _) = i++{-| Works only with the correctly defined arguments though it is not checked. Use with this caution.+-}+setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs+setIEl _ E = E+setIEl i (P n arr) = P n (arr // [(0,i)])+setIEl i (Q n _ j k l) = Q n i j k l+setIEl i (T n _ j k) = T n i j k+setIEl i (SA n _ v) = SA n i v+setIEl i (SB n _ v) = SB n i v+setIEl i (F n _ j) = F n i j+setIEl i (V n _ j) = V n i j+setIEl i (W n _ j) = W n i j+setIEl i (H n _ j k) = H n i j k+setIEl i (R n _ j k) = R n i j k+setIEl i (M n _ j k) = M n i j k+setIEl _ (N n arr) = N n arr+setIEl i (D n _ j k) = D n i j k+setIEl i (I n _ j k) = I n i j k+setIEl i (U n _ j k l m) = U n i j k l m+
+ Aftovolio/DataG.hs view
@@ -0,0 +1,301 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Aftovolio.DataG+-- Copyright   :  (c) Oleksandr Zhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Simplified version of the @phonetic-languages-common@ and @phonetic-languages-general@ packages.+-- Uses less dependencies.++{-# LANGUAGE BangPatterns, FlexibleContexts, NoImplicitPrelude #-}++module Aftovolio.DataG where++import GHC.Base+import GHC.Num ((-))+import GHC.Real+import qualified Data.Foldable as F+import Data.InsertLeft (InsertLeft(..),mapG,partitionG) +import Data.MinMax1+import Data.Maybe (fromJust) +import Aftovolio.Basis++maximumEl+  :: (F.Foldable t2, Ord c) => FuncRep2 (t a) b c+  -> t2 (t a)+  -> Result t a b c+maximumEl !frep2 data0 =+  let !l = F.maximumBy (\x y -> compare (getAC frep2 x) (getAC frep2 y)) data0+      !m = getAB frep2 l+      !tm = getBC frep2 m in R {line = l, propertiesF = m, transPropertiesF = tm}+{-# INLINE maximumEl #-}+{-# SPECIALIZE maximumEl :: (Ord c) => FuncRep2 [a] Double c -> [[a]] -> Result [] a Double c #-}++-- | Is intended to be used for the structures with at least two elements, though it is not checked.+minMaximumEls+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord (t a), Ord c) => FuncRep2 (t a) b c+  -> t2 (t a)+  -> (Result t a b c,Result t a b c)+minMaximumEls !frep2 data0 =+  let (!ln,!lx) = fromJust . minMax11By (\x y -> compare (getAC frep2 x) (getAC frep2 y)) $ data0+      !mn = getAB frep2 ln+      !mx = getAB frep2 lx+      !tmn = getBC frep2 mn+      !tmx = getBC frep2 mx in (R {line = ln, propertiesF = mn, transPropertiesF = tmn}, R {line = lx, propertiesF = mx, transPropertiesF = tmx})+{-# INLINE minMaximumEls #-}+{-# SPECIALIZE minMaximumEls :: (Ord a, Ord c) => FuncRep2 [a] Double c -> [[a]] -> (Result [] a Double c, Result [] a Double c) #-}++maximumElR+  :: (F.Foldable t2, Ord c) => t2 (Result t a b c)+  -> Result t a b c+maximumElR = F.maximumBy (\x y -> compare (transPropertiesF x) (transPropertiesF y))+{-# INLINE maximumElR #-}+{-# SPECIALIZE maximumElR :: (Ord c) => [Result [] a Double c] -> Result [] a Double c #-}++-- | Is intended to be used for the structures with at least two elements, though it is not checked.+minMaximumElRs+  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), Ord (t a), Ord b, Ord c) => t2 (Result t a b c)+  -> (Result t a b c,Result t a b c)+minMaximumElRs = fromJust . minMax11By (\x y -> compare (transPropertiesF x) (transPropertiesF y))+{-# INLINE minMaximumElRs #-}+{-# SPECIALIZE minMaximumElRs :: (Ord a, Ord c) => [Result [] a Double c] -> (Result [] a Double c, Result [] a Double c) #-}++-----------------------------------------------------------------------------------++-- | The second argument must be not empty for the function to work correctly.+innerPartitioning+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), InsertLeft t2 c, Monoid (t2 c), Ord c) => FuncRep2 (t a) b c+  -> t2 (t a)+  -> (t2 (t a), t2 (t a))+innerPartitioning !frep2 data0 =+  let !l = F.maximum . mapG (toTransPropertiesF' frep2) $ data0 in partitionG ((== l) . getAC frep2) data0+{-# INLINE innerPartitioning #-}+{-# SPECIALIZE innerPartitioning :: (Eq a, Ord c) => FuncRep2 [a] Double c -> [[a]] -> ([[a]], [[a]]) #-}++-- | The first argument must be not empty for the function to work correctly.+innerPartitioningR+  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), InsertLeft t2 c, Monoid (t2 c), Ord c) => t2 (Result t a b c)+  -> (t2 (Result t a b c), t2 (Result t a b c))+innerPartitioningR dataR =+  let !l = F.maximum . mapG transPropertiesF $ dataR in partitionG ((== l) . transPropertiesF) dataR+{-# INLINE innerPartitioningR #-}+{-# SPECIALIZE innerPartitioningR :: (Eq a, Ord c) => [Result [] a Double c] -> ([Result [] a Double c], [Result [] a Double c]) #-}++maximumGroupsClassification+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> FuncRep2 (t a) b c+  -> (t2 (t a), t2 (t a))+  -> (t2 (t a), t2 (t a))+maximumGroupsClassification !nGroups !frep2 (dataT,dataF)+ | F.null dataF = (dataT,mempty)+ | nGroups <= 0 = (dataT,dataF)+ | otherwise = maximumGroupsClassification (nGroups - 1) frep2 (dataT `mappend` partT,partF)+     where (!partT,!partF) = innerPartitioning frep2 dataF+{-# NOINLINE maximumGroupsClassification #-}++maximumGroupsClassification1+  :: (InsertLeft t2 (t a), Monoid (t2 (t a)), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> FuncRep2 (t a) b c+  -> t2 (t a)+  -> (t2 (t a), t2 (t a))+maximumGroupsClassification1 !nGroups !frep2 data0+ | F.null data0 = (mempty,mempty)+ | nGroups <= 0 = innerPartitioning frep2 data0+ | otherwise = maximumGroupsClassification (nGroups - 1) frep2 . innerPartitioning frep2 $ data0+{-# NOINLINE maximumGroupsClassification1 #-}++maximumGroupsClassificationR2+  :: (Eq a, Eq b, Eq (t a), InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> (t2 (Result t a b c), t2 (Result t a b c))+  -> (t2 (Result t a b c), t2 (Result t a b c))+maximumGroupsClassificationR2 !nGroups (dataT,dataF)+ | F.null dataF = (dataT,mempty)+ | nGroups <= 0 = (dataT,dataF)+ | otherwise = maximumGroupsClassificationR2 (nGroups - 1) (dataT `mappend` partT,partF)+     where (!partT,!partF) = innerPartitioningR dataF+{-# NOINLINE maximumGroupsClassificationR2 #-}++maximumGroupsClassificationR+  :: (Eq a, Eq b, Eq (t a), InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), InsertLeft t2 c, Monoid (t2 c), Ord c, Integral d) => d+  -> t2 (Result t a b c)+  -> (t2 (Result t a b c), t2 (Result t a b c))+maximumGroupsClassificationR !nGroups dataR+ | F.null dataR = (mempty,mempty)+ | nGroups <= 0 = innerPartitioningR dataR+ | otherwise = maximumGroupsClassificationR2 (nGroups - 1) . innerPartitioningR $ dataR+{-# NOINLINE maximumGroupsClassificationR #-}++toResultR+  :: FuncRep2 (t a) b c+  -> t a+  -> Result t a b c+toResultR !frep2 !ys = R { line = ys, propertiesF = m, transPropertiesF = tm}+  where !m = getAB frep2 ys+        !tm = getBC frep2 m+{-# INLINE toResultR #-}++toPropertiesF'+  :: FuncRep2 (t a) b c+  -> t a+  -> b+toPropertiesF' !frep2 !ys = getAB frep2 ys+{-# INLINE toPropertiesF' #-}++toTransPropertiesF'+  :: FuncRep2 (t a) b c+  -> t a+  -> c+toTransPropertiesF' !frep2 !ys = getAC frep2 ys+{-# INLINE toTransPropertiesF' #-}++-- | The second argument must be not empty for the function to work correctly.+partiR+  :: (InsertLeft t2 (Result t a b c), Monoid (t2 (Result t a b c)), InsertLeft t2 c) => (c -> Bool)+  -> t2 (Result t a b c)+  -> (t2 (Result t a b c), t2 (Result t a b c))+partiR p dataR = partitionG (p . transPropertiesF) dataR+{-# INLINE partiR #-}+{-# SPECIALIZE partiR :: (Eq a, Eq c) => (c -> Bool) -> [Result [] a Double c] -> ([Result [] a Double c], [Result [] a Double c])  #-}++-----------------------------------------------------------++maximumEl2+  :: (F.Foldable t2, Ord c) => FuncRep2 a b c+  -> t2 a+  -> Result2 a b c+maximumEl2 !frep2 data0 =+  let !l = F.maximumBy (\x y -> compare (getAC frep2 x) (getAC frep2 y)) data0+      !m = getAB frep2 l+      !tm = getBC frep2 m in R2 {line2 = l, propertiesF2 = m, transPropertiesF2 = tm}+{-# INLINE maximumEl2 #-}+{-# SPECIALIZE maximumEl2 :: (Ord c) => FuncRep2 a Double c -> [a] -> Result2 a Double c  #-}++-- | Is intended to be used with the structures with at least two elements, though it is not checked.+minMaximumEls2+  :: (InsertLeft t2 a, Monoid (t2 a), Ord a, Ord c) => FuncRep2 a b c+  -> t2 a+  -> (Result2 a b c,Result2 a b c)+minMaximumEls2 !frep2 data0 =+  let (!ln,!lx) = fromJust . minMax11By (\x y -> compare (getAC frep2 x) (getAC frep2 y)) $ data0+      !mn = getAB frep2 ln+      !mx = getAB frep2 lx+      !tmn = getBC frep2 mn+      !tmx = getBC frep2 mx in (R2 {line2 = ln, propertiesF2 = mn, transPropertiesF2 = tmn}, R2 {line2 = lx, propertiesF2 = mx, transPropertiesF2 = tmx})+{-# INLINE minMaximumEls2 #-}+{-# SPECIALIZE minMaximumEls2 :: (Ord a, Ord c) => FuncRep2 a Double c -> [a] -> (Result2 a Double c, Result2 a Double c) #-}++maximumElR2+  :: (F.Foldable t2, Ord c) => t2 (Result2 a b c)+  -> Result2 a b c+maximumElR2 = F.maximumBy (\x y -> compare (transPropertiesF2 x) (transPropertiesF2 y))+{-# INLINE maximumElR2 #-}+{-# SPECIALIZE maximumElR2 :: (Ord c) => [Result2 a Double c] -> Result2 a Double c #-}++-- | Is intended to be used with the structures with at least two elements, though it is not checked.+minMaximumElRs2+  :: (InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)), Ord a, Ord b, Ord c) => t2 (Result2 a b c)+  -> (Result2 a b c,Result2 a b c)+minMaximumElRs2 = fromJust . minMax11By (\x y -> compare (transPropertiesF2 x) (transPropertiesF2 y))+{-# INLINE minMaximumElRs2 #-}+{-# SPECIALIZE minMaximumElRs2 :: (Ord a, Ord c) => [Result2 a Double c] -> (Result2 a Double c, Result2 a Double c) #-}++-----------------------------------------------------------------------------------++-- | The second argument must be not empty for the function to work correctly.+innerPartitioning2+  :: (InsertLeft t2 a, Monoid (t2 a), InsertLeft t2 c, Monoid (t2 c), Ord c) => FuncRep2 a b c+  -> t2 a+  -> (t2 a, t2 a)+innerPartitioning2 !frep2 data0 =+  let !l = F.maximum . mapG (toTransPropertiesF'2 frep2) $ data0 in partitionG ((== l) . getAC frep2) data0+{-# INLINE innerPartitioning2 #-}+{-# SPECIALIZE innerPartitioning2 :: (Eq a, Ord c) => FuncRep2 a Double c -> [a] -> ([a], [a])  #-}++-- | The first argument must be not empty for the function to work correctly.+innerPartitioningR2+  :: (InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)), InsertLeft t2 c, Monoid (t2 c), Ord c) => t2 (Result2 a b c)+  -> (t2 (Result2 a b c), t2 (Result2 a b c))+innerPartitioningR2 dataR =+  let !l = F.maximum . mapG transPropertiesF2 $ dataR in partitionG ((== l) . transPropertiesF2) dataR+{-# INLINE innerPartitioningR2 #-}+{-# SPECIALIZE innerPartitioningR2 :: (Eq a, Ord c) => [Result2 a Double c] -> ([Result2 a Double c], [Result2 a Double c]) #-}++maximumGroupsClassification2+  :: (InsertLeft t2 a, Monoid (t2 a), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> FuncRep2 a b c+  -> (t2 a, t2 a)+  -> (t2 a, t2 a)+maximumGroupsClassification2 !nGroups !frep2 (dataT,dataF)+ | F.null dataF = (dataT,mempty)+ | nGroups <= 0 = (dataT,dataF)+ | otherwise = maximumGroupsClassification2 (nGroups - 1) frep2 (dataT `mappend` partT,partF)+     where (!partT,!partF) = innerPartitioning2 frep2 dataF+{-# NOINLINE maximumGroupsClassification2 #-}++maximumGroupsClassification12+  :: (InsertLeft t2 a, Monoid (t2 a), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> FuncRep2 a b c+  -> t2 a+  -> (t2 a, t2 a)+maximumGroupsClassification12 !nGroups !frep2 data0+ | F.null data0 = (mempty,mempty)+ | nGroups <= 0 = innerPartitioning2 frep2 data0+ | otherwise = maximumGroupsClassification2 (nGroups - 1) frep2 . innerPartitioning2 frep2 $ data0+{-# NOINLINE maximumGroupsClassification12 #-}++maximumGroupsClassificationR2_2+  :: (Eq a, Eq b, InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)), Ord c, InsertLeft t2 c, Monoid (t2 c), Integral d) => d+  -> (t2 (Result2 a b c), t2 (Result2 a b c))+  -> (t2 (Result2 a b c), t2 (Result2 a b c))+maximumGroupsClassificationR2_2 !nGroups (dataT,dataF)+ | F.null dataF = (dataT,mempty)+ | nGroups <= 0 = (dataT,dataF)+ | otherwise = maximumGroupsClassificationR2_2 (nGroups - 1) (dataT `mappend` partT,partF)+     where (!partT,!partF) = innerPartitioningR2 dataF+{-# NOINLINE maximumGroupsClassificationR2_2 #-}++maximumGroupsClassificationR_2+  :: (Eq a, Eq b, InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)), InsertLeft t2 c, Monoid (t2 c), Ord c, Integral d) => d+  -> t2 (Result2 a b c)+  -> (t2 (Result2 a b c), t2 (Result2 a b c))+maximumGroupsClassificationR_2 !nGroups dataR+ | F.null dataR = (mempty,mempty)+ | nGroups <= 0 = innerPartitioningR2 dataR+ | otherwise = maximumGroupsClassificationR2_2 (nGroups - 1) . innerPartitioningR2 $ dataR+{-# NOINLINE maximumGroupsClassificationR_2 #-}++toResultR2+  :: FuncRep2 a b c+  -> a+  -> Result2 a b c+toResultR2 !frep2 !y = R2 { line2 = y, propertiesF2 = m, transPropertiesF2 = tm}+  where !m = getAB frep2 y+        !tm = getBC frep2 m+{-# INLINE toResultR2 #-}++toPropertiesF'2+  :: FuncRep2 a b c+  -> a+  -> b+toPropertiesF'2 !frep2 !y = getAB frep2 y+{-# INLINE toPropertiesF'2 #-}++toTransPropertiesF'2+  :: FuncRep2 a b c+  -> a+  -> c+toTransPropertiesF'2 !frep2 !y = getAC frep2 y+{-# INLINE toTransPropertiesF'2 #-}++-- | The second argument must be not empty for the function to work correctly.+partiR2+  :: (InsertLeft t2 (Result2 a b c), Monoid (t2 (Result2 a b c)), InsertLeft t2 c) => (c -> Bool)+  -> t2 (Result2 a b c)+  -> (t2 (Result2 a b c), t2 (Result2 a b c))+partiR2 p dataR = partitionG (p . transPropertiesF2) dataR+{-# INLINE partiR2 #-}+{-# SPECIALIZE partiR2 :: (Eq a, Eq c) => (c -> Bool) -> [Result2 a Double c] -> ([Result2 a Double c], [Result2 a Double c]) #-}+
+ Aftovolio/General/Base.hs view
@@ -0,0 +1,403 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# OPTIONS_GHC -funbox-strict-fields -fobject-code #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}++-- |+-- Module      :  Aftovolio.General.Base+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- This is a computational scheme for generalized usage of the phonetic languages and AFTOVolio approach. +-- It is intended to be exported qualified, so that the functions in every language+-- implementation have the same names and signatures as these ones and the data type used here.+-- It is may be not the most efficient implementation.+-- ++module Aftovolio.General.Base (+  -- * Phonetics representation data type for the phonetic languages approach.+  PhoneticElement(..)+  , PhoneticsRepresentationPL(..)+  , PhoneticsRepresentationPLX(..)+  , Generations+  , InterGenerationsString+  , WritingSystemPRPLX+  , GWritingSystemPRPLX+  , PhoneticRepresentationXInter+  , IGWritingSystemPRPLX+  , fromX2PRPL+  , fromPhoneticRX+  -- * Functions to work with the one.+  -- ** Predicates+  , isPRC+  , isPRAfterC+  , isPRBeforeC+  , isPREmptyC+  -- ** Convert to the 'PhoneticsRepresentationPLX'.+  , stringToXSG+  , stringToXG+  , stringToXS+  , string2X+  -- ** Apply conversion from 'PhoneticsRepresentationPLX'.+  , rulesX+  -- * Auxiliary functions+  , fHelp4+  , findSA+  , findSAI+  -- * Some class extensions for 'Eq' and 'Ord' type classes+  , (~=)+  , compareG+) where++import GHC.Base+import GHC.List+import Data.List (sortBy,groupBy,nub,(\\),find,partition,intercalate,words)+import GHC.Int (Int8(..))+import Data.Maybe (isJust,fromJust)+import Data.Either+import Data.Char (isLetter)+import GHC.Arr+import GHC.Exts+import GHC.Num ((-))+import Data.Tuple (fst,snd)+import Text.Show (Show(..))++-- | The syllable after this is encoded with the representation with every 'Char' being some phonetic language phenomenon.+-- To see its usual written representation, use the defined 'showRepr' function (please, implement your own one).+data PhoneticsRepresentationPL = PR { string :: String, afterString :: String, beforeString :: String } |+  PRAfter { string :: String, afterString :: String } |+  PRBefore { string :: String, beforeString :: String } |+  PREmpty { string :: String }+    deriving (Eq, Ord)++instance Show PhoneticsRepresentationPL where+  show (PR xs ys zs) = intercalate " " ["R", show zs, show xs, show ys]+  show (PRAfter xs ys) = intercalate " " ["A", show xs, show ys]+  show (PRBefore xs zs) = intercalate " " ["B", show zs, show xs]+  show (PREmpty xs) = "E " `mappend` show xs++class PhoneticElement a where+  readPEMaybe :: String -> Maybe a++instance PhoneticElement PhoneticsRepresentationPL where+  readPEMaybe rs+    | not . any isLetter $ rs = Nothing+    | otherwise = case ys of+        "R" -> case yss of+           [zs,xs,ts] -> Just (PR xs ts zs)+           _ -> Nothing+        "A" -> case yss of+           [xs,ts] -> Just (PRAfter xs ts)+           _ -> Nothing+        "B" -> case yss of+           [zs,xs] -> Just (PRBefore xs zs)+           _ -> Nothing+        "E" -> case yss of+           [xs] -> Just (PREmpty xs)+           _ -> Nothing+        _ -> Nothing+       where (ys:yss) = words rs  ++-- | Extended variant of the 'PhoneticsRepresentationPL' data type where the information for the 'Char' is encoded into the+-- data itself. Is easier to implement the rules in the separate file by just specifying the proper and complete list of+-- 'PhoneticsRepresentationPLX' values. While the 'char' function can be used to group 'PhoneticRepresentationPLX'+-- that represents some phenomenae, for the phonetic languages approach the 'string1' is used in the most cases.+data PhoneticsRepresentationPLX = PRC { stringX :: String, afterStringX :: String, beforeStringX :: String, char :: Char, string1 :: String } |+  PRAfterC { stringX :: String, afterStringX :: String, char :: Char, string1 :: String } |+  PRBeforeC { stringX :: String, beforeStringX :: String, char :: Char, string1 :: String } |+  PREmptyC { stringX :: String, char :: Char, string1 :: String }+    deriving (Eq, Ord)++instance Show PhoneticsRepresentationPLX where+  show (PRC xs ys zs c us) = intercalate " " ["RC", show zs, show xs, show ys, '\'':c:"\'", us]+  show (PRAfterC xs ys c us) = intercalate " " ["AC", show xs, show ys, '\'':c:"\'", us]+  show (PRBeforeC xs zs c us) = intercalate " " ["BC", show zs, show xs, '\'':c:"\'", us]+  show (PREmptyC xs c us) = "EC " `mappend` show xs `mappend` (' ':'\'':c:"\'") `mappend` us++instance PhoneticElement PhoneticsRepresentationPLX where+  readPEMaybe rs+    | not . any isLetter $ rs = Nothing+    | otherwise = case ys of+        "RC" -> case yss of+           [zs,xs,ts,cs,us] -> case cs of+               '\'':c:"\'" -> Just (PRC xs ts zs c us)+               _ -> Nothing+           _ -> Nothing+        "AC" -> case yss of+           [xs,ts,cs,us] -> case cs of+               '\'':c:"\'" -> Just (PRAfterC xs ts c us)+               _ -> Nothing+           _ -> Nothing+        "BC" -> case yss of+           [zs,xs,cs,us] -> case cs of+               '\'':c:"\'" -> Just (PRBeforeC xs zs c us)+               _ -> Nothing+           _ -> Nothing+        "EC" -> case yss of+           [xs,cs,us] -> case cs of+               '\'':c:"\'" -> Just (PREmptyC xs c us)+               _ -> Nothing+           _ -> Nothing+        _ -> Nothing+       where (ys:yss) = words rs    ++isPRC :: PhoneticsRepresentationPLX -> Bool+isPRC (PRC _ _ _ _ _) = True+isPRC _ = False++isPRAfterC :: PhoneticsRepresentationPLX -> Bool+isPRAfterC (PRAfterC _ _ _ _) = True+isPRAfterC _ = False++isPRBeforeC :: PhoneticsRepresentationPLX -> Bool+isPRBeforeC (PRBeforeC _ _ _ _) = True+isPRBeforeC _ = False++isPREmptyC :: PhoneticsRepresentationPLX -> Bool+isPREmptyC (PREmptyC _ _ _) = True+isPREmptyC _ = False++fromX2PRPL :: PhoneticsRepresentationPLX -> PhoneticsRepresentationPL+fromX2PRPL (PREmptyC xs _ _) = PREmpty xs+fromX2PRPL (PRAfterC xs ys _ _) = PRAfter xs ys+fromX2PRPL (PRBeforeC xs zs _ _) = PRBefore xs zs+fromX2PRPL (PRC xs ys zs _ _) = PR xs ys zs+{-# INLINE fromX2PRPL #-}++-- | An analogue of the 'rulesPR' function for 'PhoneticsRepresentationPLX'. +rulesX :: PhoneticsRepresentationPLX -> Char+rulesX = char+{-# INLINE rulesX #-}++stringToXS :: WritingSystemPRPLX -> String -> [String]+stringToXS xs ys = ks : stringToX' zss l ts+  where !zss = nub . map stringX $ xs+        !l = maximum . map length $ zss+        f ys l zss = splitAt ((\xs -> if null xs then 1 else head xs) . filter (\n -> elem (take n ys) zss) $ [l,l-1..1]) ys+        {-# INLINE f #-}+        (!ks,!ts) = f ys l zss+        stringToX' rss m vs = bs : stringToX' rss m us+           where (!bs,!us) = f vs m rss++-- | Uses the simplest variant of the 'GWritingSystemPRPLX' with just two generations where all the 'PREmptyC' elements in the+-- 'WritingSystemPRPLX' are used in the last order. Can be suitable for simple languages (e. g. Esperanto).+string2X :: WritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]+string2X xs = stringToXG [(zs,1),(ys,0)]+  where (ys,zs) = partition isPREmptyC xs+{-# INLINE string2X #-}++-- | Each generation represents a subset of rules for representation transformation. The 'PhoneticsRepresentationPLX'+-- are groupped by the generations so that in every group with the same generation number ('Int8' value, typically starting+-- from 1) the rules represented have no conflicts with each other (this guarantees that they can be applied simultaneously+-- without the danger of incorrect interference). Usage of 'Generations' is a design decision and is inspired by the+-- GHC RULES pragma and the GHC compilation multistage process. +type Generations = Int8++-- | Each value represents temporary intermediate resulting 'String' data to be transformed further into the representation.+type InterGenerationsString = String++-- | If the list here is proper and complete, then it usually represents the whole writing system of the language. For proper usage,+-- the list must be sorted in the ascending order.+type WritingSystemPRPLX = [PhoneticsRepresentationPLX]++-- | The \'dynamic\' representation of the general writing system that specifies what transformations are made simultaneously+-- during the conversion to the phonetic languages phonetics representation. During transformations those elements that have+-- greater 'Generations' are used earlier than others. The last ones are used those elements with the 'Generations' element+-- equal to 0 that must correspond to the 'PREmptyC' constructor-built records. For proper usage, the lists on the first+-- place of the tuples must be sorted in the ascending order.+type GWritingSystemPRPLX = [([PhoneticsRepresentationPLX],Generations)]++{-| The intermediate representation of the phonetic languages data. Is used during conversions.+-}+type PhoneticRepresentationXInter = Either PhoneticsRepresentationPLX InterGenerationsString++fromPhoneticRX :: [PhoneticsRepresentationPLX] -> [PhoneticRepresentationXInter] -> [PhoneticsRepresentationPLX]+fromPhoneticRX ts = concatMap (fromInter2X ts)+  where fromInter2X :: [PhoneticsRepresentationPLX] -> PhoneticRepresentationXInter -> [PhoneticsRepresentationPLX]+        fromInter2X _ (Left x) = [x]+        fromInter2X ys (Right z) = filter ((== z) . stringX) ys++-- | The \'dynamic\' representation of the process of transformation for the general writing system during the conversion.+-- Is not intended to be produced by hand, but automatically by programs.+type IGWritingSystemPRPLX = [(PhoneticRepresentationXInter,Generations)]++-- | Splits the given list using 4 predicates into tuple of 4 lists of elements satisfying the predicates in the order+-- being preserved.+fHelp4 :: (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> [a] -> ([a],[a],[a],[a])+fHelp4 p1 p2 p3 p4 = foldr g v+  where v = ([],[],[],[])+        g x (xs1,xs2,xs3,xs4)+          | p1 x = (x:xs1,xs2,xs3,xs4)+          | p2 x = (xs1,x:xs2,xs3,xs4)+          | p3 x = (xs1,xs2,x:xs3,xs4)+          | p4 x = (xs1,xs2,xs3,x:xs4)+          | otherwise = (xs1,xs2,xs3,xs4)+{-# INLINE fHelp4 #-}++-- | Partial equivalence that is used to find the appropriate 'PhoneticsRepresentationPL' for the class of+-- 'PhoneticsRepresentationPLX' values. +(~=) :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Bool+(PR xs ys zs) ~= (PRC xs1 ys1 zs1 _ _) = xs == xs1 && ys == ys1 && zs == zs1+(PRAfter xs ys) ~= (PRAfterC xs1 ys1 _ _) = xs == xs1 && ys == ys1+(PRBefore ys zs) ~= (PRBeforeC ys1 zs1 _ _) = ys == ys1 && zs == zs1+(PREmpty xs) ~= (PREmptyC xs1 _ _) = xs1 == xs1+_ ~= _ = False++-- | Partial equivalence that is used to find the appropriate 'PhoneticsRepresentationPL' for the class of+-- 'PhoneticsRepresentationPLX' values. +compareG :: PhoneticsRepresentationPL -> PhoneticsRepresentationPLX -> Ordering+compareG (PR xs ys zs) (PRC xs1 ys1 zs1 _ _)+ | xs /= xs1 = compare xs xs1+ | ys /= ys1 = compare ys ys1+ | zs /= zs1 = compare zs zs1+ | otherwise = EQ+compareG (PR _ _ _) _ = LT+compareG (PREmpty xs) (PREmptyC xs1 _ _)+ | xs /= xs1 = compare xs xs1+ | otherwise = EQ+compareG (PREmpty _) _ = GT+compareG (PRAfter xs ys) (PRAfterC xs1 ys1 _ _)+ | xs /= xs1 = compare xs xs1+ | ys /= ys1 = compare ys ys1+ | otherwise = EQ+compareG (PRAfter _ _) (PRC _ _ _ _ _) = GT+compareG (PRAfter _ _) _ = LT+compareG (PRBefore ys zs) (PRBeforeC ys1 zs1 _ _)+ | ys /= ys1 = compare ys ys1+ | zs /= zs1 = compare zs zs1+ | otherwise = EQ+compareG (PRBefore _ _) (PREmptyC _ _ _) = LT+compareG (PRBefore _ _) _ = GT++-- | Is somewhat rewritten from the 'CaseBi.Arr.gBF3' function (not exported) from the @mmsyn2-array@ package.+gBF3+  :: (Ix i) => (# Int#, PhoneticsRepresentationPLX #)+  -> (# Int#, PhoneticsRepresentationPLX #)+  -> PhoneticsRepresentationPL+  -> Array i PhoneticsRepresentationPLX+  -> Maybe PhoneticsRepresentationPLX+gBF3 (# !i#, k #) (# !j#, m #) repr arr+ | isTrue# ((j# -# i#) ># 1# ) = +    case compareG repr p of+     GT -> gBF3 (# n#, p #) (# j#, m #) repr arr+     LT  -> gBF3 (# i#, k #) (# n#, p #) repr arr+     _ -> Just p+ | repr ~= m = Just m+ | repr ~= k = Just k+ | otherwise = Nothing+     where !n# = (i# +# j#) `quotInt#` 2#+           !p = unsafeAt arr (I# n#)+{-# INLINABLE gBF3 #-}++findSA+  :: PhoneticsRepresentationPL+  -> Array Int PhoneticsRepresentationPLX+  -> Maybe PhoneticsRepresentationPLX+findSA repr arr = gBF3 (# i#, k #) (# j#, m #) repr arr +     where !(I# i#,I# j#) = bounds arr+           !k = unsafeAt arr (I# i#)+           !m = unsafeAt arr (I# i#)++-- | Finds and element in the 'Array' that the corresponding 'PhoneticsRepresentationPLX' from the first argument is '~=' to the+-- it. The 'String' arguments inside the tuple pair are the 'beforeString' and the 'afterString' elements of it to be used in 'Right'+-- case.+findSAI+  :: PhoneticRepresentationXInter+  -> (String, String)+  -> Array Int PhoneticsRepresentationPLX+  -> Maybe PhoneticsRepresentationPLX+findSAI repr (xs,ys) arr+ | isLeft repr = gBF3 (# i#, k #) (# j#, m #) (fromX2PRPL . fromLeft (PREmptyC " " ' ' " ") $ repr) arr+ | otherwise = gBF3 (# i#, k #) (# j#, m #) (str2PRPL (fromRight [] repr) (xs,ys)) arr+     where !(I# i#,I# j#) = bounds arr+           !k = unsafeAt arr (I# i#)+           !m = unsafeAt arr (I# i#)+           str2PRPL :: String -> (String,String) -> PhoneticsRepresentationPL+           str2PRPL ts ([],[]) = PREmpty ts+           str2PRPL ts (ys,[]) = PRBefore ts ys+           str2PRPL ts ([],zs) = PRAfter ts zs+           str2PRPL ts (ys,zs) = PR ts zs ys++stringToXSG :: GWritingSystemPRPLX -> Generations -> String -> IGWritingSystemPRPLX+stringToXSG xs n ys+ | any ((== n) . snd) xs && n > 0 = stringToXSGI (xs \\ ts) (n - 1) . xsG zs n $ pss+ | otherwise = error "Aftovolio.General.Base.stringToXSG: Not defined for these first two arguments. "+    where !pss = stringToXS (concatMap fst xs) ys -- ps :: [String]+          !ts = filter ((== n) . snd) $ xs -- ts :: GWritingSystemPRPLX+          !zs = if null ts then [] else fst . head $ ts -- zs :: PhoneticRepresentationX+          xsG1 rs n (k1s:k2s:k3s:kss) (!r2s,!r3s,!r4s,!r5s) -- xsG1 :: [PhoneticRepresentationPLX] -> [String] -> Generations -> IGWritingSystemPRPLX+            | isJust x1 = (Right k1s,n - 1):(Left . fromJust $ x1,n):xsG1 rs n (k3s:kss) (r2s,r3s,r4s,r5s)+            | isJust x2 = (Left . fromJust $ x2,n):xsG1 rs n (k2s:k3s:kss) (r2s,r3s,r4s,r5s)+            | isJust x3 = (Right k1s,n - 1):(Left . fromJust $ x3,n):xsG1 rs n (k3s:kss) (r2s,r3s,r4s,r5s)+            | isJust x4 = (Left . fromJust $ x4,n):xsG1 rs n (k2s:k3s:kss) (r2s,r3s,r4s,r5s)+            | otherwise = (Right k1s,n - 1):xsG1 rs n (k2s:k3s:kss) (r2s,r3s,r4s,r5s)+                where !x1 = findSA (PR k2s k3s k1s) r2s+                      !x2 = findSA (PRAfter k1s k2s) r3s+                      !x3 = findSA (PRBefore k2s k1s) r4s+                      !x4 = findSA (PREmpty k1s) r5s+          xsG1 rs n (k1s:k2s:kss) (!r2s,!r3s,!r4s,!r5s)+            | isJust x2 = (Left . fromJust $ x2,n):xsG1 rs n (k2s:kss) (r2s,r3s,r4s,r5s)+            | isJust x3 = (Right k1s,n - 1):(Left . fromJust $ x3,n):xsG1 rs n kss (r2s,r3s,r4s,r5s)+            | isJust x4 = (Left . fromJust $ x4,n):xsG1 rs n (k2s:kss) (r2s,r3s,r4s,r5s)+            | otherwise = (Right k1s,n - 1):xsG1 rs n (k2s:kss) (r2s,r3s,r4s,r5s)+                where !x2 = findSA (PRAfter k1s k2s) r3s+                      !x3 = findSA (PRBefore k2s k1s) r4s+                      !x4 = findSA (PREmpty k1s) r5s+          xsG1 rs n [k1s] (_,_,_,r5s)+            | isJust x4 = [(Left . fromJust $ x4,n)]+            | otherwise = [(Right k1s,n - 1)]+                where !x4 = findSA (PREmpty k1s) r5s+          xsG1 rs n [] (_,_,_,_) = []+          xsG rs n jss = xsG1 rs n jss (r2s,r3s,r4s,r5s)+            where (!r2ls,!r3ls,!r4ls,!r5ls) = fHelp4 isPRC isPRAfterC isPRBeforeC isPREmptyC rs+                  !r2s = listArray (0,length r2ls - 1) r2ls+                  !r3s = listArray (0,length r3ls - 1) r3ls+                  !r4s = listArray (0,length r4ls - 1) r4ls+                  !r5s = listArray (0,length r5ls - 1) r5ls++-- | Is used internally in the 'stringToXSG' and 'stringToXG' functions respectively. +stringToXSGI :: GWritingSystemPRPLX -> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX+stringToXSGI xs n ys+ | n > 0 = stringToXSGI (xs \\ ts) (n - 1) . xsGI zs n $ ys+ | otherwise = ys+     where !ts = filter ((== n) . snd) xs -- ts :: GWritingSystemPRPLX+           !zs = concatMap fst ts -- zs :: PhoneticRepresentationX+           xsGI1 rs n (k1s:k2s:k3s:kss) (r2s,r3s,r4s,r5s) -- xsGI1 :: [PhoneticRepresentationPLX] -> Generations -> IGWritingSystemPRPLX -> IGWritingSystemPRPLX+            | snd k2s == n && isJust x1 = (fst k1s,n - 1):(Left . fromJust $ x1,n) : xsGI1 rs n (k3s:kss) (r2s,r3s,r4s,r5s)+            | snd k1s == n && isJust x2 = (Left . fromJust $ x2,n):xsGI1 rs n (k2s:k3s:kss) (r2s,r3s,r4s,r5s)+            | snd k2s == n && isJust x3 = (fst k1s,n - 1):(Left . fromJust $ x3 ,n):xsGI1 rs n (k3s:kss) (r2s,r3s,r4s,r5s)+            | snd k1s == n && isJust x4 = (Left . fromJust $ x4, n):xsGI1 rs n (k2s:k3s:kss) (r2s,r3s,r4s,r5s)+            | otherwise = (fst k1s,n - 1):xsGI1 rs n (k2s:k3s:kss) (r2s,r3s,r4s,r5s)+                where !x1 = findSAI (fst k2s) (either stringX id . fst $ k1s,either stringX id . fst $ k3s) r2s+                      !x2 = findSAI (fst k1s) ([],either stringX id . fst $ k2s) r3s+                      !x3 = findSAI (fst k2s) (either stringX id . fst $ k1s,[]) r4s+                      !x4 = findSAI (fst k1s) ([],[]) r5s+           xsGI1 rs n (k1s:k2s:kss) (r2s,r3s,r4s,r5s)+            | snd k1s == n && isJust x2 = (Left . fromJust $ x2,n):xsGI1 rs n (k2s:kss) (r2s,r3s,r4s,r5s)+            | snd k2s == n && isJust x3 = (fst k1s,n - 1):(Left . fromJust $ x3,n):xsGI1 rs n kss (r2s,r3s,r4s,r5s)+            | snd k1s == n && isJust x4 = (Left . fromJust $ x4,n):xsGI1 rs n (k2s:kss) (r2s,r3s,r4s,r5s)+            | otherwise = (fst k1s,n - 1):xsGI1 rs n (k2s:kss) (r2s,r3s,r4s,r5s)+                where !x2 = findSAI (fst k1s) ([],either stringX id . fst $ k2s) r3s+                      !x3 = findSAI (fst k2s) (either stringX id . fst $ k1s,[]) r4s+                      !x4 = findSAI (fst k1s) ([],[]) r5s+           xsGI1 rs n [k1s] (_,_,_,r5s)+            | snd k1s == n && isJust x4 = [(Left . fromJust $ x4,n)]+            | otherwise = [(fst k1s,n - 1)]+                where !x4 = findSAI (fst k1s) ([],[]) r5s+           xsGI1 rs n [] (_,_,_,_) = []+           xsGI rs n jss = xsGI1 rs n jss (r2s,r3s,r4s,r5s)+             where (!r2ls,!r3ls,!r4ls,!r5ls) = fHelp4 isPRC isPRAfterC isPRBeforeC isPREmptyC rs+                   !r2s = listArray (0,length r2ls - 1) r2ls+                   !r3s = listArray (0,length r3ls - 1) r3ls+                   !r4s = listArray (0,length r4ls - 1) r4ls+                   !r5s = listArray (0,length r5ls - 1) r5ls+        +-- | The full conversion function. Applies conversion into representation using the 'GWritingSystemPRPLX' provided.+stringToXG :: GWritingSystemPRPLX -> String -> [PhoneticsRepresentationPLX]+stringToXG xs ys = fromPhoneticRX ts . map fst . stringToXSG xs n $ ys+ where n = maximum . map snd $ xs+       !ts = concatMap fst . filter ((== 0) . snd) $ xs
+ Aftovolio/General/Datatype3.hs view
@@ -0,0 +1,207 @@+-- |+-- Module      :  Aftovolio.General.Datatype3 +-- Copyright   :  (c) OleksandrZhabenko 2023-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com++{-# OPTIONS_GHC -funbox-strict-fields #-}+{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}++module Aftovolio.General.Datatype3 (+   Read0+   , isA+   , isB+   , isC +   , readU2+   , readSimple3+   , basicSplit+   , line2Strings+   , read3+   , readEq4G +   , readEq4 +   , zippedDouble2Word8 +) where++import GHC.Base+import GHC.List+import GHC.Word+import GHC.Real (floor,fromIntegral,(/)) +import GHC.Float (int2Double) +import Data.List (groupBy,find)+import Data.Char (isDigit, isSpace,isLetter)+import Text.Read (readMaybe)+import Text.Show (Show(..))+import GHC.Num ((*),(+),(-))+import Data.Maybe (fromMaybe)+import Data.Tuple (fst,snd)+import qualified Data.Foldable as F (foldr) +import qualified Data.Sequence as S+import ListQuantizer (round2GL) ++-- | Is a way to read duration of the additional added time period into the line.+readU2 :: String -> Double+readU2 (y:ys) = fromMaybe 1.0 (readMaybe (y:'.':(if null ys then "0" else ys))::Maybe Double)+readU2 _ = 1.0+{-# INLINE readU2 #-}++-- | Splits a 'String' into list of 'String' so that they can be read by other functions here into respective datatypes.+splitL0 :: String -> [String]+splitL0 = groupBy (\x y -> (isDigit x && isDigit y) || (x /= '_' && x /= '=' && not (isDigit x) && y /= '_' && y /= '=' && not (isDigit y)) || ((x == '=' || x == '_') && isDigit y))+{-# INLINE splitL0 #-}++data Read0 = A {-# UNPACK #-} !Double | B {-# UNPACK #-} !Double | C String deriving (Eq, Show)++-- | Converts a specially formatted 'String' into a 'Read0' value.+reRead3 :: String -> Read0+reRead3 xs = +  case uncons xs of+    Just ('=',ts) -> A (readU2 ts)+    Just ('_',ts) -> B (readU2 ts)+    _ -> C xs++isA :: Read0 -> Bool+isA (A _) = True+isA _ = False++isB :: Read0 -> Bool+isB (B _) = True+isB _ = False++isC :: Read0 -> Bool+isC (C _) = True+isC _ = False++filterReads :: [Read0] -> S.Seq Read0+filterReads xs@(B y:A t:us) = B y S.<| filterReads (dropWhile isA us)+filterReads xs@(A y:A t:us) = A y S.<| filterReads (dropWhile isA us)+filterReads xs@(t:ts) = t S.<| filterReads ts+filterReads _ = S.empty++-- | A preparatory function for the further ones here.+basicSplit :: String -> S.Seq Read0+basicSplit = filterReads . map reRead3 . splitL0+{-# INLINE basicSplit #-}++readSimple3 +  :: (String -> Bool) -- ^ A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.+  -> Double+  -> (String -> [Word8])+  -> S.Seq Read0 -- ^ Is should be obtained using 'basicSplit' function here.+  -> [Word8]+readSimple3 p temp fConvA rs@(C xs S.:<| A x S.:<| ts) -- This branch is fixed in the version 0.6.0.0 because earlier it has an issue.+ | null qs = readSimple3 p temp fConvA ts+ | null q1 = floor xl1 : readSimple3 p xl1 fConvA ts+ | otherwise = q1 `mappend` (floor xl1 : readSimple3 p xl1 fConvA ts)+  where qs +          | p xs = fConvA xs+          | otherwise = []+        (q1,q2s) = splitAtEnd 1 qs+        ql1 = head q2s+        xl1=min (x*word8ToDouble ql1) 255.0+readSimple3 p temp fConvA rs@(C xs S.:<| ys@(B x S.:<| ts)) = qs `mappend` qqs `mappend` readSimple3 p ql fConvA ws  +  where (!ks, ws) = S.spanl isB ys+        !qs +          | p xs = fConvA xs+          | otherwise = []+        !ql+          | null qs = 0.0+          | otherwise = word8ToDouble . last $ qs+        qqs = F.foldr (\(B k) js -> double2Word8 (k * ql):js) [] ks+readSimple3 p temp fConvA rs@(B x S.:<| ts) = qqs `mappend` readSimple3 p temp fConvA ws +  where (ks, ws) = S.spanl isB rs+        qqs = F.foldr (\(B k) js -> double2Word8 (k * temp) : js) [] ks+readSimple3 p temp fConvA (C xs S.:<| _) = qs+  where qs +          | p xs = fConvA xs+          | otherwise = []+readSimple3 _ _ _ _ = []++-- | Is intended to 'floor' the values greater than 255.0 to 255::'Word8' and to be used for non-negative 'Double'.+double2Word8 :: Double -> Word8+double2Word8 = floor . min 255.0+{-# INLINE double2Word8 #-}++-- | Is done using intermediate 'Int' representation.+word8ToDouble :: Word8 -> Double+word8ToDouble = int2Double . fromIntegral+{-# INLINE word8ToDouble #-}++read3 + :: (String -> Bool) -- ^ A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.+ -> Double+ -> (String -> [Word8])+ -> String + -> [Word8]+read3 p temp fConvA = filter (/= 0) . readSimple3 p temp fConvA . basicSplit+{-# INLINE read3 #-}++splitAtEnd :: Int -> [a] -> ([a], [a])+splitAtEnd n = (\(x,y,_) -> (y,x)) . foldr f v+ where v = ([],[],0)+       f x (zs,ts,k)+        | k < n = (x : zs,[],k + 1)+        | otherwise = (zs,x : ts,k + 1)++-- | Is a specialized version of 'Data.InsertLeft.dropFromEndG' function variant from the @subG@ package. Is taken from there to+-- reduce the dependencies. Is not intended to be exported at all.+dropFromEnd :: Int -> [a] -> [a]+dropFromEnd n = (\(xs,_) -> xs) . foldr f v+ where v = ([],0)+       f x (zs,k)+        | k < n = ([],k + 1)+        | otherwise = (x : zs,k)++line2Strings + :: (String -> Bool) -- ^ A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.+ -> (String -> [String])+ -> S.Seq Read0 -- ^ Is should be obtained using 'basicSplit' function here.+ -> [String]+line2Strings p gConvC xs@(C ts S.:<| tt@(A x) S.:<| ys) + | null qs = ks `mappend` line2Strings p gConvC ys+ | otherwise = ks `mappend` ((ql `mappend` ('=':showRead0AsInsert tt)) : line2Strings p gConvC ys) +  where (ks, qs) +          | p ts = splitAtEnd 1 . gConvC $ ts +          | otherwise = ([],[])+        ql = head qs+line2Strings p gConvC xs@(C ys S.:<| ts) = gConvC ys `mappend` line2Strings p gConvC ts+line2Strings p gConvC xs@(y@(B x) S.:<| ts) = showRead0AsInsert y : line2Strings p gConvC ts+line2Strings _ _ _ = []++-- | Is intended to be used in the "music" mode for AFTOVolio.+readEq4G + :: (String -> Bool) -- ^ A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.+ -> (String -> [Word8])+ -> (String -> [String])+ -> S.Seq Read0 -- ^ Is should be obtained using 'basicSplit' function here.+ -> [(String, Word8)]+readEq4G p fConvA gConvC xs = zip ks rs+   where ks = line2Strings p gConvC xs+         rs = filter (/= 0) . readSimple3 p 1.0 fConvA $ xs+{-# INLINE readEq4G #-}++readEq4+ :: (String -> [Word8])+ -> (String -> [String])+ -> S.Seq Read0 -- ^ Is should be obtained using 'basicSplit' function here.+ -> [(String, Word8)]+readEq4 = readEq4G (not . null . filter (not . isSpace))+{-# INLINE readEq4 #-}++showRead0AsInsert :: Read0 -> String+showRead0AsInsert d@(A t) = '=':(filter (/= '.') . show $ t)+showRead0AsInsert d@(B t) = '_':(filter (/= '.') . show $ t)+showRead0AsInsert d@(C ts) = ts+{-# INLINE showRead0AsInsert #-}++-- | Is intended to be used to transform the earlier data for AFTOVolio representations durations from 'Double' to 'Word8' values. It was used during the transition from the ukrainian-phonetics-basic-array-0.7.1.1 to ukrainian-phonetics-basic-array-0.10.0.0.+zippedDouble2Word8 xs = map (\(t, u) -> (t,fromMaybe 15 . hh $ u)) xs +  where !h = snd . head $ xs+        !lt = snd . last $ xs+        !del = (lt - h)/14.0+        !ys  = take 15 . iterate (+del) $ h+        !zs = zip [1..15] ys+        gg !u = fromMaybe lt . round2GL True (\_ _ -> EQ) ys $ u+        hh !u = fmap fst . find ((== gg u) . snd) $ zs++
+ Aftovolio/General/Distance.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Aftovolio.General.Distance where++import GHC.Base+import GHC.Real (Integral,Fractional(..),Real(..),gcd,quot,(/),fromIntegral,toInteger)+import GHC.Float (Floating(..),sqrt)+import GHC.List+import Data.List (replicate)+import GHC.Num ((*),(-),subtract,abs)++-- | 'toEqLength' changes two given lists into two lists of equal+-- minimal lengths and also returs its new length and initial lengths of the lists given.+toEqLength :: [a] -> [a] -> ([a],[a],Int,Int,Int)+toEqLength xs ys +  | null xs = ([],[],0,0,0)+  | null ys = ([],[],0,0,0)+  | otherwise = (ts, vs, lx * ly `quot` dc,lx,ly) +       where lx = length xs+             ly = length ys+             dc = gcd lx ly+             ts = concatMap (replicate (ly `quot` dc)) $ xs+             vs = concatMap (replicate (lx `quot` dc)) $ ys++-- | 'toEqLengthL' changes two given lists into two lists of equal+-- minimal lengths and also returs its new length and initial lengths of the lists given. Is+-- intended to be used when the length of the lists are known and given as the first and the second parameters+-- here respectively.+toEqLengthL :: Int -> Int -> [a] -> [a] -> ([a],[a],Int,Int,Int)+toEqLengthL lx ly xs ys +  | lx == 0 = ([],[],0,0,0)+  | ly == 0 = ([],[],0,0,0)+  | otherwise = (ts, vs, lx * ly `quot` dc,lx,ly) +       where dc = gcd lx ly+             ts = concatMap (replicate (ly `quot` dc)) $ xs+             vs = concatMap (replicate (lx `quot` dc)) $ ys++-- | Is also a simplified distance between the lists. Intended to be used with 'Word8'.+sumAbsDistNorm :: (Integral a, Ord a) => [a] -> [a] -> a+sumAbsDistNorm xs ys + | lc == 0 = 0+ | otherwise = fromIntegral . sum . zipWith (\x y -> toInteger (if x > y then x-y else y-x)) ts $ vs+     where (ts, vs, lc, lx, ly) = toEqLength xs ys ++sumSqrDistNorm :: (Real a, Fractional a) => [a] -> [a] -> a+sumSqrDistNorm xs ys + | lc == 0 = 0+ | otherwise = sum (zipWith (\x y -> (x - y) * (x - y)) ts vs) / fromIntegral lc+     where (ts, vs, lc, lx, ly) = toEqLength xs ys ++-- | 'distanceSqr' is applied on two lists of non-negative 'Real' numbers (preferably, of type+-- 'Double') and returns a special kind of distance that is similar to the statistical distance used+-- in the regression analysis. Is intended to be used e. g. for the AFTOVolio approach. The less+-- is the resulting number, the more \'similar\' are the two lists of non-negative numbers in their+-- distributions. Here, in contrast to the more general 'distanceSqrG', the numbers must be normed+-- to 1.0, so that the largest ones in both listn must be 1.0.+distanceSqr :: (Real a, Floating a, Fractional a) => [a] -> [a] -> a+distanceSqr xs ys = sqrt s+   where s = sumSqrDistNorm xs ys +{-# INLINE distanceSqr #-}++-- | 'distanceSqrG' is applied on two lists of non-negative 'Real' numbers (preferably, of type+-- 'Double') and returns a special kind of distance that is similar to the statistical distance used+-- in the regression analysis. Is intended to be used e. g. for the AFTOVolio approach. The less+-- is the resulting number, the more \'similar\' are the two lists of non-negative numbers in their+-- distributions.+distanceSqrG :: (Real a, Floating a, Fractional a) => [a] -> [a] -> a+distanceSqrG xs ys = distanceSqr qs rs+   where mx = maximum xs+         my = maximum ys+         qs = map (/ mx) xs+         rs = map (/ my) ys+{-# INLINE distanceSqrG #-}++-- | 'distanceSqrG2' is an partially optimized variant of the 'distanceSqrG' if length of the least+-- common multiplier of the two lists is known and provided as the first argument, besides if it is+-- equal to the length of the second argument, and if maximum element of the second argument here is+-- equal to 1.0.+distanceSqrG2 :: (Real a, Floating a, Fractional a) => Int -> [a] -> [a] -> a+distanceSqrG2 lc xs ys = sqrt (sum (zipWith (\x y -> (x - y) * (x - y)) xs qs) / fromIntegral lc)+   where my = maximum ys+         rs = map (/ my) ys+         lr = length rs+         dc = lc `quot` lr+         qs = concatMap (replicate dc) rs+{-# INLINE distanceSqrG2 #-}+
+ Aftovolio/General/Parsing.hs view
@@ -0,0 +1,145 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}++-- |+-- Module      :  Aftovolio.General.Parsing+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- The additional parsing library functions for the AFTOVolio both old and new variants.+-- Is taken from the Phonetic.Languages.Parsing module from the+-- @phonetic-languages-simplified-examples-array@ package to reduce dependencies in general case.+-- ++module Aftovolio.General.Parsing (+  -- * Predicates+  isClosingCurlyBracket+  , isSlash+  , isOpeningCurlyBracket+  , variations+  -- * Transformations+  , breakGroupOfStrings+  , breakInSlashes+  , combineVariants+  , combineHeadsWithNexts+  , transformToVariations+  -- * Files processment for specifications+  , readLangSpecs +  , innerProcessmentSimple+  , argsProcessment+) where++import GHC.Base+import GHC.List+import Aftovolio.General.PrepareText+import System.Environment (getArgs)+import System.IO (FilePath, readFile)+import Data.List (sort,lines,unwords)+import GHC.Arr+import Aftovolio.General.Base+import Aftovolio.General.Syllables+import Text.Read (readMaybe,read)+import Data.Maybe (fromMaybe)+import Aftovolio.General.SpecificationsRead++isClosingCurlyBracket :: String -> Bool+isClosingCurlyBracket = (== "}")+{-# INLINE isClosingCurlyBracket #-}++isSlash :: String -> Bool+isSlash (x:xs)+ | x /= '/' = False+ | null xs = True+ | otherwise = False+isSlash _ = False+{-# INLINE isSlash #-}++isOpeningCurlyBracket :: String -> Bool+isOpeningCurlyBracket = (== "{")+{-# INLINE isOpeningCurlyBracket #-}++breakGroupOfStrings :: [String] -> (([String],[[String]]),[String])+breakGroupOfStrings !xss = ((tss,breakInSlashes uss []), drop 1 zss)+  where (!yss,!zss) = break isClosingCurlyBracket xss+        (!tss,!uss) = (\(t1,t2) -> (t1,drop 1 t2)) . break isOpeningCurlyBracket $ yss+{-# INLINE breakGroupOfStrings #-}++breakInSlashes :: [String] -> [[String]] -> [[String]]+breakInSlashes !wss !usss+ | null lss = kss : usss+ | otherwise = breakInSlashes (drop 1 lss) (kss : usss)+  where (!kss,!lss) = break isSlash wss++combineVariants :: ([String],[[String]]) -> [[String]]+combineVariants (!xss, (!yss:ysss)) = (xss `mappend` yss) : combineVariants (xss, ysss)+combineVariants _ = []++combineHeadsWithNexts :: [[String]] -> [String] -> [[String]]+combineHeadsWithNexts !xsss !yss+ | null yss = xsss+ | otherwise = combineHeadsWithNexts [xss `mappend` zss | xss <- xsss, zss <- zsss] uss+     where (!t,!uss) = breakGroupOfStrings yss+           !zsss = combineVariants t++transformToVariations :: [String] -> [[String]]+transformToVariations !yss+ | null yss = []+ | otherwise = combineHeadsWithNexts xsss tss+  where (!y,!tss) = breakGroupOfStrings yss+        !xsss = combineVariants y+{-# INLINE transformToVariations #-}++variations :: [String] -> Bool+variations xss + | any isSlash xss = if any isOpeningCurlyBracket xss && any isClosingCurlyBracket xss then True else False+ | otherwise = False+{-# INLINE variations #-}++innerProcessmentSimple+  :: String -- ^ Must be a valid 'GWritingSystemPRPLX' specifications 'String' representation only (see the gwrsysExample.txt file in the @phonetic-languages-phonetics-basics@ package as a schema);+  -> String -- ^ Must be a 'String' with the 5 meaningful lines that are delimited with the \'~\' line one from another with the specifications for the possible allophones (if any), 'CharPhoneticClassification', white spaces information (two 'String's) and the 'String' of all the possible 'PLL' 'Char's;+  -> String -- ^ Must be a 'String' with the 'SegmentRulesG' specifications only;+  -> String -- ^ Must be a 'String' with the 'Concatenations' specifications only (see the data in the EnglishConcatenated.txt file in the @phonetic-languages-phonetics-basics@ package as a list of English equivalents of the needed 'String's). These are to be prepended to the next word.+  -> String -- ^ Must be a 'String' with the 'Concatenations' specifications only (see the data in the EnglishConcatenated.txt file in the @phonetic-languages-phonetics-basics@ package as a list of English equivalents of the needed 'String's). These are to be appended to the previous word.+  -> (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification, SegmentRulesG, String, String, Concatenations, Concatenations, String)+innerProcessmentSimple gwrsCnts controlConts segmentData concatenationsFileP concatenationsFileA =+ let [allophonesGs, charClfs, jss, vss, wss] = groupBetweenChars '~' . lines $ controlConts+     wrs = getGWritingSystem '~' gwrsCnts+     ks = sort . fromMaybe [] $ (readMaybe (unwords allophonesGs)::Maybe [(Char, Char)])+     arr = read (unwords charClfs)::Array Int PRS -- The 'Array' must be previously sorted in the ascending order.+     gs = read segmentData::SegmentRulesG+     ysss = sort2Concat . fromMaybe [] $ (readMaybe concatenationsFileP::Maybe [[String]])+     zzzsss = sort2Concat . fromMaybe [] $ (readMaybe concatenationsFileA::Maybe [[String]])+     js = concat jss+     vs = concat vss+     ws = sort . concat $ wss+       in (wrs, ks, arr, gs, js, vs, ysss, zzzsss, ws)+{-# INLINE innerProcessmentSimple #-}++{-| -}+argsProcessment+ :: FilePath -- ^ With the 'GWritingSystemPRPLX' specifications only (see the gwrsysExample.txt file in the @phonetic-languages-phonetics-basics@ package as a schema);+ -> FilePath -- ^ With the 5 meaningful lines that are delimited with the \'~\' line one from another with the specifications for the possible allophones (if any), 'CharPhoneticClassification', white spaces information (two 'String's) and the 'String' of all the possible 'PLL' 'Char's;+ -> FilePath -- ^ With the 'SegmentRulesG' specifications only;+ -> FilePath -- ^ With the 'Concatenations' specifications only (see the data in the EnglishConcatenated.txt file in the @phonetic-languages-phonetics-basics@ package as a list of English equivalents of the needed 'String's). These are to be prepended to the next word.+ -> FilePath -- ^ With the 'Concatenations' specifications only (see the data in the EnglishConcatenated.txt file in the @phonetic-languages-phonetics-basics@ package as a list of English equivalents of the needed 'String's). These are to be appended to the previous word.+ -> IO [String]+argsProcessment fileGWrSys controlFile segmentRulesFile concatenationsFileP concatenationsFileA = mapM readFile [controlFile, fileGWrSys, segmentRulesFile, concatenationsFileP, concatenationsFileA]+{-# INLINE argsProcessment #-}++-- | The function that is mostly intended to be used by the end user. Reads the specifications from+-- the5 given files and returns the data that can be used further for generalized AFTOVolio.+readLangSpecs + :: FilePath -- ^ With the 'GWritingSystemPRPLX' specifications only (see the gwrsysExample.txt file in the @phonetic-languages-phonetics-basics@ package as a schema);+ -> FilePath -- ^ With the 5 meaningful lines that are delimited with the \'~\' line one from another with the specifications for the possible allophones (if any), 'CharPhoneticClassification', white spaces information (two 'String's) and the 'String' of all the possible 'PLL' 'Char's;+ -> FilePath -- ^ With the 'SegmentRulesG' specifications only;+ -> FilePath -- ^ With the 'Concatenations' specifications only (see the data in the EnglishConcatenated.txt file in the @phonetic-languages-phonetics-basics@ package as a list of English equivalents of the needed 'String's). These are to be prepended to the next word.+ -> FilePath -- ^ With the 'Concatenations' specifications only (see the data in the EnglishConcatenated.txt file in the @phonetic-languages-phonetics-basics@ package as a list of English equivalents of the needed 'String's). These are to be appended to the previous word.+ -> IO (GWritingSystemPRPLX, [(Char, Char)], CharPhoneticClassification, SegmentRulesG, String, String, Concatenations, Concatenations, String)+readLangSpecs  fileGWrSys controlFile segmentRulesFile concatenationsFileP concatenationsFileA = + argsProcessment fileGWrSys controlFile segmentRulesFile concatenationsFileP concatenationsFileA >>= \xss -> let [controlConts, gwrsCnts, segmentData, concatenationsFileP1, concatenationsFileA1] = xss in return $ innerProcessmentSimple gwrsCnts controlConts segmentData concatenationsFileP1 concatenationsFileA1 +{-# INLINE readLangSpecs #-}+
+ Aftovolio/General/PrepareText.hs view
@@ -0,0 +1,229 @@+{-# OPTIONS_HADDOCK show-extensions #-}++{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module      :  Aftovolio.General.PrepareText+-- Copyright   :  (c) Oleksandr Zhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Helps to order the 7 or less phonetic language words (or their concatenations)+-- to obtain (to some extent) suitable for poetry or music text.+-- Earlier it has been a module DobutokO.Poetry.Ukrainian.PrepareText+-- from the @dobutokO-poetry@ package.+-- In particular, this module can be used to prepare the phonetic language text+-- by applying the most needed grammar to avoid misunderstanding+-- for the produced text. The attention is paid to the prepositions, pronouns, conjunctions+-- and particles that are most commonly connected (or not) in a significant way+-- with the next text.+-- Uses the information from:+-- https://uk.wikipedia.org/wiki/%D0%A1%D0%BF%D0%BE%D0%BB%D1%83%D1%87%D0%BD%D0%B8%D0%BA+-- and+-- https://uk.wikipedia.org/wiki/%D0%A7%D0%B0%D1%81%D1%82%D0%BA%D0%B0_(%D0%BC%D0%BE%D0%B2%D0%BE%D0%B7%D0%BD%D0%B0%D0%B2%D1%81%D1%82%D0%B2%D0%BE)+--+-- Uses arrays instead of vectors.+-- A list of basic (but, probably not complete and needed to be extended as needed) English words (the articles, pronouns,+-- particles, conjunctions etc.) the corresponding phonetic language translations of which are intended to be used as a+-- 'Concatenations' here is written to the file EnglishConcatenated.txt in the source tarball.++module Aftovolio.General.PrepareText (+  Concatenations+  -- * Basic functions+  , concatWordsFromLeftToRight+  , splitLines+  , splitLinesN+  , isSpC+  , sort2Concat+  -- * The end-user functions+  , prepareText+  , prepareTextN+  , growLinesN+  , prepareGrowTextMN+  , tuneLinesN+  , prepareTuneTextMN+  -- * Used to transform after convertToProperphonetic language from mmsyn6ukr package+  , isPLL+) where++import GHC.Base+import Data.List+import Data.Bits (shiftR)+import GHC.Num ((+),(-),abs)+import CaseBi.Arr (getBFstL',getBFst')+import Data.IntermediateStructures1 (mapI)+import Data.Char (isAlpha,toLower)+import GHC.Arr+import Data.Tuple (fst)++-- | The lists in the list are sorted in the descending order by the word counts in the inner 'String's. All the 'String's+-- in each inner list have the same number of words, and if there is no 'String' with some intermediate number of words (e. g. there+-- are 'String's for 4 and 2 words, but there is no one for 3 words 'String's) then such corresponding list is absent (since+-- the 0.9.0.0 version). Probably the maximum number of words can be not more than 4, and the minimum number is+-- not less than 1, but it depends. The 'String's in the inner lists must be (unlike the inner+-- lists themselves) sorted in the ascending order for the data type to work correctly in the functions of the module.+type Concatenations = [[String]]++type ConcatenationsArr = [Array Int (String,Bool)]++defaultConversion :: Concatenations -> ConcatenationsArr+defaultConversion ysss = map (f . filter (not . null)) . filter (not . null) $ ysss+  where f :: [String] -> Array Int (String,Bool)+        f yss = let l = length yss in listArray (0,l-1) . zip yss . cycle $ [True]++-- | Is used to convert a phonetic language text into list of 'String' each of which is ready to be+-- used by the functions from the other modules in the package.+-- It applies minimal grammar links and connections between the most commonly used phonetic language+-- words that \"should\" be paired and not dealt with separately+-- to avoid the misinterpretation and preserve maximum of the semantics for the+-- \"phonetic\" language on the phonetic language basis.+prepareText+  :: [[String]] -- ^ Is intended to become a valid 'Concatenations'.+  -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.+  -> String -- ^ A sorted 'String' of possible characters in the phonetic language representation.+  -> String+  -> [String]+prepareText = prepareTextN 7+{-# INLINE prepareText #-}++sort2Concat+ :: [[String]]+ -> Concatenations  -- ^ Data used to concatenate the basic grammar preserving words and word sequences to the next word or+ -- to the previous word to+ -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.+sort2Concat xsss+ | null xsss = []+ | otherwise = map sort . reverse . sortOn (map (length . words)) $ xsss++-----------------------------------------------------++complexWords2 :: ConcatenationsArr -> String -> (String -> String,String)+complexWords2 ysss@(yss:zsss) zs@(r:rs)+ | getBFst' (False, yss) . unwords $ tss = ((uwxs `mappend`), unwords uss)+ | otherwise = complexWords2 zsss zs+      where y = length . words . fst . unsafeAt yss $ 0+            (tss,uss) = splitAt y . words $ zs+            uwxs = concat tss+complexWords2 _ zs = (id,zs)++pairCompl :: (String -> String,String) -> (String,String)+pairCompl (f,xs) = (f [],xs)++splitWords :: ConcatenationsArr -> [String] -> String -> (String,String)+splitWords ysss tss zs +  | null . words $ zs = (mconcat tss,[])+  | null ws = (\(xss,uss) -> (mconcat (tss `mappend` xss), unwords uss)) . splitAt 1 . words $ zs+  | otherwise = splitWords ysss (tss `mappend` [ws]) us+        where (ws,us) = pairCompl . complexWords2 ysss $ zs ++concatWordsFromLeftToRight :: ConcatenationsArr -> String -> [String]+concatWordsFromLeftToRight ysss zs = let (ws,us) = splitWords ysss [] zs in+  if null us then [ws] else ws : concatWordsFromLeftToRight ysss us++-----------------------------------------------------++append2prependConv :: Concatenations -> Concatenations+append2prependConv = map (map (unwords . reverse . words))+{-# INLINE append2prependConv #-}++left2right :: [String] -> String+left2right = unwords . reverse . map reverse+{-# INLINE left2right #-}++-----------------------------------------------------++-- | A generalized variant of the 'prepareText' with the arbitrary maximum number of the words in the lines given as the first argument.+prepareTextN+ :: Int -- ^ A maximum number of the words or their concatenations in the resulting list of 'String's.+ -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.+ -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.+ -> String -- ^ A sorted 'String' of possible characters in the phonetic language representation.+ -> String+ -> [String]+prepareTextN n ysss zsss xs = filter (any (isPLL xs)) . splitLinesN n . map (left2right .+  concatWordsFromLeftToRight (defaultConversion . sort2Concat . append2prependConv $ zsss) . left2right .+  concatWordsFromLeftToRight (defaultConversion . sort2Concat $ ysss)) . filter (not . null) . lines++-- | A predicate to check whether the given character is one of the \"\' \\x2019\\x02BC-\".+isSpC :: Char -> Bool+isSpC x = x == '\'' || x == ' ' || x == '\x2019' || x == '\x02BC' || x == '-' || x == '_' || x == '='+{-# INLINE isSpC #-}+{-# DEPRECATED #-}++-- | The first argument must be a 'String' of sorted 'Char's in the ascending order of all possible symbols that can be+-- used for the text in the phonetic language selected. Can be prepared beforehand, or read from the file.+isPLL :: String -> Char -> Bool+isPLL xs y = getBFstL' False (zip xs . replicate 10000 $ True) y++-- | The function is recursive and is applied so that all returned elements ('String') are no longer than 7 words in them.+splitLines :: [String] -> [String]+splitLines = splitLinesN 7+{-# INLINE splitLines #-}++-- | A generalized variant of the 'splitLines' with the arbitrary maximum number of the words in the lines given as the first argument.+splitLinesN :: Int -> [String] -> [String]+splitLinesN n xss+ | null xss || n <= 0 = []+ | otherwise = mapI (\xs -> compare (length . words $ xs) n == GT) (\xs -> let yss = words xs in+     splitLinesN n . map unwords . (\(q,r) -> [q,r]) . splitAt (shiftR (length yss) 1) $ yss) $ xss++------------------------------------------------++{-| @ since 0.8.0.0+Given a positive number and a list tries to rearrange the list's 'String's by concatenation of the several elements of the list+so that the number of words in every new 'String' in the resulting list is not greater than the 'Int' argument. If some of the+'String's have more than that number quantity of the words then these 'String's are preserved.+-}+growLinesN :: Int -> [String] -> [String]+growLinesN n xss+ | null xss || n < 0 = []+ | otherwise = unwords yss : growLinesN n zss+     where l = length . takeWhile (<= n) . scanl1 (+) . map (length . words) $ xss -- the maximum number of lines to be taken+           (yss,zss) = splitAt (max l 1) xss++{-| @ since 0.8.0.0+The function combines the 'prepareTextN' and 'growLinesN' function. Applies needed phonetic language preparations+to the text and tries to \'grow\' the resulting 'String's in the list so that the number of the words in every+of them is no greater than the given first 'Int' number.+-}+prepareGrowTextMN+ :: Int -- ^ A maximum number of the words or their concatenations in the resulting list of 'String's.+ -> Int -- ^ A number of words in every 'String' that the function firstly forms. To have some sense of usage, must be less than the first argument.+ -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.+ -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.+ -> String -- ^ A sorted 'String' of possible characters in the phonetic language representation.+ -> String+ -> [String]+prepareGrowTextMN m n ysss zsss xs = growLinesN m . prepareTextN n ysss zsss xs+{-# INLINE prepareGrowTextMN #-}++-------------------------------------++{-| @ since 0.6.0.0+Recursively splits the concatenated list of lines of words so that in every resulting 'String' in the list+except the last one there is just 'Int' -- the first argument -- words.+-}+tuneLinesN :: Int -> [String] -> [String]+tuneLinesN n xss+ | null xss || n < 0 = []+ | otherwise =+    let wss = words . unwords $ xss+        (yss,zss) = splitAt n wss+          in unwords yss : tuneLinesN n zss++{-| @ since 0.6.0.0+The function combines the 'prepareTextN' and 'tuneLinesN' functions. Applies needed phonetic language preparations+to the phonetic language text and splits the list of 'String's so that the number of the words in each of them (except the last one)+is equal the given first 'Int' number.+-}+prepareTuneTextMN+  :: Int -- ^ A maximum number of the words or their concatenations in the resulting list of 'String's.+  -> Int -- ^ A number of words in every 'String' that the function firstly forms. To have some sense of usage, must be less than the first argument.+  -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.+  -> [[String]] -- ^ Is intended to become a valid 'Concatenations'.+  -> String -- ^ A sorted 'String' of possible characters in the phonetic language representation.+  -> String+  -> [String]+prepareTuneTextMN m n ysss zsss xs = tuneLinesN m . prepareTextN n ysss zsss xs+{-# INLINE prepareTuneTextMN #-}
+ Aftovolio/General/Simple.hs view
@@ -0,0 +1,371 @@+{-# LANGUAGE NoImplicitPrelude, BangPatterns, DeriveGeneric #-}++module Aftovolio.General.Simple where++import GHC.Base+import GHC.Enum (fromEnum)+import GHC.Real (Integral,fromIntegral,(/),quot,rem,quotRem,round,gcd,(^))+import GHC.Word+import GHC.Generics+import Text.Show (Show(..))+import Aftovolio.General.PrepareText +import Aftovolio.General.Syllables +import Aftovolio.General.Base+import System.Environment (getArgs)+import GHC.Num (Num,(+),(-),(*),Integer)+import Text.Read (readMaybe)+import System.IO (putStrLn, FilePath,stdout,universalNewlineMode,hSetNewlineMode,getLine,appendFile,readFile,writeFile,putStr)+import Rhythmicity.MarkerSeqs hiding (id) +import Data.List hiding (foldr)+import Data.Ord (Down(..))+import Data.Maybe (fromMaybe, mapMaybe, catMaybes,isNothing,fromJust) +import Data.Tuple (fst)+import Data.Char (isDigit,isSpace)+import CLI.Arguments+import CLI.Arguments.Get+import CLI.Arguments.Parsing+import GHC.Int (Int8)+import Data.Ord (comparing)+import Aftovolio.ConstraintsEncoded+import Aftovolio.PermutationsArr+import Aftovolio.StrictVG+import Numeric (showFFloat)+import Aftovolio.Halfsplit+import System.Directory (doesFileExist,readable,writable,getPermissions,Permissions(..),doesFileExist,getCurrentDirectory)+import Data.ReversedScientific+import Control.Concurrent.Async (mapConcurrently)+import Data.MinMax1 (minMax11By) +import Aftovolio.Tests+import Aftovolio.General.Datatype3+import Aftovolio.General.Distance+import Aftovolio.UniquenessPeriodsG+import Data.ChooseLine2+import Control.DeepSeq++generalF + :: Int -- ^ A power of 10. The resulting distance using next ['Word8'] argument is quoted by 10 in this power. The default one is 0. The proper values are in the range [0..4].+ -> Int -- ^ A 'length' of the next argument here.+ -> [Word8] -- ^ A list of non-negative values normed by 255 (the greatest of which is 255) that the line options are compared with. If null, then the program works as for version 0.12.1.0 without this newly-introduced argument since the version 0.13.0.0. The length of it must be a least common multiplier of the (number of syllables plus number of \'_digits\' groups) to work correctly. Is not used when the next 'FilePath' and 'String' arguments are not null.+ -> Bool -- ^ If 'True' then adds \"<br>\" to line endings for double column output+ -> FilePath -- ^ A path to the file to save double columns output to. If empty then just prints to 'stdout'.+ -> String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types'+ -> (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#selectSounds. Use just small 'Char' if they are letters, do not use \'.\' and spaces.+ -> (String, String)  -- ^ If the next element is not equal to -1, then the prepending and appending lines to be displayed. Used basically for working with the multiline textual input data.+ -> Int -- ^ The number of the line in the file to be read the lines from. If equal to -1 then neither reading from the file is done nor the first argument influences the processment results.+ -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+ -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> CharPhoneticClassification+ -> SegmentRulesG+ -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+ -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+ -> ([[[PRS]]] -> [[Word8]]) -- ^ Since the version 0.20.0.0, here there are 'Word8' instead of 'Double'. If this function is @g@, then the module 'Aftovolio.General.Datatype3' has corresponding function 'Aftovolio.General.Datatype3.zippedDouble2Word8' to transform the previously used function into the new one. If you have the function used inside the @f::[[[PRS]]]->[[Double]]@ with main conversion semantically similar to the one by the link: 'https://hackage.haskell.org/package/ukrainian-phonetics-basic-array-0.7.1.1/docs/Phladiprelio-Ukrainian-SyllableDouble.html#v:syllableDurationsD', then you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PRS, Double)] into [(PRS, Word8)].+ -> Int+ -> HashCorrections + -> (Int8,[Int8])+ -> Bool+ -> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12. + -> Bool + -> Int8+ -> (FilePath, Int)+ -> Bool -- ^ In the testing mode, whether to execute computations in concurrent mode (for speed up) or in single thread. If specified needs the executable to be compiled with -rtsopts and -threaded options and run with the command line +RTS -N -RTS options.+ -> String -- ^ An initial string to be analyzed.+ -> [String] + -> IO [String] +generalF power10 ldc compards html dcfile selStr selFun (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (fs, code) concurrently initstr universalSet + | null universalSet = do+     let strOutput = ["You have specified the data and constraints on it that lead to no further possible options.", "Please, specify another data and constraints."] +     putStrLn . unlines $ strOutput+     return strOutput+ | length universalSet == 1 = do+     putStrLn . unlines $ universalSet+     return universalSet+ | otherwise = do+   let syllN = countSyll wrs arr us vs initstr+       f ldc compards grps mxms +          | null selStr = (if null compards then (sum . countHashes2G hashStep hc grps mxms) else ((`quot` 10^power10) . fromIntegral . sumAbsDistNorm compards)) . read3 (not . null . filter (not . isSpace)) 1.0 (mconcat . h .  createSyllablesPL wrs ks arr gs us vs)+          | otherwise = fromIntegral . diverse2GGL (selectSounds selFun selStr) (us `mappend` vs) . concatMap string1 . stringToXG wrs . filter (\c -> not (isDigit c) && c /= '_' && c /= '=')+   hSetNewlineMode stdout universalNewlineMode+   if numTest >= 0 && numTest <= 179 && numTest /= 1 && null compards then testsOutput concurrently syllN f ldc numTest universalSet +   else let sRepresent = zipWith (\k (x, ys) -> S k x ys) [1..] . +             (if descending then sortOn (\(u,w) -> (Down u,w)) else sortOn id) . map (\xss -> (f ldc compards grps mxms xss, xss)) $ universalSet+            strOutput = force . (:[]) . halfsplit1G (\(S _ y _) -> y) (if html then "<br>" else "") (jjj splitting) $ sRepresent+            lns1 = unlines strOutput+                          in do+                             putStrLn lns1+                             if null dcfile then putStr "" +                             else do +                                 doesFileExist dcfile >>= \exist -> if exist then do +                                       getPermissions dcfile >>= \perms -> if writable perms then writeFile dcfile lns1 +                                                                           else error $ "Aftovolio.General.IO.generalF: File " `mappend` dcfile `mappend` " is not writable!" +                                    else do +                                       getCurrentDirectory >>= \currdir -> do +                                          getPermissions currdir >>= \perms -> if writable perms then writeFile dcfile lns1 +                                                                               else error $ "Aftovolio.General.IO.generalF: Directory of the file " `mappend` dcfile `mappend` " is not writable!"+                             let l1 = length sRepresent+                             if code == -1 +                                 then if lineNmb == -1 then return strOutput+                                      else do +                                          print23 prestr poststr 1 [initstr]+                                          return strOutput+                                 else do +                                       print23 prestr poststr 1 [initstr]+                                       parseLineNumber l1 >>= \num -> do+                                         permiss <- getPermissions fs+                                         let writ = writable permiss+                                             readab = readable permiss+                                         if writ && readab then outputWithFile h wrs ks arr gs us vs selStr compards sRepresent code grps fs num+                                         else error "The specified file cannot be used for appending the text! Please, specify another file!"+                                         return []+     where jjj kk = let (q1,r1) = quotRem kk (if kk < 0 then -10 else 10) in jjj' q1 r1 emptyline+           jjj' q1 r1 emptyline+             | r1 == (-1) || r1 == (-3) = -10*q1 + (if emptyline then -5 else r1)+             | r1 == 1 || r1 == 3 = 10*q1 + (if emptyline then 5 else r1)+             | r1 < 0 = -10*q1 + (if emptyline then -4 else r1)+             | otherwise = 10*q1 + (if emptyline then 4 else r1)++data AftovolioGen = S Int Integer String deriving (Eq, Generic)++instance Show AftovolioGen where+  show (S i j xs) = showBignum 7 j `mappend` " " `mappend` xs `mappend` "  " `mappend` showWithSpaces 4 i++instance NFData AftovolioGen++countSyll +  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> CharPhoneticClassification +  ->  String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String +  -> Int+countSyll wrs arr us vs xs = numUnderscoresSyll + (fromEnum . foldr (\x y -> if createsSyllable x then y + 1 else y) 0 . concatMap (str2PRSs arr) . words1 . mapMaybe g . concatMap string1 . stringToXG wrs $ xs)+   where numUnderscoresSyll = length . filter (\xs -> let (ys,ts) = splitAt 1 xs in ys == "_" && all isDigit ts && not (null ts)) . groupBy (\x y -> x=='_' && isDigit y) $ xs+         g :: Char -> Maybe Char+         g x+          | x `elem` us = Nothing+          | x `notElem` vs = Just x+          | otherwise = Just ' '+         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 (== ' ') xs+                 (w, s'') = break (== ' ') ts+         {-# NOINLINE words1 #-}++stat1 :: Int -> (Int8,[Int8]) -> Int+stat1 n (k, ks) = fst (n `quotRemInt` fromEnum k) * length ks++outputSel :: AftovolioGen -> Int -> String+outputSel (S x1 y1 ts) code+  | code < 0 = []+  | code == 1 || code == 11 || code == 16 = intercalate " " [show x1, ts] `mappend` "\n"+  | code == 2 || code == 12 || code == 17 = intercalate " " [show y1, ts] `mappend` "\n"+  | code == 3 || code == 13 || code == 18 = intercalate " " [show x1, ts, show y1] `mappend` "\n"+  | code == 4 || code == 14 || code == 19 = intercalate " " [show x1, show y1] `mappend` "\n"+  | otherwise = ts `mappend` "\n"++parseLineNumber :: Int -> IO Int+parseLineNumber l1 = do +  putStrLn "Please, specify the number of the option to be written to the file specified: "+  number <- getLine+  let num = readMaybe (filter isDigit number)::Maybe Int+  if isNothing num || num > Just l1 || num == Just 0 +      then parseLineNumber l1 +      else return . fromJust $ num++{-| Uses 'getArgs' inside to get the needed data from the command line arguments. Use with this in+ mind. +-}+argsProcessing+ :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+ -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> CharPhoneticClassification+ -> SegmentRulesG+ -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+ -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+ -> ([[[PRS]]] -> [[Word8]]) -- ^ Since the version 0.20.0.0, here there are 'Word8' instead of 'Double'. If this function is @g@, then the module 'Aftovolio.General.Datatype3' has corresponding function 'Aftovolio.General.Datatype3.zippedDouble2Word8' to transform the previously used function into the new one. If you have the function used inside the @f::[[[PRS]]]->[[Double]]@ with main conversion semantically similar to the one by the link: 'https://hackage.haskell.org/package/ukrainian-phonetics-basic-array-0.7.1.1/docs/Phladiprelio-Ukrainian-SyllableDouble.html#v:syllableDurationsD', then you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PRS, Double)] into [(PRS, Word8)].+ -> [[String]]+ -> [[String]]+ -> String + -> IO (Int, Int, [Word8], Bool, FilePath, String, String, String, Int, Bool, Int8, FilePath, Int, Bool, String, [String]) -- ^ These ones are intended to be used inside 'generalF'.+argsProcessing wrs ks arr gs us vs h ysss zsss xs = do+  args0 <- getArgs+  let (argsC, args) = takeCs1R ('+','-') cSpecs args0+      (argsB, args11) = takeBsR bSpecs args+      compareByLinesFinalFile = concat . getB "-cm" $ argsB+  if not . null $ compareByLinesFinalFile then do+      compareFilesToOneCommon 14 args11 compareByLinesFinalFile+      return (0,0,[],False,[],[],[],[],0,False,0,[],0,False,[],[]) +  else do+    let prepare = any (== "-p") args11+        emptyline = any (== "+l") args11 +        splitting = fromMaybe 50 (readMaybe (concat . getB "+w" $ argsB)::Maybe Int8) +        concurrently = any (== "-C") args11+        dcspecs = getB "+dc" argsB+        (html,dcfile) +          | null dcspecs = (False, "")+          | otherwise = (head dcspecs == "1",last dcspecs)+        selStr = concat . getB "+ul" $ argsB+        filedata = getB "+f" argsB+        power10' = fromMaybe 0 (readMaybe (concat . getB "+q" $ argsB)::Maybe Int)+        power10 +           | power10' < 0 && power10' > 4 = 0+           | otherwise = power10'+        (multiline2, multiline2LineNum)+          | oneB "+m3" argsB =+              let r1ss = getB "+m3" argsB in+                    if length r1ss == 3+                        then let (kss,qss) = splitAt 2 r1ss in+                                     (kss, max 1 (fromMaybe 1 (readMaybe (concat qss)::Maybe Int)))+                        else (r1ss, 1)+          | oneB "+m2" argsB = (getB "+m" argsB,  max 1 (fromMaybe 1 (readMaybe (concat . getB "+m2" $ argsB)::Maybe Int)))+          | otherwise = (getB "+m" argsB, -1)+        (fileread,lineNmb)+          | null multiline2 = ("",-1)+          | length multiline2 == 2 = (head multiline2, fromMaybe 1 (readMaybe (last multiline2)::Maybe Int))+          | otherwise = (head multiline2, 1)+    (arg3s,prestr,poststr,linecomp3) <- do+         if lineNmb /= -1 then do+             txtFromFile <- readFile fileread+             let lns = lines txtFromFile+                 ll1 = length lns+                 ln0 = max 1 (min lineNmb (length lns))+                 lm3+                   | multiline2LineNum < 1 = -1+                   | otherwise = max 1 . min multiline2LineNum $ ll1+                 linecomp3+                   | lm3 == -1 = []+                   | otherwise = lns !! (lm3 - 1)+                 ln_1 +                    | ln0 == 1 = 0+                    | otherwise = ln0 - 1+                 ln1+                    | ln0 == length lns = 0+                    | otherwise = ln0 + 1+                 lineF = lns !! (ln0 - 1)+                 line_1F +                    | ln_1 == 0 = []+                    | otherwise = lns !! (ln_1 - 1)+                 line1F+                    | ln1 == 0 = []+                    | otherwise = lns !! (ln1 - 1)+             return $ (words lineF, line_1F,line1F,linecomp3)+         else return (args11, [], [],[])+    let line2comparewith+          | oneC "+l2" argsC || null linecomp3 = unwords . getC "+l2" $ argsC+          | otherwise = linecomp3+        basecomp = force . read3 (not . null . filter (not . isSpace)) 1.0 (mconcat . h . createSyllablesPL wrs ks arr gs us vs) $ line2comparewith+        (filesave,codesave)+          | null filedata = ("",-1)+          | length filedata == 2 = (head filedata, fromMaybe 0 (readMaybe (last filedata)::Maybe Int))+          | otherwise = (head filedata,0)+        ll = let maxWordsNum = (if any (== "+x") arg3s then 9 else 7) in take maxWordsNum . (if prepare then id else words . mconcat . prepareTextN maxWordsNum ysss zsss xs . unwords) $ arg3s+        l = length ll+        argCs = catMaybes (fmap (readMaybeECG l) . getC "+a" $ argsC)+        argCBs = unwords . getC "+b" $ argsC -- If you use the parenthese with +b ... -b then consider also using the quotation marks for the whole algebraic constraint. At the moment though it is still not working properly for parentheses functionality. The issue should be fixed in the further releases.+        !perms +          | not (null argCBs) = filterGeneralConv l argCBs . genPermutationsL $ l+          | null argCs = genPermutationsL l+          | otherwise = decodeLConstraints argCs . genPermutationsL $ l +        basiclineoption = unwords arg3s+        example = force . read3 (not . null . filter (not . isSpace)) 1.0 (mconcat . h .  createSyllablesPL wrs ks arr gs us vs) . unwords $ arg3s+        le = length example+        lb = length basecomp+        gcd1 = gcd le lb+        ldc = le * lb `quot` gcd1+        mulp = ldc `quot` lb+--        max2 = maximum basecomp+        compards = force . concatMap (replicate mulp) $ basecomp+        variants1 = force . uniquenessVariants2GNBL ' ' id id id perms $ ll+    return (power10, ldc, compards, html, dcfile, selStr, prestr, poststr, lineNmb, emptyline, splitting, filesave, codesave, concurrently, basiclineoption, variants1)++processingF+ :: (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#parsey0Choice. Use just small 'Char' if they are letters, do not use \'.\' and spaces.+ -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+ -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> CharPhoneticClassification+ -> SegmentRulesG+ -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+ -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+ -> ([[[PRS]]] -> [[Word8]]) -- ^ Since the version 0.20.0.0, here there are 'Word8' instead of 'Double'. If this function is @g@, then the module 'Aftovolio.General.Datatype3' has corresponding function 'Aftovolio.General.Datatype3.zippedDouble2Word8' to transform the previously used function into the new one. If you have the function used inside the @f::[[[PRS]]]->[[Double]]@ with main conversion semantically similar to the one by the link: 'https://hackage.haskell.org/package/ukrainian-phonetics-basic-array-0.7.1.1/docs/Phladiprelio-Ukrainian-SyllableDouble.html#v:syllableDurationsD', then you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PRS, Double)] into [(PRS, Word8)].+ -> Int+ -> HashCorrections + -> (Int8,[Int8]) + -> [[String]] + -> [[String]] + -> Bool+ -> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12. + -> String + -> IO ()+processingF selFun wrs ks arr gs us vs h numTest hc (grps,mxms) ysss zsss descending hashStep xs = argsProcessing wrs ks arr gs us vs h ysss zsss xs >>= \(power10, ldc, compards, html, dcfile, selStr, prestr, poststr, lineNmb, emptyline, splitting, filesave, codesave, concurrently, basiclineoption, variants1) -> generalF power10 ldc compards html dcfile selStr selFun (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (filesave, codesave) concurrently basiclineoption variants1 >> return ()+{-# INLINE processingF #-}++-- | Specifies the group of the command line arguments for 'processingF', which specifies the+-- PhLADiPreLiO constraints. For more information, see:+-- https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints +cSpecs :: CLSpecifications+cSpecs = zip ["+a","+b","+l2"] . cycle $ [-1]++bSpecs :: CLSpecifications+bSpecs = [("+f",2),("+m",2),("+m2",2),("+m3",3),("+ul",1),("+w",1),("+dc",2),("+q",1),("-cm",1)]++{-| 'selectSounds' converts the argument after \"+ul\" command line argument into a list of sound representations that is used for evaluation of \'uniqueness periods\' properties of the line. Is a modified Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2.parsey0Choice from the @phonetic-languages-simplified-generalized-examples-array-0.19.0.1@ package.+ -}+selectSounds +  :: (String -> String) -- ^ A function that specifies what 'Char's in the list the first argument makes to be the function sensitive to. Analogue of the @g@ function in the definition: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.html#selectSounds. Use just small 'Char' if they are letters, do not use \'.\' and spaces.+  -> String +  -> String+selectSounds g xs = f . sortOn id . concatMap g . words . map (\c -> if c  == '.' then ' ' else c) $ us+    where (_,us) = break (== '.') . filter (\c -> c /= 'H' && c /= 'G') $ xs+          f (x:ts@(y:_)) +           | x == y = f ts+           | otherwise = x:f ts+          f xs = xs++-- | Internal part of the 'generalF' for processment in case of using tests mode.+testsOutput+  :: (Show a1, Integral a1) =>+     Bool+     -> Int+     -> (p -> [a2] -> Int8 -> [Int8] -> String -> a1)+     -> p+     -> Int+     -> [String]+     -> IO [String]+testsOutput concurrently syllN f ldc numTest universalSet = do+      putStrLn "Feet   Val  Stat   Proxim" +      (if concurrently then mapConcurrently else mapM) +           (\(q,qs) -> let m = stat1 syllN (q,qs)+                           (min1,max1) = force . fromJust . minMax11By (comparing (f ldc [] q qs)) $ universalSet +                           mx = f ldc [] q qs max1+                           strTest = (show (fromEnum q) `mappend` "   |   " `mappend`  show mx `mappend` "     " `mappend` show m `mappend` "  -> " `mappend` showFFloat (Just 3) (100 * fromIntegral mx / fromIntegral m) "%" `mappend` (if rem numTest 10 >= 4 +                                                               then -- let min1 = minimumBy (comparing (f ldc [] q qs)) universalSet in +                                                                     ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n")  +                                                               else "")) in putStrLn strTest >> return strTest) . zip (sel2 numTest) $ (sel numTest)++-- | Internal part of the 'generalF' for processment with a file.+outputWithFile+  :: (Eq a1, Num a1) =>+     ([[[PRS]]] -> [[Word8]]) -- ^ Since the version 0.20.0.0, here there are 'Word8' instead of 'Double'. If this function is @g@, then the module 'Aftovolio.General.Datatype3' has corresponding function 'Aftovolio.General.Datatype3.zippedDouble2Word8' to transform the previously used function into the new one. If you have the function used inside the @f::[[[PRS]]]->[[Double]]@ with main conversion semantically similar to the one by the link: 'https://hackage.haskell.org/package/ukrainian-phonetics-basic-array-0.7.1.1/docs/Phladiprelio-Ukrainian-SyllableDouble.html#v:syllableDurationsD', then you can use 'zippedDouble2Word8' to transform the main semantic kernel of [(PRS, Double)] into [(PRS, Word8)].+     -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+     -> [(Char, Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. +     -> CharPhoneticClassification+     -> SegmentRulesG+     -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+     -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+     -> String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types'+     -> [Word8] -- ^ A list of non-negative values normed by 255 (the greatest of which is 255) that the line options are compared with. If null, then the program works as for version 0.12.1.0 without this newly-introduced argument since the version 0.13.0.0. The length of it must be a least common multiplier of the (number of syllables plus number of \'_digits\' groups) to work correctly. Is not used when the next 'FilePath' and 'String' arguments are not null.+     -> [AftovolioGen]+     -> Int+     -> a1+     -> FilePath -- ^ A file to be probably added output parts to.+     -> Int+     -> IO ()+outputWithFile h wrs ks arr gs us vs selStr compards sRepresent code grps fs num+  | mBool && code >= 10 && code <= 19 && grps == 2 = putStrLn (mconcat [textP, "\n", breaks, "\n", show rs]) >> appendF ((if code >= 15 then mconcat [show rs, "\n", breaks, "\n"] else "") `mappend` outputS)+  | otherwise = appendF outputS+           where mBool = null selStr && null compards+                 appendF = appendFile fs+                 lineOption = head . filter (\(S k _ _) -> k == num) $ sRepresent+                 textP = (\(S _ _ ts) -> ts) lineOption+                 outputS = outputSel lineOption code+                 qqs = readEq4 (mconcat . h . createSyllablesPL wrs ks arr gs us vs) (map (map charS) . mconcat . createSyllablesPL wrs ks arr gs us vs) . basicSplit $ textP+                 (breaks,rs) = showZerosFor2PeriodMusic qqs+
+ Aftovolio/General/SpecificationsRead.hs view
@@ -0,0 +1,48 @@+-- |+-- Module      :  Aftovolio.General.SpecificationsRead+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+--  Provides functions to read data specifications for other modules from textual files.+++{-# LANGUAGE NoImplicitPrelude #-}+++module Aftovolio.General.SpecificationsRead where++import GHC.Base+import GHC.List+import Data.List (sort,lines)+import Data.Char (isAlpha)+import Aftovolio.RGLPK.General+import System.Environment (getArgs)+import GHC.Arr+import Text.Read+import Data.Maybe (fromMaybe,fromJust)+import GHC.Int+import Aftovolio.General.Base++charLine :: Char -> String -> Bool+charLine c = (== [c]) . take 1+{-# INLINE charLine #-}++groupBetweenChars+ :: Char  -- ^ A delimiter (can be used probably multiple times) used between different parts of the data.+ -> [String] -- ^ A list of 'String' that is partitioned using the 'String' starting with the delimiter.+ -> [[String]]+groupBetweenChars c [] = []+groupBetweenChars c xs = css : groupBetweenChars c (dropWhile (charLine c) dss)+  where (css,dss) = span (charLine c) xs++{-| An example of the needed data structure to be read correctly is in the file gwrsysExample.txt in the source tarball. +-}+getGWritingSystem+  :: Char -- ^ A delimiter (cab be used probably multiple times) between different parts of the data file. Usually, a tilda sign \'~\'.+  -> String -- ^ Actually the 'String' that is read into the result. +  -> GWritingSystemPRPLX -- ^ The data is used to obtain the phonetic language representation of the text.+getGWritingSystem c xs = map ((\(t1,t2) -> (sort . map (\kt -> fromJust (readPEMaybe kt::Maybe PhoneticsRepresentationPLX)) $ t2,+         read (concat t1)::Int8)) . splitAt 1) . groupBetweenChars c . lines $ xs+
+ Aftovolio/General/Syllables.hs view
@@ -0,0 +1,332 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# OPTIONS_GHC -funbox-strict-fields -fobject-code #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+++-- |+-- Module      :  Aftovolio.General.Syllables+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- This module works with syllable segmentation. The generalized version for the module+-- 'Aftovolio.Ukrainian.Syllable' from @ukrainian-phonetics-basic-array@ package.+-- ++module Aftovolio.General.Syllables (+  -- * Data types and type synonyms+  PRS(..)+  , PhoneticType(..)+  , CharPhoneticClassification+  , StringRepresentation+  , SegmentationInfo1(..)+  , SegmentationPredFunction(..)+  , SegmentationPredFData(..)+  , SegmentationFDP+  , Eval2Bool(..)+  , DListFunctionResult+  , SegmentationLineFunction(..)+  , SegmentationRules1(..)+  , SegmentRulesG+  , DListRepresentation(..)+  -- * Basic functions+  , str2PRSs+  , sndGroups+  , groupSnds+  , divCnsnts+  , reSyllableCntnts+  , divSylls+  , createSyllablesPL+  -- * Auxiliary functions+  , gBF4+  , findC+  , createsSyllable+  , isSonorous1+  , isVoicedC1+  , isVoicelessC1+  , notCreatesSyllable2+  , notEqC+  , fromPhoneticType+) where++import GHC.Base+import GHC.List+import qualified Data.List as L (groupBy,find,intercalate,words)+import Aftovolio.General.Base+import CaseBi.Arr+import GHC.Arr+import GHC.Exts+import Data.IntermediateStructures1 (mapI)+import Data.Maybe (mapMaybe,fromJust)+import GHC.Int+import Text.Read (Read(..),readMaybe)+import Text.Show (Show(..))+import Data.Char (isLetter)+import GHC.Num ((-))+import Data.Tuple (fst, snd)+import GHC.Enum (fromEnum)++-- Inspired by: https://github.com/OleksandrZhabenko/mm1/releases/tag/0.2.0.0++-- CAUTION: Please, do not mix with the show7s functions, they are not interoperable.++data PRS = SylS {+  charS :: {-# UNPACK #-} !Char, -- ^ Phonetic languages phenomenon representation. Usually, a phoneme, but it can be otherwise something different.+  phoneType :: {-# UNPACK #-} !PhoneticType -- ^ Some encoded type. For the vowels it has reserved value of 'P' 0, for the sonorous consonants - 'P' 1 and 'P' 2,+  -- for the voiced consonants - 'P' 3 and 'P' 4, for the voiceless consonants - 'P' 5 and 'P' 6. Nevertheless, it is possible to redefine the data by rewriting the+  -- respective parts of the code here.+} deriving ( Eq, Read )++instance Ord PRS where+  compare (SylS x1 y1) (SylS x2 y2) =+    case compare x1 x2 of+      EQ -> compare y1 y2+      ~z -> z++instance Show PRS where+  show (SylS c (P x)) = "SylS \'" `mappend` (c:'\'':' ':show x)++data PhoneticType = P {-# UNPACK #-} !Int8 deriving (Eq, Ord, Read)++instance Show PhoneticType where+  show (P x) = 'P':' ':show x++fromPhoneticType :: PhoneticType -> Int+fromPhoneticType (P x) =  fromEnum x++-- | The 'Array' 'Int' must be sorted in the ascending order to be used in the module correctly.+type CharPhoneticClassification = Array Int PRS++-- | The 'String' of converted phonetic language representation 'Char' data is converted to this type to apply syllable+-- segmentation or other transformations.+type StringRepresentation = [PRS]++-- | Is somewhat rewritten from the 'CaseBi.Arr.gBF3' function (not exported) from the @mmsyn2-array@ package.+gBF4+  :: (Ix i) => (# Int#, PRS #)+  -> (# Int#, PRS #)+  -> Char+  -> Array i PRS+  -> Maybe PRS+gBF4 (# !i#, k #) (# !j#, m #) c arr+ | isTrue# ((j# -# i#) ># 1# ) = +    case compare c (charS p) of+     GT -> gBF4 (# n#, p #) (# j#, m #) c arr+     LT  -> gBF4 (# i#, k #) (# n#, p #) c arr+     _ -> Just p+ | c == charS m = Just m+ | c == charS k = Just k+ | otherwise = Nothing+     where !n# = (i# +# j#) `quotInt#` 2#+           !p = unsafeAt arr (I# n#)++findC+  :: Char+  -> Array Int PRS+  -> Maybe PRS+findC c arr = gBF4 (# i#, k #) (# j#, m #) c arr +     where !(I# i#,I# j#) = bounds arr+           !k = unsafeAt arr (I# i#)+           !m = unsafeAt arr (I# i#)+{-# INLINE findC #-}++str2PRSs :: CharPhoneticClassification -> String -> StringRepresentation+str2PRSs arr = map (\c -> fromJust . findC c $ arr)+{-# INLINE str2PRSs #-}+ +-- | 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 'PRS' format).+-- Usually it is a vowel, but in some languages there can be syllabic phonemes that are not considered to be+-- vowels.+createsSyllable :: PRS -> Bool+createsSyllable = (== P 0) . phoneType+{-# INLINE createsSyllable #-}++-- | Function-predicate 'isSonorous1' checks whether its argument is a sonorous consonant representation in the 'PRS' format.+isSonorous1 :: PRS -> Bool+isSonorous1 =  (`elem` [1,2]) . fromPhoneticType . phoneType+{-# INLINE isSonorous1 #-}++-- | Function-predicate 'isVoicedC1' checks whether its argument is a voiced consonant representation in the 'PRS' format.+isVoicedC1 ::  PRS -> Bool+isVoicedC1 = (`elem` [3,4]) . fromPhoneticType . phoneType+{-# INLINE isVoicedC1 #-}++-- | Function-predicate 'isVoiceless1' checks whether its argument is a voiceless consonant representation in the 'PRS' format.+isVoicelessC1 ::  PRS -> Bool+isVoicelessC1 =  (`elem` [5,6]) . fromPhoneticType . phoneType+{-# INLINE isVoicelessC1 #-} ++-- | Binary function-predicate 'notCreatesSyllable2' checks whether its arguments are both consonant representations in the 'PRS' format.+notCreatesSyllable2 :: PRS -> PRS -> Bool+notCreatesSyllable2 x y+  | phoneType x == P 0 || phoneType y == P 0 = False+  | otherwise = True+{-# INLINE notCreatesSyllable2 #-}++-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).+notEqC+ :: [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> PRS+ -> PRS+ -> Bool+notEqC xs x y+  | (== cy) . getBFstLSorted' cx xs $ cx = False+  | otherwise = cx /= cy+      where !cx = charS x+            !cy = charS y+{-# INLINE notEqC #-}++-- | Function 'sndGroups' converts a word being a list of 'PRS' to the list of phonetically similar (consonants grouped with consonants and each vowel separately)+-- sounds representations in 'PRS' format.+sndGroups :: [PRS] -> [[PRS]]+sndGroups ys@(_:_) = L.groupBy notCreatesSyllable2 ys+sndGroups _ = []+{-# INLINE sndGroups #-}++groupSnds :: [PRS] -> [[PRS]]+groupSnds = L.groupBy (\x y -> createsSyllable x == createsSyllable y)+{-# INLINE groupSnds #-}++data SegmentationInfo1 = SI {+ fieldN :: !Int8,  -- ^ Number of fields in the pattern matching that are needed to apply the segmentation rules. Not less than 1.+ predicateN :: Int8 -- ^ Number of predicates in the definition for the 'fieldN' that are needed to apply the segmentation rules.+} deriving (Eq, Read, Show)++instance PhoneticElement SegmentationInfo1 where+  readPEMaybe rs+    | not . any isLetter $ rs = Nothing+    | otherwise = let (ys:yss) = L.words rs in case ys of+        "SI" -> case yss of+           [xs,ts] -> case (readMaybe xs::Maybe Int8) of+               Just m -> case (readMaybe ts::Maybe Int8) of+                 Just n -> Just (SI m n)+                 _ -> Nothing+               _ -> Nothing+           _ -> Nothing+        _ -> Nothing++-- | We can think of 'SegmentationPredFunction' in terms of @f ('SI' fN pN) ks [x_{1},x_{2},...,x_{i},...,x_{fN}]@. Comparing with+-- 'divCnsnts' from the @ukrainian-phonetics-basics-array@ 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'.+data SegmentationPredFunction = PF (SegmentationInfo1 -> [(Char, Char)] -> [PRS] -> 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) deriving (Eq, Read, Show)++class Eval2Bool a where+  eval2Bool :: a -> Bool++type SegmentationFDP = SegmentationPredFData PRS (Char, Char)++instance Eval2Bool (SegmentationPredFData PRS (Char, Char)) where+  eval2Bool (L i js arr)+    | all (<= n) js && i <= n && i >= 1 && all (>=1) js = fromPhoneticType (phoneType (unsafeAt arr $ i - 1)) `elem` js+    | otherwise = error "Aftovolio.General.Syllables.eval2Bool: 'L' element is not properly defined. "+        where n = numElements arr+  eval2Bool (NEC i j arr ks)+    | i >= 1 && j >= 1 && i /= j && i <= n && j <= n = notEqC ks (unsafeAt arr $ i - 1) (unsafeAt arr $ j - 1)+    | otherwise = error "Aftovolio.General.Syllables.eval2Bool: 'NEC' element is not properly defined. "+        where n = numElements arr+  eval2Bool (C x y) = eval2Bool x && eval2Bool y+  eval2Bool (D x y) = eval2Bool x || eval2Bool y++type DListFunctionResult = ([PRS] -> [PRS],[PRS] -> [PRS])++class DListRepresentation a b where+  toDLR :: b -> [a] -> ([a] -> [a], [a] -> [a])++instance DListRepresentation PRS Int8 where+  toDLR left xs+    | null xs = (id,id)+    | null ts =  (id,(zs `mappend`))+    | null zs = ((`mappend` ts), id)+    | otherwise = ((`mappend` ts), (zs `mappend`))+        where (ts,zs) = splitAt (fromEnum left) xs+           +data SegmentationLineFunction = LFS {+  infoSP :: SegmentationInfo1,+  predF :: SegmentationFDP,  -- ^ The predicate to check the needed rule for segmentation.+  resF :: Int8 -- ^ The result argument to be appended to the left of the group of consonants if the 'predF' returns 'True' for its arguments. Is an argument to the 'toDLR'.+} deriving (Read, Show)++data SegmentationRules1 = SR1 {+  infoS :: SegmentationInfo1, +  lineFs :: [SegmentationLineFunction] -- ^ The list must be sorted in the appropriate order of the guards usage for the predicates.+  -- The length of the list must be equal to the ('fromEnum' . 'predicateN' . 'infoS') value.+} deriving (Read, Show) ++-- | List of the 'SegmentationRules1' sorted in the descending order by the 'fieldN' 'SegmentationInfo1' data and where the+-- length of all the 'SegmentationPredFunction' lists of 'PRS' are equal to the 'fieldN' 'SegmentationInfo1' data by definition.+type SegmentRulesG = [SegmentationRules1]++-- | 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.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+-- The example of the 'divCnsnts' can be found at: https://hackage.haskell.org/package/ukrainian-phonetics-basic-array-0.1.2.0/docs/src/Languages.Phonetic.Ukrainian.Syllable.Arr.html#divCnsnts+divCnsnts+ :: [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> SegmentRulesG+ -> [PRS]+ -> DListFunctionResult+divCnsnts ks gs xs@(_:_) = toDLR left xs+  where !js = fromJust . L.find ((== length xs) . fromEnum . fieldN . infoS) $ gs -- js :: SegmentationRules1+        !left = resF . fromJust . L.find (eval2Bool . predF). lineFs $ js+divCnsnts _ _ [] = (id,id)++reSyllableCntnts+ :: [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. + -> SegmentRulesG+ -> [[PRS]]+ -> [[PRS]]+reSyllableCntnts ks gs (xs:ys:zs:xss)+  | (/= P 0) . phoneType . last $ ys = fst (divCnsnts ks gs ys) xs:reSyllableCntnts ks gs (snd (divCnsnts ks gs ys) zs:xss)+  | otherwise = reSyllableCntnts ks gs ((xs `mappend` ys):zs:xss)+reSyllableCntnts _ _ (xs:ys:_) = [(xs `mappend` ys)]+reSyllableCntnts _ _ xss = xss++divSylls :: [[PRS]] -> [[PRS]]+divSylls = mapI (\ws -> (length . filter createsSyllable $ ws) > 1) h3+  where h3 us = [ys `mappend` take 1 zs] `mappend` (L.groupBy (\x y -> createsSyllable x && phoneType y /= P 0) . drop 1 $ zs)+                  where (ys,zs) = break createsSyllable us++{-| 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.+-}+createSyllablesPL+  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.+  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly. +  -> CharPhoneticClassification+  -> SegmentRulesG+  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Actually the converted 'String'.+  -> [[[PRS]]]+createSyllablesPL wrs ks arr gs us vs = map (divSylls . reSyllableCntnts ks gs . groupSnds . str2PRSs arr) . words1 . mapMaybe g . convertToProperPL . map (\x -> if x == '-' then ' ' else x)+  where g x+          | x `elem` us = Nothing+          | x `notElem` vs = Just x+          | otherwise = Just ' '+        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 (== ' ') xs+                (w, s'') = break (== ' ') ts+        {-# NOINLINE words1 #-}+        convertToProperPL = concatMap string1 . stringToXG wrs+{-# INLINE createSyllablesPL #-}
+ Aftovolio/Halfsplit.hs view
@@ -0,0 +1,113 @@+-- |+-- Module      :  Aftovolio.Halfsplit+-- Copyright   :  (c) OleksandrZhabenko 2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--++{-# LANGUAGE NoImplicitPrelude #-}++{-# OPTIONS_HADDOCK -show-extensions #-}++module Aftovolio.Halfsplit where++import GHC.Base+import GHC.Enum (fromEnum)+import GHC.Real (quot,quotRem)+import GHC.Num ((+),(-),abs)+import Data.List hiding (foldr)+import GHC.Int (Int8)+import Text.Show (Show(..))+import System.IO (putStrLn,getLine,putStr)+import Data.Tuple (fst)++-- | Converts the data that is an instance of 'Show' typeclass to be printed in two-column way.+halfsplit +  :: (Show a, Eq b) +  => (a -> b)+  -> Int8 +  -> [a] +  -> String+halfsplit g = halfsplit1G g "" +{-# INLINE halfsplit #-}++-- | Converts the data that is an instance of 'Show' typeclass to be printed in two-column way with+-- customizable ending of each line.+halfsplit1G +  :: (Show a, Eq b) +  => (a -> b)+  -> String -- ^ Additional 'String' added to every line before the \"\\n\" character.+  -> Int8 +  -> [a] +  -> String+halfsplit1G g appendstr m xs + | null xs = []+ | otherwise = +    let (n, rr2) = quotRem (fromEnum m) (if m < 0 then -10 else 10)+        r = +          case abs rr2 of+           1 -> let us = reverse ts in (if rrr == 0 then map show ys else replicate l0 ' ':map show ys, map show us)+           2 -> let us = (replicate (lt1 - ly1) [replicate l0 ' ']) `mappend` reverse (map reverse y1s) in (mconcat us, mconcat t1s)+           3 -> let us = (replicate (lt1 - ly1) [replicate l0 ' ']) `mappend` y1s+                    ks = reverse . map reverse $ t1s in (mconcat us, mconcat ks)+           4 -> let us = (replicate (lt2 - ly2) [replicate l0 ' ']) `mappend` reverse (map reverse y2s) in (mconcat us, mconcat t2s)+           5 -> let us = (replicate (lt2 - ly2) [replicate l0 ' ']) `mappend` y2s+                    ks = reverse . map reverse $ t2s in (mconcat us, mconcat ks)+           _ -> let us = reverse ys in (if rrr == 0 then map show us else replicate l0 ' ':map show us, map show ts) in ((\(rs, qs) -> mergePartsLine n (appendstr `mappend` "\n") rs qs) r) `mappend` appendstr+              where (ys,ts) = splitAt l xs +                    (l,rrr) = length xs `quotRem` 2+                    l0 = length . show . head $ xs +                    rss = map (map show) . groupBy (\x y ->  g x == g y) $ xs+                    r1ss = intersperse [replicate l0 ' '] rss+                    l2 = (sum . map length $ rss) `quot` 2+                    l3 = (sum . map length $ r1ss) `quot` 2+                    (y1s,t1s,_) = splitGroups l2 rss+                    ly1 = sum . map length $ y1s+                    lt1 = sum . map length $ t1s+                    (y2s,t2s,_) = splitGroups l3 r1ss+                    ly2 = sum . map length $ y2s+                    lt2 = sum . map length $ t2s++-- | A generalized version of 'halfsplit1G' with the possibility to prepend and append strings to it.+halfsplit2G +  :: (Show a, Eq b) +  => (a -> b)+  -> String -- ^ Additional 'String' added to every line before the \"\\n\" character.+  -> String -- ^ A 'String' that is prepended to the 'halfsplit1G' result.+  -> String -- ^ A 'String' that is appended to the 'halfsplit1G' result.+  -> Int8 +  -> [a] +  -> String+halfsplit2G g appendstr prestr poststr m xs = prestr `mappend` halfsplit1G g appendstr m xs `mappend` poststr+{-# INLINABLE halfsplit2G #-}++mergePartsLine :: Int -> String -> [String] -> [String] -> String+mergePartsLine n newlined xs ys = intercalate newlined . zipWith (\x y -> x `mappend` (replicate n (if n < 0 then '\t' else ' ')) `mappend` y) xs $ ys++splitGroups :: Int -> [[a]] -> ([[a]], [[a]], Int)+splitGroups l tss = foldr h ([],[],0) tss+   where h js (rss,mss,k)+            | k <= l = (rss, js:mss, k + length js)+            | otherwise = (js : rss, mss, k + length js)++showWithSpaces :: (Show a) => Int -> a -> String+showWithSpaces n x + | l < n = xs `mappend` replicate (n - l) ' '+ | otherwise = xs+    where xs = show x+          l = length xs++print23 :: String -> String -> Int -> [String] -> IO ()+print23 prestr poststr n xss = do+  putStrLn prestr+  let linez = zip xss [1..]+  if n >= 2 && n <= l - 1+      then do+          let linez3 = (\(x:y:t:xs) -> x:(' ':y):(' ':' ':t):xs) . map fst . filter (\(ts,m) -> m `elem` [n - 1..n + 1]) $ linez+          mapM (putStrLn) linez3 >> putStrLn poststr+      else (case n of+             1 -> putStr " " >> mapM putStrLn (take 2 xss)+             m -> if m == l then mapM putStrLn ((\(x:y:xs) -> x:(' ':y):xs) . drop (l - 2) $ xss) else mapM putStrLn []) >> putStrLn poststr+         where l = length xss+
+ Aftovolio/Partir.hs view
@@ -0,0 +1,83 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Aftovolio.Partir+-- Copyright   :  (c) Oleksandr Zhabenko 2022-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- ++{-# LANGUAGE BangPatterns, FlexibleContexts, MultiParamTypeClasses, NoImplicitPrelude #-}++module Aftovolio.Partir where++import GHC.Base+import GHC.Num+import GHC.Real+import GHC.Float+import qualified Data.Foldable as F+import Data.InsertLeft (InsertLeft(..)) +import Aftovolio.DataG+import Aftovolio.Basis+import Data.Char (isDigit)+import Data.List (uncons, filter, null)+import Data.Maybe (fromJust, fromMaybe)+import Text.Read (readMaybe)++class F.Foldable t => ConstraintsG t a where+  decodeCDouble :: t a -> Double -> Bool++instance ConstraintsG [] Char where+  decodeCDouble xs !y+    | null xxs = True+    | t < '2' = (if t == '0' then (>) else (<)) y (fromIntegral . fromMaybe 1 $ (readMaybe ts :: Maybe Integer))+    | otherwise = getScale c cs t y+       where xxs = filter isDigit xs+             (t,ts) = fromJust . uncons $ xxs+             (c,cs) = fromMaybe ('0',"1") . uncons $ ts+             getScale c0 ws t0 y0  +               | c0 == '1' = (ords t0) (logBase 10 y0) base+               | c0 == '2' = (ords t0) (637.0 * atan y0) base -- atan Infinity * 637.0 \approx 1000.0+               | c0 == '3' = (ords t0) (sin (k * y0)) (0.01 * base1)+               | c0 == '4' = (ords t0) (cos (k * y0)) (0.01 * base1)+               | c0 == '5' = (ords t0) (sin (k * y0)) (0.001 * base2)+               | c0 == '6' = (ords t0) (cos (k * y0)) (0.001 * base2)+               | c0 == '7' = (ords t0) (sin (k * y0)) (-0.01 * base1)+               | c0 == '8' = (ords t0) (cos (k * y0)) (-0.01 * base1)+               | otherwise = (ords t0) (y0 ** k) base1+                  where base = fromIntegral . fromMaybe 1 $ (readMaybe ws :: Maybe Integer)+                        ords t0+                          | t0 == '2' = (>)+                          | otherwise = (<)+                        (w,wws) = fromMaybe ('2',"") . uncons $ ws+                        base1 = fromIntegral . fromMaybe 50 $ (readMaybe wws :: Maybe Integer)+                        base2 = fromIntegral . fromMaybe 500 $ (readMaybe wws :: Maybe Integer)+                        k = fromIntegral . fromMaybe 2 $ (readMaybe [w] :: Maybe Integer)+             +partitioningR+  :: (InsertLeft t2 (Result [] Char b Double), Monoid (t2 (Result [] Char b Double)), InsertLeft t2 Double, Monoid (t2 Double)) => String+  -> t2 (Result [] Char b Double)+  -> (t2 (Result [] Char b Double), t2 (Result [] Char b Double))+partitioningR !xs dataR+ | F.null dataR = (mempty,mempty)+ | otherwise = partiR (decodeCDouble xs) dataR+{-# INLINE partitioningR #-}+{-# SPECIALIZE  partitioningR +  :: String+  -> [Result [] Char Double Double]+  -> ([Result [] Char Double Double], [Result [] Char Double Double])#-}++partitioningR2+  :: (InsertLeft t2 (Result2 a b Double), Monoid (t2 (Result2 a b Double)), InsertLeft t2 Double, Monoid (t2 Double)) => String+  -> t2 (Result2 a b Double)+  -> (t2 (Result2 a b Double), t2 (Result2 a b Double))+partitioningR2 !xs dataR+ | F.null dataR = (mempty,mempty)+ | otherwise = partiR2 (decodeCDouble xs) dataR+{-# INLINE partitioningR2 #-}+{-# SPECIALIZE partitioningR2 :: (Eq a) => String+  -> [Result2 a Double Double]+  -> ([Result2 a Double Double], [Result2 a Double Double]) #-}+
+ Aftovolio/PermutationsArr.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Strict #-}++-- |+-- Module      :  Aftovolio.PermutationsArr+-- Copyright   :  (c) OleksandrZhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Permutations and universal set functions for the phonetic-languages series and phladiprelio of packages+-- (AFTOVolio-related). This module uses no vectors, but instead uses arrays.++module Aftovolio.PermutationsArr (+  universalSetGL+  , genPermutations+  , genPermutationsArr+  , genPermutationsL+  , genPermutationsArrL+) where++import GHC.Enum+import GHC.List+import GHC.Num (Num,(*), (-))+import GHC.Base+import GHC.Arr+import qualified Data.List as L (permutations,product)+import Data.InsertLeft+import qualified Data.Foldable as F (Foldable,concat,foldr',foldl')+import Data.Monoid++-- | A key point of the evaluation -- the universal set of the task represented as a @[[a]]@.+universalSetGL ::+  (Eq a, F.Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) => t a+  -> t (t a)+  -> (t a -> [a]) -- ^ The function that is used internally to convert to the @[a]@ so that the function can process further the permutations+  -> ((t (t a)) -> [[a]]) -- ^ The function that is used internally to convert to the needed representation so that the function can process further+  -> [Array Int Int] -- ^ The list of permutations of 'Int' indices starting from 0 and up to n (n is probably less than 7).+  -> Array Int [a]+  -> [[a]]+universalSetGL ts uss f1 f2 permsL baseArr = map (F.concat . F.foldr' (:) [] . (f1 ts:) . (`mappend` f2 uss) . elems . amap (unsafeAt baseArr)) permsL+{-# INLINE universalSetGL #-}+{-# SPECIALIZE universalSetGL :: String -> [String] -> (String -> String) -> ([String] -> [String]) -> [Array Int Int] -> Array Int String -> [String]   #-}++genPermutations ::  (Ord a, Enum a, Num a) => Int -> Array Int [a]+genPermutations n = listArray (0,L.product [1..(n - 1)]) . L.permutations . take n $ [0..]+{-# INLINE genPermutations #-}+{-# SPECIALIZE genPermutations :: Int  -> Array Int [Int] #-}++genPermutationsArr ::  (Ord a, Enum a, Num a) => Array Int (Array Int [a])+genPermutationsArr = amap genPermutations . listArray (0,5) $ [2..7]+{-# INLINE genPermutationsArr #-}+{-# SPECIALIZE genPermutationsArr :: Array Int (Array Int [Int]) #-}++genPermutationsL ::  (Ord a, Enum a, Num a) => Int -> [Array Int a]+genPermutationsL n = map (\xs -> listArray (0,n - 1) xs) . L.permutations . take n $ [0..]+{-# INLINE genPermutationsL #-}+{-# SPECIALIZE genPermutationsL :: Int  -> [Array Int Int] #-}++genPermutationsArrL ::  (Ord a, Enum a, Num a) => Array Int [Array Int a]+genPermutationsArrL = amap genPermutationsL . listArray (0,5) $ [2..7]+{-# INLINE genPermutationsArrL #-}+{-# SPECIALIZE genPermutationsArrL :: Array Int [Array Int Int] #-}+
+ Aftovolio/PermutationsArrMini.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Strict #-}++-- |+-- Module      :  Aftovolio.PermutationsArrMini+-- Copyright   :  (c) OleksandrZhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Special permutations functions for the phonetic-languages and phladiprelio series of packages. This+-- module uses no vectors, but instead uses arrays.++module Aftovolio.PermutationsArrMini (+  genPairwisePermutations+  , pairsSwapP+  , genPairwisePermutationsArrN+  , genPairwisePermutationsArr+  , genPairwisePermutationsLN+  , genPairwisePermutationsL+  , genPairwisePermutationsArrLN+  , genPairwisePermutationsArrL+) where++import GHC.Enum+import Data.Bits (shiftR)+import GHC.Base+import GHC.Num+import GHC.List+import GHC.Arr++genPairwisePermutations :: (Ord a, Enum a, Num a) => Int -> Array Int [a]+genPairwisePermutations n = listArray (0, shiftR (n*(n-1)) 1) . pairsSwapP . take n $ [0..]+{-# INLINE genPairwisePermutations #-}+{-# SPECIALIZE genPairwisePermutations :: Int -> Array Int [Int] #-}++pairsSwapP :: (Ord a, Enum a, Num a) => [a] -> [[a]]+pairsSwapP xs = xs:[swap2Ls k m xs | k <- xs, m <- xs , k < m]+{-# SPECIALIZE pairsSwapP :: [Int] -> [[Int]] #-}++-- | The first two arguments are considered not equal, though it is not checked.+swap2ns :: (Eq a) => a -> a -> a -> a+swap2ns k m n+ | n /= k = if n /= m then n else k+ | otherwise = m+{-# INLINE swap2ns #-}+{-# SPECIALIZE swap2ns :: Int -> Int -> Int -> Int #-}++swap2Ls :: (Eq a) => a -> a -> [a] -> [a]+swap2Ls k m = map (swap2ns k m)+{-# INLINE swap2Ls #-}+{-# SPECIALIZE swap2Ls :: Int -> Int -> [Int] -> [Int] #-}++genPairwisePermutationsArrN ::  (Ord a, Enum a, Num a) => Int -> Array Int (Array Int [a])+genPairwisePermutationsArrN n = amap genPairwisePermutations . listArray (0,n - 2) $ [2..n]+{-# INLINE genPairwisePermutationsArrN #-}+{-# SPECIALIZE genPairwisePermutationsArrN :: Int -> Array Int (Array Int [Int]) #-}++genPairwisePermutationsArr ::  (Ord a, Enum a, Num a) => Array Int (Array Int [a])+genPairwisePermutationsArr = genPairwisePermutationsArrN 10+{-# INLINE genPairwisePermutationsArr #-}+{-# SPECIALIZE genPairwisePermutationsArr :: Array Int (Array Int [Int]) #-}++genPairwisePermutationsLN ::  (Ord a, Enum a, Num a) => Int -> [Array Int a]+genPairwisePermutationsLN n = map (\xs -> listArray (0,n - 1) xs) . pairsSwapP . take n $ [0..]+{-# INLINE genPairwisePermutationsLN #-}+{-# SPECIALIZE genPairwisePermutationsLN :: Int -> [Array Int Int] #-}++genPairwisePermutationsL ::  (Ord a, Enum a, Num a) => [Array Int a]+genPairwisePermutationsL = genPairwisePermutationsLN 10+{-# INLINE genPairwisePermutationsL #-}+{-# SPECIALIZE genPairwisePermutationsL :: [Array Int Int] #-}++genPairwisePermutationsArrLN ::  (Ord a, Enum a, Num a) => Int -> Array Int [Array Int a]+genPairwisePermutationsArrLN n = amap genPairwisePermutationsLN . listArray (0,n - 2) $ [2..n]+{-# INLINE genPairwisePermutationsArrLN #-}+{-# SPECIALIZE genPairwisePermutationsArrLN :: Int -> Array Int [Array Int Int] #-}++genPairwisePermutationsArrL ::  (Ord a, Enum a, Num a) => Array Int [Array Int a]+genPairwisePermutationsArrL = genPairwisePermutationsArrLN 10+{-# INLINE genPairwisePermutationsArrL #-}+{-# SPECIALIZE genPairwisePermutationsArrL :: Array Int [Array Int Int] #-}+
+ Aftovolio/PermutationsArrMini1.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE Strict #-}++-- |+-- Module      :  Aftovolio.PermutationsArrMini1+-- Copyright   :  (c) OleksandrZhabenko 2022-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Special permutations functions for the phonetic-languages and phladiprelio series of packages. This+-- module uses no vectors, but instead uses arrays.++module Aftovolio.PermutationsArrMini1 (+  genElementaryPermutations1+  , pairsSwapP1+  , genElementaryPermutationsArrN1+  , genElementaryPermutationsArr1+  , genElementaryPermutationsLN1+  , genElementaryPermutationsL1+  , genElementaryPermutationsArrLN1+  , genElementaryPermutationsArrL1+) where++import GHC.Base+import GHC.Arr+import GHC.List+import GHC.Num (Num,(-), (+), abs)+import GHC.Enum++genElementaryPermutations1 :: (Ord a, Enum a, Num a) => Int -> Array Int [a]+genElementaryPermutations1 n = listArray (0,l-1) xs+ where xs = pairsSwapP1 . take n $ [0..]+       l = length xs+{-# INLINE genElementaryPermutations1 #-}+{-# SPECIALIZE genElementaryPermutations1 :: Int -> Array Int [Int] #-}++pairsSwapP1 ::  (Ord a, Num a) => [a] -> [[a]]+pairsSwapP1 xs = xs:[swap2Ls1 k m xs | k <- xs, m <- xs , abs (k - m) > 1] `mappend` [swap2Ls1 k (k - 1) xs | k <- drop 1 xs ]+{-# SPECIALIZE pairsSwapP1 :: [Int] -> [[Int]] #-}++-- | The first two arguments are considered not equal and all three of the arguments are considered greater or equal to 0, though it is not checked.+swap2ns1 ::  (Ord a, Num a) => a -> a -> a -> a+swap2ns1 k n m+ | n > k =+    if+      | m < k -> m+      | m > n -> m+      | m < n -> m + 1+      | otherwise -> k+ | otherwise =+     if+       | m > k -> m+       | m < n -> m+       | m > n -> m - 1+       | otherwise -> k+{-# INLINE swap2ns1 #-}+{-# SPECIALIZE swap2ns1 :: Int -> Int -> Int -> Int #-}++swap2Ls1 ::  (Ord a, Num a) => a -> a -> [a] -> [a]+swap2Ls1 k m = map (swap2ns1 k m)+{-# INLINE swap2Ls1 #-}+{-# SPECIALIZE swap2Ls1 :: Int -> Int -> [Int] -> [Int] #-}++genElementaryPermutationsArrN1 ::  (Ord a, Enum a, Num a) => Int -> Array Int (Array Int [a])+genElementaryPermutationsArrN1 n = amap genElementaryPermutations1 . listArray (0,n - 2) $ [2..n]+{-# INLINE genElementaryPermutationsArrN1 #-}+{-# SPECIALIZE genElementaryPermutationsArrN1 :: Int -> Array Int (Array Int [Int]) #-}++genElementaryPermutationsArr1 ::  (Ord a, Enum a, Num a) => Array Int (Array Int [a])+genElementaryPermutationsArr1 = genElementaryPermutationsArrN1 10+{-# INLINE genElementaryPermutationsArr1 #-}+{-# SPECIALIZE genElementaryPermutationsArr1 :: Array Int (Array Int [Int]) #-}++genElementaryPermutationsLN1 ::  (Ord a, Enum a, Num a) => Int -> [Array Int a]+genElementaryPermutationsLN1 n = map (\xs -> listArray (0,n - 1) xs) . pairsSwapP1 . take n $ [0..]+{-# INLINE genElementaryPermutationsLN1 #-}+{-# SPECIALIZE genElementaryPermutationsLN1 :: Int -> [Array Int Int] #-}++genElementaryPermutationsL1 ::  (Ord a, Enum a, Num a) => [Array Int a]+genElementaryPermutationsL1 = genElementaryPermutationsLN1 10+{-# INLINE genElementaryPermutationsL1 #-}+{-# SPECIALIZE genElementaryPermutationsL1 :: [Array Int Int] #-}++genElementaryPermutationsArrLN1 ::  (Ord a, Enum a, Num a) => Int -> Array Int [Array Int a]+genElementaryPermutationsArrLN1 n = amap genElementaryPermutationsLN1 . listArray (0,n - 2) $ [2..n]+{-# INLINE genElementaryPermutationsArrLN1 #-}+{-# SPECIALIZE genElementaryPermutationsArrLN1 :: Int -> Array Int [Array Int Int] #-}++genElementaryPermutationsArrL1 ::  (Ord a, Enum a, Num a) => Array Int [Array Int a]+genElementaryPermutationsArrL1 = genElementaryPermutationsArrLN1 10+{-# INLINE genElementaryPermutationsArrL1 #-}+{-# SPECIALIZE genElementaryPermutationsArrL1 :: Array Int [Array Int Int] #-}+
+ Aftovolio/PermutationsRepresent.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module      :  Aftovolio.PermutationsRepresent+-- Copyright   :  (c) OleksandrZhabenko 2022-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Permutations data type to mark the needed permutations type from the other modules.++module Aftovolio.PermutationsRepresent (+  PermutationsType(..)+  , bTransform2Perms+) where++import GHC.Base+import Text.Show++data PermutationsType = P Int deriving (Eq, Ord)++instance Show PermutationsType where+  show (P x) = "+p " `mappend` show x++bTransform2Perms :: [String] -> PermutationsType+bTransform2Perms ys+ | ys == ["1"] = P 1+ | ys == ["2"] = P 2+ | otherwise = P 0
+ Aftovolio/RGLPK/General.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Aftovolio.RGLPK.General+-- Copyright   :  (c) Oleksandr Zhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Can be used to calculate the durations of the approximations of the phonemes+-- using some prepared text with its correct (at least mostly) pronunciation.+-- The prepared text is located in the same directory and contains lines -the+-- phonetic language word and its duration in seconds separated with whitespace.+-- The library is intended to use the functionality of the :+-- +-- 1) R programming language https://www.r-project.org/+-- +-- 2) Rglpk library https://cran.r-project.org/web/packages/Rglpk/index.html+-- +-- 3) GNU GLPK library https://www.gnu.org/software/glpk/glpk.html+-- +-- For more information, please, see the documentation for them.+-- +-- For the model correctness the js here refers to sorted list of the 'Char' representations of the phonetic language phenomenae.+-- +-- The length of the 'String' js is refered to as 'lng'::'Int'. The number of 'pairs'' function elements in the lists is refered to+-- as 'nn'::'Int'. The number of constraints is refered here as 'nc'::'Int'. @nc == nn `quot` 2@.+-- +-- Is generalized from the Numeric.Wrapper.R.GLPK.Phonetics.Ukrainian.Durations module from+-- the @r-glpk-phonetic-languages-ukrainian-durations@ package.++module Aftovolio.RGLPK.General where++import GHC.Base+import Text.Read+import Data.Maybe+import CaseBi.Arr (getBFstL')+import Data.Foldable (foldl')+import GHC.Arr+import Numeric+import Data.List+import GHC.Num ((+),(-),(*),abs)+import Data.Bits (shiftR)+import Data.Lists.FLines (newLineEnding)+import Text.Show (Show(..))++createCoeffsObj :: Int -> [String] -> [Double]+createCoeffsObj l xss+  | length xss < l = f xss  `mappend` replicate (l - length xss) 1.0 +  | otherwise = f (take l xss)+      where f = map (\ts -> fromMaybe 1.0 (readMaybe ts::Maybe Double))++countCharInWords :: [String] -> Char -> [Int]+countCharInWords xss x+  | null xss = []+  | otherwise = map (length . filter (== x)) xss++matrix1Column :: PairwiseC -> [String] -> String -> Char -> [Int]+matrix1Column pw xss js x = pairwiseComparings x pw . mconcat $ [countCharInWords xss x, rs, rs]+  where l =  length js+        iX = fromMaybe (-l - 1) . elemIndex x $ js+        rs = if iX < 0 then [] else replicate iX 0 `mappend` (1:replicate (l - 1 - iX) 0)++pairwiseComparings :: Char -> PairwiseC -> [Int] -> [Int]+pairwiseComparings x y zs = zs `mappend` pairs' y x++-- | A way to encode the pairs of the phonetic language representations that give some additional associations, connections+-- between elements, usually being caused by some similarity or commonality of the pronunciation act for the phenomenae+-- corresponding to these elements. +-- All ['Int'] must be equal in 'length' throughout the same namespace and this length is given as 'Int' argument in+-- the 'PairwisePL'. This 'Int' parameter is @nn@.+data PairwisePL = PW Char Int [Int] deriving (Eq, Read, Show)++lengthPW :: PairwisePL -> Int+lengthPW (PW _ l _) = l++charPW :: PairwisePL -> Char+charPW (PW c _ _) = c++listPW :: PairwisePL -> [Int]+listPW (PW _ _ xs) = xs++data PairwiseC = LL [PairwisePL] Int deriving (Eq, Read, Show)++isCorrectPWC :: PairwiseC -> Bool+isCorrectPWC (LL xs n) = n == minimum (map lengthPW xs)++pwsC :: PairwiseC -> [PairwisePL]+pwsC (LL xs n) = map (\(PW c m ys) -> PW c n . take n $ ys) xs++pairs' :: PairwiseC -> Char -> [Int]+pairs' y@(LL xs n) x+ | isCorrectPWC y = let z = find ((== x) . charPW) . pwsC $ y in+     if isJust z then listPW . fromJust $ z+     else replicate n 0+ | otherwise = error "Aftovolio.RGLPK.General.pairs': Not defined for the arguments. "++-- | Actually @n@ is a 'length' bss.+matrixLine+  :: Int -- ^ The number of 'pairs'' function elements in the lists.+  -> PairwiseC -- ^ Actually the data type value that sets the behaviour of the 'pairs'' function.+  -> [String]+  -> String -- ^ A sorted list of the 'Char' representations of the phonetic language phenomenae.+  -> String+matrixLine nn pw bss js+  | null bss || n <=0 = []+  | otherwise = mconcat ["mat1 <- matrix(c(", intercalate ", " . map show . concatMap +      (matrix1Column pw (bss  `mappend`  bss) js) $ js, "), nrow = ", show (2 * n + 2 * length js + nn), ")", newLineEnding]+         where n = length bss++objLine+ :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+ -- appears in the file with test words and their spoken durations.+ -> [(Int,Int)] -- ^ List of pairs of indices that shows how the input data is related to the representation+  -- (which coefficients relates to which representation elements).+ -> Array Int Double -- ^ An array of coefficients.+ -> String+objLine lng xs arr+ | numElements arr >= lng = mconcat ["obj1 <- c(", intercalate ", " . map (\t -> showFFloat Nothing t "") . objCoeffsNew lng xs $ arr,+      ")", newLineEnding]+ | otherwise = error "Aftovolio.RGLPK.General.objLine: Not defined for the short argument. "++-- | A way to reorder the coefficients of the input and the elements representations related to each other.+objCoeffsNew+  :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+  -- appears in the file with test words and their spoken durations.+  -> [(Int, Int)] -- ^ List of pairs of indices that shows how the input data is related to the representation+  -- (which coefficients relates to which representation elements).+  -> Array Int Double -- ^ An array of coefficients.+  -> [Double]+objCoeffsNew lng xs arr = let lst = map (\(x,y) -> (x,unsafeAt arr y)) xs in map (getBFstL' 1.0 lst) [0..lng - 1]++maxLine :: String+maxLine = "max1 <- TRUE\n"++dirLine+ :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+ -- appears in the file with test words and their spoken durations.+ -> Int -- ^ The number of 'pairs'' function elements in the lists.+ -> [String] -- ^ An argument of the 'matrixLine' function.+ -> String -- ^ A sorted list of the 'Char' representations of the phonetic language phenomenae.+ -> String+dirLine lng nn bss js = mconcat ["dir1 <- c(\"<",  g "<" bss,  "\", \">",  g ">" (bss,  map (:[]) js),  "\"",  h0 lng,+ h (shiftR nn 1), ")", newLineEnding]+  where g xs ys = (intercalate ("\", \""  `mappend`  xs) . replicate (length ys) $ "=")+        h n = concat . replicate n $ ", \">=\", \"<=\""+        h0 n = concat . replicate n $ ", \"<=\""++rhsLineG :: [Double] -> [Double] -> [Double] -> String+rhsLineG zs xs ys = mconcat ["rhs1 <- c(" ,  f (mconcat [xs ,  ys ,  zs]) ,  ")", newLineEnding]+  where f ts = (intercalate ", " . map (\t -> showFFloat Nothing t "") $ ts)++rhsLine+ :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+ -- appears in the file with test words and their spoken durations.+ -> Int -- ^ The number of 'pairs'' function elements in the lists.+ -> Double -- ^ Maximum duration of the phonetic language element representation in seconds.+ -> Double -- ^ A minimum positive duration value for some group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.+ -> Double -- ^ A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.+ -> Double -- ^ A minimum positive duration value for all other phonetic language representations (usually, some sorts of+  -- phonemes) to set a general (common) behaviour for the set of resulting values.+ -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the some group of representations (e. g. vowels). + -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the special group of representations (e. g. soft sign).  + -> [Double]+ -> [Double]+ -> String+rhsLine lng nn mx mn1 mnSpecial mnG xs1 sps1 = rhsLineG . mconcat $ [minDurations lng mn1 mnSpecial mnG xs1 sps1,  maxDurations lng mx,  constraintsR1 (shiftR nn 1)]++constraintsR1 :: Int -> [Double]+constraintsR1 n = replicate (2 * n) 0.0++minDurations+  :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+ -- appears in the file with test words and their spoken durations.+  -> Double -- ^ A minimum positive duration value for some group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.+  -> Double -- ^ A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.+  -> Double -- ^ A minimum positive duration value for all other phonetic language representations (usually, some sorts of+  -- phonemes) to set a general (common) behaviour for the set of resulting values.+  -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the some group of representations (e. g. vowels). +  -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the special group of representations (e. g. soft sign). +  -> [Double]+minDurations lng mn1 mnSpecial mnG xs1 sps1 = map h [0..lng - 1]+  where xs2+         | maximum xs1 <= lng - 1 = filter (>= 0) xs1+         | otherwise = error "Aftovolio.RGLPK.General.objLine: Not defined for these arguments. "+        sps2+         | maximum sps1 <= lng - 1 = filter (>= 0) sps1 \\ xs2+         | otherwise = error "Aftovolio.RGLPK.General.objLine: Not defined for these arguments. "+        h i+         | i `elem` xs2 = mn1+         | i `elem` sps2 = mnSpecial+         | otherwise = mnG++maxDurations+ :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+ -- appears in the file with test words and their spoken durations.+ -> Double -- ^ Maximum duration of the phonetic language element representation in seconds.+ -> [Double]+maxDurations lng mx = replicate lng mx++-- | A variant of the more general 'answer2' where the predefined randomization parameters are used to produce every time being run+-- a new result (e. g. this allows to model accents).+answer+ :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+ -- appears in the file with test words and their spoken durations.+ -> Int -- ^ The number of 'pairs'' function elements in the lists.+ -> PairwiseC -- ^ Actually the data type value that sets the behaviour of the 'pairs'' function.+ -> Double -- ^ Maximum duration of the phonetic language element representation in seconds.+ -> [(Int, Int)] -- ^ List of pairs of indices that shows how the input data is related to the representation+  -- (which coefficients relates to which representation elements).+ -> Double -- ^ A minimum positive duration value for some group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.+ -> Double -- ^ A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.+ -> Double -- ^ A minimum positive duration value for all other phonetic language representations (usually, some sorts of+  -- phonemes) to set a general (common) behaviour for the set of resulting values.+ -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the some group of representations (e. g. vowels). + -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the special group of representations (e. g. soft sign). + -> Array Int Double -- ^ An array of coefficients.+ -> [String] -- ^ An argument of the 'matrixLine' function.+ -> [Double]+ -> [Double]+ -> String -- ^ A sorted list of the 'Char' representations of the phonetic language phenomenae.+ -> String+answer lng nn pw mx ts = answer2 lng nn pw mx ts (-0.003) 0.003 (-0.0012) 0.0012++answer2+  :: Int -- ^ The length of the 'String' js that is a sorted list of the phonetic language representations as 'Char's that+  -- appears in the file with test words and their spoken durations.+  -> Int -- ^ The number of 'pairs'' function elements in the lists.+  -> PairwiseC -- ^ Actually the data type value that sets the behaviour of the 'pairs'' function.+  -> Double -- ^ Maximum duration of the phonetic language element representation in seconds.+  -> [(Int, Int)] -- ^ List of pairs of indices that shows how the input data is related to the representation+  -- (which coefficients relates to which representation elements).+  -> Double -- ^ A maximum in absolute value (being, usually, a negative one) possible random deviation from the computed value to be additionally applied to emulate+  -- 'more natural' behaviour and to get every time while running new sets of values. +  -> Double -- ^ A maximum in absolute value (being, usually, a positive one) possible random deviation from the computed value to be additionally applied to emulate+  -- 'more natural' behaviour and to get every time while running new sets of values. +  -> Double -- ^ A minimum in absolute value (being, usually, a negative one) possible random deviation from the computed value to be+  -- additionally applied to emulate 'more natural' behaviour and to get every time while running new sets of values. +  -> Double -- ^ A minimum in absolute value (being, usually, a positive one) possible random deviation from the computed value to be+  -- additionally applied to emulate 'more natural' behaviour and to get every time while running new sets of values. +  -> Double -- ^ A minimum positive duration value for some group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. vowels) to set some peculiar behaviour for the set of resulting values.+  -> Double -- ^ A minimum positive duration value for some *special* group of phonetic language representation (usually, some sorts of+  -- phonemes, e. g. soft sign representation) to set some peculiar behaviour for the set of resulting values.+  -> Double -- ^ A minimum positive duration value for all other phonetic language representations (usually, some sorts of+  -- phonemes) to set a general (common) behaviour for the set of resulting values.+  -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the some group of representations (e. g. vowels). +  -> [Int] -- ^ A list of indices of the phonetic languages representations in their sorted in ascending order sequence that+  -- corresponds to the elements from the special group of representations (e. g. soft sign). +  -> Array Int Double -- ^ An array of coefficients.+  -> [String] -- ^ An argument of the 'matrixLine' function.+  -> [Double]+  -> [Double]+  -> String -- ^ A sorted list of the 'Char' representations of the phonetic language phenomenae.+  -> String+answer2 lng nn pw mx ts min1 max1 min2 max2 mn1 mnSpecial mnG xs1 sps1 lsts bss xs ys js = mconcat ["library(\"Rglpk\")",newLineEnding,objLine lng ts lsts,+ matrixLine nn pw bss js,dirLine lng nn bss js, rhsLine lng nn mx mn1 mnSpecial mnG xs1 sps1 xs ys,maxLine,newLineEnding,+  "k <- Rglpk_solve_LP(obj = obj1, mat = mat1, dir = dir1, rhs = rhs1, max = max1)",newLineEnding, "y <- runif(",show lng,+   ", min = ", showFFloat Nothing (-(abs min1)) ", max = ", showFFloat Nothing (abs max1) ")", newLineEnding,+   "if (k$status == 0){k$solution / mean(k$solution)} else {c()}", newLineEnding, "\")}"]++-- read ("SylS {charS=\'k\', phoneType=P 6")::PRS++
+ Aftovolio/StrictVG.hs view
@@ -0,0 +1,59 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Aftovolio.StrictVG+-- Copyright   :  (c) Oleksandr Zhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Simplified version of the @phonetic-languages-common@ package.+-- Uses less dependencies.++{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}++module Aftovolio.StrictVG (+  -- * Working with lists+  uniquenessVariants2GNBL+  , uniquenessVariants2GNPBL+) where++import GHC.Base+import GHC.Num ((-))+import Aftovolio.PermutationsArr+import qualified Data.Foldable as F+import Data.InsertLeft (InsertLeft(..)) +import GHC.Arr++uniquenessVariants2GNBL ::+  (Eq a, F.Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) => a -- ^ The first most common element in the \"whitespace symbols\" structure+  -> (t a -> [a]) -- ^ The function that is used internally to convert to the @[a]@ so that the function can process further the permutations+  -> ((t (t a)) -> [[a]]) -- ^ The function that is used internally to convert to the @[[a]]@ so that the function can process further+  -> ([a] -> t a) -- ^ The function that is used internally to convert to the needed representation so that the function can process further+  -> [Array Int Int] -- ^ The permutations of 'Int' indices starting from 0 and up to n (n is probably less than 8).+  -> t (t a) -- ^ Must be obtained as 'subG' @whspss xs@ or in equivalent way+  -> [t a]+uniquenessVariants2GNBL !hd f1 f2 f3 perms !subs = uniquenessVariants2GNPBL mempty mempty hd f1 f2 f3 perms subs+{-# INLINE uniquenessVariants2GNBL #-}+{-# SPECIALIZE uniquenessVariants2GNBL :: Char -> (String -> String) -> ([String] -> [String]) -> (String -> String) -> [Array Int Int] ->  [String] -> [String] #-}++uniquenessVariants2GNPBL ::+  (Eq a, F.Foldable t, InsertLeft t a, Monoid (t a), Monoid (t (t a))) => t a+  -> t a+  ->  a -- ^ The first most common element in the whitespace symbols structure+  -> (t a -> [a]) -- ^ The function that is used internally to convert to the @[a]@ so that the function can process further the permutations+  -> ((t (t a)) -> [[a]]) -- ^ The function that is used internally to convert to the @[[a]]@ so that the function can process further+  -> ([a] -> t a) -- ^ The function that is used internally to convert to the needed representation that the function can process further+  -> [Array Int Int] -- ^ The permutations of 'Int' indices starting from 0 and up to n (n is probably less than 8).+  -> t (t a) -- ^ Must be obtained as @subG whspss xs@ or in equivalent way+  -> [t a]+uniquenessVariants2GNPBL !ts !us !hd f1 f2 f3 perms !subs+  | F.null subs = mempty+  | otherwise = map f3 ns+   where !uss = (hd %@ us) %^ mempty+         !base0 = map (hd %@) . f2 $ subs+         !l = F.length base0+         !baseArr = listArray (0,l - 1) base0+         !ns = universalSetGL ts uss f1 f2 perms baseArr -- in map f3 ns+{-# INLINE uniquenessVariants2GNPBL #-}+{-# SPECIALIZE uniquenessVariants2GNPBL :: String -> String -> Char -> (String -> String) -> ([String] -> [String]) -> (String -> String) -> [Array Int Int] ->  [String] -> [String] #-}
+ Aftovolio/Tests.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Aftovolio.Tests where++import GHC.Base+import GHC.Int (Int8)+import GHC.Enum (toEnum)+import GHC.Real (quot,rem)+import GHC.Num ((+),(-),(*))+import GHC.List (elem)++sel :: Int -> [[Int8]]+sel x +   | x == 1 || x < 0 || x > 179 = []+   | x == 0 || x == 4 = [[1],[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]]  -- all cases are present: 2, 3, 4, 5, 6, 7. Therefore, the slowest ones.+   | x == 2 || x == 5 = [[1],[2],[3],[4,3],[5,4],[6,5,4]]+   | x == 7 = [[0],[1,0],[1,0],[1,0],[1,0],[1,0]]+   | x == 8 = [[0],[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]]+   | x == 9 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]]+------------------------------------------------------------------+   | x >= 20 && x <= 26 && x /= 21 = [[1]]  -- at least 7 is omitted, but probably 6, or even 5, or even 4, or even 3. 2 is however present.+   | x >= 27 && x <= 29 = [[0]]+   | x == 30 || x == 34 = [[1],[2,1]]+   | x == 32 || x == 35 = [[1],[2]]+   | x >= 37 && x <= 39 = [[0],[1,0]]+   | x == 40 || x == 44 = [[1],[2,1],[3,2]]+   | x == 42 || x == 45 = [[1],[2],[3]]+   | x >= 47 && x <= 49 = [[0],[1,0],[1,0]]+   | x == 50 || x == 54 = [[1],[2,1],[3,2],[4,3,2]]+   | x == 52 || x == 55 = [[1],[2],[3],[4,3]]+   | x == 57 = [[0],[1,0],[1,0],[1,0]]+   | x == 58 || x == 59 = [[0],[1,0],[1,0],[2,1,0]]+   | x == 60 || x == 64 = [[1],[2,1],[3,2],[4,3,2],[5,4,3]]+   | x == 62 || x == 65 = [[1],[2],[3],[4,3],[5,4]]+   | x == 67 = [[0],[1,0],[1,0],[1,0],[1,0]]+   | x == 68 = [[0],[1,0],[1,0],[2,1,0],[2,1,0]]+   | x == 69 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0]]+------------------------------------------------------+   | x == 70 || x == 74 = [[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]]  -- at least 2 is omitted, but probably 3 and even 4. 5, 6 and 7 are present.+   | x == 72 || x == 75 = [[2],[3],[4,3],[5,4],[6,5,4]]+   | x == 77 = [[1,0],[1,0],[1,0],[1,0],[1,0]]+   | x == 78 = [[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]]+   | x == 79 = [[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]]+   | x == 80 || x == 84 = [[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]]+   | x == 82 || x == 85 = [[3],[4,3],[5,4],[6,5,4]]+   | x == 87 = [[1,0],[1,0],[1,0],[1,0]]+   | x == 88 = [[1,0],[2,1,0],[2,1,0],[2,1,0]]+   | x == 89 = [[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]]+   | x == 90 || x == 94 = [[4,3,2],[5,4,3],[6,5,4,3,2]]+   | x == 92 || x == 95 = [[4,3],[5,4],[6,5,4]]+   | x == 97 = [[1,0],[1,0],[1,0]]+   | x == 98 = [[2,1,0],[2,1,0],[2,1,0]]+   | x == 99 = [[2,1,0],[3,2,1,0],[3,2,1,0]]+------------------------------------------------------------------------+   | x == 100 || x == 104 = [[1],[2,1],[4,3,2],[6,5,4,3,2]]  -- 4 and 6 are omitted, just present the ones from: 2, 3, 5, 7.+   | x == 102 || x == 105 = [[1],[2],[4,3],[6,5,4]]+   | x == 107 = [[0],[1,0],[1,0],[1,0]]+   | x == 108 = [[0],[1,0],[2,1,0],[2,1,0]]+   | x == 109 = [[0],[1,0],[2,1,0],[3,2,1,0]]+------------------------------------------------------------------+   | x == 150 || x == 154 = [[1],[2,1],[4,3,2]]  -- 4, 6, 7 are omitted but 2, 3, 5 are present.+   | x == 152 || x == 155 = [[1],[2],[4,3]]+   | x == 157 = [[0],[1,0],[1,0]]+   | x == 158 || x == 159 = [[0],[1,0],[2,1,0]]+------------------------------------------------------+   | x == 170 || x == 174 = [[2,1],[4,3,2],[6,5,4,3,2]]  -- just 3, 5 and 7 are present+   | x == 172 || x == 175 = [[2],[4,3],[6,5,4]]+   | x == 177 = [[1,0],[1,0],[1,0]]+   | x == 178 = [[1,0],[2,1,0],[2,1,0]]+   | x == 179 = [[1,0],[2,1,0],[3,2,1,0]]+----------------------------------------------------------------------- +   | otherwise = [[1],[1],[2,1],[3,2,1],[3,2],[4,3,2]]+--------------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------------++sel2 :: Int -> [Int8]+sel2 y +   | y == 1 || y < 0 || y > 179 = []+   | (rem y 10 `elem` [1,3,6]) || y >= 0 && y <= 9 = [2..7]+   | y >= 20 && y <= 69 = [2..toEnum (y `quot` 10)]+   | y >= 70 && y <= 99 = [toEnum (y `quot` 10) - 4..7]+   | y >= 100 && y <= 109 = [2,3,5,7]+   | y >= 150 && y <= 159 = [2,3,5]+   | y >= 170 && y <= 179 = [3,5,7]+   | otherwise = [2..7]++minMax11ByCList :: Ord a => (a -> a -> Ordering) -> [a] -> (a, a) -- Is rewritten from the 'Data.MinMax.Preconditions.minMax11ByC' from @subG@ package.+minMax11ByCList g xs@(x:y:ys) = foldr f (if x > y then (y, x) else (x, y)) ys+    where f z (x,y)+             | g z x == LT = (z,y)+             | g z y == GT = (x,z)+             | otherwise = (x,y)+minMax11ByCList _ _ = undefined -- Is not intended to be used for lists with less than two elements.++
+ Aftovolio/Ukrainian/Common2.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}++-- |+-- Module      :  Aftovolio.Ukrainian.Common2+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2023+-- License     :  MIT+-- Maintainer  :  oleksandr.zhabenko@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 Aftovolio.Ukrainian.Common2 where++import GHC.Base+import GHC.List (zip, repeat)+import CaseBi.Arr+import GHC.Arr (Array(..))+import Text.Show (Show(..))++{-+-- 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++isUkrainianLTup :: Array Int (Char, Bool) -> Char -> Bool+isUkrainianLTup !tup15 y+               | (y >= '\1070' && y <= '\1097') = True+               | otherwise = getBFst' (False, tup15) 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))++isConsNotJTup :: Array Int (Char,Bool) -> Char -> Bool+isConsNotJTup !tup16 = getBFst' (False, tup16)
+ Aftovolio/Ukrainian/IO.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables, DeriveGeneric #-}++module Aftovolio.Ukrainian.IO where++import GHC.Arr+import GHC.Base +import GHC.Word+import GHC.Num (Num(..),Integer,(+),(-),(*))+import GHC.Real (Integral(..),fromIntegral,(/),rem,quotRem,round,(^))+import GHC.Generics+import GHC.Enum (fromEnum)+import Text.Show (Show(..))+import Text.Read (readMaybe)+import Data.Ord (Down(..)) +import Data.Char (isDigit,toLower,isSpace)+import System.IO (putStrLn, FilePath,stdout,hSetNewlineMode,universalNewlineMode,getLine,appendFile,writeFile,putStr,readFile)+import qualified Rhythmicity.MarkerSeqs as R --hiding (id)+import Data.List hiding (foldr)+import Data.Foldable (mapM_)+import Data.Maybe (isNothing,fromJust,fromMaybe) +import Data.Tuple (fst,snd)+import Aftovolio.Ukrainian.Syllable +import Aftovolio.Ukrainian.SyllableWord8+import Aftovolio.Ukrainian.Melodics +import GHC.Int (Int8)+import CaseBi.Arr (getBFst')+import Aftovolio.Ukrainian.ReadDurations+import Data.Ord (comparing)+import Numeric (showFFloat)+import Aftovolio.Halfsplit+import System.Directory (readable,writable,getPermissions,Permissions(..),doesFileExist,getCurrentDirectory)+import Data.ReversedScientific+import Control.Concurrent.Async (mapConcurrently)+import Aftovolio.Tests+import Data.MinMax1 +import Aftovolio.General.Datatype3 +import Aftovolio.General.Distance+import Aftovolio.UniquenessPeriodsG+import Control.Exception+import Control.DeepSeq  ++generalF+ :: Int -- ^ A power of 10. The distance value is quoted by 10 in this power if the next ['Word8'] argument is not empty. The default one is 0. The right values are in the range [0..4].+ -> Int -- ^ A 'length' of the next argument here.+ -> [Word8] -- ^ A list of non-negative values normed by 255 (the greatest of which is 255) that the line options are compared with. If null, then the program works as for version 0.12.1.0 without this newly-introduced argument since the version 0.13.0.0. The length of it must be a least common multiplier of the (number of syllables plus number of \'_digits\' groups) to work correctly. Is not used when the next 'FilePath' and 'String' arguments are not null.+ -> Bool -- ^ If 'True' then adds \"<br>\" to line endings for double column output+ -> FilePath -- ^ A path to the file to save double columns output to. If empty then just prints to 'stdout'.+ -> String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types'+ -> (String, String)  -- ^ If the next element is not equal to -1, then the prepending and appending lines to be displayed. Used basically for working with the multiline textual input data.+ -> Int -- ^ The number of the line in the file to be read the lines from. If equal to -1 then neither reading from the file is done nor the first argument influences the processment results.+ -> FilePath -- ^ The file to read the sound representation durations from.+ -> Int + -> R.HashCorrections + -> (Int8,[Int8]) + -> Int + -> Bool + -> Int + -> Bool + -> Int8 + -> (FilePath, Int) + -> Bool  -- ^ Whether to run tests concurrently or not. 'True' corresponds to concurrent execution that can speed up the getting results but use more resources.+ -> String -- ^ An initial string to be analysed.+ -> [String] + -> IO [String]+generalF power10 ldc compards html dcfile selStr (prestr, poststr) lineNmb file numTest hc (grps,mxms) k descending hashStep emptyline splitting (fs,code) concurrently initstr universalSet@(_:_:_) = do+   syllableDurationsDs <- readSyllableDurations file+   let syllN = countSyll initstr+       f ldc compards syllableDurationsDs grps mxms -- Since the version 0.12.0.0, has a possibility to evaluate diversity property.+            | null selStr = (if null compards then (sum . R.countHashes2G hashStep hc grps mxms) else ((`quot` 10^power10) . fromIntegral . sumAbsDistNorm compards)) . read3 (not . null . filter (not . isSpace)) 1.0 (mconcat . (if null file then case k of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 -> syllableDurationsD3; 4 -> syllableDurationsD4} +                         else  if length syllableDurationsDs >= k then syllableDurationsDs !! (k - 1) else syllableDurationsD2) . createSyllablesUkrS) +            | otherwise = fromIntegral . diverse2GGL (selectSounds selStr) [100,101] . convertToProperUkrainianI8 . filter (\c -> not (isDigit c) && c /= '_' && c/= '=')+   hSetNewlineMode stdout universalNewlineMode+   if numTest >= 0 && numTest <= 179 && numTest /= 1 && null compards then testsOutput concurrently syllN f ldc syllableDurationsDs numTest universalSet+   else let sRepresent = zipWith (\k (x, ys) -> S k x ys) [1..] . +                   (if descending then sortOn (\(u,w) -> (Down u, w)) else sortOn id) . map (\xss -> (f ldc compards syllableDurationsDs grps mxms xss, xss)) $ universalSet+            strOutput = force . (:[]) . halfsplit1G (\(S _ y _) -> y) (if html then "<br>" else "") (jjj splitting) $ sRepresent+                        in do+                             let lns1 = unlines strOutput+                             putStrLn lns1+                             if null dcfile then putStr "" +                                            else do +                                                exist <- doesFileExist dcfile +                                                if exist then do +                                                             perms <- getPermissions dcfile +                                                             if writable perms then writeFile dcfile lns1 +                                                                               else error $ "Aftovolio.Ukrainian.IO.generalF: File " `mappend` dcfile `mappend` " is not writable!"+                                                         else do +                                                             currdir <- getCurrentDirectory+                                                             perms <- getPermissions currdir+                                                             if writable perms then writeFile dcfile lns1 +                                                                               else error $ "Aftovolio.Ukrainian.IO.generalF: Directory of the file " `mappend` dcfile `mappend` " is not writable!"+                             let l1 = length sRepresent+                             if code == -1 +                                 then if lineNmb == -1 then return strOutput+                                      else do +                                          print23 prestr poststr 1 [initstr]+                                          return strOutput+                                 else do +                                       print23 prestr poststr 1 [initstr]+                                       parseLineNumber l1 >>= \num -> do+                                         permiss <- getPermissions fs+                                         let writ = writable permiss+                                             readab = readable permiss+                                         if writ && readab then outputWithFile selStr compards sRepresent file syllableDurationsDs code grps k fs num +                                         else error "Aftovolio.Ukrainian.IO.generalF: The specified file cannot be used for appending the text! Please, specify another file!"+                                         return []+          where jjj kk = let (q1,r1) = quotRem kk (if kk < 0 then -10 else 10) in jjj' q1 r1 emptyline+                jjj' q1 r1 emptyline+                  | r1 == (-1) || r1 == (-3) = -10*q1 + (if emptyline then -5 else r1)+                  | r1 == 1 || r1 == 3 = 10*q1 + (if emptyline then 5 else r1)+                  | r1 < 0 = -10*q1 + (if emptyline then -4 else r1)+                  | otherwise = 10*q1 + (if emptyline then 4 else r1)+generalF _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ [u1] = do+      putStrLn u1+      return [u1]+generalF _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ = let strOutput = ["You have specified the data and constraints on it that lead to no further possible options.", "Please, specify another data and constraints."] in do +    putStrLn . unlines $ strOutput+    return strOutput++data AftovolioUkr = S Int Integer String deriving (Eq, Generic)++instance NFData AftovolioUkr++instance Show AftovolioUkr where+  show (S i j xs) = showBignum 7 j `mappend` " " `mappend` xs `mappend` "  " `mappend` showWithSpaces 4 i++countSyll :: String -> Int+countSyll xs = numUnderscoresSyll + (fromEnum . foldr (\x y -> if isVowel1 x then y + 1 else y) 0 . convertToProperUkrainianI8 $ xs)+  where numUnderscoresSyll = length . filter (\xs -> let (ys,ts) = splitAt 1 xs in ys == "_" && all isDigit ts && not (null ts)) . groupBy (\x y -> x=='_' && isDigit y) $ xs++stat1 :: Int -> (Int8,[Int8]) -> Int+stat1 n (k, ks) = fst (n `quotRemInt` fromEnum k) * length ks++parseHelp :: [String] -> (String,[String])+parseHelp xss +  | null xss = ([],[])+  | otherwise = (unwords rss, uss `mappend` qss)+       where (yss,tss) = break (== "-b") xss+             (uss,wss) = break (== "+b") yss+             [qss,rss] = map (drop 1) [tss, wss]+             +outputSel :: AftovolioUkr -> Int -> String+outputSel (S x1 y1 ts) code+  | code < 0 = []+  | code == 1 || code == 11 || code == 16 = intercalate " " [show x1, ts] `mappend` "\n"+  | code == 2 || code == 12 || code == 17 = intercalate " " [show y1, ts] `mappend` "\n"+  | code == 3 || code == 13 || code == 18 = intercalate " " [show x1, ts, show y1] `mappend` "\n"+  | code == 4 || code == 14 || code == 19 = intercalate " " [show x1, show y1] `mappend` "\n"+  | otherwise = ts `mappend` "\n"++parseLineNumber :: Int -> IO Int+parseLineNumber l1 = do +  putStrLn "Please, specify the number of the option to be written to the file specified: "+  number <- getLine+  let num = readMaybe (filter isDigit number)::Maybe Int+  if isNothing num || num > Just l1 || num == Just 0 +      then parseLineNumber l1 +      else return . fromJust $ num++{-| 'selectSounds' converts the argument after \"+ul\" command line argument into a list of  Ukrainian sound representations that is used for evaluation of \'uniqueness periods\' properties of the line. Is a modified Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2.parsey0Choice from the @phonetic-languages-simplified-examples-array-0.21.0.0@ package. +-}+selectSounds :: String -> FlowSound+selectSounds = f . sortOn id . filter (/= 101) . concatMap g . words . map (\c -> if c  == '.' then ' ' else toLower c)+    where g = getBFst' ([101::Sound8], listArray (0,41) (("1",[1,2,3,4,5,6,7,8,10,15,17,19,21,23,25,27,28,30,32,34,36,38,39,41,43,45,47,49,50,52,54,66]):("sr",[27,28,30,32,34,36]):("vd",[8,10,15,17,19,21,23,25]) :("vs",[45,47,49,50,43,52,38,66,54,39,41]) :("vw",[1..6]) :map (\(k,t) -> (k,[t])) [("\1072",1),("\1073",15),("\1074",36),("\1075",21),("\1076",17),("\1076\1078",23),("\1076\1079",8),("\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),("\1089\1100",54),("\1090",50),("\1091",4),("\1092",43),("\1093",52),("\1094",38),("\1094\1100",66),("\1095",39),("\1096",41),("\1097",55),("\1100",7),("\1102",56),("\1103",57),("\1108",58),("\1110",6),("\1111",59),("\1169",19),("\8217",61)]))+          f (x:ts@(y:_)) +            | x == y = f ts+            | otherwise = x:f ts+          f xs = xs++-- | Part of the 'generalF' for processment in case of using tests mode.+testsOutput+  :: (Show a1, Integral a1) =>+     Bool -- ^ Whether to run tests concurrently or not. 'True' corresponds to concurrent execution that can speed up the getting results but use more resources.+     -> Int+     -> (p1 -> [a2] -> p2 -> Int8 -> [Int8] -> String -> a1)+     -> p1+     -> p2+     -> Int+     -> [String]+     -> IO [String]+testsOutput concurrently syllN f ldc syllableDurationsDs numTest universalSet = do+     putStrLn "Feet   Val  Stat   Proxim" +     (if concurrently +          then mapConcurrently+          else mapM) (\(q,qs) -> +                          let m = stat1 syllN (q,qs)+                              (min1, max1) = force . fromJust . minMax11By (comparing (f ldc [] syllableDurationsDs q qs)) $ universalSet +                              mx = f ldc [] syllableDurationsDs q qs max1 +                              strTest = (show (fromEnum q) `mappend` "   |   " `mappend`  show mx `mappend` "     " `mappend` show m `mappend` "  -> " `mappend` +                                  showFFloat (Just 3) (100 * fromIntegral mx / fromIntegral m) "%" `mappend` (if rem numTest 10 >= 4 +                                                                                                                          then ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n")+                                                                                                                          else "")) in putStrLn strTest >> return strTest) . zip (sel2 numTest) $ (sel numTest)++-- | Part of 'generalF' for processment with a file.+outputWithFile+  :: (Eq a1, Num a1) =>+     String -- ^ If not null than instead of rhythmicity evaluation using hashes and and feets, there is computed a diversity property for the specified 'String' here using the 'selectSounds' function. For more information, see: 'https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types'+     -> [Word8] -- ^ A list of non-negative values normed by 255 (the greatest of which is 255) that the line options are compared with. If null, then the program works as for version 0.12.1.0 without this newly-introduced argument since the version 0.13.0.0. The length of it must be a least common multiplier of the (number of syllables plus number of \'_digits\' groups) to work correctly. +     -> [AftovolioUkr]+     -> FilePath -- ^ The file to read the sound representation durations from.+     -> [[[[Sound8]]] -> [[Word8]]]+     -> Int+     -> a1+     -> Int+     -> FilePath -- ^ A file to be probably added output parts to.+     -> Int+     -> IO ()+outputWithFile selStr compards sRepresent file syllableDurationsDs code grps k fs num +  | mBool && code >= 10 && code <= 19 && grps == 2 = putStrLn (mconcat [textP, "\n", breaks, "\n", show rs]) >> appendF ((if code >= 15 then mconcat [show rs, "\n", breaks, "\n"] else "") `mappend` outputS)+  | otherwise = appendF outputS+           where mBool = null selStr && null compards +                 appendF = appendFile fs+                 lineOption = head . filter (\(S k _ _) -> k == num) $ sRepresent+                 textP = (\(S _ _ ts) -> ts) lineOption+--                 sylls = createSyllablesUkrS textP+                 outputS = outputSel lineOption code+                 qqs = readEq4 (mconcat . (if null file then case k of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 -> syllableDurationsD3; 4 -> syllableDurationsD4} else if length syllableDurationsDs >= k then syllableDurationsDs !! (k - 1) else syllableDurationsD2) . createSyllablesUkrS) (map showFS . mconcat . createSyllablesUkrS) . basicSplit $ textP +                 (breaks, rs) = R.showZerosFor2PeriodMusic qqs+
+ Aftovolio/Ukrainian/Melodics.hs view
@@ -0,0 +1,415 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}++-- |+-- Module      :  Aftovolio.Ukrainian.Melodics+-- Copyright   :  (c) OleksandrZhabenko 2021-2024+-- License     :  MIT+-- Maintainer  :  oleksandr.zhabenko@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 Aftovolio.Ukrainian.Melodics (+  -- * 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 GHC.Base+import GHC.List+import GHC.Num ((-))+import Data.Maybe (fromJust)+import Data.Char+import GHC.Arr+import CaseBi.Arr+import Data.List (uncons)+import GHC.Int+import Aftovolio.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'.+See for more implementation information:+<https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#ability-to-use-your-own-durations-of-representations-of-sounds-or-phonetic-phenomena>++Starting from the version 0.6.0.0:++-2 -> 102+-1 -> 101+0 -> 100+-}+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) [('\'',102),('-',101),('\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) [(55,[41,39]),(56,[27,4]),(57,[27,1]),(58,[27,2]),(59,[27,6]),+              (60,[101]),(61,[101]),(101,[101]),(102,[101])]+          !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+{-# INLINE convertToProperUkrainianI8 #-}++{-| 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+{-# INLINE convertToProperUkrainianI8WithTuples #-}++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+  | x == '\'' || x == '\x2019' || x == '\x02BC' || x == '-' = if (y `elem` ("\1102\1103\1108\1110"::String)) then '\1081':(case y of { '\1102' -> '\1091' ; '\1103' -> '\1072' ; '\1108' -> '\1077' ; ~r -> '\1110' }):changeIotated tup16 zs else changeIotated tup16 (y:zs)+  | otherwise = x:changeIotated tup16 (y:zs)+changeIotated _ xs = xs++filterUkr :: Array Int (Char,Int8) -> String -> FlowSound+filterUkr tup13 = let !tup = (100, tup13) in map (getBFst' tup)+{-# INLINE filterUkr #-}++secondConv :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+secondConv tup14 = concatMap (\y -> getBFst' ([y], tup14) y)+{-# INLINE secondConv #-}++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 || t > 99 = [100]: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 _ _ = 101+bsToCharUkr _ _ = []+{-# INLINE 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]+{-# INLINE applyChanges #-}++isVoicedObstruent :: FlowSound -> Bool+isVoicedObstruent (x:_) = x > 7 && x < 27+isVoicedObstruent _ = False+{-# INLINE isVoicedObstruent #-}++isVoicedObstruentH :: Array Int (Int8,Bool) -> FlowSound -> Bool+isVoicedObstruentH tup8 (x:_) = getBFst' (False, tup8) x+isVoicedObstruentH _ _ = False+{-# INLINE isVoicedObstruentH #-}++isVoicedObstruentS :: FlowSound -> Bool+isVoicedObstruentS (x:_) = x > 11 && x < 15+isVoicedObstruentS _ = False+{-# INLINE isVoicedObstruentS #-}++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)+{-# INLINE isSoftDOrL #-}++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)+{-# 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 :: Array Int ([Int8],Bool) -> Array Int ([Int8],Bool) -> FlowSound -> Sound8+дзT tup9 tup10 t1@(_:_) | isSoftDOrL tup9 tup10 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 :: 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+{-# 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 :: 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+{-# 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 :: 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+{-# 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 :: 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+{-# 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 (\t -> t > 0 && t < 100)+{-# INLINE takeFromFT_ #-}++correctA :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+correctA tup12 = correctSomeW . separateSoftS tup12+{-# INLINE correctA #-}++separateSoftS :: Array Int (Int8,[Int8]) -> FlowSound -> FlowSound+separateSoftS tup12 = concatMap (\x -> getBFst' ([x], tup12) x)+{-# 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 > 99) && 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 (== 100) . takeFromFT2 6 $ ys) > 1 = map (\t -> if t >= 100 then 101 else t) (takeFromFT2 6 ys) `mappend` correctB (dropFromFT2 6 ys)+  | otherwise = (if x > 100 then 101 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 = 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')]) +{-# INLINE linkFileNameI8 #-}+
+ Aftovolio/Ukrainian/PrepareText.hs view
@@ -0,0 +1,428 @@+-- |+-- Module      :  Aftovolio.Ukrainian.PrepareText+-- Copyright   :  (c) OleksandrZhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Earlier it has been a module DobutokO.Poetry.Ukrainian.PrepareText+-- from the @dobutokO-poetry@ package.+-- In particular, this module can be used to prepare the Ukrainian text+-- by applying the most needed grammar for AFTOVolio to avoid misunderstanding+-- for the produced text. The attention is paid to the prepositions, pronouns, conjunctions+-- and particles that are most commonly connected (or not) in a significant way+-- with the next text.+-- Uses the information from:+-- https://uk.wikipedia.org/wiki/%D0%A1%D0%BF%D0%BE%D0%BB%D1%83%D1%87%D0%BD%D0%B8%D0%BA+-- and+-- https://uk.wikipedia.org/wiki/%D0%A7%D0%B0%D1%81%D1%82%D0%BA%D0%B0_(%D0%BC%D0%BE%D0%B2%D0%BE%D0%B7%D0%BD%D0%B0%D0%B2%D1%81%D1%82%D0%B2%D0%BE)+--+-- Uses arrays instead of vectors.++{-# OPTIONS_HADDOCK -show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Aftovolio.Ukrainian.PrepareText (+  -- * Basic functions+  complexWords+  , participleConc+  , splitLines+  , splitLinesN+  , auxiliary1+  , isPreposition+  , isParticipleAppended+  , isPrepended+  , isConcatenated+  , isSpC+  , isUkrainianL+  , concatenated2+  , jottedConv+  , jottedCnv+  -- * The end-user functions+  , prepareText+  , prepareTextN+  , prepareTextN2+  , prepareTextN3+  , prepareTextNG+  , growLinesN+  , prepareGrowTextMN+  , prepareGrowTextMNG+  , tuneLinesN+  , prepareTuneTextMN+  , prepareTuneTextMNG+  -- * Used to transform after convertToProperUkrainian from mmsyn6ukr package+  , aux4+) where++import Data.Bits (shiftR)+import GHC.Base+import Data.List+import CaseBi.Arr (getBFstLSorted')+import Data.IntermediateStructures1 (mapI)+import Data.Char (isAlpha,toLower,isDigit)+import GHC.Arr+import GHC.Num ((+))++-- | Is used to convert a Ukrainian text into list of 'String' each of which is ready to be+-- used by the functions of the modules for the phonetic languages approach.+-- It applies minimal grammar links and connections between the most commonly used Ukrainian+-- words that \"should\" be paired and not dealt with separately+-- to avoid the misinterpretation and preserve maximum of the semantics for the+-- \"phonetic\" language on the Ukrainian basis.+prepareText :: String -> [String]+prepareText = prepareTextN 7+{-# INLINE prepareText #-}++-- | Concatenates complex words in Ukrainian so that they are not separated further by possible words order rearrangements (because they are treated+-- as a single word). This is needed to preserve basic grammar in phonetic languages.+complexWords :: [String] -> [String]+complexWords wwss@(xs:ys:zs:ts:xss) =+ getBFstLSorted' (xs:complexWords (ys:zs:ts:xss)) ([("\1074",+    if ys == "\1084\1110\1088\1091" && zs == "\1090\1086\1075\1086" &&+    ts == "\1103\1082" then auxiliary2Inner (xs `mappend` ys `mappend` zs `mappend` ts) xss else auxiliary4 wwss),+    ("\1076\1072\1088\1084\1072", if ys == "\1097\1086"+    then auxiliary3 wwss else auxiliary4 wwss), ("\1076\1083\1103",+    if ys == "\1090\1086\1075\1086" && zs == "\1097\1086\1073"+    then auxiliary2Inner (xs `mappend` ys `mappend` zs `mappend` ts) xss+    else auxiliary4 wwss), ("\1079",+      case ys of+        "\1090\1080\1084" -> if zs == "\1097\1086\1073"+          then auxiliary2Inner (xs `mappend` ys `mappend` zs) (ts:xss)+          else auxiliary4 wwss+        "\1090\1086\1075\1086" -> if zs == "\1095\1072\1089\1091" && ts == "\1103\1082"+          then auxiliary2Inner (xs `mappend` ys `mappend` zs `mappend` "\1081\1072\1082") xss+          else auxiliary4 wwss+        _ -> auxiliary4 wwss), ("\1079\1072\1083\1077\1078\1085\1086",+    if ys == "\1074\1110\1076" then auxiliary3 wwss else auxiliary4 wwss),+    ("\1079\1072\1084\1110\1089\1090\1100",+    if ys == "\1090\1086\1075\1086" && zs == "\1097\1086\1073"+    then auxiliary2Inner (xs `mappend` ys `mappend` zs) (ts:xss)+    else auxiliary4 wwss), ("\1087\1086\1087\1088\1080",+    if ys == "\1090\1077" && zs == "\1097\1086" then auxiliary2Inner (xs `mappend` ys `mappend` zs) (ts:xss)+    else auxiliary4 wwss),("\1085\1077\1079\1072\1083\1077\1078\1085\1086",+    if ys == "\1074\1110\1076" then auxiliary3 wwss else auxiliary4 wwss),+    ("\1085\1077\1079\1074\1072\1078\1072\1102\1095\1080", if ys == "\1085\1072" then+    if zs == "\1090\1077" && ts == "\1097\1086" then auxiliary2Inner (xs `mappend` ys `mappend` zs `mappend` ts) xss+    else auxiliary3 wwss else auxiliary4 wwss),+    ("\1087\1088\1080",+    if ys == "\1094\1100\1086\1084\1091" then auxiliary3 wwss+    else auxiliary4 wwss), ("\1087\1110\1089\1083\1103",+    if ys == "\1090\1086\1075\1086" && zs == "\1103\1082" then auxiliary2Inner (xs `mappend` ys `mappend` zs) (ts:xss)+    else auxiliary4 wwss), ("\1090\1072\1082", if (ys == "\1097\1086") || (ys == "\1103\1082")+    then auxiliary3 wwss else auxiliary4 wwss),+    ("\1090\1080\1084\1095\1072\1089\1086\1084", if ys == "\1103\1082"+    then auxiliary3 wwss else auxiliary4 wwss),+    ("\1090\1086\1084\1091", if ys == "\1103\1082" then auxiliary2Inner (xs `mappend` "\1081\1072\1082") (zs:ts:xss)+    else auxiliary4 wwss), ("\1091",+    if (ys == "\1079\1074'\1103\1079\1082\1091" || ys == "\1079\1074\x02BC\1103\1079\1082\1091") && zs == "\1079"+    then auxiliary2Inner (xs `mappend` "\1079\1074\1081\1072\1079\1082\1091" `mappend` zs) (ts:xss)+    else if ys == "\1084\1110\1088\1091" && zs == "\1090\1086\1075\1086" && ts == "\1103\1082"+    then auxiliary2Inner (xs `mappend` ys `mappend` zs `mappend` ts) xss else auxiliary4 wwss),+    ("\1093\1086\1095", if ys == "\1073\1080" then auxiliary3 wwss+    else auxiliary4 wwss), ("\1093\1086\1095\1072", if ys == "\1073"+    then auxiliary3 wwss else auxiliary4 wwss),+    ("\1095\1077\1088\1077\1079", if ys == "\1090\1077" && zs == "\1097\1086"+    then auxiliary2Inner (xs `mappend` ys `mappend` zs) (ts:xss) else auxiliary4 wwss)]) xs+complexWords wwss@(xs:ys:zs:xss) =+ getBFstLSorted' (xs:complexWords [ys,zs]) ([("\1076\1072\1088\1084\1072", if ys == "\1097\1086"+    then auxiliary3 wwss else auxiliary4 wwss), ("\1079\1072\1083\1077\1078\1085\1086",+    if ys == "\1074\1110\1076" then auxiliary3 wwss else auxiliary4 wwss),+    ("\1085\1077\1079\1072\1083\1077\1078\1085\1086",+    if ys == "\1074\1110\1076" then auxiliary3 wwss else auxiliary4 wwss),+    ("\1087\1088\1080",+    if ys == "\1094\1100\1086\1084\1091" then auxiliary3 wwss+    else auxiliary4 wwss), ("\1090\1072\1082", if ys == "\1097\1086" || ys == "\1103\1082"+    then auxiliary3 wwss else auxiliary4 wwss),+    ("\1090\1080\1084\1095\1072\1089\1086\1084", if ys == "\1103\1082"+    then auxiliary3 wwss else auxiliary4 wwss),+    ("\1090\1086\1084\1091", if ys == "\1103\1082" then auxiliary2Inner (xs `mappend` "\1081\1072\1082") (zs:xss)+    else auxiliary4 wwss), ("\1093\1086\1095", if ys == "\1073\1080" then auxiliary3 wwss+    else auxiliary4 wwss), ("\1093\1086\1095\1072", if ys == "\1073"+    then auxiliary3 wwss else auxiliary4 wwss)]) xs+complexWords [xs,ys]+ | ys `elem` ["\1073","\1073\1060","\1078\1077","\1078"] = [xs `mappend` ys]+ | xs == "\1076\1072\1088\1084\1072" && ys == "\1097\1086" = [xs `mappend` ys]+ | otherwise = [xs,ys]+complexWords xss = xss++auxiliary2Inner :: String -> [String] -> [String]+auxiliary2Inner ts (xs:ys:xss)+  | (concatenated2 . auxiliary1 $ [xs,ys]) /= [xs,ys] = let (rs,ws) = splitAt 1 (concatenated2 . auxiliary1 $ [xs,ys]) in+       (ts `mappend` head rs):complexWords (concat [ws,xss])+  | otherwise = (ts `mappend` xs):complexWords (ys:xss)+auxiliary2Inner ts [xs] = [ts `mappend` xs]+auxiliary2Inner ts _ = [ts]++auxiliary3 :: [String] -> [String]+auxiliary3 (xs:ys:xss) = auxiliary2Inner (xs `mappend` ys) xss+auxiliary3 xss = xss+{-# INLINE auxiliary3 #-}++auxiliary4 :: [String] -> [String]+auxiliary4 (xs:xss) = auxiliary2Inner xs xss+auxiliary4 xss = xss+{-# INLINE auxiliary4 #-}++-- | Since 0.2.1.0 version the function is recursive and is applied so that all returned elements ('String') are no longer than 7 words in them.+splitLines :: [String] -> [String]+splitLines = splitLinesN 7+{-# INLINE splitLines #-}++-- | A generalized variant of the 'splitLines' with the arbitrary maximum number of the words in the lines given as the first argument.+splitLinesN :: Int -> [String] -> [String]+splitLinesN n xss+ | null xss || n <= 0 = []+ | otherwise = mapI (\xs -> compare (length . words $ xs) n == GT) (\xs -> let yss = words xs in+     splitLines . map unwords . (\(q,r) -> [q,r]) . splitAt (shiftR (length yss) 1) $ yss) $ xss++-- | A generalized variant of the 'prepareText' with the arbitrary maximum number of the words in the lines given as the first argument.+prepareTextN :: Int -> String -> [String]+prepareTextN = prepareTextNG (\t -> isAlpha t || isSpC t) +{-# INLINE prepareTextN #-}++-- | A generalized variant of the 'prepareText' with the arbitrary maximum number of the words in the lines given as the first argument. The \'_\' is not filtered out.+prepareTextN2 :: Int -> String -> [String]+prepareTextN2 = prepareTextNG (\t -> isAlpha t || isSpC t || t == '_' || isDigit t) +{-# INLINE prepareTextN2 #-}++-- | A generalized variant of the 'prepareText' with the arbitrary maximum number of the words in the lines given as the first argument. Both \'_\' and \'=\' are not filtered out.+prepareTextN3 :: Int -> String -> [String]+prepareTextN3 = prepareTextNG (\t -> isAlpha t || isSpC t || t == '_' || t == '=' || isDigit t) +{-# INLINE prepareTextN3 #-}++-- | An even more generalized variant of the 'prepareTextN' with the arbitrary maximum number of the words in the lines given as the second argument and the possibility to provide custom function for filtering.+prepareTextNG +  :: (Char -> Bool) -- ^ A predicate to filter the symbols during preparation.+  -> Int +  -> String +  -> [String]+prepareTextNG f n = filter (any isUkrainianL) . splitLinesN n .+  map (unwords . concatenated2 . participleConc . auxiliary1 . complexWords . words . filter f) .+       filter (not . null) . lines+{-# INLINE prepareTextNG #-}++participleConc :: [String] -> [String]+participleConc (xs:ys:zs:yss)+  | isParticipleAppended ys = if isParticipleAppended zs then (xs `mappend` ys `mappend` zs):participleConc yss+         else participleConc (xs `mappend` ys:zs:yss)+  | otherwise = xs:participleConc (ys:zs:yss)+participleConc (xs:ys:yss)+  | isParticipleAppended ys = (xs `mappend` ys):participleConc yss+  | otherwise = xs:participleConc (ys:yss)+participleConc yss = yss++isParticipleAppended :: String -> Bool+isParticipleAppended xs = xs `elem` ["\1073","\1073\1080","\1078\1077","\1078"]++isPrepended :: String -> Bool+isPrepended xs+ | isParticipleAppended xs = True+ | isPreposition xs = True+ | otherwise = isConcatenated xs++jottedCnv :: String -> String+jottedCnv xs = drop 1 . jottedConv $ ' ':xs++auxiliary1 :: [String] -> [String]+auxiliary1 yss@(xs:zs:xss)+ | isParticipleAppended xs = xs:auxiliary1 (zs:xss)+ | isPreposition xs || isConcatenated xs = auxiliary1 (concatMap jottedCnv (tss `mappend` wss):vss)+ | otherwise = xs:auxiliary1 (zs:xss)+      where (tss,uss) = span isPrepended yss+            (wss,vss) = splitAt 1 uss+auxiliary1 xss = xss++isPreposition :: String -> Bool+isPreposition ts =+  getBFstLSorted' False+   (zip ["\1030\1079", "\1041\1077\1079", "\1041\1110\1083\1103", "\1042",+    "\1042\1110\1076", "\1044\1083\1103", "\1044\1086", "\1047",+    "\1047\1072", "\1047\1072\1088\1072\1076\1080", "\1047\1110",+    "\1050", "\1050\1086\1083\1086", "\1050\1088\1110\1079\1100",+    "\1050\1088\1110\1084", "\1052\1077\1078", "\1052\1077\1078\1080",+    "\1052\1110\1078", "\1053\1072", "\1053\1072\1076", "\1054",+    "\1054\1073", "\1054\1076", "\1054\1082\1088\1110\1084",+    "\1055\1077\1088\1077\1076", "\1055\1086", "\1055\1088\1080",+    "\1055\1088\1086", "\1055\1088\1086\1090\1080",+    "\1055\1110\1076", "\1055\1110\1089\1083\1103",+    "\1057\1077\1088\1077\1076", "\1057\1077\1088\1077\1076\1080",+    "\1059", "\1063\1077\1088\1077\1079", "\1073\1077\1079",+    "\1073\1110\1083\1103", "\1074", "\1074\1110\1076",+    "\1076\1083\1103", "\1076\1086", "\1079", "\1079\1072",+    "\1079\1072\1088\1072\1076\1080", "\1079\1110",+    "\1082", "\1082\1086\1083\1086", "\1082\1088\1110\1079\1100",+    "\1082\1088\1110\1084", "\1084\1077\1078", "\1084\1077\1078\1080",+    "\1084\1110\1078", "\1085\1072", "\1085\1072\1076", "\1086",+    "\1086\1073", "\1086\1076", "\1086\1082\1088\1110\1084",+    "\1087\1077\1088\1077\1076", "\1087\1086", "\1087\1088\1080",+    "\1087\1088\1086", "\1087\1088\1086\1090\1080", "\1087\1110\1076",+    "\1087\1110\1089\1083\1103", "\1089\1077\1088\1077\1076",+    "\1089\1077\1088\1077\1076\1080", "\1091",+    "\1095\1077\1088\1077\1079", "\1110\1079"] $+                           replicate 200 True) ts+{-# INLINE isPreposition #-}++-- | Since the dobutokO-poetry version 0.16.3.0 the (||) operator has been changed to the (&&).+-- The idea is that these words are the ones that are pronouns and they \"should\" be treated+-- (by the author's understanding) as independent words.+isConcatenated :: String -> Bool+isConcatenated ts+ | null ts = False+ | otherwise = compare (length ts) 2 /= GT &&+    getBFstLSorted' True (zip ["\1028", "\1042\1080", "\1052\1080", "\1058\1080", "\1058\1110",+     "\1062\1110", "\1071", "\1074\1080", "\1084\1080", "\1090\1080", "\1090\1110",+      "\1094\1110", "\1103", "\1108"] $ replicate 14 False) ts && (head ts `notElem` "\1031\1111")+{-# INLINE isConcatenated #-}++concatenated2 :: [String] -> [String]+concatenated2 (xs:ys:xss) =+ getBFstLSorted' (xs:concatenated2 (ys:xss)) (zip ["\1040\1073\1086","\1040\1076\1078\1077",+ "\1040\1083\1077","\1040\1085\1110\1078","\1041\1086\1076\1072\1081",+ "\1041\1091\1094\1110\1084\1090\1086","\1042\1078\1077","\1042\1080\1082\1083\1102\1095\1085\1086",+ "\1042\1083\1072\1089\1085\1077","\1042\1090\1110\1084","\1044\1072\1074\1072\1081",+ "\1047\1072\1090\1077","\1050\1086\1083\1080","\1051\1077\1076\1074\1077","\1051\1080\1096\1077",+ "\1052\1072\1081\1078\1077","\1052\1086\1074","\1052\1086\1074\1073\1080",+ "\1052\1086\1074\1073\1080\1090\1086","\1053\1072\1074\1110\1090\1100",+ "\1053\1072\1089\1082\1110\1083\1100\1082\1080","\1053\1072\1095\1077","\1053\1072\1095\1077\1073",+ "\1053\1072\1095\1077\1073\1090\1086","\1053\1077\1074\1078\1077","\1053\1077\1084\1086\1074",+ "\1053\1077\1084\1086\1074\1073\1080","\1053\1077\1084\1086\1074\1073\1080\1090\1086",+ "\1053\1077\1085\1072\1095\1077","\1053\1077\1085\1072\1095\1077\1073\1090\1086",+ "\1053\1077\1093\1072\1081","\1053\1090\1078\1077","\1053\1110\1073\1080",+ "\1053\1110\1073\1080\1090\1086","\1053\1110\1078","\1054\1090\1086\1078",+ "\1055\1088\1080\1090\1086\1084\1091","\1055\1088\1080\1090\1110\1084",+ "\1055\1088\1080\1095\1086\1084\1091","\1055\1088\1080\1095\1110\1084",+ "\1055\1088\1086\1090\1077","\1057\1072\1084\1077","\1057\1077\1073\1090\1086",+ "\1058\1072\1082\1080","\1058\1086\1073\1090\1086","\1058\1110\1083\1100\1082\1080",+ "\1061\1072\1081","\1061\1086\1095","\1061\1110\1073\1072","\1062\1077\1073\1090\1086",+ "\1065\1086\1073","\1071\1082\1073\1080","\1071\1082\1088\1072\1079","\1071\1082\1097\1086",+ "\1072\1073\1086","\1072\1076\1078\1077","\1072\1083\1077","\1072\1085\1110\1078",+ "\1073\1086\1076\1072\1081","\1073\1091\1094\1110\1084\1090\1086","\1074\1078\1077",+ "\1074\1080\1082\1083\1102\1095\1085\1086","\1074\1083\1072\1089\1085\1077",+ "\1074\1090\1110\1084","\1076\1072\1074\1072\1081","\1079\1072\1090\1077","\1082\1086\1083\1080",+ "\1083\1077\1076\1074\1077","\1083\1080\1096\1077","\1084\1072\1081\1078\1077","\1084\1086\1074",+ "\1084\1086\1074\1073\1080","\1084\1086\1074\1073\1080\1090\1086","\1085\1072\1074\1110\1090\1100",+ "\1085\1072\1089\1082\1110\1083\1100\1082\1080","\1085\1072\1095\1077","\1085\1072\1095\1077\1073",+ "\1085\1072\1095\1077\1073\1090\1086","\1085\1077\1074\1078\1077","\1085\1077\1084\1086\1074",+ "\1085\1077\1084\1086\1074\1073\1080","\1085\1077\1084\1086\1074\1073\1080\1090\1086",+ "\1085\1077\1085\1072\1095\1077","\1085\1077\1085\1072\1095\1077\1073\1090\1086",+ "\1085\1077\1093\1072\1081","\1085\1110\1073\1080","\1085\1110\1073\1080\1090\1086",+ "\1085\1110\1078","\1086\1090\1078\1077","\1086\1090\1086\1078","\1087\1088\1080\1090\1086\1084\1091",+ "\1087\1088\1080\1090\1110\1084","\1087\1088\1080\1095\1086\1084\1091","\1087\1088\1080\1095\1110\1084",+ "\1087\1088\1086\1090\1077","\1089\1072\1084\1077","\1089\1077\1073\1090\1086","\1090\1072\1082\1080",+ "\1090\1086\1073\1090\1086","\1090\1110\1083\1100\1082\1080","\1093\1072\1081","\1093\1086\1095",+ "\1093\1110\1073\1072","\1094\1077\1073\1090\1086","\1097\1086\1073","\1103\1082\1073\1080",+ "\1103\1082\1088\1072\1079","\1103\1082\1097\1086"] $ replicate 200 ((xs `mappend` jottedCnv ys):concatenated2 xss)) xs+concatenated2 xss = xss++isSpC :: Char -> Bool+isSpC x = x == '\'' || x == ' ' || x == '\x2019' || x == '\x02BC' || x == '-'+{-# INLINE isSpC #-}++jottedConv :: String -> String+jottedConv (x:y:xs)+  | isSpC x = x:(getBFstLSorted' (jottedConv (y:xs))+     [('\1028', '\1049':'\1077':jottedConv xs),+      ('\1031', '\1049':'\1110':jottedConv xs),+      ('\1070', '\1049':'\1091':jottedConv xs),+      ('\1071', '\1049':'\1072':jottedConv xs),+      ('\1102', '\1081':'\1091':jottedConv xs),+      ('\1103', '\1081':'\1072':jottedConv xs),+      ('\1108', '\1081':'\1077':jottedConv xs),+      ('\1111', '\1081':'\1110':jottedConv xs)] y)+  | otherwise = x:jottedConv (y:xs)+jottedConv xs = xs++-- | Can be used to prepare the text after 'convertToProperUkrainian' from 'Melodics.Ukrainian' module from @mmsyn6ukr@ package so that all the 'String' can+-- be represented as unique 'Char'.+aux4 :: String -> Char+aux4 xs+  | xs == "\1076\1078" = 'j'+  | xs == "\1076\1079" = 'z'+  | xs == "\1089\1100" = 's'+  | xs == "\1094\1100" = 'c'+  | null xs = error "Aftovolio.Ukrainian.PrepareText.aux4: Empty String. "+  | otherwise = head xs++-- | Is taken from the @mmsyn6ukr@ package version 0.8.1.0 so that the amount of dependencies are reduced (and was slightly modified).+isUkrainianL :: Char -> Bool+isUkrainianL y | (y >= '\1040' && y <= '\1065') || (y >= '\1070' && y <= '\1097') = True+               | otherwise = getBFstLSorted' False (map (\x -> (x, True)) $ "\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") y++-------------------------------------++{-| @ since 0.2.0.0+Given a positive number and a list tries to rearrange the list's 'String's by concatenation of the several elements of the list+so that the number of words in every new 'String' in the resulting list is not greater than the 'Int' argument. If some of the+'String's have more than that number quantity of the words then these 'String's are preserved.+-}+growLinesN :: Int -> [String] -> [String]+growLinesN n xss+ | null xss || n < 0 = []+ | otherwise = unwords yss : growLinesN n zss+     where l = length . takeWhile (<= n) . scanl1 (+) . map (length . words) $ xss -- the maximum number of lines to be taken+           (yss,zss) = splitAt (max l 1) xss++{-| @ since 0.2.0.0+The function combines the 'prepareTextN' and 'growLinesN' function. Applies needed phonetic language preparations+to the Ukrainian text and tries to \'grow\' the resulting 'String's in the list so that the number of the words in every+of them is no greater than the given first 'Int' number.+-}+prepareGrowTextMN+  :: Int -- ^ A maximum number of the words or their concatenations in the resulting list of 'String's.+  -> Int -- ^ A number of words in every 'String' that the function firstly forms. To have some sense of usage, must be less than the first argument.+  -> String+  -> [String]+prepareGrowTextMN m n = growLinesN m . prepareTextN n+{-# INLINE prepareGrowTextMN #-}++{-| @ since 0.11.0.0+The generalized version of the 'prepareGrowTextMN' with additional possibility to provide custom function for symbols filtering inside.+-}+prepareGrowTextMNG+  :: (Char -> Bool) -- ^ A predicate to filter the symbols during preparation.+  -> Int -- ^ A maximum number of the words or their concatenations in the resulting list of 'String's.+  -> Int -- ^ A number of words in every 'String' that the function firstly forms. To have some sense of usage, must be less than the first argument.+  -> String+  -> [String]+prepareGrowTextMNG f m n = growLinesN m . prepareTextNG f n+{-# INLINE prepareGrowTextMNG #-}++-------------------------------------++{-| @ since 0.6.0.0+Recursively splits the concatenated list of lines of words so that in every resulting 'String' in the list+except the last one there is just 'Int' -- the first argument -- words.+-}+tuneLinesN :: Int -> [String] -> [String]+tuneLinesN n xss+ | null xss || n < 0 = []+ | otherwise =+    let wss = words . unwords $ xss+        (yss,zss) = splitAt n wss+          in unwords yss : tuneLinesN n zss++{-| @ since 0.6.0.0+The function combines the 'prepareTextN' and 'tuneLinesN' functions. Applies needed phonetic language preparations+to the Ukrainian text and splits the list of 'String's so that the number of the words in each of them (except the last one)+is equal the given first 'Int' number.+-}+prepareTuneTextMN+  :: Int -- ^ A number of the words or their concatenations in the resulting list of 'String's (except probably the last one).+  -> Int -- ^ A number of words in every 'String' that the function firstly forms. To have some sense of usage, must be less than the first argument.+  -> String+  -> [String]+prepareTuneTextMN m n = tuneLinesN m . prepareTextN n+{-# INLINE prepareTuneTextMN #-}++{-| @ since 0.11.0.0+The generalized version of the 'prepareTuneTextMN' with additional possibility to provide custom function for symbols filtering inside.+-}+prepareTuneTextMNG+  :: (Char -> Bool) -- ^ A predicate to filter the symbols during preparation.+  -> Int -- ^ A number of the words or their concatenations in the resulting list of 'String's (except probably the last one).+  -> Int -- ^ A number of words in every 'String' that the function firstly forms. To have some sense of usage, must be less than the first argument.+  -> String+  -> [String]+prepareTuneTextMNG f m n = tuneLinesN m . prepareTextNG f n+{-# INLINE prepareTuneTextMNG #-}+
+ Aftovolio/Ukrainian/ReadDurations.hs view
@@ -0,0 +1,71 @@+-- |+-- Module      :  Aftovolio.Ukrainian.ReadDurations+-- Copyright   :  (c) OleksandrZhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Functions to read the properties data from the files with the special Haskell-like syntaxis.++{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}++module Aftovolio.Ukrainian.ReadDurations where++import GHC.Base+import CaseBi.Arr (getBFstLSorted')+import Aftovolio.Ukrainian.SyllableWord8+import Text.Read (readMaybe)+import Data.Maybe+import System.IO+import GHC.List+import Data.List (unlines,lines)+import System.Directory (doesFileExist)+import Aftovolio.Ukrainian.Melodics+import GHC.Word+import Aftovolio.General.Datatype3 (zippedDouble2Word8) ++{-| For more information on implementation, please refer to the link:+ +<https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#ability-to-use-your-own-durations-of-representations-of-sounds-or-phonetic-phenomena> +-}+sound8s :: FlowSound+sound8s = [1,2,3,4,5,6,7,8,9,10,11,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,+   43,44,45,46,47,48,49,50,51,52,53,54,66,101]++++{-|++Since the version 0.5.0.0 the semantics changed. Now, there is no duration for the pause between words. +The 52 'Double' numbers become the durations of the above specified 'Sound8' values respectively, the order+must be preserved (if you consider it important, well, it should be!). If some number in the file cannot be read+as a 'Double' number the function uses the first one that can be instead (the default value). If no such is specified+at all, then the default number is 5 for all the 'Sound8' sound representations.++-}+readSound8ToWord8 :: String -> (Word8,[(Sound8, Word8)])+readSound8ToWord8 xs+ | null xs = (5,zip sound8s . replicate 10000 $ 5)+ | otherwise =+    let wws = lines xs+        dbls = map (\ks -> readMaybe ks::Maybe Double) wws+        dbSs = map (fromMaybe 5) dbls in (5,zippedDouble2Word8 . zip sound8s $ dbSs `mappend` replicate 10000 1.0)++divide2SDDs :: String -> [String]+divide2SDDs ys+ | null tss = [unlines kss]+ | otherwise = unlines kss : divide2SDDs (unlines rss)+     where wwss = lines ys+           (kss,tss) = break (any (=='*')) wwss+           rss = dropWhile (any (== '*')) tss++readSyllableDurations :: FilePath -> IO [[[[Sound8]]] -> [[Word8]]]+readSyllableDurations file = do+  exists <- doesFileExist file+  if exists then do +   xs <- readFile file+   let yss = take 9 . divide2SDDs $ xs+       readData = map readSound8ToWord8 yss+   return . map (\(d,zs) -> syllableDurationsGDc (getBFstLSorted' d zs)) $ readData+  else return []+
+ Aftovolio/Ukrainian/ReverseConcatenations.hs view
@@ -0,0 +1,218 @@+-- |+-- Module      :  Aftovolio.Ukrainian.ReverseConcatenations+-- Copyright   :  (c) OleksandrZhabenko 2020-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Contains several functions that helps to reverse many of the phonetic languages approach concatenations+-- for the Ukrainian language.++{-# OPTIONS_GHC -threaded -rtsopts #-}++{-# OPTIONS_HADDOCK -show-extensions #-}+{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}++module Aftovolio.Ukrainian.ReverseConcatenations where++import Data.Tuple (snd)+import GHC.Base+import Data.List +import CaseBi.Arr (getBFstLSorted')+import Data.IntermediateStructures1 (mapI)++{-| Reverses many phonetic languages approach related concatenations for the Ukrainian text. Is intended to be used+with the text on several lines. -}+reverseConcatenations :: Int -> String -> String+reverseConcatenations n xs+ | null xs = []+ | otherwise = unlines . map (unwords . mapI (const True) (reverseConcat1 n) . words) . lines $ xs+     where yss = lines xs+           zsss = map words yss++{-| Reverses many phonetic languages approach related concatenations for just one Ukrainian word. Is used+internally in the 'reverseConcatenations'. -}+reverseConcat1 :: Int -> String -> [String]+reverseConcat1 n xs+ | null xs = []+ | otherwise = getBFstLSorted' (if n == 2 then reverseConcat2 n xs ts us else [xs]) [+    howConcat1WordEntirely n "\1040\1073\1086"us,+    ("\1040\1076\1078", howConcat1Word n 1 us "\1077" "\1040\1076\1078\1077" xs),+    howConcat1WordEntirely n "\1040\1083\1077" us,+    ("\1040\1085\1110", howConcat1Word n 1 us "\1078" "\1040\1085\1110\1078" xs),+    ("\1041\1086\1076", howConcat1Word n 2 us "\1072\1081" "\1041\1086\1076\1072\1081" xs),+    ("\1041\1091\1094", howConcat1Word n 4 us "\1110\1084\1090\1086" "\1041\1091\1094\1110\1084\1090\1086" xs),+    howConcat1WordEntirely n "\1042\1078\1077" us,+    ("\1042\1083\1072", howConcat1Word n 3 us "\1089\1085\1077" "\1042\1083\1072\1089\1085\1077" xs),+    ("\1042\1090\1110", howConcat1Word n 1 us "\1084" "\1042\1090\1110\1084" xs),+    howConcat1WordEntirely n "\1044\1083\1103" us,+    ("\1047\1072\1088", howConcat1Word n 3 us "\1072\1076\1080" "\1047\1072\1088\1072\1076\1080" xs),+    ("\1050\1088\1110", if take 2 us == "\1079\1100" then "\1050\1088\1110\1079\1100":reverseConcat1 n (drop 2 us)+    else if take 1 us == "\1084" then "\1050\1088\1110\1084":reverseConcat1 n (drop 1 us) else [xs]),+    ("\1053\1110\1073", if take 3 us == "\1080\1090\1086" then "\1053\1110\1073\1080\1090\1086":+    reverseConcat1 n (drop 3 us) else if take 1 us == "\1080" then "\1053\1110\1073\1080":reverseConcat1 n (drop 1 us)+    else [xs]),+    ("\1054\1082\1088", howConcat1Word n 2 us "\1110\1084" "\1054\1082\1088\1110\1084" xs),+    ("\1054\1090\1078", howConcat1Word n 1 us "\1077" "\1054\1090\1078\1077" xs),+    ("\1054\1090\1086", howConcat1Word n 1 us "\1078" "\1054\1090\1086\1078" xs),+    ("\1055\1088\1080", if take 4 us == "\1090\1086\1084\1091" then "\1055\1088\1080\1090\1086\1084\1091":+    reverseConcat1 n (drop 4 us) else if take 3 us == "\1090\1110\1084"+    then "\1055\1088\1080\1090\1110\1084":reverseConcat1 n (drop 3 us) else if take 4 us == "\1095\1086\1084\1091"+    then "\1055\1088\1080\1095\1086\1084\1091":reverseConcat1 n (drop 4 us)+    else if take 3 us == "\1095\1110\1084" then "\1055\1088\1080\1095\1110\1084":reverseConcat1 n (drop 3 us)+    else [xs]),+    ("\1057\1072\1084", howConcat1Word n 1 us "\1077" "\1057\1072\1084\1077" xs),+    ("\1057\1077\1073", howConcat1Word n 2 us "\1090\1086" "\1057\1077\1073\1090\1086" xs),+    ("\1058\1072\1082", howConcat1Word n 1 us "\1080" "\1058\1072\1082\1080" xs),+    ("\1058\1086\1073", howConcat1Word n 2 us "\1090\1086" "\1058\1086\1073\1090\1086" xs),+    howConcat1WordEntirely n "\1061\1072\1081" us,+    ("\1061\1110\1073", howConcat1Word n 1 us "\1072" "\1061\1110\1073\1072" xs),+    ("\1062\1077\1073", howConcat1Word n 2 us "\1090\1086" "\1062\1077\1073\1090\1086" xs),+    howConcat1WordEntirely n "\1065\1086\1073" us,+    ("\1071\1082\1073", howConcat1Word n 1 us "\1080" "\1071\1082\1073\1080" xs),+    ("\1071\1082\1088", howConcat1Word n 2 us "\1072\1079" "\1071\1082\1088\1072\1079" xs),+    ("\1071\1082\1097", howConcat1Word n 1 us "\1086" "\1071\1082\1097\1086" xs),+    howConcat1WordEntirely n "\1072\1073\1086" us,("\1072\1076\1078",+    howConcat1Word n 1 us "\1077" "\1072\1076\1078\1077" xs),howConcat1WordEntirely n "\1072\1083\1077" us,+    ("\1072\1085\1110", howConcat1Word n 1 us "\1078" "\1072\1085\1110\1078" xs),+    ("\1073\1086\1076",howConcat1Word n 2 us "\1072\1081" "\1073\1086\1076\1072\1081" xs),+    ("\1073\1091\1094",howConcat1Word n 4 us "\1110\1084\1090\1086" "\1073\1091\1094\1110\1084\1090\1086" xs),+    howConcat1WordEntirely n "\1074\1078\1077" us, ("\1074\1080\1082",+    howConcat1Word n 5 us "\1083\1102\1095\1085\1086" "\1074\1080\1082\1083\1102\1095\1085\1086" xs),+    ("\1074\1083\1072",howConcat1Word n 3 us "\1089\1085\1077" "\1074\1083\1072\1089\1085\1077" xs),+    ("\1074\1084\1110",if take 8 us == "\1088\1091\1090\1086\1075\1086\1103\1082"+    then "\1074":"\1084\1110\1088\1091":"\1090\1086\1075\1086":"\1103\1082":reverseConcat1 n (drop 11 xs)+    else [xs]), ("\1074\1090\1110",howConcat1Word n 1 us "\1084" "\1074\1090\1110\1084" xs),+    ("\1076\1072\1074",howConcat1Word n 2 us "\1072\1081" "\1076\1072\1074\1072\1081" xs),+    ("\1076\1072\1088",howConcat1Word n 4 us "\1084\1072\1097\1086" "\1076\1072\1088\1084\1072\1097\1086" xs),+    ("\1076\1083\1103", if take 7 us == "\1090\1086\1075\1086\1097\1086\1073"+    then "\1076\1083\1103":"\1090\1086\1075\1086":"\1097\1086\1073":reverseConcat1 n (drop 7 xs)+    else [xs]), ("\1079\1072\1083", if take 7 us == "\1077\1078\1085\1086\1074\1110\1076"+    then "\1079\1072\1083\1077\1078\1085\1086":"\1074\1110\1076":reverseConcat1 n (drop 7 xs)+    else [xs]), ("\1079\1072\1084", if take 11 us == "\1110\1089\1090\1100\1090\1086\1075\1086\1097\1086\1073"+    then "\1079\1072\1084\1110\1089\1090\1100":"\1090\1086\1075\1086":"\1097\1086\1073":+    reverseConcat1 n (drop 11 xs) else [xs]),+    ("\1079\1072\1088", howConcat1Word n 3 us "\1072\1076\1080" "\1079\1072\1088\1072\1076\1080" xs),+    ("\1079\1072\1090", howConcat1Word n 1 us "\1077" "\1079\1072\1090\1077" xs), ("\1079\1090\1080",+    if take 4 us == "\1084\1097\1086\1073" then "\1079":"\1090\1080\1084":"\1097\1086\1073":+    reverseConcat1 n (drop 4 xs) else [xs]),+    ("\1079\1090\1086", if take 8 us == "\1075\1086\1095\1072\1089\1091\1103\1082"+    then "\1079":"\1090\1086\1075\1086":"\1095\1072\1089\1091":"\1103\1082":reverseConcat1 n (drop 8 xs)+    else [xs]), ("\1082\1086\1083", howConcat1Word n 1 us "\1080" "\1082\1086\1083\1080" xs),+    ("\1082\1088\1110", if take 2 us == "\1079\1100" then "\1082\1088\1110\1079\1100":reverseConcat1 n (drop 2 us)+    else if take 1 us == "\1084" then "\1082\1088\1110\1084":reverseConcat1 n (drop 1 us) else [xs]),+    ("\1083\1077\1076", howConcat1Word n 2 us "\1074\1077" "\1083\1077\1076\1074\1077" xs),+    ("\1083\1080\1096", howConcat1Word n 1 us "\1077" "\1083\1080\1096\1077" xs),+    ("\1084\1072\1081", howConcat1Word n 2 us "\1078\1077" "\1084\1072\1081\1078\1077" xs),+    ("\1084\1086\1074", if take 4 us == "\1073\1080\1090\1086" then "\1084\1086\1074\1073\1080\1090\1086":+    reverseConcat1 n (drop 4 us)+    else if take 2 us == "\1073\1080" then "\1084\1086\1074\1073\1080":reverseConcat1 n (drop 2 us)+    else snd (howConcat1WordEntirely n "\1084\1086\1074" us)),+    ("\1085\1072\1074", howConcat1Word n 3 us "\1110\1090\1100" "\1085\1072\1074\1110\1090\1100" xs),+    ("\1085\1072\1089", howConcat1Word n 6 us "\1082\1110\1083\1100\1082\1080" "\1085\1072\1089\1082\1110\1083\1100\1082\1080" xs),+    ("\1085\1072\1095", if take 4 us == "\1077\1073\1090\1086" then "\1085\1072\1095\1077\1073\1090\1086":+    reverseConcat1 n (drop 4 us)+    else if take 2 us == "\1077\1073" then "\1085\1072\1095\1077\1073":reverseConcat1 n (drop 2 us)+    else if take 1 us == "\1077"+    then "\1085\1072\1095\1077":reverseConcat1 n (drop 1 us) else [xs]),("\1085\1077\1074",+    howConcat1Word n 2 us "\1078\1077" "\1085\1077\1074\1078\1077" xs),+    ("\1085\1077\1079", if take 9 us == "\1072\1083\1077\1078\1085\1086\1074\1110\1076"+    then "\1085\1077\1079\1072\1083\1077\1078\1085\1086\1074\1110\1076":reverseConcat1 n (drop 9 us) else+    if take 13 us == "\1074\1072\1078\1072\1102\1095\1080\1085\1072\1090\1077\1097\1086"+    then "\1085\1077\1079\1074\1072\1078\1072\1102\1095\1080\1085\1072\1090\1077\1097\1086":+    reverseConcat1 n (drop 13 us)+    else [xs]),("\1085\1077\1084", if take 6 us == "\1086\1074\1073\1080\1090\1086"+    then "\1085\1077\1084\1086\1074\1073\1080\1090\1086":reverseConcat1 n (drop 6 us)+    else if take 4 us == "\1086\1074\1073\1080" then "\1085\1077\1084\1086\1074\1073\1080":+    reverseConcat1 n (drop 4 us) else+    if take 2 us == "\1086\1074" then "\1085\1077\1084\1086\1074":reverseConcat1 n (drop 2 us) else [xs]),+    ("\1085\1077\1085", if take 6 us == "\1072\1095\1077\1073\1090\1086"+    then "\1085\1077\1085\1072\1095\1077\1073\1090\1086":reverseConcat1 n (drop 6 us)+    else if take 3 us == "\1072\1095\1077" then "\1085\1077\1085\1072\1095\1077":+    reverseConcat1 n (drop 3 us) else [xs]),+    ("\1085\1077\1093", howConcat1Word n 2 us "\1072\1081" "\1085\1077\1093\1072\1081" xs),+    ("\1085\1110\1073", if take 3 us == "\1080\1090\1086" then "\1085\1110\1073\1080\1090\1086":+    reverseConcat1 n (drop 3 us) else+    if take 1 us == "\1080" then "\1085\1110\1073\1080":reverseConcat1 n (drop 1 us) else [xs]),+    howConcat1WordEntirely n "\1085\1110\1078" us,+    ("\1086\1082\1088", howConcat1Word n 2 us "\1110\1084" "\1086\1082\1088\1110\1084" xs),+    ("\1086\1090\1078", howConcat1Word n 1 us "\1077" "\1086\1090\1078\1077" xs),+    ("\1086\1090\1086", howConcat1Word n 1 us "\1078" "\1086\1090\1086\1078" xs),+    ("\1087\1086\1087", if take 6 us == "\1088\1080\1090\1077\1097\1086"+    then "\1087\1086\1087\1088\1080":"\1090\1077":"\1097\1086":reverseConcat1 n (drop 6 us) else [xs]),+    ("\1087\1088\1080", if take 4 us == "\1090\1086\1084\1091" then "\1087\1088\1080\1090\1086\1084\1091":+    reverseConcat1 n (drop 4 us)+    else if take 3 us == "\1090\1110\1084" then "\1087\1088\1080\1090\1110\1084":+    reverseConcat1 n (drop 3 us) else+    if take 5 us == "\1094\1100\1086\1084\1091" then "\1087\1088\1080\1094\1100\1086\1084\1091":+    reverseConcat1 n (drop 5 us) else+    if take 4 us == "\1095\1086\1084\1091" then "\1087\1088\1080\1095\1086\1084\1091":+    reverseConcat1 n (drop 4 us) else+    if take 3 us == "\1095\1110\1084" then "\1087\1088\1080\1095\1110\1084":reverseConcat1 n (drop 3 us)+    else [xs]),+    ("\1087\1088\1086", howConcat1Word n 2 us "\1090\1077" "\1087\1088\1086\1090\1077" xs),+    ("\1087\1110\1089", if take 8 us == "\1083\1103\1090\1086\1075\1086\1103\1082"+    then "\1087\1110\1089\1083\1103":"\1090\1086\1075\1086":"\1103\1082":reverseConcat1 n (drop 8 us)+    else [xs]), ("\1089\1072\1084", howConcat1Word n 1 us "\1077" "\1089\1072\1084\1077" xs),+    ("\1089\1077\1073", howConcat1Word n 2 us "\1090\1086" "\1089\1077\1073\1090\1086" xs),+    ("\1090\1072\1082", if take 1 us == "\1080" then "\1090\1072\1082\1080":reverseConcat1 n (drop 1 us) else+    if take 3 us == "\1081\1072\1082" then "\1090\1072\1082":"\1103\1082":reverseConcat1 n (drop 3 us) else+    if take 2 us == "\1097\1086" then "\1090\1072\1082":"\1097\1086":reverseConcat1 n (drop 2 us) else [xs]),+    ("\1090\1080\1084", if take 8 us == "\1095\1072\1089\1086\1084\1081\1072\1082"+    then "\1090\1080\1084":"\1095\1072\1089\1086\1084":"\1103\1082":reverseConcat1 n (drop 8 us) else [xs]),+    ("\1090\1086\1073", howConcat1Word n 2 us "\1090\1086" "\1090\1086\1073\1090\1086" xs),+    ("\1090\1086\1084", if take 3 us == "\1091\1097\1086" then "\1090\1086\1084\1091":"\1097\1086":+    reverseConcat1 n (drop 3 us)+    else if take 3 us == "\1091\1103\1082" then "\1090\1086\1084\1091":"\1103\1082":+    reverseConcat1 n (drop 3 us) else [xs]),+    ("\1090\1110\1083", howConcat1Word n 3 us "\1100\1082\1080" "\1090\1110\1083\1100\1082\1080" xs),+    ("\1091\1079\1074", if take 6 us == "\1081\1072\1079\1082\1091\1079"+    then "\1091":"\1079\1074\x02BC\1103\1079\1082\1091":"\1079":reverseConcat1 n (drop 6 us) else [xs]),+    ("\1091\1084\1110", if take 8 us == "\1088\1091\1090\1086\1075\1086\1103\1082"+    then "\1091":"\1084\1110\1088\1091":"\1090\1086\1075\1086":"\1103\1082":reverseConcat1 n (drop 8 us)+    else [xs]), howConcat1WordEntirely n "\1093\1072\1081" us,("\1093\1086\1095", if take 2 us == "\1073\1080"+    then "\1093\1086\1095":"\1073\1080":reverseConcat1 n (drop 2 us) else if take 2 us == "\1072\1073"+    then "\1093\1086\1095\1072":"\1073":reverseConcat1 n (drop 2 us) else "\1093\1086\1095":[us]),+    ("\1093\1110\1073", howConcat1Word n 1 us "\1072" "\1093\1110\1073\1072" xs),+    ("\1094\1077\1073", howConcat1Word n 2 us "\1090\1086" "\1094\1077\1073\1090\1086" xs),+    ("\1095\1077\1088", if take 6 us == "\1077\1079\1090\1077\1097\1086"+    then "\1095\1077\1088\1077\1079":"\1090\1077":"\1097\1086":reverseConcat1 n (drop 6 us) else [xs]),+    howConcat1WordEntirely n "\1097\1086\1073" us, ("\1103\1082\1073",+    howConcat1Word n 1 us "\1080" "\1103\1082\1073\1080" xs),+    ("\1103\1082\1088", howConcat1Word n 2 us "\1072\1079" "\1103\1082\1088\1072\1079" xs),+    ("\1103\1082\1097", howConcat1Word n 1 us "\1086" "\1103\1082\1097\1086" xs)] ts+      where (ts,us) = splitAt 3 xs++reverseConcat2 :: Int -> String -> String -> String -> [String]+reverseConcat2 n xs ts us =+  getBFstLSorted' [xs] [("\1041\1110\1083", howConcat1Word n 1 us "\1103" "\1041\1110\1083\1103" xs),+  ("\1042\1080\1082", howConcat1Word n 5 us "\1083\1102\1095\1085\1086" "\1042\1080\1082\1083\1102\1095\1085\1086" xs),+  ("\1044\1072\1074", howConcat1Word n 2 us "\1072\1081" "\1044\1072\1074\1072\1081" xs),+  ("\1047\1072\1090", howConcat1Word n 1 us "\1077" "\1047\1072\1090\1077" xs),+  ("\1050\1086\1083", if take 1 us == "\1080" then "\1050\1086\1083\1080":reverseConcat1 n (drop 1 us)+  else if take 1 us == "\1086" then "\1050\1086\1083\1086":reverseConcat1 n (drop 1 us) else [xs]),+  ("\1051\1080\1096", howConcat1Word n 1 us "\1077" "\1051\1080\1096\1077" xs),+  howConcat1WordEntirely n "\1053\1110\1078" us,+  ("\1055\1110\1089", howConcat1Word n 2 us "\1083\1103" "\1055\1110\1089\1083\1103" xs),+  ("\1057\1077\1088", howConcat1Word n 2 us "\1077\1076" "\1057\1077\1088\1077\1076" xs),+  ("\1058\1110\1083", howConcat1Word n 3 us "\1100\1082\1080" "\1058\1110\1083\1100\1082\1080" xs),+  ("\1073\1110\1083", howConcat1Word n 1 us "\1103" "\1073\1110\1083\1103" xs),+  ("\1076\1072\1074", howConcat1Word n 2 us "\1072\1081" "\1076\1072\1074\1072\1081" xs),+  ("\1079\1072\1090", howConcat1Word n 1 us "\1077" "\1079\1072\1090\1077" xs),+  ("\1082\1086\1083", if take 1 us == "\1080" then "\1082\1086\1083\1080":reverseConcat1 n xs+  else if take 1 us == "\1086" then "\1082\1086\1083\1086":reverseConcat1 n xs else [xs]),+  ("\1083\1080\1096", howConcat1Word n 1 us "\1077" "\1083\1080\1096\1077" xs),+  howConcat1WordEntirely n "\1085\1110\1078" us,+  ("\1087\1077\1088", howConcat1Word n 2 us "\1077\1076" "\1087\1077\1088\1077\1076" xs),+  ("\1087\1110\1089", howConcat1Word n 2 us "\1083\1103" "\1087\1110\1089\1083\1103" xs),+  ("\1089\1077\1088", howConcat1Word n 2 us "\1077\1076" "\1089\1077\1088\1077\1076" xs)] ts++howConcat1Word :: Int -> Int -> String -> String -> String -> String -> [String]+howConcat1Word m n us us' us'' xs+  | take n us == us' = us'':reverseConcat1 m (drop n us)+  | otherwise = [xs]+{-# INLINE howConcat1Word #-}++howConcat1WordEntirely :: Int -> String -> String -> (String, [String])+howConcat1WordEntirely m ts us = (ts,ts:reverseConcat1 m us)+{-# INLINE howConcat1WordEntirely #-}
+ Aftovolio/Ukrainian/Syllable.hs view
@@ -0,0 +1,275 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}++-- |+-- Module      :  Aftovolio.Ukrainian.Syllable+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@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 Aftovolio.Ukrainian.Syllable (+  -- * Basic functionality+  isVowel1+  , isSonorous1+  , isVoicedC1+  , isVoicelessC1+  , isNotVowel2+  , isNotVowel2'+  , sndGroups+  , groupSnds+  , divCnsnts+  , reSyllableCntnts+  , divVwls+  , createSyllablesUkrS+  , notEqC+  , representProlonged+  , showS8+  , showFS+  -- * With additional data used (probably for speed up)+  , notEqCTup+  , divCnsntsTup+  , reSyllableCntntsTup+  , createSyllablesUkrSTup+) where++import GHC.Base+import GHC.List+import Data.Tuple +import GHC.Num (abs,(-))+import GHC.Arr+import Data.Typeable+import qualified Data.List as L (groupBy)+import Aftovolio.Ukrainian.Melodics+import CaseBi.Arr+import GHC.Int+import Data.IntermediateStructures1 (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 < 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.+-- Starting from the version 0.6.0.0 variants of either of arguments is greater than 99 is also included.+isNotVowel2 :: Sound8 -> Sound8 -> Bool+isNotVowel2 x y = x > 6 && y > 6+{-# INLINE isNotVowel2 #-}++-- | Binary function-predicate 'isNotVowel2'' checks whether its arguments are both consonant representations in the 'Sound8' format.+-- Starting from the version 0.6.0.0 variants of either of arguments is greater than 99 are not included (so its behaviour is equivalent  to the+-- 'isNotVowel2' till the 0.5.3.0 version).+isNotVowel2' :: Sound8 -> Sound8 -> Bool+isNotVowel2' x y = x < 100 && y < 100 && 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@(y:zs@(z:ts@(_:_))))+  | isSonorous1 x || isVoicedC1 x =+      case y of+        7 -> ((`mappend` [x,7]),mappend zs) -- "рибаль-ство"+        _ -> ((`mappend` [x]),mappend ys)+  | isSonorous1 y =+      case z of+        7 -> ((`mappend` [x,y,7]),mappend ts) -- "рокль-ський" (?), "супрасль-ський"+        _ -> ((`mappend` [x,y]),mappend zs) -- "дофр-ський" (?)+  | otherwise = (id,mappend xs)+divCnsnts xs@(x:ys@(y:zs@(z:ts)))+  | isSonorous1 x =+      case y of+        7 -> ((`mappend` [x,7]),mappend zs) -- "поль-ка", "каль-ка"+        _ -> ((`mappend` [x]),mappend ys)+  | isSonorous1 y =+      case z of+        7 -> (id,mappend xs) -- "сього-дні"+        _ -> ((`mappend` [x,y]),mappend zs)+  | otherwise = (id,mappend xs)+divCnsnts xs@(x:ys@(y:zs))+  | (isSonorous1 x && notEqC x y && y /= 7) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys)+  | otherwise = (id,mappend xs)+divCnsnts xs = (id,mappend xs)++-- | Function 'divCnsntsTup' is a variant of the 'divCnsts' where you can provide the tuple element for 'getBFst'' inside.+divCnsntsTup :: Array Int (Int8,Bool) -> FlowSound -> (FlowSound -> FlowSound,FlowSound -> FlowSound)+divCnsntsTup !tup17 xs@(x:ys@(y:zs@(z:ts@(_:_))))+  | isSonorous1 x || isVoicedC1 x =+      case y of+        7 -> ((`mappend` [x,7]),mappend zs) -- "рибаль-ство"+        _ -> ((`mappend` [x]),mappend ys)+  | isSonorous1 y =+      case z of+        7 -> ((`mappend` [x,y,7]),mappend ts) -- "рокль-ський" (?), "супрасль-ський"+        _ -> ((`mappend` [x,y]),mappend zs) -- "дофр-ський" (?)+  | otherwise = (id,mappend xs)+divCnsntsTup !tup17 xs@(x:ys@(y:zs@(z:ts)))+  | isSonorous1 x =+      case y of+        7 -> ((`mappend` [x,7]),mappend zs) -- "поль-ка", "каль-ка"+        _ -> ((`mappend` [x]),mappend ys)+  | isSonorous1 y =+      case z of+        7 -> (id,mappend xs) -- "сього-дні"+        _ -> ((`mappend` [x,y]),mappend zs)  +  | otherwise = (id,mappend xs)+divCnsntsTup !tup17 xs@(x:ys@(y:_))+  | (isSonorous1 x && (notEqCTup tup17 x y) && y /= 7) || (isVoicedC1 x && isVoicelessC1 y) = ((`mappend` [x]),mappend ys)+  | otherwise = (id,mappend xs)+divCnsntsTup _ xs = (id,mappend xs)++reSyllableCntntsTup :: Array Int (Int8,Bool) -> [FlowSound] -> [FlowSound]+reSyllableCntntsTup !tup17 (xs:ys:zs:xss)+  | (> 6) . last $ ys = fst (divCnsntsTup tup17 ys) xs:reSyllableCntntsTup tup17 (snd (divCnsntsTup tup17 ys) zs:xss)+  | otherwise = reSyllableCntntsTup tup17 ((xs `mappend` ys):zs:xss)+reSyllableCntntsTup !tup17 (xs:ys:_) = [xs `mappend` ys]+reSyllableCntntsTup !tup17 xss = xss++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+{-# INLINE createSyllablesUkrS #-}++createSyllablesUkrSTup+ :: 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)+     -> Array Int (Int8,Bool)+     -> String+     -> [[FlowSound]]+createSyllablesUkrSTup !tup1 !tup2 !tup3 !tup4 !tup5 !tup6 !tup7 !tup8 !tup9 !tup10 !tup11 !tup12 !tup13 !tup14 !tup15 !tup16 !tup17 =+ map (divVwls . reSyllableCntntsTup tup17 . groupSnds) . words1 .+  convertToProperUkrainianI8WithTuples tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16+{-# INLINE createSyllablesUkrSTup #-}++-- | Practically this is an optimized version for this case 'words' function from Prelude.+words1 :: FlowSound -> [FlowSound]+words1 xs = if null ts then [] else w : words1 s'' +  where ts = dropWhile (> 99) xs+        (w, s'') = span (< 100) ts+{-# NOINLINE words1 #-}++-----------------------------------------------------++-- | 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+{-# INLINE notEqC #-}++-- | Binary function-predicate 'notEqC' checks whether its arguments are not the same consonant sound representations (not taking palatalization into account).+notEqCTup :: Array Int (Int8,Bool) -> Sound8 -> Sound8 -> Bool+notEqCTup !tup17 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 = getBFst' (True, tup17) . min x $ y+  | otherwise = True+{-# INLINE notEqCTup #-}++-- | 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++showS8 :: Sound8 -> String+showS8 = getBFstLSorted' " " [(1,"\1072"),(2,"\1077"),(3,"\1086"),(4,"\1091"),(5,"\1080"),(6,"\1110"),(7,"\1100"),(8,"\1076\1079"),+  (9,"\1076\1079"),(10,"\1078"),(11,"\1078"),(15,"\1073"),(16,"\1073"),(17,"\1076"),(18,"\1076"),(19,"\1169"),(20,"\1169"),+  (21,"\1075"),(22,"\1075"),(23,"\1076\1078"),(24,"\1076\1078"),(25,"\1079"),(26,"\1079"),(27,"\1081"),(28,"\1083"),(29,"\1083"),+  (30,"\1084"),(31,"\1084"),(32,"\1085"),(33,"\1085"),(34,"\1088"),(35,"\1088"),(36,"\1074"),(37,"\1074"),(38,"\1094"),+  (39,"\1095"),(40,"\1095"),(41,"\1096"),(42,"\1096"),(43,"\1092"),(44,"\1092"),(45,"\1082"),(46,"\1082"),(47,"\1087"),+  (48,"\1087"),(49,"\1089"),(50,"\1090"),(51,"\1090"),(52,"\1093"),(53,"\1093"),(54,"\1089\1100"),(66,"\1094\1100")]+{-# INLINE showS8 #-}++showFS :: FlowSound -> String+showFS = concatMap showS8  -- Probably, it is better to transform several consequent spaces into the combination smth like \", \" (but not in this version)+{-# INLINE showFS #-}
+ Aftovolio/Ukrainian/SyllableWord8.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE TypeSynonymInstances, NoImplicitPrelude, Strict, BangPatterns #-}+{-# OPTIONS_HADDOCK show-extensions #-}+-- |+-- Module      :  Aftovolio.Ukrainian.SyllableWord8+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- This module works with syllable segmentation in Ukrainian. Uses 'Word8' whenever possible.+-- Is inspired by the DobutokO.Sound.DIS5G6G module from @dobutokO2@ package.+-- See: 'https://hackage.haskell.org/package/dobutokO2-0.43.0.0/docs/DobutokO-Sound-DIS5G6G.html'.+-- The initial 'Word8' data are gotten from there.++module Aftovolio.Ukrainian.SyllableWord8 where++import GHC.Base+import GHC.Num ((+))+import CaseBi.Arr+import Aftovolio.Ukrainian.Melodics (Sound8)+import GHC.Int+import Data.Foldable (foldl')+import GHC.Word++s0DuratD1 :: Sound8 -> Word8+s0DuratD1 = getBFstLSorted' 5 [(1,15),(2,10),(3,13),(4,12),(5,11),(6,10),(7,1),(8,6),(9,6),(10,7),(11,7),(15,6),(16,6),(17,8),(18,8),(19,7),(20,7),(21,8),(22,8),(23,5),(24,5),(25,6),(26,6),(27,6),(28,7),(29,7),(30,8),(31,8),(32,8),(33,8),(34,5),(35,5),(36,9),(37,9),(38,5),(39,6),(40,6),(41,7),(42,7),(43,6),(44,6),(45,4),(46,4),(47,15),(48,15),(49,8),(50,12),(51,12),(52,8),(53,8),(54,8),(66,10)]+{-# INLINE s0DuratD1 #-}++-- |+s0DuratD2 :: Sound8 -> Word8+s0DuratD2 = getBFstLSorted' 5 [(1,15),(2,15),(3,15),(4,14),(5,11),(6,11),(7,1),(8,4),(9,4),(10,5),(11,5),(15,6),(16,6),(17,4),(18,4),(19,4),(20,4),(21,3),(22,3),(23,5),(24,5),(25,4),(26,4),(27,5),(28,6),(29,6),(30,8),(31,8),(32,3),(33,3),(34,4),(35,4),(36,5),(37,5),(38,3),(39,7),(40,7),(41,7),(42,7),(43,9),(44,9),(45,3),(46,3),(47,5),(48,5),(49,3),(50,3),(51,3),(52,5),(53,5),(54,4),(66,4)] +{-# INLINE s0DuratD2 #-}++s0DuratD3 :: Sound8 -> Word8+s0DuratD3 = getBFstLSorted' 5 [(1,15),(2,14),(3,15),(4,12),(5,12),(6,12),(7,1),(8,5),(9,5),(10,6),(11,6),(15,8),(16,8),(17,5),(18,5),(19,5),(20,5),(21,6),(22,6),(23,6),(24,6),(25,4),(26,4),(27,7),(28,7),(29,7),(30,9),(31,9),(32,4),(33,4),(34,4),(35,4),(36,5),(37,5),(38,4),(39,7),(40,7),(41,9),(42,9),(43,10),(44,10),(45,4),(46,4),(47,7),(48,7),(49,4),(50,4),(51,4),(52,8),(53,8),(54,5),(66,5)]+{-# INLINE s0DuratD3 #-}++s0DuratD4 :: Sound8 -> Word8+s0DuratD4 = getBFstLSorted' 5 [(1,12),(2,12),(3,12),(4,12),(5,12),(6,12),(7,1),(8,5),(9,5),(10,10),(11,10),(15,5),(16,5),(17,8),(18,8),(19,8),(20,8),(21,13),(22,13),(23,10),(24,10),(25,5),(26,5),(27,4),(28,10),(29,10),(30,15),(31,15),(32,8),(33,8),(34,4),(35,4),(36,6),(37,6),(38,4),(39,12),(40,12),(41,14),(42,14),(43,11),(44,11),(45,6),(46,6),(47,4),(48,4),(49,6),(50,11),(51,11),(52,15),(53,15),(54,7),(66,5)]+{-# INLINE s0DuratD4 #-}++{-+help1 xs = map (\(t, u) -> (t,fromMaybe 15 . hh $ u)) xs +  where !h = snd . head $ xs+        !lt = snd . last $ xs+        !del = (lt - h)/14.0+        !ys  = take 15 . iterate (+del) $ h+        !zs = zip [1..15] ys+        gg !u = fromMaybe lt . round2GL True (\_ _ -> EQ) ys $ u+        hh !u = fmap fst . find ((== gg u) . snd) $ zs+-}++class (Eq a) => SyllableDurations4 a where+  sDuratsD :: a -> Word8+  sDuratsD2 :: a -> Word8+  sDuratsD3 :: a -> Word8+  sDuratsD4 :: a -> Word8+  syllableDurationsGDc :: (a -> Word8) -> [[[a]]] -> [[Word8]]+  syllableDurationsGDc g = map (map (k g))+    where k f = foldl' (\y x -> f x + y) 0+  {-# INLINE syllableDurationsGDc #-}++instance SyllableDurations4 Sound8 where+  sDuratsD = s0DuratD1+  sDuratsD2 = s0DuratD2+  sDuratsD3 = s0DuratD3+  sDuratsD4 = s0DuratD4++-- | General variant of the 'syllableDurationsD' function.+syllableDurationsGD :: (Sound8 -> Word8) -> [[[Sound8]]] -> [[Word8]]+syllableDurationsGD g = syllableDurationsGDc g+{-# INLINE syllableDurationsGD #-}++syllableDurationsD :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD = syllableDurationsGDc s0DuratD1+{-# INLINE syllableDurationsD #-}++syllableDurationsD2 :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD2 = syllableDurationsGDc s0DuratD2+{-# INLINE syllableDurationsD2 #-}++syllableDurationsD3 :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD3 = syllableDurationsGDc s0DuratD3+{-# INLINE syllableDurationsD3 #-}++syllableDurationsD4 :: [[[Sound8]]] -> [[Word8]]+syllableDurationsD4 = syllableDurationsGDc s0DuratD4+{-# INLINE syllableDurationsD4 #-}+
+ Aftovolio/UniquenessPeriodsG.hs view
@@ -0,0 +1,104 @@+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- |+-- Module      :  Aftovolio.UniquenessPeriodsG+-- Copyright   :  (c) OleksandrZhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Generalization of the uniqueness-periods and uniqueness-periods-general+-- packages functionality for small 'F.Foldable' data structures. Uses less dependencies.+--++{-# LANGUAGE BangPatterns #-}++module Aftovolio.UniquenessPeriodsG (+  -- * List functions+  uniquenessPeriodsGG+  , uniquenessPeriodsG+  , uniquenessPeriodsGI8+  , diverse2GGL+  , diverse2GL+  , diverse2GLInt8+)  where++import GHC.Base+import GHC.Int+import Data.List hiding (foldr)+import GHC.Num ((-))+import Data.Tuple+import Data.Maybe (mapMaybe)+import qualified Data.Foldable as F++-- | A generalization of the uniquenessPeriods function of the @uniqueness-periods@ package.+uniquenessPeriodsGG :: (F.Foldable t1, F.Foldable t2, F.Foldable t3, Ord a) => t3 a -> t1 a -> t2 a -> [Int16]+uniquenessPeriodsGG sels whspss ws+ | F.null ws = []+ | otherwise = mapMaybe (helpGSel sels F.sum whspss) . unfoldr f $ ks+     where !ks = indexedL ws+           !vs = mapMaybe g ks+           g (x,y)+            | y `F.elem` whspss = Just x+            | otherwise = Nothing+           {-# INLINE g #-}+           f ys@(y:_) = let !idX0 = snd y in Just . (\(v2,v3) -> ((helpUPV3 vs [] .+                    map fst $ v2,snd . head $ v2),v3)) . partition (\(_,xs) -> xs == idX0) $ ys+           f _ = Nothing+{-# INLINE uniquenessPeriodsGG #-}++-- | A general variant of the diversity property. Use it in general case.+diverse2GGL :: (F.Foldable t1, F.Foldable t2, F.Foldable t3, Ord a) => t3 a -> t1 a -> t2 a -> Int16+diverse2GGL sels whspss = sum . uniquenessPeriodsGG sels whspss+{-# INLINE diverse2GGL #-}++-- | A variant of the 'diverse2GGL' function for 'Char'.+diverse2GL :: (F.Foldable t1, F.Foldable t2) => t1 Char -> t2 Char -> Int16+diverse2GL = diverse2GGL []+{-# INLINE diverse2GL #-}+--+-- | A variant for the 'uniquenessPeriodsGG' function for 'Char'.+uniquenessPeriodsG :: (F.Foldable t1, F.Foldable t2) => t1 Char -> t2 Char -> [Int16]+uniquenessPeriodsG = uniquenessPeriodsGG []+{-# INLINE uniquenessPeriodsG #-}++-- | A variant of the 'diverse2GGL' function for 'Int8'.+diverse2GLInt8 :: (F.Foldable t1, F.Foldable t2) => t1 Int8 -> t2 Int8 -> Int16+diverse2GLInt8 = diverse2GGL []+{-# INLINE diverse2GLInt8 #-}++-- | A variant for the 'uniquenessPeriodsGG' function for 'Int8'.+uniquenessPeriodsGI8 :: (F.Foldable t1, F.Foldable t2) => t1 Int8 -> t2 Int8 -> [Int16]+uniquenessPeriodsGI8 = uniquenessPeriodsGG []+{-# INLINE uniquenessPeriodsGI8 #-}++-- | The first and the third list arguments of numbers (if not empty) must be sorted in the ascending order.+helpUPV3 :: [Int16] -> [Int16] -> [Int16] -> [Int16]+helpUPV3 ks@(!z:zs) !acc ps@(!x:qs@(!y:_))+ | z < y && z > x = helpUPV3 zs ((y - x):acc) qs + | z < y = helpUPV3 zs acc ps+ | otherwise = helpUPV3 ks acc qs+helpUPV3 _ !acc _ = acc++indexedL :: F.Foldable t => t b -> [(Int16, b)]+indexedL = F.foldr f []+  where f x ((j,z):ys) = (j-1,x):(j,z):ys+        f x _ = [(1,x)]++helpG :: (Eq a, F.Foldable t1, F.Foldable t2) => (t1 b -> b) -> t2 a -> (t1 b, a) -> Maybe b+helpG h xs (ts, x)+  | F.null ts = Nothing+  | x `F.elem` xs = Nothing+  | otherwise = Just (h ts)+{-# INLINE helpG #-}++helpGSel :: (Eq a, F.Foldable t1, F.Foldable t2, F.Foldable t3) => t3 a -> (t1 b -> b) -> t2 a -> (t1 b, a) -> Maybe b+helpGSel sels h xs (ts, x)+  | F.null sels = helpG h xs (ts,x)+  | F.null ts = Nothing+  | x `F.elem` xs = Nothing+  | x `F.elem` sels = Just (h ts)+  | otherwise = Nothing+{-# INLINE helpGSel #-}+
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Revision history for aftovolio++## 0.1.0.0 -- 2024-09-21++* First version. Released on an unsuspecting world.+
+ Data/ChooseLine2.hs view
@@ -0,0 +1,67 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Data.ChooseLine2+-- Copyright   :  (c) Oleksandr Zhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- General shared by phladiprelio-ukrainian-simple and phladiprelio-general-simple functionality to compare contents of the up to 14 files line-by-line +-- and to choose the resulting option. ++{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables #-}++module Data.ChooseLine2 where++import GHC.Base+import Data.Foldable (mapM_) +import Data.Maybe (fromMaybe) +import Text.Show (Show(..))+import Text.Read (readMaybe)+import System.IO (putStrLn, FilePath,getLine,appendFile,putStr,readFile)+import Data.List+import Data.Tuple (fst,snd)+import Control.Exception (IOException,catch) ++-- | Is rewritten from the <https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array-0.21.0.0/docs/src/Phonetic.Languages.Lines.html#compareFilesToOneCommon>+-- Given a list of different filepaths and the resulting filepath for the accumulated data provides a simple way to compare options of the lines in every file in the+-- first argument and to choose that option for the resulting file. Therefore, the resulting file can combine options for lines from various sources.+compareFilesToOneCommon + :: Int -- ^ A number of files to be read and treated as sources of lines to choose from.+ -> [FilePath] + -> FilePath + -> IO ()+compareFilesToOneCommon n files file3 = do+ contentss <- mapM ((\(j,ks) -> do {readFileIfAny ks >>= \fs -> return (j, zip [1..] . lines $ fs)})) . zip [1..] . take n $ files+ compareF contentss file3+   where compareF :: [(Int,[(Int,String)])] -> FilePath -> IO ()+         compareF ysss file3 = mapM_ (\i -> do+          putStr "Please, specify which variant to use as the result, "+          putStrLn "maximum number is the quantity of the files from which the data is read: "+          let strs = map (\(j,ks) -> (\ts -> if null ts then (j,"")+                      else let (_,rs) = head ts in  (j,rs)) .+                       filter ((== i) . fst) $ ks) ysss+          putStrLn . unlines . map (\(i,xs) -> show i ++ ":\t" ++ xs) $ strs+          ch <- getLine+          let choice2 = fromMaybe 0 (readMaybe ch::Maybe Int)+          toFileStr file3 ((\us -> if null us then [""] else [snd . head $ us]) . filter ((== choice2) . fst) $ strs)) $ [1..]++{-| Inspired by: 'https://hackage.haskell.org/package/base-4.15.0.0/docs/src/GHC-IO.html#catch' + Is taken from the +https://hackage.haskell.org/package/string-interpreter-0.8.0.0/docs/src/Interpreter.StringConversion.html#readFileIfAny+to reduce general quantity of dependencies.+Reads a textual file given by its 'FilePath' and returns its contents lazily. If there is+some 'IOException' thrown or an empty file then returns just "". Raises an exception for the binary file. -}+readFileIfAny :: FilePath -> IO String+readFileIfAny file = catch (readFile file) (\(_ :: IOException) -> return "")+{-# INLINE readFileIfAny #-}++-- | Prints list of 'String's to the file as a multiline 'String' with default line ending. Uses 'appendFile' function inside.+toFileStr ::+  FilePath -- ^ The 'FilePath' to the file to be written in the 'AppendMode' (actually appended with) the information output.+  -> [String] -- ^ Each element is appended on the new line to the file.+  -> IO ()+toFileStr file = appendFile file . unlines+{-# INLINE toFileStr #-}+
+ EnglishConcatenated.txt view
@@ -0,0 +1,1 @@+["A","About","Across","Actually","After","After all","Against","Allegedly","Almost","Already","Among","Around","As","As far as","As if","As though","Aside","At","Barely","Before","Behind","Below","Beneath","Between","But","By","Despite","Even","Exactly","Except","Exclusively","For","From","However","I.e.","If","In","In addition","In order to","Into","Just","Let","Likewise","Near","Of","On","Only","Onto","Or","Over","Round","Still","Than","That is","The","Therefore","Though","Through","Throughout","To","Under","Unless","When","With","Without","a","about","across","after","against","allegedly","almost","already","among","around","as","as far as","as if","as the","as though","aside","at","barely","because","because of","because of that","before","behind","below","beneath","between","but","by","despite","despite that","even","even though","exactly","except","exclusively","for","from","however","i.e.","if","in","in order to","inhibit","instead of","into","just","let","like","moreover","near","of","on","only","onto","or","over","round","since the","so","so as","so that","still","than","that is","the","therefore","though","through","throughout","to","under","unless","whatever","whereas","while as","with","without"]
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020-2024 Oleksandr Zhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,42 @@+-- |+-- Module      :  Main+-- Copyright   :  (c) OleksandrZhabenko 2021-2024+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+--++{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK -show-extensions #-}+{-# LANGUAGE NoImplicitPrelude #-}++{-# LANGUAGE BangPatterns #-}++module Main where++import GHC.Base+import Aftovolio.Ukrainian.ReverseConcatenations+import System.Environment (getArgs)+import Text.Read (readMaybe)+import Data.Maybe (fromMaybe)+import System.IO+import GHC.List+++main :: IO ()+main = do+  args0 <- getArgs+  let !fstA = fromMaybe 1 (readMaybe (mconcat . take 1 $ args0)::Maybe Int)+      !args+        | fstA == 1 = filter (/= "-i") args0+        | otherwise = filter (/= "-i") . drop 1 $ args0+      !stdinput = any (== "-i") args0 -- If you specify \"-i\" then reads the input text from the stdin otherwise from the file specified instead.+  if stdinput then do+     contents <- getContents+     putStrLn . reverseConcatenations fstA $ contents+  else do+     let !file = concat . take 1 $ args+         !toFile = concat . drop 1 . take 2 $ args+     if null file then putStrLn "No file to read the Ukrainian text is specified. "+     else readFile file >>= return . reverseConcatenations fstA >>= (\ts -> if null toFile then putStrLn ts else writeFile toFile ts)
+ README.md view
@@ -0,0 +1,1044 @@+# aftovolio-ukrainian++Author and [software+developer:](https://hackage.haskell.org/package/aftovolio-ukrainian)+Oleksandr Zhabenko++# Introduction++Here is a brief introduction of AFTOVolio ideas and usage (that is Dutch 'Aanpak van Fonetische Talen voor het Ontdekken van de VOorkeursLIneOpties' — Phonetic Languages Approach for Discovering the Preferred Line Options).++Using AFTOVolio lets a person learn how to write the texts with the desired properties in pronunciation. ++The idea behind AFTOVolio is that the text is first created based on the meaning of what needs to be said. And then (or even during the previous one) it is organised (edited) into a better pronunciation, including a more rhythmic one.++## Basic idea++There are different languages. They have different structure and rules.+It is possible to create and use (based on one of existing widely used+and well-spoken languages, in particular Ukrainian in this work) a+'phonetic' language that is better suited for poetry and music. It is+even possible to create different versions of phonetic language. This+paper proposes to create several different phonetic languages based on+Ukrainian.++## What does this mean?++If someone builds a phrase in a language that violates the rules of+grammar or semantics, then this error is visible to a skilled speaker at+once, it is identified as such almost instantly. Instead, if the sound+of a phrase has some phonetic features, not counting accents, for+example, the complexity of pronunciation or vice versa lightness,+smoothness or abruptness, etc., then it is possible to identify it as an+error or something significant not immediately or with special+attention. One can imagine this as giving preference to the language+semantics (meaning) and grammar, but less weight to phonetics. Phonetic+language is that one built specifically to enhance the meaning and+importance of the phonetic component itself.++## Phonetic or prosodic language?++An interesting question is whether to call the approach \"phonetic\" or+\"prosodic\" languages. But I must say that we study the+actual phonetic features, what is associated with the sound of speech.+Among them is that which concerns certain phonetic phenomena in the+general case, in particular phonemes or even palatalization. These+questions are generally not the subject of the study of prosody as a+science, as a certain component of phonetics, but are the subject of a+broader study of phonetics. Moreover, there are no restrictions and+bindings of the proposed approach to the actual syllables, which is more+typical for the subject of the study of prosody. Generalizations in the+package+[aftovolio-general](https://hackage.haskell.org/package/aftovolio-general)+can be made for more general cases.++However, at this stage of development, the vast majority of information+here relates to or is directly related to syllables and prosody.+Therefore, I leave the name \"phonetic languages\", given that prosody+is a more specific branch of phonetics.++## Ethical component++The proposed approach is similar to the approach of music theory. Thus,+in music, among all sounds, musical ones stand out, later consonances+and dissonances are studied, later notes, intervals, chords, melodies,+composition, etc. There are recommendations, but they do not bind the+creators, but help. Similarly, the proposed approach is designed to+provide such assistance. Its strangeness at first glance cannot be a+reason to deny it.++For Christians, to whom the author himself belongs, the words of Moses+are important: \"And Moses went out, and spake unto the people the word+of the LORD, and gathered together seventy men of the elders of the+people, and set them near the tabernacle. And the LORD came down in the+cloud, and spake unto him, Two of the men remained in the state, one+named Eldad and the other named Modad, but the Spirit also rested on+them. And the young man ran, and told Moses, and said, Eldad and Modad+are prophesying in the camp: And Joshua the son of Nun, the servant of+Moses, one of his chosen ones, answered and said, My lord Moses. But+Moses said unto him, Hast thou not jealous of me? O that all the people+of the LORD should be prophets, if the LORD would send His Spirit upon+them\". (Numbers XI, 24-29).++It is good that everybody can well write and speak.++## First idea++Imagine that you can understand the information in the text regardless+of the order of the words and preserve only the most necessary grammar+(for example, the rule does not separate the preposition and the next+word is preserved). Understand just like reading a text (after some+learning and training, perhaps), in which only the first and last+letters are preserved in words in their positions, and all the others+are mutually mixed with each other. So imagine that you can understand+(and express your thoughts, feelings, motives, etc.) the message of the+text without adherence to strict word order. In this case, you can+organize the words (keeping the most necessary grammar to reduce or+eliminate possible ambiguity due to grammar, or rather a decrease in its+volume), placing them so that they provide a more interesting phonetic+sounding. You can try to create poetic (or at least a little more+rhythmic and expressive) text or music.++It can also be an inspiring developmental exercise in itself. But how+could you quickly find out which combinations are more or less fit?+Also, can the complexity of the algorithms be reduced?++These are just some of the interesting questions. This work does not+currently provide a complete answer to them, but is experimental one and+a research, and any result of it is valuable.++Ukrainian is a language without strict requirements for word order in a+sentence (although there are some established preferred options) and has+a pleasant sounding. So, it can be a good example and instance. In+addition, it is a native language for the author of the programs. Even+if you don't want to create and use "phonetic" languages where phonetics+is more important than grammar, then you can assess the phonetic+potential of the words used in the text to produce specially sounded+texts. It can also be valuable and helpful in writing poetry and+possible other related fields.++## Sound Representations Durations as the Basis of the Approach++There is the fact as the basis of the approach that the language sounds+have different durations, which depends on the many factors e. g. mean+of the phoneme producing (the different one for every one of them),+other factors that can be more or less controlled but usually the full+control is not required and is not achieved. This leads to the fact that+chaining of the phonemes and phonetic phenomenae sequentially among+which there is also their syllables groupping introduces some rhythmic+painting (picture, scheme). A human can (that is also trainable and can+be developed) recognize the traits of the picture, compare them one with+another, come to some phonetic-rhythmic generalizations and conclusions.++The question of determining the duration of speech sounds is not easy,+but the exact result as already mentioned is not required. In this+implementation of the approach of phonetic languages, certain+statistical characteristics of sounds are used, in particular, possible+durations are determined. If we compare the method of determining+durations, which is proposed and used in the program of the+[r-glpk-phonetic-languages-ukrainian-durations](https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations)+package, the analogy will be the packaging of bulky objects. For the+observer, the packaging will be an imaginary model of the process of+obtaining sound durations. The pldUkr program (its generalization pldPL+from the phonetic-languages-phonetics-basics package also follows this+path, but it does not have normalization, because for different+languages there may not be such a phenomenon as palatalization) uses+linear programming to find the minimum convex hull (not in a strict+mathematical sense), which can 'contain' the sounds of speech. This+convex hull has an analogy of packaging, while the sounds of speech have+an analogy of objects of variable volume inside the package. The same+sound can be used in different situations, in different words with+different durations, but the program tries to choose such durations that+would 'cover' (similar to the envelope curve 'covers' a family of+curves) all these variations for all sounds, with an additional+normalization of the duration of the phonetic phenomenon of+palatalization (softening) of the consonant, which is least controlled+by man, and therefore it is expected that this duration is the most+resistant to possible random or systematic fluctuations. For the+Ukrainian language the possible duration which does not change strongly+sounding is defined experimentally with use of the computer program+[mm1](https://github.com/OleksandrZhabenko/mm1).++Finally, normalization is not mandatory, it is important that all+durations are proportional to each other, i.e. it is not the durations+themselves (which are numerically expressed as real positive numbers)+that are important, but their mutual ratios (it is allowed to multiply+these durations simultaneously by one and the same positive number that+does not affect the results of the approach).++## Polyrhythm as a Multi-Ordered Sequence Pattern++Let us have some sequence organized in the following way. Let us+implement (generally speaking a conditional one) division of the+sequence into compact single-connected subgroups with the same number of+elements each in the subgroup, which actually means that we split the+sequence into a sequence of subsequences with the same number of+elements in each. Consider the internal ordering of each subsequence+from the perspective of the placement of the values of its elements and+repeatability of the some patterns of the placement of the elements. We+assume that the elements can be compared in relation of order, that is,+they are the elements of the data type that has an implemented instance+of the class Ord.++Considering that the elements of the subsequences may be pairwise+different (or in some cases equal), we will compare the positions on+which the subgroups of elements that have a higher degree of relatedness+(\"closeness\", \"similarity\") in value and order are located. Denote+such subgroups by indices that have in the module code mostly a letter+designation.++Then each subsequence will consist of the same number of elements of one+nature (in particular, numbers of the type Double), in each subsequence+there will be selected several subgroups of \"similar\" elements in+value (and order, if the subsequences are sorted by the value), each of+which will have its own index as a symbol (most often in the code -- the+characters). Subgroups must have (actually approximately) the same+number of elements (in the code it is not strictly used for+simplification of the former one, but it is so in the vast majority of+cases because of the excessive \"accuracy\" of numbers of type Double+that are used). Consider the question of positions in the subsequences+of the corresponding subgroups in case of they have been belonging to+different subsequences.++To assess this, we introduce certain numerical functions that have+regular behavior and allow us to determine whether the subsequences+actually have elements that belong to the relevant corresponding+subgroups in the same places, or on different ones. It can be shown that+the situation \"on different ones\" corresponds to the presence of+several rhythmimc patterns - for each subgroup will be their own, which+do not mutually match, at the same time the ideal situation \"completely+in the same places\" corresponds to the case when these rhythms are+consistent with each other, as is the case of coherence in quantum+physics, in particular spatial and temporal coherence, which is+important in particular for understanding of lasers and masers.+Polyrhythms consisting of such rhythms, which cohere with each other,+form a more noticeable overall rhythm, as well as the presence of+coherence in the radiation leads to a more structured latter one+(Zhabenko, n.d.b).++## Coherent States of Polyrhythmicity as One of the Essential Sources of Rhythmicity++The described pattern of rhythmicity is one of the significant possible+options for the formation of rhythmicity in particular in lyrics or+music, but not the only one. It should be noted that the described+mechanism of rhythm formation, as is noticed in the statistical+experiments with texts using this code (the code of the library and its+dependent packages on the Hackage site) may not be the only possible+option, but in many cases it is crucial and influences the course of the+rhythmization process (formation, change or disappearance of the+rhythm). It is also known that the presence of the statistical+relationship does not mean the existence of deeper connections between+phenomena, in particular -- the causality. \"Correlation does not mean+causality.\" A deeper connection implies the presence of other than the+statistical ones to confirm it.++## Rap Music Consequences++The code of the library allows in practice to obtain rhythmic patterns+that are often close to the lyrics in rap style. Therefore, this can be+attributed to one of the direct applications of the+library.++## A Child Learns to Read, or Somebody New to the Language++When a child just begins to read words in the language (or, there can be+just somebody new to the language) he or she starts with phonemes+pronunciation for every meaningful written (and, hence, read) symbol.+Afterwards, after some practice, he / she starts to read smoothly.+Nevertheless, if the text is actually a poetic piece, e. g. some poem,+it is OFTEN (may be, usually, or sometimes, or occasionally, etc.) just+evident that the text being read in such a manner has some rhythmicity+properties, despite the fact that the phonemes are read and pronounced+in a manner of irregular and to some extent irrelevant to the normal+speech mode lengths (durations). We can distinguish (often) the poetic+text from the non-poetic one just by some arrangement of the elements.++The same situation occurs when a person with an accent (probably,+strong, or rather uncommon) reads a poetic text. Or in other situations.+The library design works just as in these situations. It assumes+predefined durations, but having several reasonable (sensible) ones we+can evaluate (approximately, of course) the rhythmicity properties and+some other ones, just as the algorithms provided here.++This, to the mind of the author, is a ground for using the library and+its functionality in such cases.++## Problem of choosing the best function and related issues++Consider the following question: suppose we have obtained the best+version (in our subjective opinion or on the basis of some criteria, it+is irrelevant here) of the line in one way or another (here the method+does not really matter). Is there a function that makes this particular+variant of the string optimal, i. e. for which such a variant of the+string gives the maximum of all possible permutations? Yes, there is.+This is easy to prove. The proof is reminiscent of the principle of+equalizers.++Let $n \in N$ be the number of syllables in such a line. Arrange the+durations of the syllables in ascending order (standard procedure for+descriptive statistics). We will find the smallest nonzero difference+between adjacent values, divide it by 5. Denote this value by $\delta$.+Now consider a number of syllable durations for our best string. Number+each syllable from the beginning, counting from 1. Denote by+$Y = \{y_{i}, \quad i \in N, \quad i= 1,2, \ldots, n \}$ the set of all+values of durations in the order of sequencing in the best line. Denote+by $X = \{0 = x_1, x_2, \ldots, x_i, x_{i+ 1}, \ldots, x_{n + 1}, +\quad i \in N, \quad i = 1,2, \ldots, n \}$ the set of coordinates of+the points of the ends of time conventional intervals, into which our+best line divides the time line (the left edge is 0, because the+countdown starts with 0). Denote by+$M = \{z_i = \dfrac {x_i + x_{i + 1}} {2},\quad i \in N, +\quad i = 1,2, \ldots, n - 1 \}$ a set of midpoints of the segments into+which the time line is divided by the conditional intervals ends. Denote+by $L_1 [a, b]$ the class of Lebesgue-integrable functions on the+interval $[a, b]$. Let's mark+$I (y_i, z_i, \delta) [z_i - \delta, z_i + \delta]$ class of all bounded+functions with $L_1 [z_i - \delta, z_i + \delta]$, the maximum and+minimum values of each of which lie on the segment+$[y_i -\delta, y_i + \delta]$. We denote each function of class $I$ by+$g$.++Consider the class of functions $F$ (a kind of finite analogues of the+known delta functions of Dirac), defined as follows:++$$f (x, i) = +\begin {cases} +g \in I (y_i, z_i, \delta) [z_i - \delta, z_i + \delta], +\quad \text {if } y_ {i} \text { is a unique value in the set } Y, \, x+\in [z_i - \delta, z_i + \delta] \\ +y_ {i}, \quad \text {if } y_ {i} \text {+has equal value with some other number from the set } Y, \, x \in [z_i - +\delta, z_i + \delta] \\ +0, \quad \text { otherwise} +\end {cases}$$++It is easy to see that+$$\sum_{i = 1}^n \int_{-\infty}^{\infty} f(x, i) \, +\textrm {d} x,$$ where integration is carried out according to Lebesgue,+is the desired function (because only the syllables of the best string+in their places, taken into account with their indices, give a positive+contribution to its value, and for all other variants of the function at+least some of the syllables give 0 contribution), and it is not unique+due to the fact that in the first line of definition $f(x, i)$ the+function can have an arbitrary value from a closed non-empty interval.+Therefore, there is at least one class of functions that is described by+such a formula, for each of which this particular variant of the string+will be optimal.++Let's ask the following question: if we consider not a line, but their+combination, for example, a poem. Does a function that makes each line+optimal (i. e. which will describe the whole work, each line in it)+exist for the whole work (for this whole set of lines)?++In this case, the previous method of constructing the function does not+give the desired result, because for two lines it may be that what is+best for one of them is not the best for the other. In the case of+increasing the number of lines, this general suboptimality only+intensifies. However, the existence of such a function for different+particular cases is a fundamentally possible situation, however, the+probability of its existence should decrease both with increasing number+of rows and with the appearance of different features of rows, which+increase the differences between them. In general, the search for just+one such function may be virtually impractical.++Nevertheless, if we consider the whole work as one line, considering it+optimal, then the method just described to construct the corresponding+function (class of functions) again gives the result. Yes, the number of+syllables in it (in the generalized \"line\"-work) increases, but the+procedure itself gives similar results (if we neglect the possible+identical durations and repetitions of syllables in a larger text, which+lead to the fact that some words can be rearranged and that makes the+text only approximately optimal). It is possible to suggest further+improvement of this procedure (for example, introduction of the factors+which depend on values ​​of the next durations of syllables) that allows+to reduce suboptimality of the text.++But still, if you go from one text to another, the resulting function is+unlikely to be optimal.++We conclude that for the whole set of expediently organized texts the+existence of a universal function is seen as a certain hypothesis (with+almost certainly proposes a negative answer).++## Ability to use your own durations of representations of sounds or phonetic phenomena++The programs offer four different sets of phonetic representations by+default but starting with version 0.13.0.0 it is possible to set your+own durations. To do this, specify them as numbers of type 'Double' in+the file in the order defined as follows:++where the specified values in the list refer to the phonetic+representations of the data type UZPP2 (from the module+Phladiprelio.Ukrainian.Syllable). The last column is 8-bit integers+(GHC.Int.Int8), which represent these sounds in the new modules.++If you want to specify several such sets (up to 9 inclusive), you can+specify '\*' or several such characters from a new line, and then from+the next line there will be a new set of values.++Each set should be in the following order:+\[1,2,3,4,5,6,7,8,9,10,11,15,16,17,18,19,20,21,22,23,24,25,26, 27,28,29,30,31, 32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,66,101\]++where the number corresponds to the last column in the above diagram.+101 (prior to the version 0.20.0.0 here there was -1 instead, and it was+at the beginning of the list, not at the end) corresponds to a pause+between words (does not affect the search results of the line). Every+new value must be written in the file from the new line.++Then when executing the program somewhere among the command line+arguments (it does not matter where exactly) specify \<\<+d\>\> \<path+to the file with the specified data\>. Programs will read these values+and convert them to the appropriate values. As properties it is+necessary to use then those which begin with the letter \<\<H\>\>, and+further the corresponding designation of property merged with it. For+example, \<\<Hw04\>\>, the last digit in the record in this case will+mean the ordinal number of the set of values, starting from 1 (maximum+9).++Along with the custom values, you can use the provided by the library+ones, as usual, in the mode of several properties.++## Minimum grammar for possible preservation of meaning and intelligibility++Programs use permutations of words that neglect any (or at least part+of) grammatical connections, word order, and so on. This can lead (in+addition to the need to think) to situations where grammatically related+language constructions are broken, their parts are transferred to other+places, forming new connections and changing the meaning of the text.++To reduce this, to eliminate some of these effects, programs use+concatenation of words that have a close grammatical connection, so as+not to break them in the analysis. This allows you to maintain greater+semantic ease and recognizability of the text, as well as a side effect+to increase the overall length of the line, which can be analyzed. In+the Ukrainian language, grammatically related auxiliary or dependent+words precede the independent or main one, so the concatenation of these+auxiliary or dependent words to the next one is used. The completeness+of the definition of such cases is not exhaustive, but the most frequent+cases are considered.++To reduce this, to eliminate some of these effects, programs use+concatenation of words that have a close grammatical connection, so as+not to break them in the analysis. For the general case, it should be+borne in mind that auxiliar or dependent words can go after the+independent or the main, so this should be considered separately (and+attach such words to the previous, not to the next). Currently, the+generalized version of aftovolio-general-simple supports both.++## Advice how to use the programs++In correspondence with the previous information, the rhythmicity of the+proposed by the programs variants can be in many cases more evident and+perceived better if you read the words (their concatenations) at the+lines without significant pauses between them (as one single phonetic+flow), not trying to strengthen emphases (probably even without well+articulated emphases, smoothly, with liasing). This can be even in a+different way, but if the obtained variants do not seem to be rhythmic+enough then try just this option and since then compare and come to+conclusion whether such sounding is just suitable for your situation.++An interesting additional information about the rhythm and related+musical topics is in the video:++1\. Adam Neely. [Solving James Brown's Rhythmic Puzzle](https://youtu.be/DcrYaRJD_e8). Adam Neely. 2021.++# Constraints++An interesting system of constraints+was introduced, which allow considering only some subsets of all+possible options, which are built taking into account the relative order+of words and their place in a line.++When starting the aftovolioUkr program, constraints can be specified+as command line arguments. They allow you to reduce the number of+calculations, consider only certain options (for example, with a certain+defined order of some words, etc.), which allows you to actually expand+the capabilities of the program.++There are two options for encoding information about constraints. They+use the same basic constraints, but differ in that the extended version+allows you to perform algebraic operations on Boolean sets, which allows+you to get the complete result, whatever it is, in one input. Instead,+the older variant is based on simple linear logic, which can also be+sufficient in many cases - all used constraints in the base form must be+fulfilled simultaneously, which is equivalent to having a relationship+between them through the operator (&&) (boolean \"AND\") and the+intersection of the corresponding Boolean sets.++Since words and their combinations in this implementation are assumed to+be no more than 7 in a row, all numbers in the basic constraints must be+no larger than 7 for the constraint to be \"non-zero\".++It is also worth saying that to get more or less interesting results, it+is often advisable to reduce the number of restrictions and use less+than necessary.++There are 15 types of basic constraints, and they can be combined in any+way, but in compliance with the specifications for each of them. If the+specifications are violated, the program will read this constraint as+its absence (equal to \"E\").++The basic principle is that the digits indicate the ordinal number of a+word or a combination of words written as one word in a string starting+from 1 (a natural number), and the letter indicates the type of basic+constraint. The rule has an exception -- a \"zero\" constraint (its+absence, i.e. the entire set of all possible permutations is indicated),+which has only a letter and no digits -- \"E\".++Another necessary condition for the constraint to be non-zero is that no+digital symbols within the same encoded constraint cannot be repeated+twice. For example, the following constraints are known to be invalid+constraints: Q2235 (repeated digits), E2 (numeric characters in a zero+constraint where there are none), T2435 (8 is greater than 7). T248 (8+is greater than 7), F1 (one character instead of the required two),+A3852 (8 is greater than 7), B5 (one character, but there should be+more).++The types of restrictions and their meanings are described in more+detail below.++-   Constraint E -- No additional numeric characters - Corresponds to+    the absence of an additional constraint. Denotes the entire set of+    all theoretically possible permutations. If used in the extended+    version (+b \... -b), it can be negated by the symbol \"-\", and+    then it corresponds together with this symbol to an empty set of+    permutations, i.e. no actual options are present.++-   Constraint Q -- 4 pairwise unequal digits in the range from 1 to the+    number of words or their concatenations. The digits are the numbers+    of 4 words or their concatenations, the mutual order of which will+    be preserved in the permutations.++    Also, if these words are the same (without taking into account+    uppercase and lowercase letters), then this is a convenient way to+    reduce the amount of data to be analysed.++-   Constraint T -- 3 pairwise unequal digits between 1 and the number+    of words or their concatenations -- The digits are the numbers of 3+    words or their concatenations, the mutual order of which will be+    preserved in the permutations.++    Also, if these words are the same (without taking into account+    uppercase and lowercase letters), then this is a convenient way to+    reduce the amount of data that will be analysed.++-   Constraint U -- 5 pairwise unequal digits in the range from 1 to the+    number of words or their concatenations. The digits are the numbers+    of 5 words or their concatenations, the mutual order of which will+    be preserved in the permutations.++    Also, if these words are the same (without taking into account+    uppercase and lowercase letters), then this is a convenient way to+    reduce the amount of data to be analysed.++-   Constraint F -- 2 unequal digits between 1 and the number of words+    or their concatenations -- The digits are the numbers of 2 words or+    their concatenations, the mutual order of which will be preserved in+    the permutation.++    Also, if these words are the same (without taking into account+    uppercase and lowercase letters), then this is a convenient way to+    reduce the amount of data to be analysed.++-   Constraint A -- 1 digit and several more unequal digits (all unequal+    to each other) to its right in the range from 1 to the number of+    words or their concatenations - The first digit is the sequence+    number of the element, relative to which the placement of all other+    elements (words or their concatenations); all other digits to the+    right -- the numbers of the elements that should appear in the+    resulting permutations TO THE RIGHT of the element with the number+    equal to the first digit.++-   Constraint B -- 1 digit and several more pairwise unequal digits to+    its right in the range from 1 to the number of words or their+    concatenations -- The first digit is the sequence number of the+    element in relation to which the placement of all other elements+    (words or their combinations); all other digits to the right -- the+    numbers of the elements to be placed in the resulting permutations+    TO THE LEFT of the item with the number equal to the first digit.++-   Constraint P (fixed Point) -- 1 or more several pairwise unequal+    digits in the range from 1 to number of words or their+    concatenations -- each of them means the ordinal number of the word+    that will remain in its place during permutations place.++-   Constraint V -- (as half of W) -- 2 unequal digits in the range from+    1 to the number of words or their concatenations, each of which+    means the ordinal numbers of two words, the distance between which+    and the mutual order of which will be preserved in all permutations.+    Most often it can be used for two neighbouring words and means then,+    that they will be present as such a pair in all the variants being+    analysed. It is also important if you don't want to concatenate such+    words so as not to change the syllables of their common+    (\"tangent\") boundaries at the same time.++-   Constraint W -- (from the word tWo -- 2) -- 2 unequal digits in the+    range from 1 to the number of words or their concatenations, each of+    which means the ordinal numbers of the two words, the distance+    between which will be preserved in all permutations. Most often it+    can be used for two neighbouring words and means then, that they+    will be present in all variants together, but their relative order+    can be also reversed.++-   Constraint H -- (from the word tHree -- 3) -- 3 unequal digits in+    pairs in the range from 1 to the number of words or their+    concatenations, each of which means the ordinal numbers of the three+    words, the distances between which and the mutual order of which+    will be preserved in all permutations. A certain subset of the+    constraint R. Most often used for three words in a row.++-   Constraint R -- (from the word thRee -- 3) -- similar to H, but only+    the distances between the first two words are preserved, and the+    same for the distances between the second and third words. Their+    order can be changed to reverse. It's a rather complicated+    combination, but it can be important in terms of grammar, as well as+    the string to be analysed.++-   Constraint M -- (from the word Mixed) -- mixed H-R constraint --+    similar to H, but between the first two words are preserved both the+    distance and their relative position, and only the distance is+    preserved between the second and third ones. It is also a rather+    complex combination, a certain subset of the constraint R.++-   Constraint N --- (fixed poiNts) --- an even non-zero number of+    digits, where each digit in an odd position (first digit, third,+    fifth, etc.) means the ordinal number of the word or combination in+    the string that must be fixed in a new position, and the next digit+    is the new ordinal number of this word or combination; thus, if this+    pair of digits is the same, it means that this word should remain in+    its place, otherwise it will be fixed in a new position. Generalised+    constraint P, where the user can change the position of words and+    their combinations in the string and fix them.++-   Constraint D --- (DistanceD worDs) --- three digits, the first two+    of which must be unequal and indicate the sequence numbers of two+    words or their combinations, which must preserve the mutual order,+    and the third digit is the new distance between these words (1 means+    that the words are consecutive, 2 means that there is one other word+    between the words, etc.), it must be in the range from 1 to the+    number of words and their combinations minus 1. A generalisation of+    constraint V, where the user can specify a new distance between+    words.++-   Constraint I --- (dIstanced words) --- is similar to D, with the+    difference that the words can be in reverse order. Therefore, in the+    symbolic notation, Iabc == Ibac. Also, Dabc + Dbac == Iabc. A+    generalisation of the W constraint, where the user can specify their+    own distance between words.++## Simple linear \"AND\" logic++If only one of the basic constraints is used, or it is known for sure+that it is necessary that all basic constraints in their set are+fulfilled simultaneously, then you can use this option. It is logically+the same as the one implemented previously.++To do this, you use +a \... -a \"brackets\" between which there are+constraints in their record, and all of them are separated from each+other by a space. For example:++-   +a P23 A456 -a -- means that Ρ23 and Α456 are satisfied+    simultaneously, i.e. that the second and third words must remain in+    their places (constraint P), and that the fifth and sixth words must+    come after the fourth (constraint A).++-   +a B23 F45 E T356 -a means that B23, F45, E and T356 are satisfied+    simultaneously, i.e. the third word must come after the second, the+    fifth after the fourth, a \"zero constraint\" (meaning that it can+    be omitted), and the relative order of the third, fifth and sixth+    words must be preserved.++In fact, the space character between the constraints in this variant+means a logical \"AND\".++If you need to set more complex constraints, or in general, in view of+the possible faster work with the program, you should use the general+algebraic version of setting constraints.++## Algebraic (universal) variant of constraints++I would like to point out that in order to use this functionality+efficiently, you need to know the basics of logic and/or set theory, but+these materials are widely available in different languages, including+Ukrainian and English, at different levels of complexity. As for+mathematics, you should at least understand what logical AND+(conjunction), logical OR (disjunction), logical negation (NOT),+universal set, and complementary set are. If you know how to program in+at least one language, you are also familiar with these concepts and+have used them.++To use the algebraic version of constraints, you use +b \... -b+\"brackets\" between which the constraints in their record are placed,+and you can additionally use brackets and the \"-\" sign, which means a+logical negation (logical \"NOT\") of the next after minus expression in+brackets or the basic constraint. Parentheses, as is often the case,+indicate the order of calculation, as in algebra. After the minus, there+must be either an open parenthesis and an expression or an underlying+constraint.++If the constraints are written consecutively without spaces, the program+understands this as a \"multiplication\" of the constraints, i.e. a+logical \"AND\", and if there is a space between them, it is an+\"addition\" (logical \"OR\").++There can be no more than 1 \"-\" in a row, and there can be only one+space between groups of constraints. Parentheses must be opened and+closed according to the general rules of algebra (for example, the+number of open and closed parentheses must be equal to each other). If+these rules are violated, the program will display a message that it is+impossible to output options that meet these constraints and ask you to+specify other data and constraints. A bracketed group must contain at+least one basic constraint. The priority of operations is the same as+for logical operators in Haskell and in Boolean logic in general.++Note: if you use Linux shells (e. g. bash) or Windows PowerShell then+for the usage of parentheses you need to use quotation marks for the+whole generalized algebraic constraint. Please, refer to the further+documentation for your shell or PowerShell.++Examples of correct constraints:++-   +b '(A23-H345 P45-(A24 B56))' -b is a symbolic representation of a+    Boolean set++        (Α23 && not H345 || P45 && not (A24 || B56)),++    where 'not' means a completion to the set in the universal set of+    permutations, i.e. here it means all those theoretically possible+    permutations, except for those denoted by the expression after+    \"-\". Mathematically, this can be written as:+    $$(A23 \land \neg H345 \lor P45 \land \neg (A24 \lor B56))$$++-   +b A345B62 P4-Q3612 -b is a symbolic representation of a Boolean set++        A345 && B62 || P4 && not Q3612,++    which is mathematically equivalent to:+    $$A345 \land B62 \lor P4 \land \neg Q3612$$++-   +b '(E)-P4' -b is a symbolic representation of a Boolean set++        (E) && not P4,++    which is mathematically equivalent: $$U \land \neg P4 = \neg P4,$$+    where $U$ is the universal set of all theoretically possible+    permutations.++Examples of mis-specification of constraints -- if in each of the+previous examples above remove one character except for numbers and+spaces, or write two consecutive minuses or spaces anywhere. Or open and+close brackets without letters inside.+++# Why some lines are easy to pronounce and others are not, or Prosodic unpredictability as a characteristic of text++## Unpredictability in reading and speaking++### Main observations and the idea++Let’s take a look at how the software works and why the strings it offers in different parts of its output+can be read and pronounced so differently, even though they consist of the same words (almost the+same sounds, if we do not take into account possible phenomena of assimilation and similarity).++The author of the software noticed that when working with the program for different options of a line,+unexpected pauses may appear in the program output, during which a certain change in the rhythm+of speech occurs (the previously mentioned incongruities). Such pauses for an experienced reader+(speaker) do not (may not) occur within words, but only between words and their combinations.++The phenomena of perception and apperception are known to be combined.++During perception, a person partially "guesses" the part of the line that he or she is going to read+and prepares his or her speech apparatus for this.++It can be reasonably assumed that the appearance or absence of such pauses is due to an unpredictable+change in the line, which does not correspond to the pattern to which the person has been attuned+by their combination of aperception and perception.++One of the factors that affect apperception is specifically the presence of a previously detected rhythmic+pattern, and therefore, the appearance of these pauses is more likely to occur when this pattern+changes. Nevertheless, it has also been observed that a person can learn to read (pronounce) a line+as a single phrase without the presence of these pauses, if he or she makes a certain effort and also+as a result of training (repeated readings of one of the lines with memorisation of the structure). Also,+the number of such pauses is significantly reduced if you read different options of the same line in a+row (one can think that a person is preparing for such changes, which they already partially know).+Let us dwell a little more on "guessing" (prediction).++If, as a result of a combination of apperception and perception, a person "guesses" what the next+speech structure will be, the "fluidity" (smoothness) of the line, then there is no such pause, the text is+read (pronounced) further according to the combination of perception and apperception by the already+prepared speech apparatus, which minimises delays.++If, on the other hand, perception creates an instantaneous "false prediction" of what the further speech+construction, the "smoothness" of the line will be, then for expressive speech, the speech apparatus+has to be readjusted on the fly, first detecting this discrepancy between the aperceptual predicted+pattern and the actual construction of the text, and only then readjusting to this change and forming+a new perception, a new forecast for the future. These latter processes take more time, and therefore+an additional, prolonged pause and the emergence of a feeling of a "break" in the line, intonation,+difficulty of pronunciation, etc.++It can also be assumed that for an inexperienced reader or speaker who reads (pronounces) line by+syllables, slowly, such additional delays should be almost non-existent, since they are much less+likely to use apperception, but mostly perception.++### Analysis of the prediction pattern++What is the pattern of prediction?++The software offers variants in which there is a certain repeatability (or its somewhat unpredictable+change) of the relative relative placement of syllables (time elements in the more general case) wdifferent durations, and allows also, in certain cases, to say what these patterns will be approximately. Perception, when repeated several times (for several metrical feet) or at least once in a line of a+certain sequence of durations, causes an expectation, a forecast for the continuation of such repetition+as something more likely, i.e. recognises a certain pattern of rhythmicity, and causes a certain+preparation for it. ++## The case of a two-syllable metrical foot++Let’s take the case of a two-syllable foot as an example. If you run the program by calling++aftovolioUkr +r 21 <Ukrainian text>++then this is exactly the case when the program will analyse two-syllable feet.++It often happens that the value of the property in this case for several variants will be 0.++What does this mean? If you look at the code, you can see that this corresponds to the case when+each subsequent metric foot, starting with the first in the string, offers a modified version of the foot+to a mirror-opposite one if the syllable durations in it are not the same (which is the case in the vast+majority of cases). This means a consistent, constant alternation of the iamb and the chorus according+to one of two options.++In the first case, the first foot is a chorus, and in the second -- an iambic. Then in the first case,+such a line will have the structure (except for the first syllable, which is "extra") -- pyrrhic -- spondee -+pyrrhic - spondee \.\.\., and in the second case (except for the "extra" first syllable) -- spondee -- pyrrhic+-- spondee -- pyrrhic \.\.\.++This leads in many cases to a more undulating intonation, with short groups of longer and shorter+syllables alternating (except for the first syllable). Moreover, the ending of such a line can contain+either a full spondee or pyrrhic (if the number of syllables in the line is odd) or only half of it (if the+number of syllables in the line is even).++The opposite options in the output of the program will be those for which the property value will+be the maximum possible for these words. This, in turn, means that if this number is equal to the+theoretical maximum (the quotient of the number of syllables in a line and 2), then the line is a+perfectly constructed iambic or chorus (according to its metrical properties), except, perhaps, for its+immediate ending (the last syllable if the number of syllables is odd). This often leads to the fact+that such a line is often read in accordance with a distinctive iambic or chorus pattern - often quite+smoothly, without the above-mentioned pauses.++In practice, the first option (with a value of 0) is very common, almost always is present, but the latter+is rare. More commonly, it is not possible to create a perfect iambic or chorus for the given words+(but if you replace them with other, more appropriate ones, you can get a perfect line in many cases+due to the synonymous richness of the language).++However, if the maximum value of a property differs from the maximum theoretically possible by an+even number (2, 4, 6, etc.), then the feet at the beginning and end of the line are the same (except+possibly the last syllable if the number of syllables is odd), and inside the line they alternate as+many times as this number differs from the maximum possible number. If the maximum number differs+from the maximum theoretically possible by an odd number (1, 3, 5, etc.), then at the beginning and+end of the line - different feet (except, perhaps, the last syllable if the number of syllables is odd++In these "close to ideal" cases, pauses are often possible, but also possible pauses are often present,+but they can also be absent, depending on where the changes in the feet occur (between words or+within words), and whether it is correctly predicted.++If we consider the intermediate values of the property, we get less predictable line options, which can+still be reasoned about in a similar way to the second case (and the closer the value of the property+is to 0, the more the line becomes similar to the first case with a more undulating structure).++# Stylistic peculiarities in language and versification of the Taras Shevchenko’s poem ”Садок вишневий коло хати” using AFTOVolio++Let's consider Taras Hryhorovych Shevchenko's poem \"Cherry orchard+around the house\...\" in relation to the author's style, and more+precisely, the peculiarities of language and versification. To do this,+we will use the programs of the+phonetic-languages-simplified-examples-array package from the Hackage+website.++Next, it is shown how you can analyze the text, knowing how to work with+the programs of the package, and what conclusions this leads to.++## Analysis++Let's try to use the property y0 with a selective sum to analyze the+original version of the poem \"Садок вишневий коло хати\" by Taras+Shevchenko.++Let's pay attention to the second line - \"Хрущі над вишнями гудуть.\"+In it, the words \"хрущі\" and \"гудуть\" with \"у\" are placed as far+as possible from each other. This suggests that this line satisfies the+property y0.y. We check:++    aftovolioUkr +ul  y0.у Хрущі над вишнями гудуть+    7  Хрущі гудуть надвишнями   3        7  надвишнями Хрущі гудуть   4+    6  надвишнями гудуть Хрущі   2        18  гудуть надвишнями Хрущі   5+    6  гудуть Хрущі надвишнями   1        19  Хрущі надвишнями гудуть   6+    +Indeed, 19 out of a maximum possible 19! But it can be noticed that the+vowels in the words are selected so that they do not repeat closely, so+the maximum can be expected not only for y0.y, but also for the more+general property y0.vw:++    aftovolioUkr +ul y0.vw Хрущі над вишнями гудуть+    7  Хрущі гудуть надвишнями   3        7  надвишнями Хрущі гудуть   4+    6  надвишнями гудуть Хрущі   2        18  гудуть надвишнями Хрущі   5+    6  гудуть Хрущі надвишнями   1        19  Хрущі надвишнями гудуть   6+    +Again the maximum 19 out of 19 possible! Okay, that's it for this line.+And for the whole poem? If we check every line with ++    aftovolioUkr +ul y0.vw++command, then we see many maximums. ++We check: indeed, many maximums! But not all\.\.\. Let's try to add+something or take something away to increase the number of maxima, then+this new property will be the most appropriate. Let's see where there+are no maxima and why. For example, lines in a row --- \"А матері+вечерять ждуть. // Сем'я вечеря коло хати // \" --- in them we notice+that the sounds \"е\" are close to each other. Then if you take away the+\"е\", maybe it will be closer to the maximum? We check:++    aftovolioUkr +ul y0.а.о.у.и.і++We pay attention, indeed, for these lines there was a shift towards+maximums, the last line \"Та соловейко не затих\" also \"risen\" to the+maximum (admittedly, from two possible options). Instead, the line+\"Дочка вечерять подає\" \"dropped\" from the maximum to the 3 interval.+It can be assumed that the \"status\" of \"е\" in the poem is+\"unclear\": with or without it.++As you can see, it is not possible to achieve maximums everywhere under+various options. This is especially true of the three lines in a row at+the end: \"Поклала мати коло хати // Маленьких діточок своїх // Сама+заснула коло їх\" And also \"Співають ідучи дівчата // А матері вечерять+ждуть.\" In the second case, can see that \"у\" alternates with \"i\",+that is, we have \"ю(у) - i - y\", as well as in the next \"e - i - e -+e\". It can be assumed that there is 'art sound painting' here - vowels+alternate to reproduce the motifs of the melody and rhythm of folk+songs. Similarly, it can be assumed that before the end of the poem, the+vowels begin to \"group\" closer, that is, a \"coherent, dynamic\"+effect is created, that is, amplification, and it can be thought that it+describes a certain change in the situation. Let's see, it can really be+called the highest point (climax) of the poem, and therefore its+amplification by grouping of vowels creates the effect of the top of the+picture. Accordingly, it is necessary to read (recite) these lines (this+is justified, see the title) with a certain acceleration, not measured,+but more cohesively. At the same time, es where we have a maximum for+vowels (or vowels with deaf consonants) should be read more measuredly,+so that it is possible to see the richness of the painting, its calmness+and stability. The penultimate line has a pause in the middle---like a+pause after a highest point (climax). And then the denouement.++It must be said that, having 3-4, sometimes 2 words in a line, in order+not to create the impression of \"short lines\", a certain+\"ungrouping\" of sounds should be applied, so that it can be perceived+as a leisurely narration (as in this case).++## Conclusions++It can be concluded that Taras Shevchenko wrote the lines of the poem in+such a way as to place vowels more widely, as well as voiceless+consonants (where there are not enough vowels, for melodiousness), but+there, perhaps, there was more dynamism --- there, on the contrary, he+chose options with their closer grouping . Therefore, these lines should+be read more dynamically.++# Usage of the executable++SYNOPSIS:++- aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+c <HashCorrections encoded>] [+n] [+l] [+d <FilePath to file with durations>] [+k <number - hash step>] [+r <groupping info>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>]] <Ukrainian textual line>++OR:+- aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+c <HashCorrections encoded>] [+n] [+l] [+d <FilePath to file with durations>] [+k <number - hash step>] [-t <number of the test or its absence if 1 is here> [-C +RTS -N -RTS]] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+x <maximum number of words taken>]] <Ukrainian textual line>++OR:+- aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+ul <diversity property encoding string>] [+n] [+l] [-p] [+w <splitting parameter>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>]] <Ukrainian textual line>++OR:+- aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+n] [+l] [+d <FilePath to file with durations>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+q <power of 10 for multiplier in [2..6]>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>] [+l2 <a Ukrainian text line to compare similarity with> -l2]] <Ukrainian textual line>++OR:+- aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+n] [+l] [+d <FilePath to file with durations>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+q <power of 10 for multiplier in [2..6]>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>] [+m <FilePath> <num1> +m2 <num2>]]++OR:+- aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+n] [+l] [+d <FilePath to file with durations>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+q <power of 10 for multiplier in [2..6]>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>] [+m3 <FilePath> <num1> <num2>]]++OR:+- aftovolioUkr [-cm <FilePath to write the resulting combined output to> <FilePaths of the files to be compared and chosen the resulting options line-by-line>]++### Executable commandline parameters and their meaning++- +n      — if specified then the order of sorting and printing is descending (the reverse one to the default otherwise).++- +l      — if specified then the output for one property (no tests) contains empty lines between the groups of the line option with the same value of property.++- +w      — if specified with the next Int8 number then the splitting of the output for non-testing options is used. Is used when no "-t" argument is given. The output is splitten into two columns to improve overall experience. The parameter after the "+w" is divided by 10 (-10 for negative numbers) to obtain the quotient and remainder (Int8 numbers). The quotient specifies the number of spaces or tabular characters to be used between columns (if the parameter is positive then the spaces are used, otherwise tabular characters). The remainder specifies the option of displaying. If the absolute value of the remainder (the last digit of the parameter) is 1 then the output in the second column is reversed; if it is in the range [2..5] then the output is groupped by the estimation values: if it is 2 then the first column is reversed; if it is 3 then the second column is reversed; if it is 4 then like 2 but additionally the empty line is added between the groups; if it is 5 then like for 3 and additionally the empty line is added between the groups. Otherwise, the second column is reversed. The rules are rather complex, but you can give a try to any number (Int8, [129..128] in the fullscreen terminal). The default value is 50 that corresponds to some reasonable layout.++- +s      — the next is the digit from 1 to 4 included. The default one is 2. Influences the result in the case of +d parameter is not given.++- +d      — if present, then afterwards should be a FilePath to the file with new durations of the Ukrainian AFTOVolio representations. They can be obtained using the information in the manual by [the link](https://oleksandr-zhabenko.github.io/uk/rhythmicity/aftovolioEng.7.pdf#page=12) and the 2 next pages in the pdf file, besides on [the page](https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations) and on [the commentaries here](https://hackage.haskell.org/package/aftovolio-ukrainian-shared-0.5.0.0/docs/Phladiprelio-Ukrainian-ReadDurations.html#v:readSound8ToWord8) with the last one having priority.++- -p      — if present the minimal grammar transformations (appending and prepending the dependent parts) are not applied. Can be useful also if the text is analyzed as a Ukrainian transcription of text in some other language.++- +f      — if present with two arguments specifies the file to which the output information should be appended and the mode of appending (which parts to write). The default value if the secodnd parameter is 0 or not element of [1,2,3,4,10,11,12,13,14,15,16,17,18,19] is just the resulting String option. If the second parameter is 1 then the sequential number and the text are written; if it is 2 then the estimation value and the string are written; if it is 3 then the full information is written i. e. number, string and estimation; if it is 4 then the number and estimation (no string).+The second arguments greater or equal to 10 take effect only if the meter consists of two syllables (in case of "+r 21" command line options given). If it is 10 in such a case then before appending the line option itself to the given file there is hashes information for this line option displayed. If it is 11 — the same hashes information is displayed before processing as for 1. If it is 12 — the same hashes information is displayed before processing as for 2 and so on for 13, 14. If it is 15 up to 19 — it is analogically to the the 10–14 but the hashes information is not only printed on the screen, but appended to the file specified. These values are intended to test the interesting hypothesis about where the pauses can occur. For more information on the hypothesis, see:+ https://www.academia.edu/105067761/Why_some_lines_are_easy_to_pronounce_and_others_are_not_or_prosodic_unpredictability_as_a_characteristic_of_text++- +dc     — if specified with two further arguments then the first one can be 1 or something  else. If it is 1 then additionally to every line as usual there is printed also <br> html tag at the end of the line for the two-columns output. Otherwise, nothing is added to each line. The second argument further is a FilePath to the writable existing file or to the new file that will be located in the writable by the user directory. The two-column output will be additionally written to this file if it is possible, otherwise the program will end with an exception.++- +a \... -a       — if present contains a group of constraints for AFTOVolio. For more information, see:+https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints +in English or in Ukrainian:+https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Ukr.21.html#%D0%BE%D0%B1%D0%BC%D0%B5%D0%B6%D0%B5%D0%BD%D0%BD%D1%8F-constraints++- +b \... -b       — if present takes precedence over those ones in the +a \... -a group (the latter ones have no effect). A group of constraints for AFTOVolio using some boolean-based algebra. If you use parentheses there, please, use quotation of the whole expression between the +b and -b (otherwise there will be issues with the shell or command line interpreter related to parentheses). For example, on Linux bash or Windows PowerShell: +b 'P45(A345 B32)' -b. If you use another command line environment or interpreter, please, refer to the documentation for your case about the quotation and quotes. For more information, see:+https://oleksandr-zhabenko.github.io/uk/rhythmicity/phladiprelioEng.7.pdf +in English or:+https://oleksandr-zhabenko.github.io/uk/rhythmicity/phladiprelioUkr.7.pdf +in Ukrainian.++- +l2 \... -l2     — if present and has inside Ukrainian text then the line options are compared with it using the idea of lists similarity. The greater values correspond to the less similar and more different lines. Has no effect with +dc group of command line arguments. Has precedence over +t, +r, +k, +c etc. groups of command line options so that these latter ones have no effect when +l2 \... -l2 is present.++- +q      — if present with +l2 \... -l2 group of arguments then the next argument is a power of 10 which the distance between line option and the predefined line is quoted by. The default one is 0 (that means no change). You can specify not less than 0 and not greater than 4. Otherwise, these limit numbers are used instead. The greater value here leads to more groupped options output.++- +ul     — afterwards there is a string that encodes which sounds are used for diversity property evaluation. If used, then +r group has no meaning and is not used. Unlike in the link, the argument "1" means computing the property for all the sound representations included (for all of the present representations, so the value is maximal between all other strings instead of "1"). For more information, [see](https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types)++- +r      — afterwards are several unique digits not greater than 8 in the descending order — the first one is the length of the group of syllables to be considered as a period, the rest — positions of the maximums and minimums. Example: "543" means that the line is splitted into groups of 5 syllables starting from the beginning, then the positions of the most maximum (4 = 5 - 1) and the next (smaller) maximum (3 = 4 - 1). If there are no duplicated values then the lowest possible value here is 0, that corresponds to the lowest minimum. If there are duplicates then the lowest value here is the number of the groups of duplicates, e. g. in the sequence 1,6,3,3,4,4,5 that is one group there are two groups of duplicates — with 3 and 4 — and, therefore, the corresponding data after +r should be 7\...2. The values less than the lowest minimum are neglected.++- +c      — see explanation at [the link](https://hackage.haskell.org/package/rhythmic-sequences-0.3.0.0/docs/src/Rhythmicity.MarkerSeqs.html#HashCorrections). Some preliminary tests show that theee corrections influence the result but not drastically, they can lead to changes in groupping and order, but mostly leave the structure similar. This shows that the algorithms used are more stable for such changes.++- -t      — and afterwards the number in the range [0..179] (with some exceptions) showing the test for 'smoothness' (to be more accurate - absence or presence of some irregularities that influences the prosody) to be run - you can see a list of possible values for the parameter here at the link:+[link1](https://hackage.haskell.org/package/aftovolio-ukrainian-simple-0.6.0.0/src/app/Main.hs)  on the lines number: 51; 56-115; 118-126. The first section of the lines numbers 56-63 and 120 corresponds to the detailed explanation below.+For ideas of actual usage of the tests, see the documentation by [the link](https://www.academia.edu/105067723/%D0%A7%D0%BE%D0%BC%D1%83_%D0%B4%D0%B5%D1%8F%D0%BA%D1%96_%D1%80%D1%8F%D0%B4%D0%BA%D0%B8_%D0%BB%D0%B5%D0%B3%D0%BA%D0%BE_%D0%B2%D0%B8%D0%BC%D0%BE%D0%B2%D0%BB%D1%8F%D1%82%D0%B8_%D0%B0_%D1%96%D0%BD%D1%88%D1%96_%D0%BD%D1%96_%D0%B0%D0%B1%D0%BE_%D0%BF%D1%80%D0%BE%D1%81%D0%BE%D0%B4%D0%B8%D1%87%D0%BD%D0%B0_%D0%BD%D0%B5%D1%81%D0%BF%D1%80%D0%BE%D0%B3%D0%BD%D0%BE%D0%B7%D0%BE%D0%B2%D0%B0%D0%BD%D1%96%D1%81%D1%82%D1%8C_%D1%8F%D0%BA_%D1%85%D0%B0%D1%80%D0%B0%D0%BA%D1%82%D0%B5%D1%80%D0%B8%D1%81%D1%82%D0%B8%D0%BA%D0%B0_%D1%82%D0%B5%D0%BA%D1%81%D1%82%D1%83?source=swp_share) and [link2](https://www.academia.edu/105067761/Why_some_lines_are_easy_to_pronounce_and_others_are_not_or_prosodic_unpredictability_as_a_characteristic_of_text)++- -C      — If specified with +RTS -N -RTS rtsoptions for the multicore computers with -t option then it can speed up the full computation of the all tests using more resources. Uses asynchcronous concurrent threads in computation. This groups (-C and rtsoptions) can be specified in any position as command line groups of arguments. The output is in this case not sorted in the order of 2,3,4,5,6,7, but can vary depending on your CPU configurations and states and / or some other factors.++- +k      — and then the number greater than 2 (better, greater than 12, the default value if not specified is 20). The greater value leads to greater numbers. The number less than some infimum here leads to wiping of some information from the result and, therefore, probably is not the desired behaviour. For most cases the default value is just enough sensible, but you can give it a try for other values.++- +x      — If specified with the further natural number then means that instead of maximum 7 words or their concatenations that can be analysed together as a line there will be taken the specified number here or 9 if the number is greater than 8. More words leads to more computations, therefore, please, use with this caution in mind. It can be useful mostly for the cases with the additional constraints specified (+a \... -a or +b \... -b groups, see above).++- +m      — If present followed with two arguments — the name of the file to be used for reading data for multiline processment and the second one — the number of line to be processed. The numeration of the lines in the file for the aftovolioUkr program here starts from 1 (so, it is: 1, 2, 3, 4,.. etc). The program then uses instead of text the specified line from the file specified here and prints information about its previous and next lines (if available).++- +m2     — If present, it means that the line with the corresponding number specified here will be taken from the same file specified as +m <file>. For example, the entry +m <file> 1 +m2 4 means that 1 line will be taken from the file <file> for the similarity analysis and it will be compared not with contents of +l2 \... -l2, but with the 4th line from the same file.++The abbreviation for +m <file> <num1> +m2 <num2> is +m3 <file> <num1> <num2>, which has the same meaning but a slightly shorter entry.++If <num1> == <num2>, then there is at least one of all the options with a property value of 0.++You can also use the "music" mode, which allows you to write better lyrics and music. To do this, you can add a record of the form \_{set of digits} or ={set of digits} to a word or between syllables after the needed to be referred to, and this set of digits will be converted to a non-negative Double number by the program and then used to modulate the duration of the previous syllable or of the additional one(s) added here. The first digit in the record after '=' or '\_' is a whole number and the rest is a fraction (mantissa).++If you have added \_{set of digits} then this number will be multiplied by the duration of the syllable to which this insertion refers, and the resulting number will be rounded so that is can be no more than 255 (the maximum possible value of Word8 datatype that is used internally to calculate the statistics). Afterwards, this value is placed among the others in the place where this entry is inserted.++If you have added ={a set of digits} then this number will also be multiplied by the duration of the syllable to which this insertion refers, and the resulting number will be rounded and then will be placed instead of the duration that it was multiplied by (again, the maximum resulting value here can be 255, so that the greater values are rounded to this limit). This allows to make syllables longer or shorter to follow language or creative intentions and rules (e. g. in French there have been noticed that the duration of the last syllable in the word, especially in the sentence or phrase is prolonged to some extent, so you can use '=12' or '=13' or '=14'  here). Not as for the \_{set of digits} group, you can place it only after the syllable and only once to change the duration of the syllable. If you use this option, the following \_{set of digits} will be referred to the new changed duration here, so that "так"=2_05_1 will mean that you will use instead of the usual duration of the syllable "так" the twice as much duration, and then half of this twice as much (therefore, equal to duration of the syllable without altering)and then again the twice as much duration etc. The insertion of =1, =10, =100, =1000 etc will not change anything at all, except for the time of computations (you probably do not need this).++These two additional possibilities allows you to change rhythmic structures, and interpret this insert as a musical pause or, conversely, a musical phrase inserted to change the rhythm. What syllable does this insertion refer to? It refers to the previous syllable in the line. There can be several such inserts, their number is not limited by the program itself (in the program code), but a significant number of inserts can significantly increase the duration of the calculation.++When the results of the program are displayed on the screen, these inserts will also be displayed in the appropriate places.++If you specify \_1, \_10, \_100, \_1000, etc. as such an insertion, the program will assume that this insertion duration is equal to the duration of the syllable to which it refers. If the set of digits is preceded by a 0, the insertion has a shorter duration, if the 1 in the first 4 examples above is followed by digits other than 0, or if another digit is used instead of 1 or 0, the insertion has a longer duration. For example, \_05 means exactly half the duration of the syllable, and \_2 means double the duration. In any case the resulting values cannot be greater than 255, the greater ones are rounded to 255.++For the "music" mode the number of syllables printed for the line does include the inserts (since the version 0.15.2.0).++- -cm     — If present, the program works in a special comparative mode reading information from the several files line-by-line and prompting to choose the resulting option from the files given. If some files do not have such lines, then the resulting option for the file is empty. You choose the resulting option by typing its number on the terminal. In the version 0.16.0.0 the total number of sources is limited to no more than 14. For more information, please refer to [the link](https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#comparative-mode-of-operation-c)++
+ aftovolio.cabal view
@@ -0,0 +1,55 @@+cabal-version:      2.4+name:               aftovolio+version:            0.1.0.0++-- A short (one-line) description of the package.+synopsis:           An AFTOVolio implementation for creating texts with special phonetic / prosodic properties.++-- A longer description of the package.+description:        It is another project that is based on the similar ideas as [phonetic-languages-simplified-examples-array package](https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array). It combines general functionality with an example of complete one for Ukrainian language with extended documentation, mostly in the README.md file. ++-- A URL where users can report bugs.+bug-reports:        https://github.com/Oleksandr-Zhabenko/aftovolio/issues++-- The license under which the package is released.+license:            MIT+license-file:       LICENSE+author:             Oleksandr Zhabenko+maintainer:         oleksandr.zhabenko@yahoo.com++-- A copyright notice.+copyright:          Oleksandr Zhabenko+category:           Language, Math, Music+extra-source-files: CHANGELOG.md, README.md, controlDataExample.txt, gwrsysExample.txt, EnglishConcatenated.txt++library+    -- Modules included in this executable, other than Main.+    exposed-modules:  Aftovolio.Ukrainian.Common2, Aftovolio.Ukrainian.IO, Aftovolio.Ukrainian.PrepareText, Aftovolio.Ukrainian.ReverseConcatenations, Aftovolio.DataG, Aftovolio.StrictVG, Aftovolio.Partir, Data.ChooseLine2, Aftovolio.PermutationsArr, Aftovolio.PermutationsArrMini, Aftovolio.PermutationsArrMini1, Aftovolio.PermutationsRepresent, Aftovolio.Constraints, Aftovolio.ConstraintsEncoded, Aftovolio.Tests, Aftovolio.Ukrainian.Syllable, Aftovolio.Ukrainian.Melodics, Aftovolio.Ukrainian.SyllableWord8, Aftovolio.Basis, Aftovolio.UniquenessPeriodsG, Aftovolio.Coeffs, Aftovolio.Ukrainian.ReadDurations, Aftovolio.General.Datatype3, Aftovolio.General.Distance, Aftovolio.Halfsplit, Aftovolio.General.Parsing, Aftovolio.General.Base, Aftovolio.General.PrepareText, Aftovolio.General.Simple, Aftovolio.General.SpecificationsRead, Aftovolio.General.Syllables, Aftovolio.RGLPK.General ++    -- LANGUAGE extensions used by modules in this package.+    other-extensions: NoImplicitPrelude, BangPatterns, DeriveGeneric+    build-depends:    base >=4.13 && <5, rhythmic-sequences ==0.8.0.0, cli-arguments ==0.7.0.0, directory >=1.3.4.0 && <2, rev-scientific ==0.2.1.0, async >= 2.2.2 && <3, mmsyn2-array ==0.3.1.1, minmax ==0.1.1.0, deepseq >=1.4.4.0 && <2, monoid-insertleft ==0.1.0.1, intermediate-structures ==0.1.1.0, quantizer ==0.3.1.0, containers >=0.5.11.0 && <1, lists-flines == 0.1.3.0+    hs-source-dirs:   .+    default-language: Haskell2010++executable aftovolioUkr+    main-is:          Main.hs++    -- Modules included in this executable, other than Main.+    other-modules:    Aftovolio.Ukrainian.Common2, Aftovolio.Ukrainian.IO, Aftovolio.Ukrainian.PrepareText, Aftovolio.Ukrainian.ReverseConcatenations, Aftovolio.DataG, Aftovolio.StrictVG, Aftovolio.Partir, Data.ChooseLine2, Aftovolio.PermutationsArr, Aftovolio.PermutationsArrMini, Aftovolio.PermutationsArrMini1, Aftovolio.PermutationsRepresent, Aftovolio.Constraints, Aftovolio.ConstraintsEncoded, Aftovolio.Tests, Aftovolio.Ukrainian.Syllable, Aftovolio.Ukrainian.Melodics, Aftovolio.Ukrainian.SyllableWord8, Aftovolio.Basis, Aftovolio.UniquenessPeriodsG, Aftovolio.Coeffs, Aftovolio.Ukrainian.ReadDurations, Aftovolio.General.Datatype3, Aftovolio.General.Distance, Aftovolio.Halfsplit, Aftovolio.General.Parsing, Aftovolio.General.Base, Aftovolio.General.PrepareText, Aftovolio.General.Simple, Aftovolio.General.SpecificationsRead, Aftovolio.General.Syllables, Aftovolio.RGLPK.General+    ghc-options:      -threaded -rtsopts+    -- LANGUAGE extensions used by modules in this package.+    other-extensions: NoImplicitPrelude, BangPatterns, DeriveGeneric+    build-depends:    base >=4.13 && <5, rhythmic-sequences ==0.8.0.0, cli-arguments ==0.7.0.0, directory >=1.3.4.0 && <2, rev-scientific ==0.2.1.0, async >= 2.2.2 && <3, mmsyn2-array ==0.3.1.1, minmax ==0.1.1.0, deepseq >=1.4.4.0 && <2, monoid-insertleft ==0.1.0.1, intermediate-structures ==0.1.1.0, quantizer ==0.3.1.0, containers >=0.5.11.0 && <1, lists-flines == 0.1.3.0 +    hs-source-dirs:   src, .+    default-language: Haskell2010++executable unconcatUkr2+  main-is:             Main.hs+  other-modules:       Aftovolio.Ukrainian.ReverseConcatenations+  other-extensions:    BangPatterns, NoImplicitPrelude+  build-depends:       base >=4.13 && <5, mmsyn2-array ==0.3.1.1, intermediate-structures == 0.1.1.0+  ghc-options:         -threaded -rtsopts+  hs-source-dirs:      .+  default-language:    Haskell2010+
+ controlDataExample.txt view
@@ -0,0 +1,13 @@+nn+PairwisePL_{1}+PairwisePL_{2}+...+.+.+.+PairwisePL_{k}+~~~~~~~~~~~~~~~~~~~~~~~~~~+[(Int,Int)]+~~~~~~~~~~~~~~~~~~~~~~~~~~+[Int]+[Int]
+ gwrsysExample.txt view
@@ -0,0 +1,33 @@+n_max+PhoneticRepresentationPLX_{1,n_max}+PhoneticRepresentationPLX_{2,n_max}+...+.+.+.+PhoneticRepresentationPLX_{k_n_max,n_max}+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+n_max - 1+PhoneticRepresentationPLX_{1,n_max - 1}+PhoneticRepresentationPLX_{2,n_max - 1}+...+.+.+.+PhoneticRepresentationPLX_{m_n_max,n_max - 1}+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+...+.+.+.+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+0+PhoneticRepresentationPLX_{1,0}+PhoneticRepresentationPLX_{2,0}+...+.+.+.+PhoneticRepresentationPLX_{p_n_max,0}+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+
+ src/Main.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}++{-# OPTIONS_GHC -rtsopts -threaded #-}++module Main where++import GHC.Base+import GHC.Num (abs,(+),(-),(*))+import Text.Read (readMaybe)+import Text.Show (show) -- Added in 0.14.1.0+import System.IO (putStrLn,readFile, hSetNewlineMode, stdout, universalNewlineMode)+import qualified Rhythmicity.MarkerSeqs as R hiding (id) +import Data.List hiding (foldr)+import Data.Char (isSpace)+import Data.Maybe (fromMaybe,catMaybes) +import Data.Tuple (snd)+import Aftovolio.Ukrainian.PrepareText +import System.Environment (getArgs)+import GHC.Int (Int8)+import CLI.Arguments+import CLI.Arguments.Get+import CLI.Arguments.Parsing+import Aftovolio.ConstraintsEncoded+import Aftovolio.PermutationsArr+import Aftovolio.StrictVG+import Aftovolio.Ukrainian.IO+import Aftovolio.General.Datatype3 (read3)+import GHC.Real ((/),quot,gcd)+import Aftovolio.Ukrainian.Syllable +import Aftovolio.Ukrainian.SyllableWord8+import Aftovolio.Ukrainian.ReadDurations+import Data.ChooseLine2+import Control.DeepSeq (force) ++main :: IO ()+main = do+  args0 <- getArgs+  let (argCBs, args) = parseHelp args0+      (argsA, argsB, argsC, arg2s) = args2Args31R ('+','-') (aSpecs `mappend` bSpecs `mappend` cSpecs) args+      compareByLinesFinalFile = concat . getB "-cm" $ argsB+  if not . null $ compareByLinesFinalFile then do+    compareFilesToOneCommon 14 arg2s compareByLinesFinalFile+  else do+    let fileDu = concat . getB "+d" $ argsB+        sylD = let k = snd (fromMaybe 2 (readMaybe (concat . getB "+s" $ argsB)::Maybe Int) `quotRemInt` 4) in if k == 0 then 4 else k+    syllableDurationsDs <- readSyllableDurations fileDu+    let maxNumWords = let k = fromMaybe 7 (readMaybe (concat . getB "+x" $ argsB)::Maybe Int) in if k == 0 || abs k >= 9 then 9 else max (abs k) 2+        hc = R.readHashCorrections . concat . getB "+c" $ argsB+        dcspecs = getB "+dc" argsB+        power10' = fromMaybe 0 (readMaybe (concat . getB "+q" $ argsB)::Maybe Int)+        power10 +           | power10' < 0 && power10' > 4 = 0+           | otherwise = power10'+        (html,dcfile) +          | null dcspecs = (False, "")+          | otherwise = (head dcspecs == "1",last dcspecs)+        prepare = oneA "-p" argsA+        selStr = concat . getB "+ul" $ argsB+        grpp = R.grouppingR . concat . getB "+r" $ argsB+        splitting = fromMaybe 50 (readMaybe (concat . getB "+w" $ argsB)::Maybe Int8)+        emptyline = oneA "+l" argsA+        numTest = fromMaybe 1 (readMaybe (concat . getB "-t" $ argsB)::Maybe Int)+        hashStep = fromMaybe 20 (readMaybe (concat . getB "+k" $ argsB)::Maybe Int)+        helpMessage = any (== "-h") args0+        helpArg = concat . getB "-h" $ argsB+        filedata = getB "+f" argsB+        concurrently = oneA "-C" argsA+        (multiline2, multiline2LineNum) +          | oneB "+m3" argsB = +              let r1ss = getB "+m3" argsB in +                    if length r1ss == 3 +                        then let (kss,qss) = splitAt 2 r1ss in +                                     (kss, max 1 (fromMaybe 1 (readMaybe (concat qss)::Maybe Int))) +                        else (r1ss, 1)+          | oneB "+m2" argsB = (getB "+m" argsB,  max 1 (fromMaybe 1 (readMaybe (concat . getB "+m2" $ argsB)::Maybe Int)))+          | otherwise = (getB "+m" argsB, -1)+        (fileread,lineNmb)+          | null multiline2 = ("",-1)+          | length multiline2 == 2 = (head multiline2, fromMaybe 1 (readMaybe (last multiline2)::Maybe Int))+          | otherwise = (head multiline2, 1)+    (arg3s,prestr,poststr,linecomp3) <- do +         if lineNmb /= -1 then do+             txtFromFile <- readFile fileread+             let lns = lines txtFromFile+                 ll1 = length lns+                 ln0 = max 1 (min lineNmb (length lns))+                 lm3 +                   | multiline2LineNum < 1 = -1+                   | otherwise = max 1 . min multiline2LineNum $ ll1+                 linecomp3 +                   | lm3 == -1 = []+                   | otherwise = lns !! (lm3 - 1)+                 ln_1 +                    | ln0 == 1 = 0+                    | otherwise = ln0 - 1+                 ln1+                    | ln0 == length lns = 0+                    | otherwise = ln0 + 1+                 lineF = lns !! (ln0 - 1)+                 line_1F +                    | ln_1 == 0 = []+                    | otherwise = lns !! (ln_1 - 1)+                 line1F+                    | ln1 == 0 = []+                    | otherwise = lns !! (ln1 - 1)+             return $ (words lineF, line_1F,line1F,linecomp3)+         else return (arg2s, [], [],[])+    let line2comparewith +          | oneC "+l2" argsC || null linecomp3 = unwords . getC "+l2" $ argsC+          | otherwise = linecomp3+        basecomp = force . read3 (not . null . filter (not . isSpace)) 1.0 (mconcat . (if null fileDu then case sylD of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 -> syllableDurationsD3; 4 -> syllableDurationsD4} +                           else  if length syllableDurationsDs >= sylD then syllableDurationsDs !! (sylD - 1) else syllableDurationsD2) . createSyllablesUkrS) $ line2comparewith+ +        example = force . read3 (not . null . filter (not . isSpace)) 1.0 (mconcat . (if null fileDu then case sylD of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 -> syllableDurationsD3; 4 -> syllableDurationsD4} +                           else  if length syllableDurationsDs >= sylD then syllableDurationsDs !! (sylD - 1) else syllableDurationsD2) . createSyllablesUkrS) $ (unwords arg3s)+        le = length example+        lb = length basecomp+        gcd1 = gcd le lb+        ldc = (le * lb) `quot` gcd1+        mulp = ldc `quot` lb+--        max2 = maximum basecomp+        compards = force . concatMap (replicate mulp) $ basecomp+        (filesave,codesave)  +          | null filedata = ("",-1)+          | length filedata == 2 = (head filedata, fromMaybe 0 (readMaybe (last filedata)::Maybe Int))+          | otherwise = (head filedata,0)+        ll = take maxNumWords . (if prepare then id else words . mconcat . prepareTextN3 maxNumWords . unwords) $ arg3s+        l = length ll+        argCs = catMaybes (fmap (readMaybeECG l) . getC "+a" $ argsC)+        !perms +          | not (null argCBs) = filterGeneralConv l argCBs . genPermutationsL $ l+          | null argCs = genPermutationsL l+          | otherwise = decodeLConstraints argCs . genPermutationsL $ l +        descending = oneA "+n" argsA+        variants1 = force . uniquenessVariants2GNBL ' ' id id id perms $ ll+    if helpMessage then do +      hSetNewlineMode stdout universalNewlineMode+      helpPrint helpArg+    else generalF power10 ldc compards html dcfile selStr (prestr, poststr) lineNmb fileDu numTest hc grpp sylD descending hashStep emptyline splitting (filesave, codesave) concurrently (unwords arg3s) variants1 >> return ()+++bSpecs :: CLSpecifications+bSpecs = (zip ["+c","+d","+k","-h","+r","+s","-t","+ul","+w","+x","+q","+m2","-cm"] . cycle $ [1]) `mappend` [("+f",2),("+m",2),("+dc",2),("+m3",3)] ++aSpecs :: CLSpecifications+aSpecs = zip ["+l", "+n","-p", "-C"] . cycle $ [0]++cSpecs :: CLSpecifications+cSpecs = [("+a",-1),("+l2",-1)]++helpPrint :: String -> IO ()+helpPrint xs+  | xs == "0" = putStrLn "SYNOPSIS:\n"+  | xs == "1" = putStrLn "aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+c <HashCorrections encoded>] [+n] [+l] [+d <FilePath to file with durations>] [+k <number - hash step>] [+r <groupping info>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>]] <Ukrainian textual line>\n" +  | xs == "2" = putStrLn "aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+c <HashCorrections encoded>] [+n] [+l] [+d <FilePath to file with durations>] [+k <number - hash step>] [-t <number of the test or its absence if 1 is here> [-C +RTS -N -RTS]] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+x <maximum number of words taken>]] <Ukrainian textual line>\n"+  | xs == "3" = putStrLn "aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+ul <diversity property encoding string>] [+n] [+l] [-p] [+w <splitting parameter>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>]] <Ukrainian textual line>\n"+  | xs == "4" = putStrLn "aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+n] [+l] [+d <FilePath to file with durations>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+q <power of 10 for multiplier in [2..6]>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>] [+l2 <a Ukrainian text line to compare similarity with> -l2]] <Ukrainian textual line>\n"+  | xs == "5" = putStrLn "aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+n] [+l] [+d <FilePath to file with durations>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+q <power of 10 for multiplier in [2..6]>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>] [+m <FilePath> <num1> +m2 <num2>]]\n"+  | xs == "6" = putStrLn "aftovolioUkr [[+a <AFTOVolio constraints> -a] [+b <extended algebraic AFTOVolio constraints> -b] [+n] [+l] [+d <FilePath to file with durations>] [+s <syllable durations function number>] [-p] [+w <splitting parameter>] [+q <power of 10 for multiplier in [2..6]>] [+f <FilePath to the file to be appended the resulting String> <control parameter for output parts>] [+x <maximum number of words taken>] [+dc <whether to print <br> tag at the end of each line for two-column output> <FilePath to the file where the two-column output will be written in addition to stdout>] [+m3 <FilePath> <num1> <num2>]]\n"+  | xs == "7" = putStrLn "aftovolioUkr [-cm <FilePath to write the resulting combined output to> <FilePaths of the files to be compared and chosen the resulting options line-by-line>]\n"+  | xs == "OR" = putStrLn "OR:"+  | xs == "n" = putStrLn "+n \t— if specified then the order of sorting and printing is descending (the reverse one to the default otherwise). \n"+  | xs == "l" = putStrLn "+l \t— if specified then the output for one property (no tests) contains empty lines between the groups of the line option with the same value of property. \n"+  | xs == "w" = putStrLn "+w \t— if specified with the next Int8 number then the splitting of the output for non-testing options is used. Is used when no \"-t\" argument is given. The output is splitten into two columns to improve overall experience. The parameter after the \"+w\" is divided by 10 (-10 for negative numbers) to obtain the quotient and remainder (Int8 numbers). The quotient specifies the number of spaces or tabular characters to be used between columns (if the parameter is positive then the spaces are used, otherwise tabular characters). The remainder specifies the option of displaying. If the absolute value of the remainder (the last digit of the parameter) is 1 then the output in the second column is reversed; if it is in the range [2..5] then the output is groupped by the estimation values: if it is 2 then the first column is reversed; if it is 3 then the second column is reversed; if it is 4 then like 2 but additionally the empty line is added between the groups; if it is 5 then like for 3 and additionally the empty line is added between the groups. Otherwise, the second column is reversed. The rules are rather complex, but you can give a try to any number (Int8, [129..128] in the fullscreen terminal). The default value is 50 that corresponds to some reasonable layout.\n"+  | xs == "s" = putStrLn "+s \t— the next is the digit from 1 to 4 included. The default one is 2. Influences the result in the case of +d parameter is not given. \n"+  | xs == "d" = putStrLn "+d \t— if present, then afterwards should be a FilePath to the file with new durations of the Ukrainian AFTOVolio representations. They can be obtained using the information in the manual by the link: https://oleksandr-zhabenko.github.io/uk/rhythmicity/phladiprelioEng.7.pdf#page=12 and the 2 next pages in the pdf file, besides on the page https://hackage.haskell.org/package/r-glpk-phonetic-languages-ukrainian-durations and on the commentaries here: https://hackage.haskell.org/package/phladiprelio-ukrainian-shared-0.5.0.0/docs/Aftovolio-Ukrainian-ReadDurations.html#v:readSound8ToWord8 with the last one having priority.\n"+  | xs == "p" = putStrLn "-p \t— if present the minimal grammar transformations (appending and prepending the dependent parts) are not applied. Can be useful also if the text is analyzed as a Ukrainian transcription of text in some other language.\n"+  | xs == "f" = putStrLn "+f \t— if present with two arguments specifies the file to which the output information should be appended and the mode of appending (which parts to write). The default value if the secodnd parameter is 0 or not element of [1,2,3,4,10,11,12,13,14,15,16,17,18,19] is just the resulting String option. If the second parameter is 1 then the sequential number and the text are written; if it is 2 then the estimation value and the string are written; if it is 3 then the full information is written i. e. number, string and estimation; if it is 4 then the number and estimation (no string).\nThe second arguments greater or equal to 10 take effect only if the meter consists of two syllables (in case of \"+r 21\" command line options given). If it is 10 in such a case then before appending the line option itself to the given file there is hashes information for this line option displayed. If it is 11 — the same hashes information is displayed before processing as for 1. If it is 12 — the same hashes information is displayed before processing as for 2 and so on for 13, 14. If it is 15 up to 19 — it is analogically to the the 10–14 but the hashes information is not only printed on the screen, but appended to the file specified. These values are intended to test the interesting hypothesis about where the pauses can occur. For more information on the hypothesis, see: \n https://www.academia.edu/105067761/Why_some_lines_are_easy_to_pronounce_and_others_are_not_or_prosodic_unpredictability_as_a_characteristic_of_text\n"+  | xs == "dc" = putStrLn "+dc \t— if specified with two further arguments then the first one can be 1 or something  else. If it is 1 then additionally to every line as usual there is printed also <br> html tag at the end of the line for the two-columns output. Otherwise, nothing is added to each line. The second argument further is a FilePath to the writable existing file or to the new file that will be located in the writable by the user directory. The two-column output will be additionally written to this file if it is possible, otherwise the program will end with an exception.\n"+  | xs == "a" = putStrLn "+a ... -a \t— if present contains a group of constraints for AFTOVolio. For more information, see: \nhttps://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints in English or in Ukrainian: \nhttps://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Ukr.21.html#%D0%BE%D0%B1%D0%BC%D0%B5%D0%B6%D0%B5%D0%BD%D0%BD%D1%8F-constraints\n"+  | xs == "b" = putStrLn "+b ... -b \t— if present takes precedence over those ones in the +a ... -a group (the latter ones have no effect). A group of constraints for AFTOVolio using some boolean-based algebra. If you use parentheses there, please, use quotation of the whole expression between the +b and -b (otherwise there will be issues with the shell or command line interpreter related to parentheses). For example, on Linux bash or Windows PowerShell: +b \'P45(A345 B32)\' -b. If you use another command line environment or interpreter, please, refer to the documentation for your case about the quotation and quotes. For more information, see: \nhttps://oleksandr-zhabenko.github.io/uk/rhythmicity/phladiprelioEng.7.pdf in English or: \nhttps://oleksandr-zhabenko.github.io/uk/rhythmicity/phladiprelioUkr.7.pdf in Ukrainian.\n"+  | xs == "l2" = putStrLn "+l2 ... -l2 \t— if present and has inside Ukrainian text then the line options are compared with it using the idea of lists similarity. The greater values correspond to the less similar and more different lines. Has no effect with +dc group of command line arguments. Has precedence over +t, +r, +k, +c etc. groups of command line options so that these latter ones have no effect when +l2 ... -l2 is present.\n"+  | xs == "q" = putStrLn "+q \t— if present with +l2 ... -l2 group of arguments then the next argument is a power of 10 which the distance between line option and the predefined line is quoted by. The default one is 0 (that means no change). You can specify not less than 0 and not greater than 4. Otherwise, these limit numbers are used instead. The greater value here leads to more groupped options output.\n"+  | xs == "ul" = putStrLn "+ul \t— afterwards there is a string that encodes which sounds are used for diversity property evaluation. If used, then +r group has no meaning and is not used. Unlike in the link, the argument \"1\" means computing the property for all the sound representations included (for all of the present representations, so the value is maximal between all other strings instead of \"1\"). For more information, see: https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#types\n"+  | xs == "r" = putStrLn "+r \t— afterwards are several unique digits not greater than 8 in the descending order — the first one is the length of the group of syllables to be considered as a period, the rest — positions of the maximums and minimums. Example: \"543\" means that the line is splitted into groups of 5 syllables starting from the beginning, then the positions of the most maximum (4 = 5 - 1) and the next (smaller) maximum (3 = 4 - 1). If there are no duplicated values then the lowest possible value here is 0, that corresponds to the lowest minimum. If there are duplicates then the lowest value here is the number of the groups of duplicates, e. g. in the sequence 1,6,3,3,4,4,5 that is one group there are two groups of duplicates — with 3 and 4 — and, therefore, the corresponding data after +r should be 7...2. The values less than the lowest minimum are neglected.\n"+  | xs == "c" = putStrLn "+c \t— see explanation at the link: https://hackage.haskell.org/package/rhythmic-sequences-0.3.0.0/docs/src/Rhythmicity.MarkerSeqs.html#HashCorrections Some preliminary tests show that theee corrections influence the result but not drastically, they can lead to changes in groupping and order, but mostly leave the structure similar. This shows that the algorithms used are more stable for such changes.\n"+  | xs == "t" = putStrLn "-t \t— and afterwards the number in the range [0..179] (with some exceptions) showing the test for \'smoothness\' (to be more accurate - absence or presence of some irregularities that influences the prosody) to be run - you can see a list of possible values for the parameter here at the link: \nhttps://hackage.haskell.org/package/phladiprelio-ukrainian-simple-0.6.0.0/src/app/Main.hs  on the lines number: 51; 56-115; 118-126. The first section of the lines numbers 56-63 and 120 corresponds to the detailed explanation below. \nFor ideas of actual usage of the tests, see the documentation by the links: https://www.academia.edu/105067723/%D0%A7%D0%BE%D0%BC%D1%83_%D0%B4%D0%B5%D1%8F%D0%BA%D1%96_%D1%80%D1%8F%D0%B4%D0%BA%D0%B8_%D0%BB%D0%B5%D0%B3%D0%BA%D0%BE_%D0%B2%D0%B8%D0%BC%D0%BE%D0%B2%D0%BB%D1%8F%D1%82%D0%B8_%D0%B0_%D1%96%D0%BD%D1%88%D1%96_%D0%BD%D1%96_%D0%B0%D0%B1%D0%BE_%D0%BF%D1%80%D0%BE%D1%81%D0%BE%D0%B4%D0%B8%D1%87%D0%BD%D0%B0_%D0%BD%D0%B5%D1%81%D0%BF%D1%80%D0%BE%D0%B3%D0%BD%D0%BE%D0%B7%D0%BE%D0%B2%D0%B0%D0%BD%D1%96%D1%81%D1%82%D1%8C_%D1%8F%D0%BA_%D1%85%D0%B0%D1%80%D0%B0%D0%BA%D1%82%D0%B5%D1%80%D0%B8%D1%81%D1%82%D0%B8%D0%BA%D0%B0_%D1%82%D0%B5%D0%BA%D1%81%D1%82%D1%83?source=swp_share and https://www.academia.edu/105067761/Why_some_lines_are_easy_to_pronounce_and_others_are_not_or_prosodic_unpredictability_as_a_characteristic_of_text\n"+  | xs == "C" = putStrLn "-C \t— If specified with +RTS -N -RTS rtsoptions for the multicore computers with -t option then it can speed up the full computation of the all tests using more resources. Uses asynchcronous concurrent threads in computation. This groups (-C and rtsoptions) can be specified in any position as command line groups of arguments. The output is in this case not sorted in the order of 2,3,4,5,6,7, but can vary depending on your CPU configurations and states and / or some other factors.\n"+  | xs == "k" = putStrLn "+k \t— and then the number greater than 2 (better, greater than 12, the default value if not specified is 20). The greater value leads to greater numbers. The number less than some infimum here leads to wiping of some information from the result and, therefore, probably is not the desired behaviour. For most cases the default value is just enough sensible, but you can give it a try for other values.\n"+  | xs == "x" = putStrLn "+x \t— If specified with the further natural number then means that instead of maximum 7 words or their concatenations that can be analysed together as a line there will be taken the specified number here or 9 if the number is greater than 8. More words leads to more computations, therefore, please, use with this caution in mind. It can be useful mostly for the cases with the additional constraints specified (+a ... -a or +b ... -b groups, see above).\n"+  | xs == "m" = putStrLn "+m \t— If present followed with two arguments — the name of the file to be used for reading data for multiline processment and the second one — the number of line to be processed. The numeration of the lines in the file for the aftovolioUkr program here starts from 1 (so, it is: 1, 2, 3, 4,.. etc). The program then uses instead of text the specified line from the file specified here and prints information about its previous and next lines (if available).\n"+  | xs == "m2" || xs == "m3" = putStrLn "+m2 \t— If present, it means that the line with the corresponding number specified here will be taken from the same file specified as +m <file>. For example, the entry +m <file> 1 +m2 4 means that 1 line will be taken from the file <file> for the similarity analysis and it will be compared not with contents of +l2 ... -l2, but with the 4th line from the same file. \n\nThe abbreviation for +m <file> <num1> +m2 <num2> is +m3 <file> <num1> <num2>, which has the same meaning but a slightly shorter entry. \n\nIf <num1> == <num2>, then there is at least one of all the options with a property value of 0. \n\nYou can also use the \"music\" mode, which allows you to write better lyrics and music. To do this, you can add a record of the form _{set of digits} or ={set of digits} to a word or between syllables after the needed to be referred to, and this set of digits will be converted to a non-negative Double number by the program and then used to modulate the duration of the previous syllable or of the additional one(s) added here. The first digit in the record after '=' or '_' is a whole number and the rest is a fraction (mantissa). \n\nIf you have added _{set of digits} then this number will be multiplied by the duration of the syllable to which this insertion refers, and the resulting number will be rounded so that is can be no more than 255 (the maximum possible value of Word8 datatype that is used internally to calculate the statistics). Afterwards, this value is placed among the others in the place where this entry is inserted. \n\nIf you have added ={a set of digits} then this number will also be multiplied by the duration of the syllable to which this insertion refers, and the resulting number will be rounded and then will be placed instead of the duration that it was multiplied by (again, the maximum resulting value here can be 255, so that the greater values are rounded to this limit). This allows to make syllables longer or shorter to follow language or creative intentions and rules (e. g. in French there have been noticed that the duration of the last syllable in the word, especially in the sentence or phrase is prolonged to some extent, so you can use '=12' or '=13' or '=14'  here). Not as for the _{set of digits} group, you can place it only after the syllable and only once to change the duration of the syllable. If you use this option, the following _{set of digits} will be referred to the new changed duration here, so that \"так\"=2_05_1 will mean that you will use instead of the usual duration of the syllable \"так\" the twice as much duration, and then half of this twice as much (therefore, equal to duration of the syllable without altering) and then again the twice as much duration etc. The insertion of =1, =10, =100, =1000 etc will not change anything at all, except for the time of computations (you probably do not need this). \n\nThese two additional possibilities allows you to change rhythmic structures, and interpret this insert as a musical pause or, conversely, a musical phrase inserted to change the rhythm. What syllable does this insertion refer to? It refers to the previous syllable in the line. There can be several such inserts, their number is not limited by the program itself (in the program code), but a significant number of inserts can significantly increase the duration of the calculation. \n\nWhen the results of the program are displayed on the screen, these inserts will also be displayed in the appropriate places. \n\nIf you specify _1, _10, _100, _1000, etc. as such an insertion, the program will assume that this insertion duration is equal to the duration of the syllable to which it refers. If the set of digits is preceded by a 0, the insertion has a shorter duration, if the 1 in the first 4 examples above is followed by digits other than 0, or if another digit is used instead of 1 or 0, the insertion has a longer duration. For example, _05 means exactly half the duration of the syllable, and _2 means double the duration. In any case the resulting values cannot be greater than 255, the greater ones are rounded to 255.\n\nFor the \"music\" mode the number of syllables printed for the line does include the inserts (since the version 0.15.2.0).\n"+  | xs == "cm" = putStrLn "-cm \t— If present, the program works in a special comparative mode reading information from the several files line-by-line and prompting to choose the resulting option from the files given. If some files do not have such lines, then the resulting option for the file is empty. You choose the resulting option by typing its number on the terminal. In the version 0.16.0.0 the total number of sources is limited to no more than 14. For more information, please refer to the link: https://oleksandr-zhabenko.github.io/uk/rhythmicity/AFTOVolio.Eng.21.html#comparative-mode-of-operation-c "+  | otherwise = helpFE xs+    where helpFE xs = mapM helpPrint js >> return ()+          js+            | xs == "-cm" = ["0","7","cm"] +            | xs == "+n" = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","n"] +            | xs == "+l" = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","l"] +            | xs == "+w" = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","w"] +            | xs == "+s" = ["0","1","OR","2","OR","4","OR","5","OR","6","s"] +            | xs == "+d" = ["0","1","OR","2","OR","4","OR","5","OR","6","d"] +            | xs == "-p" = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","p"] +            | xs == "+f" = ["0","1","OR","3","OR","4","OR","5","OR","6","f"] +            | xs == "+dc" = ["0","1","OR","3","OR","4","OR","5","OR","6","dc"] +            | xs == "+a" = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","a"] +            | xs == "+b" = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","b"] +            | xs == "+l2" = ["0","4","l2"] +            | xs == "+q" = ["0","4","OR","5","OR","6","q"] +            | xs == "+ul" = ["0","3","ul"] +            | xs == "+r" = ["0","1","r"] +            | xs == "+c" = ["0","1","OR","2","c"] +            | xs == "-t" = ["0","2","t"] +            | xs == "-C" = ["0","2","C"] +            | xs == "+k" = ["0","1","OR","2","k"] +            | xs == "+x" = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","x"] +            | xs == "+m" = ["0","5","m"] +            | xs == "+m2" = ["0","5","m2"] +            | xs == "+m3" = ["0","6","m3"] +            | otherwise = ["0","1","OR","2","OR","3","OR","4","OR","5","OR","6","OR","7","n","l","w","s","d","p","f","dc","a","b","l2","q","ul","r","c","t","C","k","x","m","m2","cm"]+