{-# 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 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
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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
-> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last 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 -- ^ 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 choice
| null lInes = do
contents <- readFile file
let !flines
| gr1 == 0 = fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine 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 $ contents
getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines
| otherwise = do
contents <- readFile file
let !flines
| gr1 == 0 = fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) ysss zzzsss xs js vs toOneLine . unlines . linesFromArgsG lInes . fLines ysss zzzsss xs js vs 0 $ 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 . unlines . linesFromArgsG lInes . fLines ysss zzzsss xs js vs 0 $ contents
getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine choice multiples2 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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
-> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last 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 -- ^ 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]
-> [String]
-> IO ()
getData3 pairwisePermutations wrs ks arr gs js vs h rs lstW coeffs coeffsWX gz printLine choice multiples3 zss =
let !permsV4 = case pairwisePermutations of
R.P 2 -> genPairwisePermutationsArrLN 10
R.P 1 -> genElementaryPermutationsArrLN1 10
_ -> genPermutationsArrL in do
putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz)
mapM_ (process1Line wrs ks arr gs js vs h rs lstW coeffs coeffsWX gz printLine choice multiples3 permsV4) 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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
-> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last 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 -- ^ 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 choice multiples4 !permsV50 v
| null multiples4 = 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
((!minE,!maxE),!data2) = runEval (parTuple2 rpar rpar (minMax11C . map (toTransPropertiesF' (if take 1 choice == "w" || take 1 choice == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choice else chooseMax wrs ks arr gs js vs id h coeffs qs choice)) .
uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (if take 1 choice == "w" || take 1 choice == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choice else chooseMax wrs ks arr gs js vs id h coeffs qs choice) .
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 -> (minMax11C .
map (toTransPropertiesF' (if take 1 choiceMMs == "w" || take 1 choiceMMs == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choiceMMs else chooseMax wrs ks arr gs js vs id h coeffs qs choiceMMs)) .
uniquenessVariants2GNBL ' ' id id id permsV5 $ v2,
toTransPropertiesF' (if take 1 choiceMMs == "w" || take 1 choiceMMs == "x" then chooseMax wrs ks arr gs js vs id h coeffsWX qs choiceMMs else chooseMax wrs ks arr gs js vs id h coeffs qs choiceMMs) .
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 "")