{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}
module Phladiprelio.General.Simple where
import GHC.Base
import GHC.Enum (fromEnum,toEnum)
import GHC.Real (fromIntegral,(/),quot,rem,quotRem)
import Text.Show (Show(..))
import Phladiprelio.General.PrepareText
import Phladiprelio.General.Syllables
import Phladiprelio.General.Base
import System.Environment (getArgs)
import GHC.Num ((+),(-),(*),Integer)
import Text.Read (readMaybe)
import System.IO (putStrLn, FilePath,stdout,universalNewlineMode,hSetNewlineMode,getLine,appendFile,readFile)
import Rhythmicity.MarkerSeqs hiding (id)
import Rhythmicity.BasicF
import Data.List hiding (foldr)
import Data.Maybe (fromMaybe, mapMaybe, catMaybes,isNothing,fromJust)
import Data.Tuple (fst,snd)
import Data.Char (isDigit)
import CLI.Arguments
import CLI.Arguments.Get
import CLI.Arguments.Parsing
import GHC.Int (Int8)
import Data.Ord (comparing)
import Phladiprelio.PermutationsRepresent
import Phladiprelio.ConstraintsEncoded
import Phladiprelio.PermutationsArr
import Phladiprelio.StrictVG
import Numeric (showFFloat)
import Phladiprelio.Halfsplit
import System.Directory (doesFileExist,readable,writable,getPermissions,Permissions(..))
import Data.ReversedScientific
import Control.Concurrent.Async (mapConcurrently)
import Phladiprelio.Tests
generalF
:: (String, String) -- ^ If the next element is not equal to -1, then the prepending and appending lines to be displayed. Used basically for working with the multiline textual input data.
-> Int -- ^ The number of the line in the file to be read the lines from. If equal to -1 then neither reading from the file is done nor the first argument influences the processment results.
-> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
-> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly.
-> CharPhoneticClassification
-> SegmentRulesG
-> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
-> ([[[PRS]]] -> [[Double]])
-> Int
-> HashCorrections
-> (Int8,[Int8])
-> Bool
-> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12.
-> Bool
-> Int8
-> (FilePath, Int)
-> Bool -- ^ In the testing mode, whether to execute computations in concurrent mode (for speed up) or in single thread. If specified needs the executable to be compiled with -rtsopts and -threaded options and run with the command line +RTS -N -RTS options.
-> String -- ^ An initial string to be analyzed.
-> [String]
-> IO [String]
generalF (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (fs, code) concurrently initstr universalSet
| null universalSet = let strOutput = ["You have specified the data and constraints on it that lead to no further possible options.", "Please, specify another data and constraints."] in mapM putStrLn strOutput >> return strOutput
| length universalSet == 1 = mapM putStrLn universalSet >> return universalSet
| otherwise = do
let syllN = countSyll wrs arr us vs initstr
-- universalSet = map unwords . permutations $ rss
f grps mxms = sum . countHashes2G hashStep hc grps mxms . mconcat . h . createSyllablesPL wrs ks arr gs us vs
hSetNewlineMode stdout universalNewlineMode
if numTest >= 0 && numTest <= 179 && numTest /= 1 then do
putStrLn "Feet Val Stat Proxim"
(if concurrently then mapConcurrently else mapM)
(\(q,qs) -> let m = stat1 syllN (q,qs)
(min1,max1) = minMax11ByCList (comparing (f q qs)) universalSet
mx = f q qs max1
strTest = (show (fromEnum q) `mappend` " | " `mappend` show mx `mappend` " " `mappend` show m `mappend` " -> " `mappend` showFFloat (Just 3) (100 * fromIntegral mx / fromIntegral m) "%" `mappend` (if rem numTest 10 >= 4
then let min1 = minimumBy (comparing (f q qs)) universalSet in ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n")
else "")) in putStrLn strTest >> return strTest) . zip (sel2 numTest) $ (sel numTest)
else let sRepresent = zipWith (\k (x, ys) -> S k x ys) [1..] .
(let h1 = if descending then (\(u,w) -> ((-1)*u,w)) else id in sortOn h1) . map (\xss -> (f grps mxms xss, xss)) $ universalSet
strOutput = (:[]) . halfsplit (\(S _ y _) -> y) (jjj splitting) $ sRepresent
in do
_ <- mapM putStrLn strOutput
let l1 = length sRepresent
if code == -1
then if lineNmb == -1 then return strOutput
else do
print23 prestr poststr 1 [initstr]
return strOutput
else do
print23 prestr poststr 1 [initstr]
parseLineNumber l1 >>= \num -> do
permiss <- getPermissions fs
let writ = writable permiss
readab = readable permiss
if writ && readab then do
let lineOption = head . filter (\(S k _ ts) -> k == num) $ sRepresent
textP = (\(S _ _ ts) -> ts) lineOption
sylls = createSyllablesPL wrs ks arr gs us vs textP
if code >= 10 && code <= 19 && grps == 2
then do
let structData = h . createSyllablesPL wrs ks arr gs us vs $ textP
(breaks,rs) = showZerosFor2Period structData syllN (\(SylS c _) -> [c]) sylls
putStrLn textP
putStrLn breaks
putStrLn . show $ rs
appendFile fs ((if code >= 15 then (show rs `mappend` "\n" `mappend` breaks `mappend` "\n") else "") `mappend` outputSel lineOption code)
else appendFile fs (outputSel lineOption code)
else error "The specified file cannot be used for appending the text! Please, specify another file!"
return []
where jjj kk = let (q1,r1) = quotRem kk (if kk < 0 then -10 else 10) in jjj' q1 r1 emptyline
jjj' q1 r1 emptyline
| r1 == (-1) || r1 == (-3) = -10*q1 + (if emptyline then -5 else r1)
| r1 == 1 || r1 == 3 = 10*q1 + (if emptyline then 5 else r1)
| r1 < 0 = -10*q1 + (if emptyline then -4 else r1)
| otherwise = 10*q1 + (if emptyline then 4 else r1)
data PhladiprelioGen = S Int Integer String deriving Eq
instance Show PhladiprelioGen where
show (S i j xs) = showBignum 7 j `mappend` " " `mappend` xs `mappend` " " `mappend` showWithSpaces 4 i
countSyll
:: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
-> CharPhoneticClassification
-> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String
-> Int
countSyll wrs arr us vs xs = fromEnum . foldr (\x y -> if createsSyllable x then y + 1 else y) 0 . concatMap (str2PRSs arr) . words1 . mapMaybe g . concatMap string1 . stringToXG wrs $ xs
where g :: Char -> Maybe Char
g x
| x `elem` us = Nothing
| x `notElem` vs = Just x
| otherwise = Just ' '
words1 xs = if null ts then [] else w : words1 s'' -- Practically this is an optimized version for this case 'words' function from Prelude.
where ts = dropWhile (== ' ') xs
(w, s'') = break (== ' ') ts
{-# NOINLINE words1 #-}
stat1 :: Int -> (Int8,[Int8]) -> Int
stat1 n (k, ks) = fst (n `quotRemInt` fromEnum k) * length ks
outputSel :: PhladiprelioGen -> Int -> String
outputSel (S x1 y1 ts) code
| code < 0 = []
| code == 1 || code == 11 || code == 16 = intercalate " " [show x1, ts] `mappend` "\n"
| code == 2 || code == 12 || code == 17 = intercalate " " [show y1, ts] `mappend` "\n"
| code == 3 || code == 13 || code == 18 = intercalate " " [show x1, ts, show y1] `mappend` "\n"
| code == 4 || code == 14 || code == 19 = intercalate " " [show x1, show y1] `mappend` "\n"
| otherwise = ts `mappend` "\n"
parseLineNumber :: Int -> IO Int
parseLineNumber l1 = do
putStrLn "Please, specify the number of the option to be written to the file specified: "
number <- getLine
let num = readMaybe (filter isDigit number)::Maybe Int
if isNothing num || num > Just l1 || num == Just 0
then parseLineNumber l1
else return . fromJust $ num
processingF
:: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
-> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon (e. g. allophones). Must be sorted in the ascending order to be used correctly.
-> CharPhoneticClassification
-> SegmentRulesG
-> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
-> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
-> ([[[PRS]]] -> [[Double]])
-> Int
-> HashCorrections
-> (Int8,[Int8])
-> [[String]]
-> [[String]]
-> Bool
-> Int -- ^ The hashing function step. The default value is 20. Is expected to be greater than 2, and better greater than 12.
-> String
-> IO ()
processingF wrs ks arr gs us vs h numTest hc (grps,mxms) ysss zsss descending hashStep xs = do
args0 <- getArgs
let (argsC, args) = takeCs1R ('+','-') cSpecs args0
(argsB, args11) = takeBsR bSpecs args
prepare = any (== "-p") args11
emptyline = any (== "+l") args11
splitting = fromMaybe 50 (readMaybe (concat . getB "+w" $ argsB)::Maybe Int8)
concurrently = any (== "-C") args11
filedata = getB "+f" argsB
multiline2 = getB "+m" argsB
(fileread,lineNmb)
| null multiline2 = ("",-1)
| length multiline2 == 2 = (head multiline2, fromMaybe 1 (readMaybe (last multiline2)::Maybe Int))
| otherwise = (head multiline2, 1)
(arg3s,prestr,poststr) <- do
if lineNmb /= -1 then do
txtFromFile <- readFile fileread
let lns = lines txtFromFile
ln0 = max 1 (min lineNmb (length lns))
ln_1
| ln0 == 1 = 0
| otherwise = ln0 - 1
ln1
| ln0 == length lns = 0
| otherwise = ln0 + 1
lineF = lns !! (ln0 - 1)
line_1F
| ln_1 == 0 = []
| otherwise = lns !! (ln_1 - 1)
line1F
| ln1 == 0 = []
| otherwise = lns !! (ln1 - 1)
return $ (words lineF, line_1F,line1F)
else return (args11, [], [])
let (filesave,codesave)
| null filedata = ("",-1)
| length filedata == 2 = (head filedata, fromMaybe 0 (readMaybe (last filedata)::Maybe Int))
| otherwise = (head filedata,0)
ll = take (if any (== "+x") arg3s then 9 else 7) . (if prepare then id else words . mconcat . prepareText ysss zsss xs . unwords) $ arg3s
l = length ll
argCs = catMaybes (fmap (readMaybeECG l) -- . (showB l lstW2:)
. getC "+a" $ argsC)
argCBs = unwords . getC "+b" $ argsC -- If you use the parenthese with +b ... -b then consider also using the quotation marks for the whole algebraic constraint. At the moment though it is still not working properly for parentheses functionality. The issue should be fixed in the further releases.
!perms
| not (null argCBs) = filterGeneralConv l argCBs . genPermutationsL $ l
| null argCs = genPermutationsL l
| otherwise = decodeLConstraints argCs . genPermutationsL $ l
variants1 = uniquenessVariants2GNBL ' ' id id id perms ll
generalF (prestr,poststr) lineNmb wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (filesave, codesave) concurrently (unwords arg3s) variants1 >> return ()
-- | Specifies the group of the command line arguments for 'processingF', which specifies the
-- PhLADiPreLiO constraints. For more information, see:
-- https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints
cSpecs :: CLSpecifications
cSpecs = zip ["+a","+b"] . cycle $ [-1]
bSpecs :: CLSpecifications
bSpecs = [("+f",2), ("+w",1), ("+m",2)]