packages feed

phonetic-languages-simplified-examples-array (empty) → 0.1.0.0

raw patch · 12 files changed

+632/−0 lines, 12 filesdep +basedep +heapsdep +mmsyn2setup-changed

Dependencies added: base, heaps, mmsyn2, mmsyn2-array, parallel, phonetic-languages-constraints-array, phonetic-languages-filters-array, phonetic-languages-permutations-array, phonetic-languages-plus, phonetic-languages-rhythmicity, phonetic-languages-simplified-base, phonetic-languages-simplified-examples-common, phonetic-languages-simplified-properties-array, phonetic-languages-ukrainian-array, print-info, subG, ukrainian-phonetics-basic-array, uniqueness-periods-vector-stats

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for phonetic-languages-simplified-examples-array++## 0.1.0.0 -- 2021-01-02++* First version. Released on an unsuspecting world.
+ GetInfo/Main.hs view
@@ -0,0 +1,62 @@+-- |+-- 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 Phonetic.Languages.GetTextualInfo+import Data.Maybe (fromMaybe)+import Text.Read (readMaybe)+import System.Environment (getArgs)+import Data.Monoid (mappend)+import Phonetic.Languages.Common+import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2+import Languages.UniquenessPeriods.Array.Constraints.Encoded++main :: IO ()+main = do+ args000 <- getArgs+ let !args00 = filter (/= "++B") args000+     !lstW = any (== "++B") args000+     !args0 = takeWhile (/= "+M") args00 `mappend` drop 1 (dropWhile (/= "-M") args00)+     !multiples = drop 1 . dropWhile (/= "+M") . takeWhile (/= "-M") $ args00 -- Arguments for multiple metrices mode+     !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 lstW multiples 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 lstW multiples lInes coeffs file gzS printLine toOneLine choice+  else do+   contents <- readFile file+   fLinesIO contents
+ LICENSE view
@@ -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.
+ Lines/Main.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- 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).++module Main where++import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2+import Text.Read (readMaybe)+import Data.Maybe (fromMaybe)+import System.Environment (getArgs)+import Data.Char (isDigit)+import Phonetic.Languages.Common+import Phonetic.Languages.Lines++-- | 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 \"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
+ Phonetic/Languages/GetTextualInfo.hs view
@@ -0,0 +1,114 @@+{-# 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 "")+
+ Phonetic/Languages/Lines.hs view
@@ -0,0 +1,95 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      :  Phonetic.Languages.Lines+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Library functions for the rewritePoemG3 executable.+-- 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).++module Phonetic.Languages.Lines where++import Phonetic.Languages.Simplified.DeEnCoding (newLineEnding)+import System.IO+import Data.SubG+import Data.MinMax.Preconditions+import GHC.Arr+import Data.List (sort,nub)+import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2+import Phonetic.Languages.Simplified.StrictVG.Base+import Phonetic.Languages.Permutations.Arr+import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)+import Text.Read (readMaybe)+import Data.Maybe (fromMaybe)+import Phonetic.Languages.Ukrainian.PrepareText+import Phonetic.Languages.Simplified.DataG.Base+import Data.Char (isDigit)+import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2+import Data.Monoid (mappend)+import Phonetic.Languages.Common++generalProcessment :: Coeffs2 -> [String] -> String -> Int -> FilePath -> IO ()+generalProcessment coeffs numericArgs choice numberI file = do+  contents <- readFile file+  let !permsV = genPermutationsArrL+      !flines = fLines 0 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 [numberI] else nub 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 = unsafeAt permsV $ l2+          (!minE,!maxE) = let !frep20 = chooseMax id coeffs choice in minMax11C . map (toPropertiesF' 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))++-- | Processment without rearrangements.+circle2 :: Coeffs2 -> Array Int [Array Int 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 (unsafeAt permsG1 (l - 3)) . init $ rs++-- | Processment with rearrangements.+circle2I :: Coeffs2 -> Array Int [Array Int Int] -> String -> [String] -> Int -> [Int] -> Double -> Double -> [String] -> [String]+circle2I coeffs permsG1 choice yss numberI intervNbrs minE maxE xss+ | null xss = yss+ | otherwise = circle2I coeffs permsG1 choice (yss `mappend` [ws]) numberI intervNbrs 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 intervNbrs) coeffs choice+            !ws = if compare (length rs) 3 == LT then unwords rs else line . maximumElR . map (toResultR frep2) .+               uniquenessVariants2GNPBL [] (last rs) ' ' id id id (unsafeAt permsG1 (l - 3)) . init $ rs+            (!minE1,!maxE1)+             | compare l3 0 /= LT =+               let !perms3 = unsafeAt permsG1 l3+                   !v4 = init w2s+                   !frep20 = chooseMax id coeffs choice in minMax11C . map (toPropertiesF' 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
+ Phonetic/Languages/Simple.hs view
@@ -0,0 +1,148 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      :  Phonetic.Languages.Simple+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- The library functions for the lineVariantsG3 executable.++module Phonetic.Languages.Simple where++import Numeric+import Languages.UniquenessPeriods.Array.Constraints.Encoded (decodeLConstraints,readMaybeECG)+import GHC.Arr+import Phonetic.Languages.Simplified.DataG.Base+import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2+import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)+import Phonetic.Languages.Simplified.StrictVG.Base+import Phonetic.Languages.Ukrainian.PrepareText+import Data.Char (isDigit,isAlpha)+import qualified Data.List  as L (span,sort,zip4,isPrefixOf,nub)+import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2+import Phonetic.Languages.Permutations.Arr+import Data.SubG hiding (takeWhile,dropWhile)+import System.Environment+import Data.Maybe+import Data.MinMax.Preconditions+import Text.Read (readMaybe)+import Phonetic.Languages.Simplified.DeEnCoding+import Phonetic.Languages.Simplified.SimpleConstraints+import Phonetic.Languages.Common++forMultiplePropertiesF :: [String] -> [(String,[String])]+forMultiplePropertiesF (xs:xss)+ | any isAlpha xs = (xs,yss):forMultiplePropertiesF zss+ | otherwise = []+     where l = length . takeWhile (all isDigit) $ xss+           (yss,zss) = splitAt l xss+forMultiplePropertiesF _ = []++generalProc2 :: FilePath -> Bool -> Bool -> [String] -> Coeffs2 -> [String] -> Bool -> IO ()+generalProc2 toFile1 interactive jstL0 args0 coeffs args lstW2 = do+  let !argMss = take 5 . filter (not . null) . forMultiplePropertiesF . drop 1 . dropWhile (/= "+M") . takeWhile (/= "-M") $ args0+  if null argMss then do+   let (!numericArgs,!textualArgs) = L.span (all isDigit) $ args+       !xs = concat . take 1 . fLines 0 . unwords . drop 1 $ textualArgs+       !l = length . words $ xs+       !argCs = catMaybes (fmap (readMaybeECG (l - 1)) . (showB l lstW2:) . 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+       !intervalNmbrs = (\zs -> if null zs then [numberI] else L.nub zs) . L.sort . filter (<= numberI) .+           map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs+   if compare l 2 == LT then let !frep20 = chooseMax id coeffs choice in let !wwss = (:[]) . toResultR frep20 $ xs in+    if interactive then interactivePrintResult line toFile1 wwss else print1el jstL0 choice wwss+   else do+    let !subs = subG " 01-" xs+    if null argCs then let !perms = genPermutationsL l in do+          temp <- generalProcMs coeffs perms subs (intervalNmbrs, arg0, numberI, choice)+          if interactive then interactivePrintResult line toFile1 temp else print1el jstL0 choice temp+    else do+     correct <- printWarning xs+     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 do+          temp <- generalProcMs coeffs perms subs (intervalNmbrs, arg0, numberI, choice)+          if interactive then interactivePrintResult line toFile1 temp else print1el jstL0 choice temp+  else do+   let !choices = map fst argMss+       !numericArgss = map snd argMss+       !arg0s = map (\ts -> fromMaybe 1 $ (readMaybe (concat . take 1 $ ts)::Maybe Int)) numericArgss+       !numberIs = map (\ts -> fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ ts)::Maybe Int)) numericArgss+       !intervalNmbrss = map (\us -> let !numberI = fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ us)::Maybe Int) in+         (\zs -> if null zs then [numberI] else L.nub zs) . L.sort . filter (<= numberI) .+           map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ us) $ numericArgss+       !argsZipped = L.zip4 intervalNmbrss arg0s numberIs choices+       !xs = concat . take 1 . fLines 0 . unwords $ args+       !l = length . words $ xs+       !argCs = catMaybes (fmap (readMaybeECG (l - 1)) . (showB l lstW2:) . drop 1 . dropWhile (/= "+A") . takeWhile (/= "-A") $ args0)+   if compare l 2 == LT then let !frep20 = chooseMax id coeffs (concat . take 1 $ choices) in let !wwss = (:[]) . toResultR frep20 $ xs in if interactive then interactivePrintResult line toFile1 wwss else print1el jstL0 (concat . take 1 $ choices) wwss+   else do+    let !subs = subG " 01-" xs+    if null argCs then let !perms = genPermutationsL l in generalProcMMs interactive toFile1 coeffs argsZipped perms subs+    else do+     correct <- printWarning xs+     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 generalProcMMs interactive toFile1 coeffs argsZipped perms subs++interactivePrintResult :: (a -> String) -> String -> [a] -> IO ()+interactivePrintResult f ys xss+  | null xss = putStrLn ""+  | otherwise = do+     let !datas = map (\(idx,str) -> show idx `mappend` ('\t' : str)) . trans232 . map f $ xss+     mapM_ putStrLn datas+     putStrLn ""+     putStrLn "Please, specify the variant which you would like to become the resulting string by its number. "+     number <- getLine+     let !lineRes = concat . filter ((number `mappend` "\t")`L.isPrefixOf`) $ datas+     (\xs -> if null ys then putStrLn xs else putStrLn xs >> appendFile ys (xs `mappend` newLineEnding)) . drop 1 . dropWhile (/= '\t') $ lineRes++printWarning :: String -> IO String+printWarning xs = do+  putStr "Please, check whether the line below corresponds and is consistent with the constraints you have specified between the +A and -A options. "+  putStr "Check also whether you have specified the \"++B\" or \"++BL\" option(s). "+  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+  getLine++generalProcMs :: Coeffs2 -> [Array Int Int] -> [String] -> ([Int],Int,Int,String) -> IO [Result [] Char Double Double]+generalProcMs coeffs perms subs (intervalNmbrs, arg0, numberI, choice) = do+  if compare numberI 2 == LT then let !frep2 = chooseMax id coeffs choice in return . fst . maximumGroupsClassificationR arg0 .+    map (toResultR frep2) . uniquenessVariants2GNBL ' ' id id id perms $ subs+  else do+    let !variants1 = uniquenessVariants2GNBL ' ' id id id perms subs+        !frep20 = chooseMax id coeffs choice+        (!minE,!maxE) = minMax11C . map (toPropertiesF' frep20) $ variants1+        !frep2 = chooseMax (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) coeffs choice+    return . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) $ variants1++generalProcMMs :: Bool -> FilePath -> Coeffs2 -> [([Int],Int,Int,String)] -> [Array Int Int] -> [String] -> IO ()+generalProcMMs interactiveMM file coeffs rs perms subs =+ case length rs of+  0 -> putStrLn "No data has been specified to control the computation process. "+  1 -> putStrLn "You have specified just one variant of the metrices. " >> do+        temp <- generalProcMs coeffs perms subs (head rs)+        finalProc interactiveMM file line temp+  _ -> do+         genVariants <- mapM (generalProcMs coeffs perms subs) rs+         finalProc interactiveMM file id . foldlI . map (map line) $ genVariants++foldlI :: [[String]] -> [String]+foldlI (xs:ys:xss) = foldlI (intersectInterResults xs ys : xss)+foldlI (xs:_) = xs+foldlI _ = []++finalProc :: Bool -> FilePath -> (a -> String) -> [a] -> IO ()+finalProc bool ys f xss = if bool then interactivePrintResult f ys xss else mapM_ (putStrLn . f) xss++print1el :: Bool -> String -> [Result [] Char Double Double] -> IO ()+print1el jstlines choice (x:xs)+ | jstlines == True = putStrLn (line x) >> print1el True choice xs+ | otherwise = putStrLn (line x) >> putStrLn (showFFloat ch (propertiesF x) "") >> putStrLn (showFFloat ch (transPropertiesF x) "") >> print1el False choice xs+       where !ch = precChoice choice+print1el _ _ _ = return ()
+ Phonetic/Languages/Simplified/Array/Ukrainian/FuncRep2RelatedG2.hs view
@@ -0,0 +1,33 @@+-- |+-- Module      :  Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Functions to choose from the 'FuncRep2' variants.++{-# LANGUAGE BangPatterns #-}++module Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2 where++import CaseBi.Arr (getBFstL')+import Phonetic.Languages.Simplified.DataG.Base+import Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2+import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2++-- | Allows to choose the variant of the computations in case of usual processment.+chooseMax :: (Ord c) => (Double -> c) -> Coeffs2 -> String -> FuncRep2 String Double c+chooseMax g coeffs choice+ | isPair coeffs = getBFstL' (procBoth3InvF g coeffs) [("02y",procRhythmicity23F g "02y" coeffs),+    ("03y",procRhythmicity23F g "03y" coeffs), ("0y",procRhythmicity23F g "0y" coeffs),+     ("y",procBothF g coeffs),("y0",procDiverse2F g),("y2",procBoth2F g coeffs),("y3",procBoth3F g coeffs),+       ("yy",procBothInvF g coeffs),("yy2",procBoth2InvF g coeffs)] choice+ | otherwise = getBFstL' (procBoth3InvF g coeffs) [("02y",procRhythmicity23F g "02y" coeffs),+    ("03y",procRhythmicity23F g "03y" coeffs),("0y",procRhythmicity23F g "0y" coeffs),+     ("y",procBothF g coeffs),("y0",procDiverse2F g),("y2",procBoth2F g coeffs),("y3",procBoth3F g coeffs),+       ("yy",procBothInvF g coeffs),("yy2",procBoth2InvF g coeffs)] choice++-- | Allows to choose precision in the Numeric.showFDouble function being given a choice parameter.+precChoice :: String -> Maybe Int+precChoice = getBFstL' (Just 4) [("02y",Just 0),("03y",Just 0),("0y",Just 0),("y",Just 0),("y0",Just 0),("y2",Just 0),("y3",Just 0)]
+ README.md view
@@ -0,0 +1,4 @@+The short (possibly) instruction how to use the programs of the package phonetic-languages-simplified-examples-array+in Ukrainian is here:++https://web.archive.org/web/20210102195934/https://github.com/OleksandrZhabenko/uk/blob/master/Instruction_phonetic-languages-simplified-examples-array-0.1.0.0.pdf
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Simple/Main.hs view
@@ -0,0 +1,48 @@+-- |+-- 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.++{-# OPTIONS_GHC -threaded -rtsopts #-}++{-# LANGUAGE BangPatterns #-}++module Main where++import Languages.UniquenessPeriods.Array.Constraints.Encoded+import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2+import System.Environment (getArgs)+import Text.Read (readMaybe)+import Phonetic.Languages.Simple++-- | 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 \"03y\", or \"yy2\", or \"y3\", 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. Besides, you can use multiple metrices (no more than 5 different ones) together by+-- using \"+M\" ... \"-M\" command line arguments.+--+-- 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. The \"+M\" ... \"-M\" and \"+A\" ... \"-A\" groups must not mutually intersect one another.+main :: IO ()+main = do+ args00 <- getArgs+ let args0 = filter (\xs -> xs /= "++B" && xs /= "++L" && xs /= "++BL" && xs /= "++I") args00+     lstW = if any (\x -> x == "++B" || x == "++BL") args00 then True else False -- If one of the command line options is \"++B\" or \"++BL\" then the last word of the line will remain the last one.+     jstL0 = if any (\x -> x == "++L" || x == "++BL") args00 then True else False -- If one of the command line options is \"++L\" or \"++BL\" then the program outputs just lines without metrices values.+     toFileMode1 = concat . take 1 . drop 1 . dropWhile (/= "+IF") . takeWhile (/= "-IF") $ args0  -- Prints the last resulting line of the interactive mode processment (the last selected variant) to the file and also to the stdout.+     interactiveP = if any (\xs -> xs == "++I" || xs == "+IF") args00 then True else False -- If one of the command line options is \"++I\", or \"+FIB\", or \"+IF\" then the program prints the variants and then prompts for the preferred variant. Afterwards, it prints just that variant alone.+     args01 = takeWhile (/= "+A") args0 `mappend` (drop 1 . dropWhile (/= "-A") $ args0)+     args02+      | null toFileMode1 = filter (\xs -> xs /= "+IF" && xs /= "-IF") args01+      | otherwise = takeWhile (/= "+IF") args01 `mappend` (drop 1 . dropWhile (/= "-IF") $ args01)+     args = takeWhile (/= "+M") args02 `mappend` (drop 1 . dropWhile (/= "-M") $ args02)+     coeffs = readCF . concat . take 1 $ args -- The first command line argument. If not sure, just pass \"1_\".+ if isPair coeffs then generalProc2 toFileMode1 interactiveP jstL0 args0 coeffs (drop 1 args) lstW+ else generalProc2 toFileMode1 interactiveP jstL0 args0 coeffs args lstW
+ phonetic-languages-simplified-examples-array.cabal view
@@ -0,0 +1,52 @@+-- Initial phonetic-languages-simplified-examples-array.cabal generated by cabal init.  For+-- further documentation, see http://haskell.org/cabal/users-guide/++name:                phonetic-languages-simplified-examples-array+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-examples-array+license:             MIT+license-file:        LICENSE+author:              OleksandrZhabenko+maintainer:          olexandr543@yahoo.com+copyright:           (c) 2020-2021 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.Array.Ukrainian.FuncRep2RelatedG2, Phonetic.Languages.Simple, Phonetic.Languages.Lines, Phonetic.Languages.GetTextualInfo+  -- other-modules:+  other-extensions:    BangPatterns+  build-depends:       base >=4.8 && <4.15, ukrainian-phonetics-basic-array >=0.1.1 && <1, phonetic-languages-simplified-base >=0.1 && <1, phonetic-languages-simplified-properties-array >=0.1.1 && <1, phonetic-languages-ukrainian-array >=0.1 && <1, phonetic-languages-filters-array >=0.1 && <1, uniqueness-periods-vector-stats >=0.2.1 && <1, parallel >=3.2.0.6 && <4, phonetic-languages-plus >=0.2 && <1, subG >= 0.4 && < 1, phonetic-languages-rhythmicity >=0.1.2 && <1, phonetic-languages-permutations-array >= 0.1 && <1, mmsyn2 >= 0.3 && < 1, heaps >= 0.3.6.1 && <1, phonetic-languages-constraints-array >=0.1 && <1, phonetic-languages-simplified-examples-common >=0.1 && <1, mmsyn2-array >= 0.1.1 && <1+  -- hs-source-dirs:+  default-language:    Haskell2010++executable lineVariantsG3+  main-is:             Main.hs+  other-modules:       Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2, Phonetic.Languages.Simple+  other-extensions:    BangPatterns+  build-depends:       base >=4.8 && <4.15, ukrainian-phonetics-basic-array >=0.1.1 && <1, phonetic-languages-simplified-base >=0.1 && <1, phonetic-languages-simplified-properties-array >=0.1.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian-array >=0.1 && <1, phonetic-languages-filters-array >=0.1 && <1, phonetic-languages-plus >=0.2 && <1, subG >=0.4 && < 1, mmsyn2-array >= 0.1.1 && <1, phonetic-languages-constraints-array >=0.1 && <1, phonetic-languages-permutations-array >= 0.1 && <1, heaps >= 0.3.6.1 && <1, phonetic-languages-simplified-examples-common >=0.1 && <1+  ghc-options:         -threaded -rtsopts+  hs-source-dirs:      ., Simple+  default-language:    Haskell2010++executable rewritePoemG3+  main-is:             Main.hs+  other-modules:       Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2, Phonetic.Languages.Lines+  other-extensions:    BangPatterns+  build-depends:       base >=4.8 && <4.15, ukrainian-phonetics-basic-array >=0.1.1 && <1, phonetic-languages-simplified-base >=0.1 && <1, phonetic-languages-simplified-properties-array >=0.1.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian-array >=0.1 && <1, phonetic-languages-filters-array >=0.1 && <1, phonetic-languages-plus >=0.2 && <1, subG >= 0.4 && < 1, phonetic-languages-rhythmicity >=0.1.2 && <1, mmsyn2 >=0.3 && <1, phonetic-languages-constraints-array >=0.1 && <1, phonetic-languages-permutations-array >= 0.1 && <1, heaps >= 0.3.6.1 && <1, phonetic-languages-simplified-examples-common >=0.1 && <1, mmsyn2-array >= 0.1.1 && <1+  ghc-options:         -threaded -rtsopts+  hs-source-dirs:      ., Lines+  default-language:    Haskell2010++executable propertiesTextG3+  main-is:             Main.hs+  other-modules:       Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2, Phonetic.Languages.GetTextualInfo+  other-extensions:    BangPatterns+  build-depends:       base >=4.8 && <4.15, ukrainian-phonetics-basic-array >=0.1.1 && <1, phonetic-languages-simplified-base >=0.1 && <1, phonetic-languages-simplified-properties-array >=0.1.1 && <1, phonetic-languages-ukrainian-array >=0.1 && <1, phonetic-languages-filters-array >=0.1 && <1, uniqueness-periods-vector-stats >=0.2.1 && <1, parallel >=3.2.0.6 && <4, phonetic-languages-plus >=0.2 && <1, subG >= 0.4 && < 1, phonetic-languages-rhythmicity >=0.1.2 && <1, phonetic-languages-permutations-array >= 0.1 && <1, mmsyn2 >= 0.3 && < 1, heaps >= 0.3.6.1 && <1, phonetic-languages-constraints-array >=0.1 && <1, phonetic-languages-simplified-examples-common >=0.1 && <1, mmsyn2-array >= 0.1.1 && <1+  ghc-options:         -threaded -rtsopts+  hs-source-dirs:      ., GetInfo+  default-language:    Haskell2010