{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}
-- |
-- Module : Phonetic.Languages.GetTextualInfo
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Library module that contains functions used by the propertiesTextG3
-- executable.
module Phonetic.Languages.GetTextualInfo (
generalProc
, linesFromArgs1
, linesFromArgsG
, getData3
, process1Line
) where
import Data.SubG hiding (takeWhile,dropWhile)
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 GHC.Arr
import Melodics.ByteString.Ukrainian.Arr
import Phonetic.Languages.Ukrainian.PrepareText
import Numeric (showFFloat)
import Phonetic.Languages.Filters
import Data.Char (isAlpha)
import Data.Statistics.RulesIntervalsPlus
import Data.MinMax.Preconditions
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.StrictVG.Base
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2
import Languages.UniquenessPeriods.Array.Constraints.Encoded
import Phonetic.Languages.Simplified.SimpleConstraints
import Phonetic.Languages.Common
generalProc :: Bool -> [String] -> [String] -> Coeffs2 -> FilePath -> String -> Int -> Int -> String -> IO ()
generalProc lstW multiples2 lInes coeffs file gzS printLine toOneLine choice
| null lInes = do
contents <- readFile file
let !flines = fLines toOneLine contents
getData3 lstW coeffs (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines
| otherwise = do
contents <- readFile file
let !flines = fLines toOneLine . unlines . linesFromArgsG lInes . fLines 0 $ contents
getData3 lstW coeffs (getIntervalsNS lstW gzS flines) printLine choice multiples2 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
getData3 :: Bool -> Coeffs2 -> Int -> Int -> String -> [String] -> [String] -> IO ()
getData3 lstW coeffs gz printLine choice multiples3 zss = let !permsV4 = genPermutationsArrL in putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz) >> mapM_ (process1Line lstW coeffs gz printLine choice multiples3 permsV4) zss
process1Line :: Bool -> Coeffs2 -> Int -> Int -> String -> [String] -> Array Int [Array Int Int] -> String -> IO ()
process1Line lstW coeffs gz printLine choice multiples4 !permsV50 v
| null multiples4 = bracket (do {
myThread <- forkIO (do
let !v2 = words v
!l2 = length v2 - 2
if l2 >= (if lstW then 1 else 0) then do
let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) .
unsafeAt permsV50 $ l2
((!minE,!maxE),!data2) = runEval (parTuple2 rpar rpar (minMax11C . map (toTransPropertiesF' (chooseMax id coeffs choice )) .
uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (chooseMax id coeffs choice) . unwords . subG " 01-" $ v))
(!wordsN,!intervalN) = (l2 + 2, intervalNRealFrac minE maxE gz data2)
!ratio = if maxE == 0.0 then 0.0 else 2.0 * data2 / (minE + maxE)
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 "")
else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else ""))
; return myThread }) (killThread) (\_ -> putStr "")
| otherwise = bracket (do {
myThread <- forkIO (do
let !v2 = words v
!l2 = length v2 - 2
if l2 >= (if lstW then 1 else 0) then do
let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) .
unsafeAt permsV50 $ l2
rs = parMap rpar (\choiceMMs -> (minMax11C .
map (toTransPropertiesF' (chooseMax id coeffs choiceMMs)) .
uniquenessVariants2GNBL ' ' id id id permsV5 $ v2,
toTransPropertiesF' (chooseMax id coeffs choiceMMs) . unwords . subG " 01-" $ v,gz)) multiples4
(!wordsN,!intervalNs) = (l2 + 2, map (\((!x,!y),!z,!t) -> intervalNRealFrac x y t z) rs)
in do
hPutStr stdout (show (wordsN::Int))
mapM_ (\i -> hPutStr stdout ('\t':show (i::Int))) intervalNs
hPutStrLn stdout (if printLine == 1 then '\t':v else "")
else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else ""))
; return myThread }) (killThread) (\_ -> putStr "")