{-# 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) 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(..)) generalF :: 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) -> [String] -> IO [String] generalF wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (fs, code) 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 . concat . take 1 $ universalSet -- 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" 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 return strOutput else parseLineNumber l1 >>= \num -> do permiss <- getPermissions fs let writ = writable permiss readab = readable permiss if writ && readab then appendFile fs (flip outputSel code . head . filter (\(S k _ _) -> k == num) $ sRepresent) else error "The specified file cannot be used for appending the text! Please, specify another file!" return [] where sel x | x == 1 || x < 0 || x > 179 = [] | x == 0 || x == 4 = [[1],[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]] -- all cases are present: 2, 3, 4, 5, 6, 7. Therefore, the slowest ones. | x == 2 || x == 5 = [[1],[2],[3],[4,3],[5,4],[6,5,4]] | x == 7 = [[0],[1,0],[1,0],[1,0],[1,0],[1,0]] | x == 8 = [[0],[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]] | x == 9 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]] ----------------------------------------------------------------------------- | x >= 20 && x <= 26 && x /= 21 = [[1]] -- at least 7 is omitted, but probably 6, or even 5, or even 4, or even 3. 2 is however present. | x >= 27 && x <= 29 = [[0]] | x == 30 || x == 34 = [[1],[2,1]] | x == 32 || x == 35 = [[1],[2]] | x >= 37 && x <= 39 = [[0],[1,0]] | x == 40 || x == 44 = [[1],[2,1],[3,2]] | x == 42 || x == 45 = [[1],[2],[3]] | x >= 47 && x <= 49 = [[0],[1,0],[1,0]] | x == 50 || x == 54 = [[1],[2,1],[3,2],[4,3,2]] | x == 52 || x == 55 = [[1],[2],[3],[4,3]] | x == 57 = [[0],[1,0],[1,0],[1,0]] | x == 58 || x == 59 = [[0],[1,0],[1,0],[2,1,0]] | x == 60 || x == 64 = [[1],[2,1],[3,2],[4,3,2],[5,4,3]] | x == 62 || x == 65 = [[1],[2],[3],[4,3],[5,4]] | x == 67 = [[0],[1,0],[1,0],[1,0],[1,0]] | x == 68 = [[0],[1,0],[1,0],[2,1,0],[2,1,0]] | x == 69 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0]] ----------------------------------------------------------------- | x == 70 || x == 74 = [[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]] -- at least 2 is omitted, but probably 3 and even 4. 5, 6 and 7 are present. | x == 72 || x == 75 = [[2],[3],[4,3],[5,4],[6,5,4]] | x == 77 = [[1,0],[1,0],[1,0],[1,0],[1,0]] | x == 78 = [[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]] | x == 79 = [[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]] | x == 80 || x == 84 = [[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]] | x == 82 || x == 85 = [[3],[4,3],[5,4],[6,5,4]] | x == 87 = [[1,0],[1,0],[1,0],[1,0]] | x == 88 = [[1,0],[2,1,0],[2,1,0],[2,1,0]] | x == 89 = [[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]] | x == 90 || x == 94 = [[4,3,2],[5,4,3],[6,5,4,3,2]] | x == 92 || x == 95 = [[4,3],[5,4],[6,5,4]] | x == 97 = [[1,0],[1,0],[1,0]] | x == 98 = [[2,1,0],[2,1,0],[2,1,0]] | x == 99 = [[2,1,0],[3,2,1,0],[3,2,1,0]] ----------------------------------------------------------------------------------- | x == 100 || x == 104 = [[1],[2,1],[4,3,2],[6,5,4,3,2]] -- 4 and 6 are omitted, just present the ones from: 2, 3, 5, 7. | x == 102 || x == 105 = [[1],[2],[4,3],[6,5,4]] | x == 107 = [[0],[1,0],[1,0],[1,0]] | x == 108 = [[0],[1,0],[2,1,0],[2,1,0]] | x == 109 = [[0],[1,0],[2,1,0],[3,2,1,0]] ----------------------------------------------------------------------------- | x == 150 || x == 154 = [[1],[2,1],[4,3,2]] -- 4, 6, 7 are omitted but 2, 3, 5 are present. | x == 152 || x == 155 = [[1],[2],[4,3]] | x == 157 = [[0],[1,0],[1,0]] | x == 158 || x == 159 = [[0],[1,0],[2,1,0]] ----------------------------------------------------------------- | x == 170 || x == 174 = [[2,1],[4,3,2],[6,5,4,3,2]] -- just 3, 5 and 7 are present | x == 172 || x == 175 = [[2],[4,3],[6,5,4]] | x == 177 = [[1,0],[1,0],[1,0]] | x == 178 = [[1,0],[2,1,0],[2,1,0]] | x == 179 = [[1,0],[2,1,0],[3,2,1,0]] ---------------------------------------------------------------------------------- | otherwise = [[1],[1],[2,1],[3,2,1],[3,2],[4,3,2]] -------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------- sel2 y | y == 1 || y < 0 || y > 179 = [] | (rem y 10 `elem` [1,3,6]) || y >= 0 && y <= 9 = [2..7] | y >= 20 && y <= 69 = [2..toEnum (y `quot` 10)] | y >= 70 && y <= 99 = [toEnum (y `quot` 10) - 4..7] | y >= 100 && y <= 109 = [2,3,5,7] | y >= 150 && y <= 159 = [2,3,5] | y >= 170 && y <= 179 = [3,5,7] | otherwise = [2..7] minMax11ByCList :: Ord a => (a -> a -> Ordering) -> [a] -> (a, a) -- Is rewritten from the 'Data.MinMax.Preconditions.minMax11ByC' from @subG@ package. minMax11ByCList g xs@(x:y:ys) = foldr f (if x > y then (y, x) else (x, y)) ys where f z (x,y) | g z x == LT = (z,y) | g z y == GT = (x,z) | otherwise = (x,y) minMax11ByCList _ _ = undefined -- Is not intended to be used for lists with less than two elements. 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) = show j `mappend` " " `mappend` xs `mappend` " " `mappend` show 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 == 0 = ts `mappend` "\n" | code == 1 = intercalate " " [show x1, ts] `mappend` "\n" | code == 2 = intercalate " " [show y1, ts] `mappend` "\n" | code == 3 = intercalate " " [show x1, ts, show y1] `mappend` "\n" | code == 4 = 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 argCs = catMaybes (fmap (readMaybeECG l) -- . (showB l lstW2:) . getC "+a" $ argsC) splitting = fromMaybe 50 (readMaybe (concat . getB "+w" $ argsB)::Maybe Int8) filedata = getB "+f" argsB (filesave,codesave) | null filedata = ("",-1) | length filedata == 2 = (head filedata, fromMaybe 0 (readMaybe (last filedata)::Maybe Int)) | otherwise = (head filedata,0) ll = take 7 . (if prepare then id else words . mconcat . prepareText ysss zsss xs . unwords) $ args11 l = length ll 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 wrs ks arr gs us vs h numTest hc (grps,mxms) descending hashStep emptyline splitting (filesave, codesave) 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)]