diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for phonetic-languages-simplified-lists-examples + +## 0.1.0.0 -- 2020-11-29 + +* First version. Released on an unsuspecting world. diff --git a/GetInfo/Main.hs b/GetInfo/Main.hs new file mode 100644 --- /dev/null +++ b/GetInfo/Main.hs @@ -0,0 +1,147 @@ +-- | +-- 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.PropertiesSyllablesG +import Phonetic.Languages.Simplified.StrictVG +import Phonetic.Languages.Permutations +import Phonetic.Languages.Simplified.DataG +import Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG + + +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 (toTransMetrices' (chooseMax id coeffs choice)) . + uniquenessVariants2GNBL ' ' id id id (VB.unsafeIndex permsV5 l2) $ v2, toTransMetrices' (chooseMax id coeffs choice) . unwords . subG " 01-" $ v)) + | otherwise = let !mono = toTransMetrices' (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 Nothing 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 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2020 OleksandrZhabenko + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Lines/Main.hs b/Lines/Main.hs new file mode 100644 --- /dev/null +++ b/Lines/Main.hs @@ -0,0 +1,135 @@ +-- | +-- 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 System.IO +import Data.SubG +import Data.MinMax.Preconditions +import qualified Data.Vector as VB +import Data.List (sort) +import Phonetic.Languages.Lists.Ukrainian.PropertiesSyllablesG +import Phonetic.Languages.Simplified.StrictVG +import Phonetic.Languages.Permutations +import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI) +import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) +import System.Environment +import Languages.Phonetic.Ukrainian.PrepareText +import Phonetic.Languages.Simplified.DataG +import Data.Char (isDigit) +import Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG +import Data.Monoid (mappend) + +-- | 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 its position, and the rest of the line is rearranged using the specified other command line +-- arguments. They are general for the whole program. The first command line argument is a FilePath to the file with a Ukrainian text to be rewritten. +-- The second one is a variant of the metrics (\"properties\") used to evaluate the variants. +-- 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 coeffs = readCF . concat . take 1 $ args -- The first command line argument. If not sure, pass just \"1_\". + if isPair coeffs then do + let !numericArgs = filter (all isDigit) . drop 3 $ args + !choice = concat . drop 2 . take 3 $ args + !numberI = fromMaybe 1 (readMaybe (concat . take 1 $ numericArgs)::Maybe Int) + !file = concat . drop 1 . take 2 $ args + generalProcessment coeffs numericArgs choice numberI file + else do + let !numericArgs = filter (all isDigit) . drop 2 $ args + !choice = concat . drop 1 . take 2 $ args + !numberI = fromMaybe 1 (readMaybe (concat . take 1 $ numericArgs)::Maybe Int) + !file = concat . take 1 $ args + generalProcessment coeffs numericArgs choice numberI file + +generalProcessment :: Coeffs2 -> [String] -> String -> Int -> FilePath -> IO () +generalProcessment coeffs numericArgs choice numberI file = do + contents <- readFile file + let !permsV = VB.force genPermutationsVL + !flines = fLines contents + !lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines + if compare numberI 2 == LT then toFileStr (file ++ ".new.txt") (circle2 coeffs permsV choice [] $ flines) + else do + let !intervalNmbrs = (\vs -> if null vs then VB.singleton numberI else VB.uniq . VB.fromList $ vs) . sort . filter (<= numberI) . + map (\t -> fromMaybe numberI (readMaybe t::Maybe Int)) . drop 2 $ numericArgs + !us = words . concat . take 1 $ flines + !l2 = (subtract 3) . length $ us + if compare l2 0 /= LT then do + let !perms2 = VB.unsafeIndex permsV $ l2 + (!minE,!maxE) = let !frep20 = chooseMax id coeffs choice in minMax11C . map (toMetrices' frep20) . + uniquenessVariants2GNPBL [] (concat . take 1 $ lasts) ' ' id id id perms2 . init $ us + toFileStr (file ++ ".new.txt") (circle2I coeffs permsV choice [] numberI intervalNmbrs minE maxE $ flines) + else toFileStr (file ++ ".new.txt") ((concat . take 1 $ flines):(circle2I coeffs permsV choice [] numberI intervalNmbrs 0.0 0.0 . drop 1 $ flines)) + +fLines :: String -> [String] +fLines ys = + let preText = 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 g preText wss + +-- | Processment without rearrangements. +circle2 :: Coeffs2 -> VB.Vector [VB.Vector Int] -> String -> [String] -> [String] -> [String] +circle2 coeffs permsG1 choice yss xss + | null xss = yss + | otherwise = circle2 coeffs permsG1 choice (yss `mappend` [ws]) tss + where (!zss,!tss) = splitAt 1 xss + !rs = words . concat $ zss + !l = length rs + !frep2 = chooseMax id coeffs choice + !ws = if compare l 3 == LT then unwords rs else line . maximumElR . map (toResultR frep2) . + uniquenessVariants2GNPBL [] (last rs) ' ' id id id (VB.unsafeIndex permsG1 (l - 3)) . init $ rs + + +-- | Processment with rearrangements. +circle2I :: Coeffs2 -> VB.Vector [VB.Vector Int] -> String -> [String] -> Int -> VB.Vector Int -> Float -> Float -> [String] -> [String] +circle2I coeffs permsG1 choice yss numberI vI minE maxE xss + | null xss = yss + | otherwise = circle2I coeffs permsG1 choice (yss `mappend` [ws]) numberI vI minE1 maxE1 tss + where (!zss,!tss) = splitAt 1 xss + !w2s = words . concat . take 1 $ tss + !l3 = (subtract 3) . length $ w2s + !rs = words . concat $ zss + !l = length rs + !frep2 = chooseMax (unsafeSwapVecIWithMaxI minE maxE numberI vI) coeffs choice + !ws = if compare (length rs) 3 == LT then unwords rs else line . maximumElR . map (toResultR frep2) . + uniquenessVariants2GNPBL [] (last rs) ' ' id id id (VB.unsafeIndex permsG1 (l - 3)) . init $ rs + (!minE1,!maxE1) + | compare l3 0 /= LT = + let !perms3 = VB.unsafeIndex permsG1 l3 + !v4 = init w2s + !frep20 = chooseMax id coeffs choice in minMax11C . map (toMetrices' frep20) . + uniquenessVariants2GNPBL [] (last w2s) ' ' id id id perms3 $ v4 + | otherwise = (0.0,0.0) + +-- | Prints every element from the structure on the new line to the file. Uses 'appendFile' function inside. Is taken from +-- the Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package. +toFileStr :: + FilePath -- ^ The 'FilePath' to the file to be written in the 'AppendMode' (actually appended with) the information output. + -> [String] -- ^ Each element is appended on the new line to the file. + -> IO () +toFileStr file xss = mapM_ (\xs -> appendFile file (xs `mappend` newLineEnding)) xss + +-- | Auxiliary printing function to define the line ending in some cases. Is taken from the +-- Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package +newLineEnding :: String +newLineEnding + | nativeNewline == LF = "\n" + | otherwise = "\r\n" diff --git a/Phonetic/Languages/Simplified/Lists/Ukrainian/FuncRep2RelatedG.hs b/Phonetic/Languages/Simplified/Lists/Ukrainian/FuncRep2RelatedG.hs new file mode 100644 --- /dev/null +++ b/Phonetic/Languages/Simplified/Lists/Ukrainian/FuncRep2RelatedG.hs @@ -0,0 +1,30 @@ +-- | +-- Module : Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Functions to choose from the 'FuncRep' variants. + +{-# LANGUAGE BangPatterns #-} + +module Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG where + +import CaseBi (getBFst') +import qualified Data.Vector as VB +import Phonetic.Languages.Simplified.DataG +import Phonetic.Languages.Lists.Ukrainian.PropertiesFuncRepG +import Phonetic.Languages.Lists.Ukrainian.PropertiesSyllablesG + +-- | Allows to choose the variant of the computations in case of usual processment. +chooseMax :: (Ord c) => (Float -> c) -> Coeffs2 -> String -> FuncRep2 String Float c +chooseMax g coeffs choice + | isPair coeffs = getBFst' (procBoth2InvF g coeffs, VB.fromList [("02y",procRhythmicity232F g "02y" coeffs), ("0y",procRhythmicity23F g "0y" coeffs), + ("y",procBothF g coeffs),("y0",procDiverse2F g),("y2",procBoth2F g coeffs),("yy",procBothInvF g coeffs)]) choice + | otherwise = getBFst' (procBoth2InvF g coeffs, VB.fromList [("02y",procRhythmicity232F g "02y" coeffs),("0y",procRhythmicity23F g "0y" coeffs), + ("y",procBothF g coeffs),("y0",procDiverse2F g),("y2",procBoth2F g coeffs),("yy",procBothInvF g coeffs)]) choice + +-- | Allows to choose precision in the Numeric.showFFloat function being given a choice parameter. +precChoice :: String -> Maybe Int +precChoice = getBFst' (Just 4, VB.fromList [("02y",Just 0),("0y",Just 0),("y",Just 0),("y0",Just 0),("y2",Just 0)]) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +The short (possibly) instruction how to use the programs of the package phonetic-languages-simplified-lists-examples +in Ukrainian is here: + +https://web.archive.org/web/20201128230022/https://oleksandrzhabenko.github.io/uk/%D0%9A%D0%BE%D1%80%D0%BE%D1%82%D0%BA%D0%B0_%D1%96%D0%BD%D1%81%D1%82%D1%80%D1%83%D0%BA%D1%86%D1%96%D1%8F_%D1%89%D0%BE%D0%B4%D0%BE_%D0%BA%D0%BE%D1%80%D0%B8%D1%81%D1%82%D1%83%D0%B2%D0%B0%D0%BD%D0%BD%D1%8F_%D0%BF%D1%80%D0%BE%D0%B3%D1%80%D0%B0%D0%BC%D0%B0%D0%BC%D0%B8_%D0%BF%D0%B0%D0%BA%D0%B5%D1%82%D1%83_phonetic-languages-simplified-lists-examples.pdf diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Simple/Main.hs b/Simple/Main.hs new file mode 100644 --- /dev/null +++ b/Simple/Main.hs @@ -0,0 +1,103 @@ +-- | +-- Module : Main +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Prints the rearrangements with the \"property\" information for the Ukrainian language text. +-- The most interesting is the first line of the output. But other ones also are noteworthy. + +{-# OPTIONS_GHC -threaded -rtsopts #-} + +{-# LANGUAGE BangPatterns #-} + +module Main where + +import Numeric +import Languages.UniquenessPeriods.Vector.Constraints.Encoded (decodeLConstraints,readMaybeECG) +import qualified Data.Vector as VB +import Phonetic.Languages.Simplified.DataG +import Phonetic.Languages.Lists.Ukrainian.PropertiesSyllablesG +import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI) +import Phonetic.Languages.Simplified.StrictVG +import Languages.Phonetic.Ukrainian.PrepareText +import Data.Char (isDigit,isAlpha) +import Melodics.ByteString.Ukrainian (isUkrainianL) +import qualified Data.List as L (span,sort) +import Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG +import Phonetic.Languages.Permutations +import Data.SubG hiding (takeWhile,dropWhile) +import System.Environment +import Data.Maybe +import Data.MinMax.Preconditions +import Text.Read (readMaybe) + + +-- | Prints the rearrangements with the \"property\" information for the Ukrainian language text. The first command line argument must be a +-- positive 'Int' number and is a number of printed variants for the line (if they are present, otherwise just all possible variants are printed). +-- The second one is the number of the intervals into which the all range of possible metrics values are divided. The next numeric arguments that must be +-- sequenced without interruptions further are treated as the numbers of the intervals (counting is started from 1) which values are moved to the maximum +-- values of the metrics interval using the 'unsafeSwapVecIWithMaxI' function. The first textual command line argument should be in the form either \"y0\", +-- or \"0y\", or \"yy\", or \"y\", or \"02y\", or \"y2\", or some other variant and specifies, which property or properties is or are evaluated. +-- The rest of the command line arguments is the Ukrainian text. +-- +-- You can specify constraints according to the 'decodeLConstraints' function between +A and -A command line arguments. If so, the program will +-- ask you additional question before proceeding. +main :: IO () +main = do + args0 <- getArgs + let args = takeWhile (/= "+A") args0 `mappend` (drop 1 . dropWhile (/= "-A") $ args0) + coeffs = readCF . concat . take 1 $ args -- The first command line argument. If not sure, just pass \"1_\". + if isPair coeffs then generalProc2 args0 coeffs (drop 1 args) + else generalProc2 args0 coeffs args + + +generalProc2 :: [String] -> Coeffs2 -> [String] -> IO () +generalProc2 args0 coeffs args = do + let (!numericArgs,!textualArgs) = L.span (all isDigit) $ args + !xs = concat . take 1 . fLines . unwords . drop 1 $ textualArgs + !l = length . words $ xs + !argCs = catMaybes (fmap (readMaybeECG l) . drop 1 . dropWhile (/= "+A") . takeWhile (/= "-A") $ args0) + !arg0 = fromMaybe 1 $ (readMaybe (concat . take 1 $ numericArgs)::Maybe Int) + !numberI = fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ numericArgs)::Maybe Int) + !choice = concat . take 1 $ textualArgs + if compare l 2 == LT then let !frep20 = chooseMax id coeffs choice in print1el choice . (:[]) . toResultR frep20 $ xs + else do + let !subs = subG " 01-" xs + if null argCs then let !perms = genPermutationsL l in generalProc1 coeffs numericArgs arg0 numberI choice perms subs + else do + putStr "Please, check whether the line below corresponds and is consistent with the data you have specified between the +A and -A options. " + putStrLn "If it is inconsistent then enter further \"n\", press Enter and then run the program again with better arguments. " + putStrLn "If the line is consistent with your input between +A and -A then just press Enter to proceed further. " + putStrLn xs + correct <- getLine + if correct == "n" then putStrLn "You stopped the program, please, if needed, run it again with better arguments. " + else let !perms = decodeLConstraints argCs . genPermutationsL $ l in generalProc1 coeffs numericArgs arg0 numberI choice perms subs + +generalProc1 :: Coeffs2 -> [String] -> Int -> Int -> String -> [VB.Vector Int] -> [String] -> IO () +generalProc1 coeffs numericArgs arg0 numberI choice perms subs = do + if compare numberI 2 == LT then let !frep2 = chooseMax id coeffs choice in print1el choice . fst . maximumGroupsClassificationR arg0 . + map (toResultR frep2) . uniquenessVariants2GNBL ' ' id id id perms $ subs + else do + let !variants1 = uniquenessVariants2GNBL ' ' id id id perms subs + !intervalNmbrs = (\zs -> if null zs then VB.singleton numberI else VB.uniq . VB.fromList $ zs) . L.sort . filter (<= numberI) . + map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs + !frep20 = chooseMax id coeffs choice + (!minE,!maxE) = minMax11C . map (toMetrices' frep20) $ variants1 + !frep2 = chooseMax (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) coeffs choice + print1el choice . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) $ variants1 + +fLines :: String -> [String] +fLines 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 g preText wss + +print1el :: String -> [Result [] Char Float Float] -> IO () +print1el choice (x:xs) = putStrLn (line x) >> putStrLn (showFFloat ch (metrices x) "") >> + putStrLn (showFFloat ch (transMetrices x) "") >> print1el choice xs + where !ch = precChoice choice +print1el _ _ = return () diff --git a/phonetic-languages-simplified-lists-examples.cabal b/phonetic-languages-simplified-lists-examples.cabal new file mode 100644 --- /dev/null +++ b/phonetic-languages-simplified-lists-examples.cabal @@ -0,0 +1,52 @@ +-- Initial phonetic-languages-examples.cabal generated by cabal init. For +-- further documentation, see http://haskell.org/cabal/users-guide/ + +name: phonetic-languages-simplified-lists-examples +version: 0.1.0.0 +synopsis: Simplified and somewhat optimized version of the phonetic-languages-examples. +description: Is intended to use more functionality of lists and subG package. +homepage: https://hackage.haskell.org/package/phonetic-languages-simplified-lists-examples +license: MIT +license-file: LICENSE +author: OleksandrZhabenko +maintainer: olexandr543@yahoo.com +copyright: (c) 2020 Oleksandr Zhabenko +category: Language, Math, Game +build-type: Simple +extra-source-files: CHANGELOG.md, README.md +cabal-version: >=1.10 + +library + exposed-modules: Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG + -- other-modules: + other-extensions: BangPatterns + build-depends: base >=4.8 && <4.15, phonetic-languages-simplified-common >=0.3.4 && <1, phonetic-languages-simplified-properties-lists >=0.2 && <1, vector >=0.11 && < 0.14, mmsyn2 >=0.3 && <1, phonetic-languages-constraints >=0.4 && <1 + -- hs-source-dirs: + default-language: Haskell2010 + +executable lineVariantsG2 + main-is: Main.hs + other-modules: Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG + other-extensions: BangPatterns + build-depends: base >=4.8 && <4.15, ukrainian-phonetics-basic >=0.3.1.2 && <1, vector >=0.11 && <0.14, phonetic-languages-simplified-common >=0.3.4 && <1, phonetic-languages-simplified-properties-lists >=0.2 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.3 && <1, uniqueness-periods-vector-filters >=0.3 && <1, vector >=0.11 && <0.14, phonetic-languages-plus >=0.1 && <1, subG >=0.4 && < 1, mmsyn2 >= 0.3 && <1, phonetic-languages-constraints >=0.4 && <1, phonetic-languages-permutations >= 0.2 && <1 + ghc-options: -threaded -rtsopts + hs-source-dirs: ., Simple + default-language: Haskell2010 + +executable rewritePoemG2 + main-is: Main.hs + other-modules: Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG + other-extensions: BangPatterns + build-depends: base >=4.8 && <4.15, ukrainian-phonetics-basic >=0.3.1.2 && <1, vector >=0.11 && <0.14, phonetic-languages-simplified-common >=0.3.4 && <1, phonetic-languages-simplified-properties-lists >=0.2 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.3 && <1, uniqueness-periods-vector-filters >=0.3 && <1, vector >=0.11 && <0.14, phonetic-languages-plus >=0.1 && <1, subG >= 0.4 && < 1, phonetic-languages-rhythmicity >=0.1.2 && <1, mmsyn2 >=0.3 && <1, phonetic-languages-constraints >=0.4 && <1, phonetic-languages-permutations >= 0.2 && <1 + ghc-options: -threaded -rtsopts + hs-source-dirs: ., Lines + default-language: Haskell2010 + +executable propertiesTextG2 + main-is: Main.hs + other-modules: Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG + other-extensions: BangPatterns + build-depends: base >=4.8 && <4.15, ukrainian-phonetics-basic >=0.3.1.2 && <1, vector >=0.11 && <0.14, phonetic-languages-simplified-common >=0.3.4 && <1, phonetic-languages-simplified-properties-lists >=0.2 && <1, phonetic-languages-ukrainian >=0.3 && <1, uniqueness-periods-vector-filters >=0.3 && <1, uniqueness-periods-vector-stats >=0.1.2 && <1, parallel >=3.2.0.6 && <4, phonetic-languages-plus >=0.1 && <1, subG >= 0.4 && < 1, phonetic-languages-rhythmicity >=0.1.2 && <1, phonetic-languages-permutations >= 0.2 && <1, mmsyn2 >= 0.3 && < 1 + ghc-options: -threaded -rtsopts + hs-source-dirs: ., GetInfo + default-language: Haskell2010