-- |
-- Module : Main
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Analyzes a poetic text in Ukrainian, for every line prints statistic data and
-- then for the whole poem prints the hypothesis evaluation information.
--
-- To enable parallel computations (potentially, they can speed up the work), please, run the @propertiesText@ executable with
-- @+RTS -threaded -RTS@ command line options with possibly @-N@ option inside.
--
{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}
module Main where
import Data.SubG
import System.IO
import Control.Concurrent
import Control.Exception
import Control.Parallel.Strategies
import Data.Maybe (fromMaybe)
import Data.List (sort)
import Text.Read (readMaybe)
import qualified Data.Vector as VB
import Melodics.ByteString.Ukrainian
import System.Environment
import Languages.Phonetic.Ukrainian.PrepareText
import Numeric (showFFloat)
import Languages.UniquenessPeriods.Vector.Filters
import Data.Char (isAlpha)
import Data.Statistics.RulesIntervals
import Data.MinMax.Preconditions
import Phonetic.Languages.Lists.Ukrainian.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.StrictVG
import Phonetic.Languages.Permutations
import Phonetic.Languages.Simplified.DataG
import Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG2
main :: IO ()
main = do
args0 <- getArgs
let args = filter (\xs -> all (/= ':') xs && all (/= '@') xs) args0
!coeffs = readCF . concat . take 1 $ args -- The first command line argument. If not sure, just enter \"1_\".
!lInes = filter (any (== ':')) args0
!numbersJustPrint = filter (== "@n") args0
if isPair coeffs then do
let !file = concat . drop 1 . take 2 $ args -- The second command line argument except those ones that are RTS arguments
if null numbersJustPrint then do
let !gzS = concat . take 1 . drop 2 $ args -- The third command line argument that controls the choice of the number of intervals
!printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int)) -- The fourth command line argument except those ones that are RTS arguments. Set to 1 if you would like to print the current line within the information
!toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 4 $ args)::(Maybe Int)) -- The fifth command line argument except those ones that are RTS arguments. Set to 1 if you would like to convert the text into one single line before applying to it the processment (it can be more conceptually consistent in such a case)
!choice = concat . drop 5 . take 6 $ args -- The sixth command line argument that controls what properties are used.
generalProc lInes coeffs file gzS printLine toOneLine choice
else do
contents <- readFile file
fLinesIO contents
else do
let !file = concat . take 1 $ args
if null numbersJustPrint then do
let !gzS = concat . take 1 . drop 1 $ args
!printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 2 $ args)::(Maybe Int))
!toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int))
!choice = concat . drop 4 . take 5 $ args
generalProc lInes coeffs file gzS printLine toOneLine choice
else do
contents <- readFile file
fLinesIO contents
generalProc :: [String] -> Coeffs2 -> FilePath -> String -> Int -> Int -> String -> IO ()
generalProc lInes coeffs file gzS printLine toOneLine choice
| null lInes = do
contents <- readFile file
let !flines = fLines toOneLine contents
getData3 coeffs (getIntervalsN gzS flines) printLine choice flines
| otherwise = do
contents <- readFile file
let flines = fLines toOneLine . unlines . linesFromArgsG lInes . fLines 0 $ contents
getData3 coeffs (getIntervalsN gzS flines) printLine choice flines
linesFromArgs1 :: Int -> String -> [String] -> [String]
linesFromArgs1 n xs yss =
let (!ys,!zs) = (\(x,z) -> (x, drop 1 z)) . break (== ':') $ xs
!ts = sort . map (min n . abs) $ [fromMaybe 1 (readMaybe ys::Maybe Int), fromMaybe n (readMaybe zs::Maybe Int)] in
drop (head ts - 1) . take (last ts) $ yss
linesFromArgsG :: [String] -> [String] -> [String]
linesFromArgsG xss yss = let n = length yss in concatMap (\ts -> linesFromArgs1 n ts yss) xss
getIntervalsN :: String -> [String] -> Int
getIntervalsN xs ys
| xs == "s" = sturgesH (length ys)
| xs == "l" = levynskyiMod (length ys)
| otherwise = fromMaybe 9 (readMaybe xs::(Maybe Int))
{-# INLINE getIntervalsN #-}
getData3 :: Coeffs2 -> Int -> Int -> String -> [String] -> IO ()
getData3 coeffs gz printLine choice zs = let !permsV4 = genPermutationsVL in mapM_ (process1Line coeffs gz printLine choice permsV4) zs
process1Line :: Coeffs2 -> Int -> Int -> String -> VB.Vector [VB.Vector Int] -> String -> IO ()
process1Line coeffs gz printLine choice !permsV5 v = bracket (do
myThread <- forkIO (do
let !v2 = words v
!l2 = (length v2) - 2
((!minE,!maxE),!data2)
| l2 >= 0 = runEval (parTuple2 rpar rpar (minMax11C . map (toTransPropertiesF' (chooseMax id coeffs choice)) .
uniquenessVariants2GNBL ' ' id id id (VB.unsafeIndex permsV5 l2) $ v2, toTransPropertiesF' (chooseMax id coeffs choice) . unwords . subG " 01-" $ v))
| otherwise = let !mono = toTransPropertiesF' (chooseMax id coeffs choice) v in ((mono,mono),mono)
(!wordsN,!intervalN)
| l2 >= 0 = runEval (parTuple2 rpar rpar (l2 + 2, intervalNRealFrac minE maxE gz data2))
| otherwise = (1,intervalNRealFrac data2 data2 gz data2)
!ratio
| l2 >= 0 = if maxE == 0.0 then 0.0 else 2.0 * data2 / (minE + maxE)
| otherwise = 1.0 in do
hPutStr stdout . showFFloat (precChoice choice) minE $ "\t"
hPutStr stdout . showFFloat (precChoice choice) data2 $ "\t"
hPutStr stdout . showFFloat (precChoice choice) maxE $ "\t"
hPutStr stdout . showFFloat (Just 4) (data2 / minE) $ "\t"
hPutStr stdout . showFFloat (Just 4) (maxE / minE) $ "\t"
hPutStr stdout . showFFloat (Just 4) (maxE / data2) $ "\t"
hPutStr stdout . showFFloat (Just 8) ratio $ "\t"
hPutStr stdout ('\t':show (wordsN::Int))
hPutStr stdout ('\t':show (intervalN::Int))
hPutStrLn stdout (if printLine == 1 then '\t':v else ""))
return myThread) (killThread) (\_ -> putStr "")
fLines :: Int -> String -> [String]
fLines !toOneLine ys =
let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText . (\z -> if toOneLine == 1 then unwords . words $ z else z) $ ys
wss = map (length . subG " 01-") preText
g (t:ts) (r:rs) = if r > 7 then filter (`notElem` "01-") t:g ts rs else t:g ts rs
g _ _ = []
in g preText wss
fLinesIO :: String -> IO ()
fLinesIO ys =
let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText $ ys
wss = map (length . subG " 01-") preText
g (t:ts) (r:rs) = if r > 7 then filter (`notElem` "01-") t:g ts rs else t:g ts rs
g _ _ = []
in VB.mapM_ putStrLn . VB.map (\(i,x) -> show (i + 1) ++ "\t" ++ x) . VB.indexed . VB.fromList . g preText $ wss