Update on Hackage

Author: OleksandrZhabenko

CHANGELOG.md

@@ -0,0 +1,40 @@
+# Revision history for phonetic-languages-simplified-lists-examples
+
+## 0.1.0.0 -- 2020-11-29
+
+* First version. Released on an unsuspecting world.
+
+## 0.2.0.0 -- 2020-12-01
+
+* Second version. Added a new module Phonetic.Languages.Simplified.Lists.DeEnCoding for dealing with intersections using heaps functionality.
+For lineVariantsG2:
+ ** Added for this heaps as a new dependency (a lightweight one).
+
+ ** Added the possibilities to leave the last word in the line on its place (this can lead to preserving rhymes in poetry, for example),
+to print either metrices information or not.
+
+ ** Added the possibility to use multiple metrices at once by using +M ... -M blocks of command line arguments. The type of metrics is the first argument and
+the numeric arguments for it (as usual) are all further, then again you can specify up to two additional metrices with arguments enclosed by the block
++M and -M delimiters.
+
+## 0.3.0.0 -- 2020-12-03
+
+* Third version. Extended the multiple properties mode up to 4 different properties. Added the possibility to use more
+intercation by interactive mode and to write the single line result to file in file writing mode.
+Some documentation improvements.
+
+## 0.4.0.0 -- 2020-12-03
+
+* Fourth version. Added the new properties ralated to the uzpp2Durat3 function -- 03y, y3 (and yy2 related to
+uzpp2Durat2 function).
+
+## 0.5.0.0 -- 2020-12-05
+
+* Fifth version. Switched to the Double instead of Float whenever possible. Some dependencies changes for this.
+
+## 0.6.0.0 -- 2020-12-07
+
+* Sixth version. Added multiproperties mode for propertiesTextG2 executable. Added constraint of ++B to it, too. Extended
+up to 5 possible properties for the lineVariantsG2 executable. Added 'whitelines' modes. Some code and documentation
+improvements. Added a new module Phonetic.Languages.Simplified.Lists.SimpleConstraints.
+

GetInfo/Main.hs

@@ -0,0 +1,162 @@
+-- |
+-- Module      :  Main
+-- Copyright   :  (c) OleksandrZhabenko 2020
+-- License     :  MIT
+-- Stability   :  Experimental
+-- Maintainer  :  [email protected]
+--
+-- 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 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 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.RulesIntervalsPlus
+import Data.MinMax.Preconditions
+import Phonetic.Languages.Lists.Ukrainian.PropertiesSyllablesG2
+import Phonetic.Languages.Simplified.StrictVG
+import Phonetic.Languages.Permutations
+import Phonetic.Languages.Simplified.DataG
+import Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG2
+import Languages.UniquenessPeriods.Vector.Constraints.Encoded
+import Phonetic.Languages.Simplified.Lists.SimpleConstraints
+
+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
+
+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 = genPermutationsVL 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] -> VB.Vector [VB.Vector 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) .
+            VB.unsafeIndex 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) .
+            VB.unsafeIndex 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 "")
+
+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

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.

Lines/Main.hs

@@ -0,0 +1,129 @@
+-- |
+-- Module      :  Main
+-- Copyright   :  (c) OleksandrZhabenko 2020
+-- License     :  MIT
+-- Stability   :  Experimental
+-- Maintainer  :  [email protected]
+--
+-- 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 Phonetic.Languages.Simplified.Lists.DeEnCoding (newLineEnding)
+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.PropertiesSyllablesG2
+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.FuncRep2RelatedG2
+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 \"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 (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))
+
+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 -> Double -> Double -> [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 (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