-- |
-- 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)
-- | 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 1 $ 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)) (procDiverse2I) . unwords . init . words . concat . take 1 $ flines
toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2 (concat . take 1 $ lasts) [] . 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 then 1.0 else int2Float k) . (\rs -> if null rs then 0 else head rs) . firstFrom3 .
maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (procDiverse2I) $ xs), (\k -> if k == 0 then 1.0 else int2Float k) . abs . (\rs -> if null rs then 0 else head rs) .
firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty))
(procDiverse2Ineg) $ 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)) (procDiverse2F) .
unwords . init . words . concat . take 1 $ flines
toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2I (concat . take 1 $ lasts) [] numberI intervalNmbrs minE maxE . drop 1 $ flines))
-- | Processment without rearrangements.
circle2 :: String -> [String] -> [String] -> [String]
circle2 xs yss xss
| null xss = yss
| otherwise = circle2 (if null rs then [] else last rs) (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)) (procDiverse2I) . unwords . init $ rs
-- | Processment with rearrangements.
circle2I :: String -> [String] -> Int -> V.Vector Int -> Float -> Float -> [String] -> [String]
circle2I xs yss numberI vI minE maxE xss
| null xss = yss
| otherwise = circle2I (if null rs then [] else last rs) (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)) (procDiverse2F) . 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 #-}