packages feed

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

raw patch · 9 files changed

+810/−0 lines, 9 filesdep +basedep +mmsyn2-arraydep +parallelsetup-changed

Dependencies added: base, mmsyn2-array, parallel, phonetic-languages-constraints-array, phonetic-languages-filters-array, phonetic-languages-permutations-array, phonetic-languages-phonetics-basics, phonetic-languages-plus, phonetic-languages-simplified-base, phonetic-languages-simplified-generalized-examples-common, phonetic-languages-simplified-generalized-properties-array, subG

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for phonetic-languages-simplified-generalized-examples-array++## 0.1.0.0 -- 2021-05-08++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2021 Oleksndr Zhabenko++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.
+ Phonetic/Languages/General/GetTextualInfo.hs view
@@ -0,0 +1,175 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns, FlexibleContexts #-}++-- |+-- Module      :  Phonetic.Languages.General.GetTextualInfo+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Library module that contains functions used by the propertiesTextG3+-- executable.+-- Is rewritten from the Phonetic.Languages.GetTextualInfo module from the+-- @phonetic-languages-simplified-examples-array@ package.++module Phonetic.Languages.General.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 Data.Phonetic.Languages.Base+import Data.Phonetic.Languages.PrepareText+import Numeric (showFFloat)+import Phonetic.Languages.Filters+import Data.Char (isAlpha)+import Data.Statistics.RulesIntervalsPlus+import Data.MinMax.Preconditions+import Phonetic.Languages.Array.General.PropertiesSyllablesG2+import Phonetic.Languages.Simplified.StrictVG.Base+import Phonetic.Languages.Permutations.Arr+import Phonetic.Languages.Simplified.DataG.Base+import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2+import Languages.UniquenessPeriods.Array.Constraints.Encoded+import Phonetic.Languages.General.SimpleConstraints+import Phonetic.Languages.General.Common+import Data.Phonetic.Languages.Base+import Data.Phonetic.Languages.Syllables++generalProc+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Concatenations+ -> String+ -> String+ -> String+ -> Bool+ -> [String]+ -> [String]+ -> Coeffs2+ -> FilePath+ -> String+ -> Int+ -> Int+ -> String+ -> IO ()+generalProc wrs ks arr gs h rs ysss xs js vs lstW multiples2 lInes coeffs file gzS printLine toOneLine choice+ | null lInes = do+    contents <- readFile file+    let !flines = fLines ysss xs js vs toOneLine contents+    getData3  wrs ks arr gs js vs h rs lstW coeffs (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines+ | otherwise = do+    contents <- readFile file+    let !flines = fLines ysss xs js vs toOneLine . unlines . linesFromArgsG lInes . fLines ysss xs js vs 0 $ contents+    getData3  wrs ks arr gs js vs h rs 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+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> String+ -> String+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Bool+ -> Coeffs2+ -> Int+ -> Int+ -> String+ -> [String]+ -> [String]+ -> IO ()+getData3 wrs ks arr gs js vs h rs lstW coeffs gz printLine choice multiples3 zss = let !permsV4 = genPermutationsArrL in putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz) >> mapM_ (process1Line wrs ks arr gs js vs h rs lstW coeffs gz printLine choice multiples3 permsV4) zss++process1Line+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> String+ -> String+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Bool+ -> Coeffs2+ -> Int+ -> Int+ -> String+ -> [String]+ -> Array Int [Array Int Int]+ -> String+ -> IO ()+process1Line wrs ks arr gs js vs h qs 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 -- wrs ks arr gs js vs id h coeffs rs choice+          ((!minE,!maxE),!data2) = runEval (parTuple2 rpar rpar (minMax11C . map (toTransPropertiesF' (chooseMax wrs ks arr gs js vs id h coeffs qs choice )) .+                uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (chooseMax wrs ks arr gs js vs id h coeffs qs choice) . unwords . subG (' ':js `mappend` vs) $ 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  -- wrs ks arr gs js vs id h coeffs rs choice+         rs = parMap rpar (\choiceMMs -> (minMax11C .+           map (toTransPropertiesF' (chooseMax wrs ks arr gs js vs id h coeffs qs choiceMMs)) .+             uniquenessVariants2GNBL ' ' id id id permsV5 $ v2,+               toTransPropertiesF' (chooseMax wrs ks arr gs js vs id h coeffs qs choiceMMs) . unwords .+                 subG (' ':js `mappend` vs) $ 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/General/Lines.hs view
@@ -0,0 +1,165 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      :  Phonetic.Languages.General.Lines+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- 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).+-- Is rewritten from the Phonetic.Languages.Lines module from the+-- @phonetic-languages-simplified-examples-array@ package.++module Phonetic.Languages.General.Lines where++import Phonetic.Languages.General.DeEnCoding (newLineEnding)+import System.IO+import Data.SubG+import Data.MinMax.Preconditions+import GHC.Arr+import Data.List (sort,nub)+import Phonetic.Languages.Array.General.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 Data.Phonetic.Languages.PrepareText+import Data.Phonetic.Languages.Base+import Data.Phonetic.Languages.Syllables+import Phonetic.Languages.Simplified.DataG.Base+import Data.Char (isDigit)+import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2+import Data.Monoid (mappend)+import Phonetic.Languages.General.Common++generalProcessment+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Concatenations+ -> String+ -> String+ -> String+ -> Coeffs2+ -> [String]+ -> String+ -> Int+ -> FilePath+ -> IO ()+generalProcessment wrs ks arr gs h rs ysss xs js vs coeffs numericArgs choice numberI file = do+  contents <- readFile file+  let !permsV = genPermutationsArrL+      !flines = fLines ysss xs js vs 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 wrs ks arr gs js vs h rs 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 wrs ks arr gs js vs id h coeffs rs choice in minMax11C . map (toPropertiesF' frep20) .+                    uniquenessVariants2GNPBL [] (concat . take 1 $ lasts) ' ' id id id perms2 . init $ us+      toFileStr (file ++ ".new.txt") (circle2I wrs ks arr gs js vs h rs coeffs permsV choice [] numberI intervalNmbrs minE maxE $ flines)+    else toFileStr (file ++ ".new.txt") ((concat . take 1 $ flines):(circle2I wrs ks arr gs js vs h rs coeffs permsV choice [] numberI intervalNmbrs 0.0 0.0 . drop 1 $ flines))++compareFilesToOneCommon :: FilePath -> FilePath -> FilePath -> IO ()+compareFilesToOneCommon file1 file2 file3 = do+ contents1 <- fmap lines . readFile $ file1+ contents2 <- fmap lines . readFile $ file2+ let linesZipped = zip contents1 contents2+ compare2F linesZipped file3+   where compare2F :: [(String,String)] -> FilePath -> IO ()+         compare2F yss file3 = mapM_ (\xs -> do+           putStrLn "Please, specify which variant to use as the result, either 1 or 2: "+           putStrLn $ "1:\t" ++ fst xs+           putStrLn $ "2:\t" ++ snd xs+           ch <- getLine+           let choice2 = fromMaybe 0 (readMaybe ch::Maybe Int)+           case choice2 of+            1 -> toFileStr file3 [fst xs]+            2 -> toFileStr file3 [snd xs]+            _ -> toFileStr file3 [""]) yss++-- | Processment without rearrangements.+circle2+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> String+ -> String+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Coeffs2+ -> Array Int [Array Int Int]+ -> String+ -> [String]+ -> [String]+ -> [String]+circle2 wrs ks arr gs js vs h qs coeffs permsG1 choice yss xss+ | null xss = yss+ | otherwise = circle2 wrs ks arr gs js vs h qs coeffs permsG1 choice (yss `mappend` [ws]) tss+      where (!zss,!tss) = splitAt 1 xss+            !rs = words . concat $ zss+            !l = length rs+            !frep2 = chooseMax wrs ks arr gs js vs id h coeffs qs 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+  :: GWritingSystemPRPLX+  -> [(Char,Char)]+  -> CharPhoneticClassification+  -> SegmentRulesG+  -> String+  -> String+  -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+  -> [([[[PRS]]] -> [[Double]])]+  -> Coeffs2+  -> Array Int [Array Int Int]+  -> String+  -> [String]+  -> Int+  -> [Int]+  -> Double+  -> Double+  -> [String]+  -> [String]+circle2I wrs ks arr gs js vs h qs coeffs permsG1 choice yss numberI intervNbrs minE maxE xss+ | null xss = yss+ | otherwise = circle2I wrs ks arr gs js vs h qs 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 wrs ks arr gs js vs (unsafeSwapVecIWithMaxI minE maxE numberI intervNbrs) h coeffs qs 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 wrs ks arr gs js vs id h coeffs qs 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/General/Parsing.hs view
@@ -0,0 +1,76 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      :  Phonetic.Languages.General.Parsing+-- Copyright   :  (c) OleksandrZhabenko 2021+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- The additional parsing library functions for the lineVariantsG3 executable.+-- Is taken from the Phonetic.Languages.Parsing module from the+-- @phonetic-languages-simplified-examples-array@ package to reduce dependencies in general case.+-- ++module Phonetic.Languages.General.Parsing (+  -- * Predicates+  isClosingCurlyBracket+  , isSlash+  , isOpeningCurlyBracket+  , variations+  -- * Transformations+  , breakGroupOfStrings+  , breakInSlashes+  , combineVariants+  , combineHeadsWithNexts+  , transformToVariations+) where++isClosingCurlyBracket :: String -> Bool+isClosingCurlyBracket = (== "}")++isSlash :: String -> Bool+isSlash (x:xs)+ | x /= '/' = False+ | null xs = True+ | otherwise = False+isSlash _ = False++isOpeningCurlyBracket :: String -> Bool+isOpeningCurlyBracket = (== "{")++breakGroupOfStrings :: [String] -> (([String],[[String]]),[String])+breakGroupOfStrings !xss = ((tss,breakInSlashes uss []), drop 1 zss)+  where (!yss,!zss) = break isClosingCurlyBracket xss+        (!tss,!uss) = (\(t1,t2) -> (t1,drop 1 t2)) . break isOpeningCurlyBracket $ yss++breakInSlashes :: [String] -> [[String]] -> [[String]]+breakInSlashes !wss !usss+ | null lss = kss : usss+ | otherwise = breakInSlashes (drop 1 lss) (kss : usss)+  where (!kss,!lss) = break isSlash wss++combineVariants :: ([String],[[String]]) -> [[String]]+combineVariants (!xss, (!yss:ysss)) = (xss `mappend` yss) : combineVariants (xss, ysss)+combineVariants _ = []++combineHeadsWithNexts :: [[String]] -> [String] -> [[String]]+combineHeadsWithNexts !xsss !yss+ | null yss = xsss+ | otherwise = combineHeadsWithNexts [xss `mappend` zss | xss <- xsss, zss <- zsss] uss+     where (!t,!uss) = breakGroupOfStrings yss+           !zsss = combineVariants t++transformToVariations :: [String] -> [[String]]+transformToVariations !yss+ | null yss = []+ | otherwise = combineHeadsWithNexts xsss tss+  where (!y,!tss) = breakGroupOfStrings yss+        !xsss = combineVariants y++variations :: [String] -> Bool+variations xss + | any isSlash xss = if any isOpeningCurlyBracket xss && any isClosingCurlyBracket xss then True else False+ | otherwise = False
+ Phonetic/Languages/General/Simple.hs view
@@ -0,0 +1,252 @@+{-# OPTIONS_GHC -threaded -rtsopts #-}+{-# OPTIONS_HADDOCK show-extensions #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module      :  Phonetic.Languages.General.Simple+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- The library functions for the lineVariantsG3 executable. Is rewritten from the Phonetic.Languages.Simple module from the+-- @phonetic-languages-simplified-examples-array@ package.++module Phonetic.Languages.General.Simple where++import Phonetic.Languages.General.Parsing+import Numeric+import Languages.UniquenessPeriods.Array.Constraints.Encoded (decodeLConstraints,readMaybeECG)+import GHC.Arr+import Phonetic.Languages.Simplified.DataG.Base+import Phonetic.Languages.Array.General.PropertiesSyllablesG2+import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)+import Phonetic.Languages.Simplified.StrictVG.Base+import Data.Phonetic.Languages.Base+import Data.Phonetic.Languages.PrepareText+import Data.Char (isDigit,isAlpha)+import qualified Data.List  as L (span,sort,zip4,isPrefixOf,nub)+import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2+import Phonetic.Languages.Permutations.Arr+import Data.SubG hiding (takeWhile,dropWhile)+import Data.Maybe+import Data.MinMax.Preconditions+import Text.Read (readMaybe)+import Phonetic.Languages.General.DeEnCoding+import Phonetic.Languages.General.SimpleConstraints+import Phonetic.Languages.General.Common+import Data.Phonetic.Languages.Syllables+++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 _ = []++-- | Is used to do general processment.+generalProc2G+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> String+ -> String+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Concatenations+ -> String+ -> FilePath+ -> Bool+ -> Bool+ -> [String]+ -> Coeffs2+ -> [String]+ -> Bool+ -> IO ()+generalProc2G wrs ks arr gs js vs h qs ysss ws toFile1 interactive jstL0 args0 coeffs args lstW2+ | variations args = do+    let !zsss = transformToVariations args+    print zsss+    variantsG <- mapM (\xss -> generalProc2 wrs ks arr gs js vs h qs ysss ws interactive jstL0 args0 coeffs xss lstW2) zsss+    interactivePrintResult id variantsG >>= \rs ->+      case toFile1 of+       "" -> return ()+       ~fileName -> appendFile fileName (rs `mappend` newLineEnding)+ | otherwise = generalProc2 wrs ks arr gs js vs h qs ysss ws interactive jstL0 args0 coeffs args lstW2 >>= \rs ->+      case toFile1 of+       "" -> return ()+       ~fileName -> appendFile fileName (rs `mappend` newLineEnding)++-- |+generalProc2+  :: GWritingSystemPRPLX+  -> [(Char,Char)]+  -> CharPhoneticClassification+  -> SegmentRulesG+  -> String+  -> String+  -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+  -> [([[[PRS]]] -> [[Double]])]+  -> Concatenations+  -> String+  -> Bool+  -> Bool+  -> [String]+  -> Coeffs2+  -> [String]+  -> Bool+  -> IO String+generalProc2 wrs ks arr gs js vs h qs ysss ws 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 ysss ws js vs 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 wrs ks arr gs js vs id h coeffs qs choice in let !wwss = (:[]) . toResultR frep20 $ xs in+    if interactive then interactivePrintResult line wwss else print1el jstL0 choice wwss+   else do+    let !subs = subG (' ':js `mappend` vs) xs+    if null argCs then let !perms = genPermutationsL l in do+          temp <- generalProcMs wrs ks arr gs js vs h qs coeffs perms subs (intervalNmbrs, arg0, numberI, choice)+          if interactive then interactivePrintResult line temp else print1el jstL0 choice temp+    else do+     correct <- printWarning xs+     if correct == "n" then putStrLn (messageInfo 1) >> return "" -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.+     else let !perms = decodeLConstraints argCs . genPermutationsL $ l in do+          temp <- generalProcMs wrs ks arr gs js vs h qs coeffs perms subs (intervalNmbrs, arg0, numberI, choice)+          if interactive then interactivePrintResult line 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 ysss ws js vs 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 wrs ks arr gs js vs id h coeffs qs (concat . take 1 $ choices) in+    let !wwss = (:[]) . toResultR frep20 $ xs in+       if interactive then interactivePrintResult line wwss+       else print1el jstL0 (concat . take 1 $ choices) wwss+   else do+    let !subs = subG (' ':js `mappend` vs) xs+    if null argCs then let !perms = genPermutationsL l in generalProcMMs wrs ks arr gs js vs h qs interactive coeffs argsZipped perms subs+    else do+     correct <- printWarning xs+     if correct == "n" then putStrLn (messageInfo 1) >> return "" -- for the multiple variations mode (with curly brackets and slash in the text) the program does not stop here, but the variation is made empty and is proposed further as a variant.+     else let !perms = decodeLConstraints argCs . genPermutationsL $ l in+        generalProcMMs wrs ks arr gs js vs h qs interactive coeffs argsZipped perms subs++{-|+Function provides message information. +-}+messageInfo :: Int -> String+messageInfo n + | n == 1 = "You stopped the program, please, if needed, run it again with better arguments. "+ | n == 2 = "Please, specify the variant which you would like to become the resulting string by its number. "+ | n == 3 = "Please, check whether the line below corresponds and is consistent with the constraints you have specified between the +A and -A options. Check also whether you have specified the \"++B\" or \"++BL\" option(s). If it is inconsistent then enter further \"n\", press Enter and then run the program again with better arguments. " `mappend` newLineEnding `mappend` "If the line is consistent with your input between +A and -A then just press Enter to proceed further. " `mappend` newLineEnding+ | n == 4 = "No data has been specified to control the computation process. "+ | otherwise = "You have specified just one variant of the properties. "++-- |+interactivePrintResult :: (a -> String) -> [a] -> IO String+interactivePrintResult f xss+  | null xss = putStrLn "" >> return ""+  | otherwise = do+     let !datas = map (\(idx,str) -> show idx `mappend` ('\t' : str)) . trans232 . map f $ xss+     mapM_ putStrLn datas+     putStrLn ""+     putStrLn . messageInfo $ 2+     number <- getLine+     let !lineRes = concat . filter ((number `mappend` "\t")`L.isPrefixOf`) $ datas+         !ts = drop 1 . dropWhile (/= '\t') $ lineRes+     putStrLn ts >> return ts+     +printWarning :: String -> IO String+printWarning xs = do+  putStrLn . messageInfo $ 3+  putStrLn xs+  getLine++generalProcMs+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> String+ -> String+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Coeffs2+ -> [Array Int Int]+ -> [String]+ -> ([Int],Int,Int,String)+ -> IO [Result [] Char Double Double]+generalProcMs wrs ks arr gs js vs h qs coeffs perms subs (intervalNmbrs, arg0, numberI, choice) = do+  if compare numberI 2 == LT then let !frep2 = chooseMax wrs ks arr gs js vs id h coeffs qs 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 wrs ks arr gs js vs id h coeffs qs choice+        (!minE,!maxE) = minMax11C . map (toPropertiesF' frep20) $ variants1+        !frep2 = chooseMax wrs ks arr gs js vs (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) h coeffs qs choice+    return . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) $ variants1++-- |+generalProcMMs+ :: GWritingSystemPRPLX+ -> [(Char,Char)]+ -> CharPhoneticClassification+ -> SegmentRulesG+ -> String+ -> String+ -> (Double -> String -> ([[[PRS]]] -> [[Double]]))+ -> [([[[PRS]]] -> [[Double]])]+ -> Bool+ -> Coeffs2+ -> [([Int],Int,Int,String)]+ -> [Array Int Int]+ -> [String]+ -> IO String+generalProcMMs wrs ks arr gs js vs h qs interactiveMM coeffs rs perms subs =+ case length rs of+  0 -> putStrLn (messageInfo 4) >> return ""+  1 -> putStrLn (messageInfo 5) >> do+        temp <- generalProcMs wrs ks arr gs js vs h qs coeffs perms subs (head rs)+        finalProc interactiveMM line temp+  _ -> do+         genVariants <- mapM (generalProcMs wrs ks arr gs js vs h qs coeffs perms subs) rs+         finalProc interactiveMM id . foldlI . map (map line) $ genVariants++foldlI :: [[String]] -> [String]+foldlI (xs:ys:xss) = foldlI (intersectInterResults xs ys : xss)+foldlI (xs:_) = xs+foldlI _ = []++-- |+finalProc :: Bool -> (a -> String) -> [a] -> IO String+finalProc bool f xss = if bool then interactivePrintResult f xss else putStrLn ts >> return ts+  where ts = concatMap (\t -> f t `mappend` newLineEnding) xss++-- |+print1el :: Bool -> String -> [Result [] Char Double Double] -> IO String+print1el jstlines choice y+ | jstlines == True = putStrLn us >> return us+ | otherwise = putStrLn zs >> return zs+       where !ch = precChoice choice+             !us = concatMap (\ys -> line ys `mappend` newLineEnding) y+             !zs = concatMap (\ys -> line ys `mappend` newLineEnding `mappend` showFFloat ch (propertiesF ys) (newLineEnding `mappend` showFFloat ch (transPropertiesF ys) newLineEnding)) y
+ Phonetic/Languages/Simplified/Array/General/FuncRep2RelatedG2.hs view
@@ -0,0 +1,89 @@+-- |+-- Module      :  Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2+-- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Functions to choose from the 'FuncRep2' variants.++{-# LANGUAGE BangPatterns #-}++module Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2 where++import CaseBi.Arr (getBFstL')+import Phonetic.Languages.Simplified.DataG.Base+import Phonetic.Languages.Array.General.PropertiesFuncRepG2+import Phonetic.Languages.Array.General.PropertiesSyllablesG2+import Data.Monoid (mappend)+import Data.Phonetic.Languages.Base+import Data.Phonetic.Languages.Syllables++-- | Allows to choose the variant of the computations in case of usual processment. The coefficient 1.3 (anyway, it must+-- be greater than 1.0) )is an empirical and approximate, you can use your own if you like.+chooseMax+  :: (Ord c) =>GWritingSystemPRPLX+  -> [(Char,Char)]+  -> CharPhoneticClassification+  -> SegmentRulesG+  -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.+  -> (Double -> c)+  -> (Double -> String -> ([[[PRS]]] -> [[Double]])) -- ^ The function that is needed in the 'procRhythmicity23F' function.+  -> Coeffs2+  -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the+  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most+  -- exact one and, therefore, the default one.+  -> String+  -> FuncRep2 String Double c+chooseMax = chooseMaxG 1.3+{-# INLINE chooseMax #-}++-- | Allows to choose the variant of the computations in case of usual processment.+chooseMaxG+  :: (Ord c) => Double -- ^ Must be greater than 1.0 though it is not checked.+  -> GWritingSystemPRPLX+  -> [(Char,Char)]+  -> CharPhoneticClassification+  -> SegmentRulesG+  -> String -- ^ Corresponds to the \'0\' symbol delimiter in the @ukrainian-phonetics-basic-array@ package.+  -> String -- ^ Corresponds to the \'1\' and \'-\' symbol delimiters in the @ukrainian-phonetics-basic-array@ package.+  -> (Double -> c)+  -> (Double -> String -> ([[[PRS]]] -> [[Double]])) -- ^ The function that is needed in the 'procRhythmicity23F' function.+  -> Coeffs2+  -> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the+  -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most+  -- exact one and, therefore, the default one.+  -> String+  -> FuncRep2 String Double c+chooseMaxG k wrs ks arr gs us vs g h coeffs xs choice = getBFstL' (procB2InvF wrs ks arr gs us vs g (xs !! 3) coeffs)+ [("02y",procRhythmicity23F k g h "02y" coeffs wrs ks arr gs us vs),+  ("02z",procRhythmicity23F k g h "02z" coeffs wrs ks arr gs us vs),+   ("03y",procRhythmicity23F k g h "03y" coeffs wrs ks arr gs us vs),+    ("03z",procRhythmicity23F k g h "03z" coeffs wrs ks arr gs us vs),+     ("04y",procRhythmicity23F k g h "04y" coeffs wrs ks arr gs us vs),+      ("04z",procRhythmicity23F k g h "04z" coeffs wrs ks arr gs us vs),+       ("0y",procRhythmicity23F k g h "0y" coeffs wrs ks arr gs us vs),+        ("0z",procRhythmicity23F k g h "0z" coeffs wrs ks arr gs us vs),+         ("y",procB2F wrs ks arr gs us vs g (xs !! 0) coeffs),+          ("y0",procDiverse2F wrs (' ':us `mappend` vs) g),+           ("y2",procB2F wrs ks arr gs us vs g (xs !! 1) coeffs),+            ("y3",procB2F wrs ks arr gs us vs g (xs !! 2) coeffs),+             ("y4",procB2F wrs ks arr gs us vs g (xs !! 3) coeffs),+              ("yy",procB2InvF wrs ks arr gs us vs g (xs !! 0) coeffs),+               ("yy2",procB2InvF wrs ks arr gs us vs g (xs !! 1) coeffs),+                ("yy3",procB2InvF wrs ks arr gs us vs g (xs !! 2) coeffs),+                 ("z",procB2FF wrs ks arr gs us vs k g (xs !! 0) coeffs),+                  ("z2",procB2FF wrs ks arr gs us vs k g (xs !! 1) coeffs),+                   ("z3",procB2FF wrs ks arr gs us vs k g (xs !! 2) coeffs),+                    ("z4",procB2FF wrs ks arr gs us vs k g (xs !! 3) coeffs),+                     ("zz",procB2InvFF wrs ks arr gs us vs k g (xs !! 0) coeffs),+                      ("zz2",procB2InvFF wrs ks arr gs us vs k g (xs !! 1) coeffs),+                       ("zz3",procB2InvFF wrs ks arr gs us vs k g (xs !! 2) coeffs),+                        ("zz4", procB2InvFF wrs ks arr gs us vs k g (xs !! 3) 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),("02z",Just 0),("03y",Just 0),("03z",Just 0),("04y",Just 0),+  ("04z",Just 0),("0y",Just 0),("0z",Just 0),("y",Just 0),("y0",Just 0),("y2",Just 0),("y3",Just 0), ("y4",Just 0),+    ("z",Just 0),("z0",Just 0),("z2",Just 0),("z3",Just 0), ("z4",Just 0)]
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ phonetic-languages-simplified-generalized-examples-array.cabal view
@@ -0,0 +1,26 @@+-- Initial phonetic-languages-simplified-generalized-examples-array.cabal+-- generated by cabal init.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                phonetic-languages-simplified-generalized-examples-array+version:             0.1.0.0+synopsis:            Helps to create texts with the given phonetic properties (e. g. poetic).+description:         +homepage:            https://hackage.haskell.org/package/phonetic-languages-simplified-generalized-examples-array+license:             MIT+license-file:        LICENSE+author:              Oleksndr Zhabenko+maintainer:          olexandr543@yahoo.com+copyright:           Oleksandr Zhabenko+category:            Language, Math, Game+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++library+  exposed-modules:     Phonetic.Languages.General.Lines, Phonetic.Languages.General.Parsing, Phonetic.Languages.General.Simple, Phonetic.Languages.General.GetTextualInfo, Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2+  -- other-modules:+  other-extensions:    BangPatterns, FlexibleContexts+  build-depends:       base >=4.8 && <4.15, phonetic-languages-simplified-generalized-examples-common >=0.1.0.1 && <1, subG >=0.4.2 && <1, phonetic-languages-simplified-generalized-properties-array >=0.1.0.2 && <1, phonetic-languages-simplified-base >=0.2 && <1, phonetic-languages-permutations-array >=0.1 && <1, phonetic-languages-filters-array >=0.1 && <1, phonetic-languages-phonetics-basics >=0.6.1 && <1, phonetic-languages-constraints-array >=0.1 && <1, parallel >=3.2.0.6 && <4, phonetic-languages-plus >=0.2 && <1, mmsyn2-array >=0.1.3 && <1+  -- hs-source-dirs:+  default-language:    Haskell2010