-- |
-- 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 (yss `mappend` [ws]) 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 (yss `mappend` [ws]) 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 #-}