{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
-- |
-- Module : Phonetic.Languages.General.Lines
-- Copyright : (c) OleksandrZhabenko 2020-2022
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Library module that contains functions earlier used by the rewritePoemG3
-- executable for the Ukrainian language (see: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array).
-- Inspired by: https://functional-art.org/2020/papers/Poetry-OleksandrZhabenko.pdf from the https://functional-art.org/2020/performances ;
-- Allows to rewrite the given text (usually a poetical one).
-- Is rewritten from the Phonetic.Languages.Lines module from the
-- @phonetic-languages-simplified-examples-array@ package.
module Phonetic.Languages.General.Lines where
import Phonetic.Languages.General.DeEnCoding (newLineEnding)
import System.IO
import Data.SubG
import Data.MinMax.Preconditions
import GHC.Arr
import Data.List (sort,nub)
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.Filters (unsafeSwapVecIWithMaxI)
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Data.Phonetic.Languages.PrepareText
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Basis
import Phonetic.Languages.Simplified.DataG.Partir
import Data.Char (isDigit)
import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2
import Data.Monoid (mappend)
import Phonetic.Languages.General.Common
import Interpreter.StringConversion
import qualified Phonetic.Languages.Permutations.Represent as R
import Phonetic.Languages.EmphasisG
{-| @ since 0.12.0.0 -- Changed the arguments. Now it can run multiple rewritings for the one given data file
on the given list of choices for the properties given as the second ['String'] argument. Every new file is being
saved with the choice prefix.
-}
generalProcessment
:: 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
-> Coeffs2
-> [String]
-> [String] -- ^ List of properties encoded which are used to rewrite the text.
-> Int
-> FilePath
-> IO ()
generalProcessment pairwisePermutations (gr1,gr2) wrs ks arr gs h rs ysss zzzsss xs js vs coeffs numericArgs choices0 numberI file = do
contents <- readFile file
let !choices = map (filter (/='a')) choices0
!permsV
| pairwisePermutations == R.P 2 = genPairwisePermutationsArrLN 10
| pairwisePermutations == R.P 1 = genElementaryPermutationsArrLN1 10
| otherwise = genPermutationsArrL
!flines
| gr1 == 0 = fLinesN (if pairwisePermutations /= R.P 0 then 10 else 7) 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 0 $ contents
!lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines
if compare numberI 2 == LT then
mapM_ (\choice -> toFileStr (choice ++ "." ++ file ++ ".new.txt") (circle2 wrs ks arr gs js vs h rs coeffs permsV choice [] $ flines)) choices
else do
let !intervalNmbrs = (\vs -> if null vs then [numberI] else nub vs) . sort . filter (<= numberI) .
map (\t -> fromMaybe numberI (readMaybe t::Maybe Int)) . drop 2 $ numericArgs
!us = words . concat . take 1 $ flines
!l2 = (subtract 3) . length $ us
if compare l2 0 /= LT then do
let !perms2 = unsafeAt permsV $ l2
minMaxTuples = let !frep20Zip = zip choices . map (\choice -> chooseMax wrs ks arr gs js vs id h coeffs rs choice "") $ choices in
map (\(choice,frep20) -> minMax11C . map (toPropertiesF'2 frep20 . StrG) .
uniquenessVariants2GNPBL [] (concat . take 1 $ lasts) ' ' id id id perms2 . init $ us) frep20Zip
mapM_ (\(choice, (minE,maxE)) ->
toFileStr (choice ++ "." ++ file ++ ".new.txt") (circle2I wrs ks arr gs js vs h rs coeffs permsV choice [] numberI intervalNmbrs minE maxE $ flines)) .
zip choices $ minMaxTuples
else mapM_ (\choice -> toFileStr (choice ++ "." ++ file ++ ".new.txt") ((concat . take 1 $ flines):
(circle2I wrs ks arr gs js vs h rs coeffs permsV choice [] numberI intervalNmbrs 0.0 0.0 . drop 1 $ flines))) choices
compareFilesToOneCommon :: [FilePath] -> FilePath -> IO ()
compareFilesToOneCommon files file3 = do
contentss <- mapM ((\(j,ks) -> do {readFileIfAny ks >>= \fs -> return (j, zip [1..] . lines $ fs)})) . zip [1..7] . take 7 $ 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 (k,rs) = head ts in (j,rs)) .
filter ((== i) . fst) $ ks) ysss
mapM_ (\(i,xs) -> putStrLn $ 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..]
-- | Processment without rearrangements.
circle2
:: 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.
-> Coeffs2
-> Array Int [Array Int Int] -- ^ A permutations array of indices.
-> 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. Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-> [String]
-> [String]
-> [String]
circle2 wrs ks arr gs js vs h qs coeffs permsG1 choice yss xss
| null xss = yss
| otherwise = circle2 wrs ks arr gs js vs h qs coeffs permsG1 choice (yss `mappend` [ws]) tss
where (!zss,!tss) = splitAt 1 xss
!rs = words . concat $ zss
!l = length rs
!frep2 = chooseMax wrs ks arr gs js vs id h coeffs qs choice ""
!ws = if compare l 3 == LT then unwords rs else (\rrrr -> fromMaybe "" . fromReadyFCPLS $ rrrr) . line2 . maximumElR2 . map (toResultR2 frep2 . StrG) .
uniquenessVariants2GNPBL [] (last rs) ' ' id id id (unsafeAt permsG1 (l - 3)) . init $ rs
-- | Processment with rearrangements.
circle2I
:: 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.
-> Coeffs2
-> Array Int [Array Int Int] -- ^ A permutations array of indices.
-> 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. Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-> [String]
-> Int
-> [Int]
-> Double
-> Double
-> [String]
-> [String]
circle2I wrs ks arr gs js vs h qs coeffs permsG1 choice yss numberI intervNbrs minE maxE xss
| null xss = yss
| otherwise = circle2I wrs ks arr gs js vs h qs coeffs permsG1 choice (yss `mappend` [ws]) numberI intervNbrs minE1 maxE1 tss
where (!zss,!tss) = splitAt 1 xss
!w2s = words . concat . take 1 $ tss
!l3 = (subtract 3) . length $ w2s
!rs = words . concat $ zss
!l = length rs
!frep2 = chooseMax wrs ks arr gs js vs (unsafeSwapVecIWithMaxI minE maxE numberI intervNbrs) h coeffs qs choice ""
!ws = if compare (length rs) 3 == LT then unwords rs else (\rrrr -> fromMaybe "" . fromReadyFCPLS $ rrrr) . line2 . maximumElR2 . map (toResultR2 frep2 . StrG) .
uniquenessVariants2GNPBL [] (last rs) ' ' id id id (unsafeAt permsG1 (l - 3)) . init $ rs
(!minE1,!maxE1)
| compare l3 0 /= LT =
let !perms3 = unsafeAt permsG1 l3
!v4 = init w2s
!frep20 = chooseMax wrs ks arr gs js vs id h coeffs qs choice "" in minMax11C . map (toPropertiesF'2 frep20 . StrG) .
uniquenessVariants2GNPBL [] (last w2s) ' ' id id id perms3 $ v4
| otherwise = (0.0,0.0)
-- | Prints every element from the structure on the new line to the file. Uses 'appendFile' function inside. Is taken from
-- the Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package.
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 xss = mapM_ (\xs -> appendFile file (xs `mappend` newLineEnding)) xss