{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}
-- |
-- Module : Phonetic.Languages.General.GetTextualInfo
-- Copyright : (c) OleksandrZhabenko 2020-2022
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Library module that contains functions earlier used by the propertiesTextG3
-- executable for the Ukrainian language (see: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array).
-- Is rewritten from the Phonetic.Languages.GetTextualInfo module from the
-- @phonetic-languages-simplified-examples-array@ package.
module Phonetic.Languages.General.GetTextualInfo (
generalProc
, linesFromArgs1
, linesFromArgsG
, getData3
, process1Line
) where
import Phonetic.Languages.General.Parsing
import Data.SubG hiding (takeWhile,dropWhile)
import System.IO
import Control.Concurrent
import Control.Exception
import Control.Parallel.Strategies
import Data.Maybe (fromMaybe)
import Data.List (sort)
import Text.Read (readMaybe)
import GHC.Arr
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.PrepareText
import Numeric (showFFloat)
import Phonetic.Languages.Filters
import Data.Char (isAlpha)
import Data.Statistics.RulesIntervalsPlus
import Data.MinMax.Preconditions
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.StrictVG.Base
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Permutations.ArrMini
import Phonetic.Languages.Permutations.ArrMini1
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Basis
import Phonetic.Languages.Simplified.DataG.Partir
import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2
import Languages.UniquenessPeriods.Array.Constraints.Encoded
import Phonetic.Languages.General.SimpleConstraints
import Phonetic.Languages.General.Common
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import qualified Phonetic.Languages.Permutations.Represent as R
import Phonetic.Languages.EmphasisG
import Phonetic.Languages.Coeffs
generalProc
:: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
-> (Int,Int) -- ^ Argument to specify possible 'line growing'.
-> 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 -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
-> SegmentRulesG
-> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
-- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
-- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
-- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
-> [MappingFunctionPL] -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
-- exact one and, therefore, the default one.
-> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
-- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
-> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
-- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
-> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
-> FilePath
-> String
-> Int
-> Int
-> (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.
-> Bool -- ^ Whether to print just the syllables statistics line-by-line
-> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
-- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
-- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
-- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-- @ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function
-- with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then
-- to rewrite it.
-> IO ()
generalProc pairwisePermutations (gr1,gr2) wrs ks arr gs h rs ysss zzzsss xs js vs lstW multiples2 lInes coeffs coeffsWX file gzS printLine toOneLine g1 syllableStats choice
| null lInes = do
contents0 <- do (if file == "+i" then getContents else readFile file)
let !contsWss = map words . lines $ contents0
!newconts = unlines . map (\lineswrdss -> if variations lineswrdss then unlines . map unwords . transformToVariations $ lineswrdss else unwords lineswrdss) $ contsWss
!flines
| gr1 == 0 = fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine newconts -- contents
| otherwise = prepareGrowTextMN gr1 gr2 ysss zzzsss xs . unlines . fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine $ newconts -- contents
getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine g1 choice multiples2 syllableStats flines
| otherwise = do
contents0 <- do (if file == "+i" then getContents else readFile file)
let !contsWss = map words . lines $ contents0
!newconts = unlines . map (\lineswrdss -> if variations lineswrdss then unlines . map unwords . transformToVariations $ lineswrdss else unwords lineswrdss) $ contsWss
!flines = (if gr1 == 0 then id else prepareGrowTextMN gr1 gr2 ysss zzzsss xs . unlines) . fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine . unlines . linesFromArgsG lInes . fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs 0 $ newconts -- contents
getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine g1 choice multiples2 syllableStats flines
linesFromArgs1
:: Int
-> String
-> [String]
-> [String]
linesFromArgs1 n xs yss =
let (!ys,!zs) = (\(x,z) -> (x, drop 1 z)) . break (== ':') $ xs
!ts = sort . map (min n . abs) $ [fromMaybe 1 (readMaybe ys::Maybe Int), fromMaybe n (readMaybe zs::Maybe Int)] in
drop (head ts - 1) . take (last ts) $ yss
linesFromArgsG :: [String] -> [String] -> [String]
linesFromArgsG xss yss = let n = length yss in concatMap (\ts -> linesFromArgs1 n ts yss) xss
getData3
:: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
-> 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 -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
-- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
-- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
-- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
-> [MappingFunctionPL] -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
-- exact one and, therefore, the default one.
-> Bool
-> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
-> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
-> Int
-> Int
-> (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.
-> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
-- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
-- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
-- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-- @ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function
-- with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then
-- to rewrite it.
-> [String]
-> Bool
-> [String]
-> IO ()
getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX gz printLine g1 choice0 multiples3 syllableStats zss = do
let choice = filter (/= 'a') choice0
!permsV4
| pairwisePermutations == R.P 2 = genPairwisePermutationsArrLN 10
| pairwisePermutations == R.P 1 = genElementaryPermutationsArrLN1 10
| otherwise = genPermutationsArrL
putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz)
mapM_ (\qs -> case syllableStats of
True -> let tsss = createSyllablesPL wrs ks arr gs js vs qs in putStrLn ((show . length . concat $ tsss) `mappend` "\t" `mappend` (show . map length $ tsss) `mappend` (if printLine == 1 then '\t':qs else ""))
_ -> process1Line wrs ks arr gs js vs h rs lstW coeffs coeffsWX gz printLine g1 choice multiples3 permsV4 qs) zss
process1Line
:: 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 -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
-- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
-- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
-- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
-> [MappingFunctionPL] -- ^ A list of either 'PhoPaaW'-based or 'SaaW'-based (and not both ones) different functions that specifies the syllables durations in the PhoPaaW or SaaW mode respectively (the former one has been introduced earlier), analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one in case of 'PhoPaaW'-based ones must be probably the most
-- exact one and, therefore, the default one.
-> Bool
-> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
-> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
-> Int
-> Int
-> (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.
-> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
-- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
-- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
-- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-- @ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function
-- with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then
-- to rewrite it.
-> [String]
-> Array Int [Array Int Int] -- ^ A permutations array of indices.
-> String
-> IO ()
process1Line wrs ks arr gs js vs h qs lstW coeffs coeffsWX gz printLine g1 choice multiples4 !permsV50 v
| null multiples4 = bracket (do {
myThread <- forkIO (do
let !v2 = words v
!l2 = length v2 - 2
!sels = parsey0Choice g1 choice
if l2 >= (if lstW then 1 else 0) then do
let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) .
unsafeAt permsV50 $ l2
((!minE,!maxE),!data2) = runEval (parTuple2 rpar rpar (minMax11C . map (toTransPropertiesF'2 (if take 1 choice == "w" || take 1 choice == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX sels qs choice "" else chooseMax wrs ks arr gs js vs id h coeffs sels qs choice "")) .
map StrG . uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF'2 (if take 1 choice == "w" || take 1 choice == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX sels qs choice "" else chooseMax wrs ks arr gs js vs id h coeffs sels qs choice "") .
StrG . unwords . subG (' ':js `mappend` vs) $ v))
(!wordsN,!intervalN) = (l2 + 2, intervalNRealFrac minE maxE gz data2)
!ratio = if maxE == 0.0 then 0.0 else 2.0 * data2 / (minE + maxE)
hPutStr stdout . showFFloat (precChoice choice) minE $ "\t"
hPutStr stdout . showFFloat (precChoice choice) data2 $ "\t"
hPutStr stdout . showFFloat (precChoice choice) maxE $ "\t"
hPutStr stdout . showFFloat (Just 4) (data2 / minE) $ "\t"
hPutStr stdout . showFFloat (Just 4) (maxE / minE) $ "\t"
hPutStr stdout . showFFloat (Just 4) (maxE / data2) $ "\t"
hPutStr stdout . showFFloat (Just 8) ratio $ "\t"
hPutStr stdout ('\t':show (wordsN::Int))
hPutStr stdout ('\t':show (intervalN::Int))
hPutStrLn stdout (if printLine == 1 then '\t':v else "")
else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else ""))
; return myThread }) (killThread) (\_ -> putStr "")
| otherwise = bracket (do {
myThread <- forkIO (do
let !v2 = words v
!l2 = length v2 - 2
if l2 >= (if lstW then 1 else 0) then do
let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) .
unsafeAt permsV50 $ l2
rs = parMap rpar (\choiceMMs -> let sels = parsey0Choice g1 choiceMMs in (minMax11C .
map (toTransPropertiesF'2 (if take 1 choiceMMs == "w" || take 1 choiceMMs == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX sels qs choiceMMs "" else chooseMax wrs ks arr gs js vs id h coeffs sels qs choiceMMs "")) .
map StrG . uniquenessVariants2GNBL ' ' id id id permsV5 $ v2,
toTransPropertiesF'2 (if take 1 choiceMMs == "w" || take 1 choiceMMs == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX sels qs choiceMMs "" else chooseMax wrs ks arr gs js vs id h coeffs sels qs choiceMMs "") .
StrG . unwords . subG (' ':js `mappend` vs) $ v,gz)) multiples4
(!wordsN,!intervalNs) = (l2 + 2, map (\((!x,!y),!z,!t) -> intervalNRealFrac x y t z) rs)
in do
hPutStr stdout (show (wordsN::Int))
mapM_ (\i -> hPutStr stdout ('\t':show (i::Int))) intervalNs
hPutStrLn stdout (if printLine == 1 then '\t':v else "")
else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else ""))
; return myThread }) (killThread) (\_ -> putStr "")