{-# OPTIONS_GHC -threaded -rtsopts #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE BangPatterns #-} -- | -- Module : Phonetic.Languages.Lines -- Copyright : (c) OleksandrZhabenko 2020 -- 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) 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 generalProcessment :: Coeffs2 -> [String] -> String -> Int -> FilePath -> IO () generalProcessment coeffs numericArgs choice numberI file = do contents <- readFile file let !permsV = genPermutationsArrL !flines = fLines 0 contents !lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines if compare numberI 2 == LT then toFileStr (file ++ ".new.txt") (circle2 coeffs permsV choice [] $ flines) 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 (!minE,!maxE) = let !frep20 = chooseMax id coeffs choice in minMax11C . map (toPropertiesF' frep20) . uniquenessVariants2GNPBL [] (concat . take 1 $ lasts) ' ' id id id perms2 . init $ us toFileStr (file ++ ".new.txt") (circle2I coeffs permsV choice [] numberI intervalNmbrs minE maxE $ flines) else toFileStr (file ++ ".new.txt") ((concat . take 1 $ flines):(circle2I coeffs permsV choice [] numberI intervalNmbrs 0.0 0.0 . drop 1 $ flines)) compareFilesToOneCommon :: FilePath -> FilePath -> FilePath -> IO () compareFilesToOneCommon file1 file2 file3 = do contents1 <- fmap lines . readFile $ file1 contents2 <- fmap lines . readFile $ file2 let linesZipped = zip contents1 contents2 compare2F linesZipped file3 where compare2F :: [(String,String)] -> FilePath -> IO () compare2F yss file3 = mapM_ (\xs -> do putStrLn "Please, specify which variant to use as the result, either 1 or 2: " putStrLn $ "1:\t" ++ fst xs putStrLn $ "2:\t" ++ snd xs ch <- getLine let choice2 = fromMaybe 0 (readMaybe ch::Maybe Int) case choice2 of 1 -> toFileStr file3 [fst xs] 2 -> toFileStr file3 [snd xs] _ -> toFileStr file3 [""]) yss -- | 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