-- | -- 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 Languages.UniquenessPeriods.Vector.Properties import Languages.UniquenessPeriods.Vector.General.Debug 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.AuxiliaryG 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 its position, and the rest of the line is rearranged using the specified other command line -- arguments. They are general for the whole program. The first command line argument is a FilePath to the file with a Ukrainian text to be rewritten. -- The second one is a variant of the metrics (\"properties\") used to evaluate the variants. -- 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 minE1 maxE1 tss where (!zss,!tss) = splitAt 1 xss !rs = words . concat $ zss !l3 = (subtract 3) . length $ rs !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 (!maxE1,!minE1) | compare l3 0 /= LT = let !w2s = unwords . init . words . concat . take 1 $ tss in runEval (parTuple2 rpar rpar ((\k -> if k == 0.0 then 1.0 else k) . (\ls -> if null ls then 0.0 else head ls) . firstFrom3 . maximumElBy 1 (V.singleton oneProperty) $ UL2 ([], uniquenessVariants2GN " 01-" (V.singleton oneProperty) (chooseMax choice) $ w2s), (\k -> if k == 0.0 then 1.0 else k) . abs . (\ls -> if null ls then 0.0 else head ls) . firstFrom3 . maximumElBy 1 (V.singleton oneProperty) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton oneProperty) (chooseMin choice) $ w2s))) | otherwise = (0.0,0.0) headU2 :: [UniquenessG1 a b] -> UniquenessG1 a b headU2 zs | null zs = ([],V.empty,[]) | otherwise = head zs {-# INLINE headU2 #-} noDoubleWords :: [String] -> [String] noDoubleWords = map (unwords . drop 1 . words) {-# INLINE noDoubleWords #-}