{-# OPTIONS_GHC -threaded -rtsopts #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE BangPatterns #-} -- | -- Module : Phonetic.Languages.Lines -- Copyright : (c) OleksandrZhabenko 2020-2021 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- Library functions for the rewritePoemG3 executable. -- 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). module Phonetic.Languages.Lines where import Phonetic.Languages.Simplified.DeEnCoding (newLineEnding) import System.IO import Data.SubG import Data.MinMax.Preconditions import GHC.Arr import Data.List (sort,nub,zip,zip3,zip4,zip5,zip6,zip7) import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 import Phonetic.Languages.Simplified.StrictVG.Base import Phonetic.Languages.Permutations.Arr import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI) import Text.Read (readMaybe) import Data.Maybe (fromMaybe) import Phonetic.Languages.Ukrainian.PrepareText import Phonetic.Languages.Simplified.DataG.Base import Data.Char (isDigit) import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2 import Data.Monoid (mappend) import Phonetic.Languages.Common import Interpreter.StringConversion {-| @ since 0.5.0.0 -- The meaning of the first command line argument (and 'Coeffs2' here everywhere in the module) depends on the 'String' argument -- whether it starts with \'w\', \'x\' or otherwise. In the first case it represents the k1 and k2 coefficients (default ones equal to 2.0 and 0.125) for the functions from the Rhythmicity.TwoFourth module. Otherwise, it is used for the functions to specify the level of emphasizing the two-based and three-based periods (the default values here are 1.0 both). @ 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. Besides there are new lines of the arguments for the 'String' argument that can begin with \"c\", \"s\", \"t\", \"u\", \"v\", \"C\", \"N\", \"S\", \"T\", \"U\", \"V\", \"W\", \"X\", \"Y\" and \"Z\" letters. For more information, please, refer to the 'Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2.rhythmicity'. @ 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 :: (Int,Int) -> Coeffs2 -> [String] -> [String] -> Int -> FilePath -> IO () generalProcessment (gr1,gr2) coeffs numericArgs choices numberI file = do contents <- readFile file let !permsV = genPermutationsArrL !flines | gr1 == 0 = fLines 0 contents | otherwise = prepareGrowTextMN gr1 gr2 . unlines . fLines 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 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 (chooseMax id coeffs) $ choices in map (\(choice,frep20) -> minMax11C . map (toPropertiesF' frep20) . uniquenessVariants2GNPBL [] (concat . take 1 $ lasts) ' ' id id id perms2 . init $ us) frep20Zip mapM_ (\(choice, (minE,maxE)) -> toFileStr (choice ++ "." ++ file ++ ".new.txt") (circle2I coeffs permsV choice [] numberI intervalNmbrs minE maxE $ flines)) . zip choices $ minMaxTuples else mapM_ (\choice -> toFileStr (choice ++ "." ++ file ++ ".new.txt") ((concat . take 1 $ flines): (circle2I 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 :: Coeffs2 -> Array Int [Array Int Int] -> String -> [String] -> [String] -> [String] circle2 coeffs permsG1 choice yss xss | null xss = yss | otherwise = circle2 coeffs permsG1 choice (yss `mappend` [ws]) tss where (!zss,!tss) = splitAt 1 xss !rs = words . concat $ zss !l = length rs !frep2 = chooseMax id coeffs choice !ws = if compare l 3 == LT then unwords rs else line . maximumElR . map (toResultR frep2) . uniquenessVariants2GNPBL [] (last rs) ' ' id id id (unsafeAt permsG1 (l - 3)) . init $ rs -- | Processment with rearrangements. circle2I :: Coeffs2 -> Array Int [Array Int Int] -> String -> [String] -> Int -> [Int] -> Double -> Double -> [String] -> [String] circle2I coeffs permsG1 choice yss numberI intervNbrs minE maxE xss | null xss = yss | otherwise = circle2I 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 (unsafeSwapVecIWithMaxI minE maxE numberI intervNbrs) coeffs choice !ws = if compare (length rs) 3 == LT then unwords rs else line . maximumElR . map (toResultR frep2) . 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 id coeffs choice in minMax11C . map (toPropertiesF' frep20) . 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