-- | -- Module : Main -- Copyright : (c) OleksandrZhabenko 2020 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- 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). {-# OPTIONS_GHC -threaded -rtsopts #-} {-# LANGUAGE BangPatterns #-} module Main where import Control.Parallel.Strategies import qualified Data.Vector as V import Data.List (sort) import String.Languages.UniquenessPeriods.Vector import Languages.UniquenessPeriods.Vector.Properties import Languages.UniquenessPeriods.Vector.General.Debug import Languages.UniquenessPeriods.Vector.PropertiesFuncRep import Languages.UniquenessPeriods.Vector.StrictV import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI) import Text.Read (readMaybe) import Data.Maybe (fromMaybe) import System.Environment import Languages.Phonetic.Ukrainian.PrepareText import Languages.UniquenessPeriods.Vector.Data import Languages.UniquenessPeriods.Vector.Auxiliary import GHC.Float (int2Float) import Data.Char (isDigit) import Languages.UniquenessPeriods.Vector.FuncRepRelated -- | The function allows to rewrite the Ukrainian text in the file given as the first command line argument to a new file. In between, it is rewritten -- so that every last word on the lines is preserved at theirs position, and the rest of the line is rearranged using the specified other command line -- arguments. They are general for the whole program. The further command line arguments are: the number of the intervals and the numbers of the intervals -- that are swapped with the maximum one so that they are available for further usage by the program. See documentation for @uniqueness-periods-vector-filters@ -- package -- 'https://hackage.haskell.org/package/uniqueness-periods-vector-filters' -- main :: IO () main = do args <- getArgs let !numericArgs = filter (all isDigit) . drop 2 $ args !choice = concat . drop 1 . take 2 $ args !numberI = fromMaybe 1 $ (readMaybe (concat . take 1 $ numericArgs)::Maybe Int) !file = concat . take 1 $ args contents <- readFile file let !flines = prepareText contents !lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines if compare numberI 2 == LT then do let !zs = if compare (length . words . concat . take 1 $ flines) 3 == LT then concat . take 1 $ flines else lastFrom3 . headU2 . fst . get22 . uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (oneProperty)) (chooseMax choice) . unwords . init . words . concat . take 1 $ flines toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2 (concat . take 1 $ lasts) choice [] . drop 1 $ flines)) else do let !intervalNmbrs = (\vs -> if null vs then V.singleton numberI else V.uniq . V.fromList $ vs) . sort . filter (<= numberI) . map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs !us = words . concat . take 1 $ flines !xs = if compare (length us) 2 == LT then [] else unwords . init $ us (!maxE,!minE) = runEval ((parTuple2 rpar rpar) ((\k -> if k == 0.0 then 1.0 else k) . (\rs -> if null rs then 0.0 else head rs) . firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (chooseMax choice) $ xs), (\k -> if k == 0.0 then 1.0 else k) . abs . (\rs -> if null rs then 0.0 else head rs) . firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (chooseMin choice) $ xs))) !zs = if compare (length . words . concat . take 1 $ flines) 3 == LT then concat . take 1 $ flines else lastFrom3 . headU2 . fst . get22 . uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs . oneProperty)) (chooseMax choice) . unwords . init . words . concat . take 1 $ flines toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2I (concat . take 1 $ lasts) choice [] numberI intervalNmbrs minE maxE . drop 1 $ flines)) -- | Processment without rearrangements. circle2 :: String -> String -> [String] -> [String] -> [String] circle2 xs choice yss xss | null xss = yss | otherwise = circle2 (if null rs then [] else last rs) choice (ws:yss) tss where (!zss,!tss) = splitAt 1 xss !rs = words . concat $ zss !ws = if compare (length rs) 3 == LT then unwords (xs:rs) else lastFrom3 . headU2 . fst . get22 . uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (oneProperty)) (chooseMax choice) . unwords . init $ rs -- | Processment with rearrangements. circle2I :: String -> String -> [String] -> Int -> V.Vector Int -> Float -> Float -> [String] -> [String] circle2I xs choice yss numberI vI minE maxE xss | null xss = yss | otherwise = circle2I (if null rs then [] else last rs) choice (ws:yss) numberI vI minE maxE tss where (!zss,!tss) = splitAt 1 xss !rs = words . concat $ zss !ws = if compare (length rs) 3 == LT then unwords (xs:rs) else lastFrom3 . headU2 . fst . get22 . uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (unsafeSwapVecIWithMaxI minE maxE numberI vI . oneProperty)) (chooseMax choice) . unwords . init $ rs headU2 :: [UniquenessG1 a b] -> UniquenessG1 a b headU2 zs | null zs = ([],V.empty,[]) | otherwise = head zs {-# INLINE headU2 #-} noDoubleWords :: [String] -> [String] noDoubleWords xss = map (unwords . drop 1 . words) xss {-# INLINE noDoubleWords #-}