diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -109,3 +109,7 @@ ## 0.9.1.0 -- 2020-10-06 * Ninth version revised A. Fixed several issues with rewritePoem executable related to dependencies issues. Updated the dependencies bounds. + +## 0.10.0.0 -- 2020-10-07 + +* Tenth version. Changed the behaviour of the lineVariants and rewritePoem executables. Now you can introspect the inner structure of the variants of the line or for the whole text. Added build dependencies to it (they are already included for other executables). Updated the versions because of better printing output. diff --git a/Lines/Main.hs b/Lines/Main.hs --- a/Lines/Main.hs +++ b/Lines/Main.hs @@ -8,47 +8,95 @@ -- 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 Control.Parallel.Strategies import qualified Data.Vector as V -import Data.List (intercalate,intersperse) -import System.IO +import Data.List (sort) import String.Languages.UniquenessPeriods.Vector import Languages.UniquenessPeriods.Vector.General.Debug import Languages.UniquenessPeriods.Vector.Properties +import Languages.UniquenessPeriods.Vector.StrictV +import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI) +import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) import Melodics.Ukrainian import System.Environment import Languages.Phonetic.Ukrainian.PrepareText import Languages.UniquenessPeriods.Vector.Data import Languages.UniquenessPeriods.Vector.Auxiliary -import Data.Lists.FLines (newLineEnding) +import GHC.Float (int2Float) +import Data.Char (isDigit) +-- | 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 theirs position, and the rest of the line is rearranged using the specified other command line +-- arguments. They are general for the whole program. 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 file = concat . take 1 $ args + let !numericArgs = filter (all isDigit) . drop 1 $ args + !numberI = fromMaybe 1 $ (readMaybe (concat . take 1 $ numericArgs)::Maybe Int) + !file = concat . take 1 $ args contents <- readFile file - let flines = prepareText contents - mapM_ putStrLn flines - let lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines - zs = if compare (length . words . concat . take 1 $ flines) 3 == LT then concat . take 1 $ flines else lastFrom3 . headU2 . fst . get22 . uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . - aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . init . words . concat . take 1 $ flines - toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2 (concat . take 1 $ lasts) . drop 1 $ flines)) + let !flines = prepareText contents + !lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines + if compare numberI 2 == LT then do + let !zs = if compare (length . words . concat . take 1 $ flines) 3 == LT then concat . take 1 $ flines else lastFrom3 . headU2 . fst . get22 . + uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . init . words . concat . take 1 $ flines + toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2 (concat . take 1 $ lasts) [] . drop 1 $ flines)) + else do + let !intervalNmbrs = (\vs -> if null vs then V.singleton numberI else V.uniq . V.fromList $ vs) . sort . filter (<= numberI) . + map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs + !us = words . concat . take 1 $ flines + !xs = if compare (length us) 2 == LT then [] else unwords . init $ us + (!maxE,!minE) = runEval ((parTuple2 rpar rpar) ((\k -> if k == 0 then 1.0 else int2Float k) . (\rs -> if null rs then 0 else head rs) . firstFrom3 . + maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . + aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) $ xs), (\k -> if k == 0 then 1.0 else int2Float k) . abs . (\rs -> if null rs then 0 else head rs) . + firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) + (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . negate . diverse2) $ xs))) + !zs = if compare (length . words . concat . take 1 $ flines) 3 == LT then concat . take 1 $ flines else lastFrom3 . headU2 . fst . get22 . + uniqNProperties2GN " 01-" (PA [] (concat . take 1 $ lasts)) 1 1 (V.singleton (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs . + oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . int2Float . diverse2) . + unwords . init . words . concat . take 1 $ flines + toFile (file ++ "new.txt") (zs:(noDoubleWords . circle2I (concat . take 1 $ lasts) [] numberI intervalNmbrs minE maxE . drop 1 $ flines)) -circle2 :: String -> [String] -> [String] -circle2 xs xss - | null xss = [] - | otherwise = let (zss,tss) = splitAt 1 xss in do - let rs = words . concat $ zss - ws = if compare (length rs) 3 == LT then unwords (xs:rs) else lastFrom3 . headU2 . fst . get22 . - uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . - aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . init $ rs in - ws:circle2 (if null rs then [] else last rs) tss +-- | Processment without rearrangements. +circle2 :: String -> [String] -> [String] -> [String] +circle2 xs yss xss + | null xss = yss + | otherwise = circle2 (if null rs then [] else last rs) (ws:yss) tss + where (!zss,!tss) = splitAt 1 xss + !rs = words . concat $ zss + !ws = if compare (length rs) 3 == LT then unwords (xs:rs) else lastFrom3 . headU2 . fst . get22 . + uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . + aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . init $ rs +-- | Processment with rearrangements. +circle2I :: String -> [String] -> Int -> V.Vector Int -> Float -> Float -> [String] -> [String] +circle2I xs yss numberI vI minE maxE xss + | null xss = yss + | otherwise = circle2I (if null rs then [] else last rs) (ws:yss) numberI vI minE maxE tss + where (!zss,!tss) = splitAt 1 xss + !rs = words . concat $ zss + !ws = if compare (length rs) 3 == LT then unwords (xs:rs) else lastFrom3 . headU2 . fst . get22 . + uniqNProperties2GN " 01-" (PA xs (if null rs then [] else last rs)) 1 1 (V.singleton (unsafeSwapVecIWithMaxI minE maxE numberI vI . + oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . int2Float . diverse2) . + unwords . init $ rs + headU2 :: [UniquenessG1 a b] -> UniquenessG1 a b headU2 zs | null zs = ([],V.empty,[]) | otherwise = head zs +{-# INLINE headU2 #-} noDoubleWords :: [String] -> [String] noDoubleWords xss = map (unwords . drop 1 . words) xss +{-# INLINE noDoubleWords #-} diff --git a/Simple/Main.hs b/Simple/Main.hs --- a/Simple/Main.hs +++ b/Simple/Main.hs @@ -5,27 +5,57 @@ -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- --- Prints the rearrangements with the \"property\" information for the Ukrainian language text. The first command line argument must be a --- positive 'Int' number. The rest is the Ukrainian text. The most interesting is the first line of the output. But other ones also are noteworthy. +-- Prints the rearrangements with the \"property\" information for the Ukrainian language text. +-- The most interesting is the first line of the output. But other ones also are noteworthy. +{-# OPTIONS_GHC -threaded -rtsopts #-} + +{-# LANGUAGE BangPatterns #-} + module Main where +import Control.Parallel.Strategies import qualified Data.Vector as V import Data.Print.Info import String.Languages.UniquenessPeriods.Vector import Languages.UniquenessPeriods.Vector.General.Debug import Languages.UniquenessPeriods.Vector.Properties +import Languages.UniquenessPeriods.Vector.Auxiliary +import Languages.UniquenessPeriods.Vector.StrictV +import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI) +import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) import Melodics.Ukrainian import System.Environment import Languages.Phonetic.Ukrainian.PrepareText import Languages.UniquenessPeriods.Vector.Data +import Data.Char (isDigit) +import Data.List (span,sort) +import GHC.Float (int2Float) --- | Prints the rearrangements with the \"property\" information for the Ukrainian language text. The first command line argument must be a --- positive 'Int' number. The rest is the Ukrainian text. The most interesting is the first line of the output. But other ones also are noteworthy. + +-- | 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 rest of the command line arguments is the Ukrainian text. +-- +-- The most interesting is the first line of the output. But other ones also are noteworthy. main :: IO () main = do args <- getArgs - let arg0 = read (concat . take 1 $ args)::Int - xs = unwords . drop 1 $ args - printUniquenessG1List (I1 H) . fst . get22 . uniqNProperties2GN " 01-" K arg0 1 (V.singleton (oneProperty)) + let (!numericArgs,!textualArgs) = span (all isDigit) args + !arg0 = fromMaybe 1 $ (readMaybe (concat . take 1 $ numericArgs)::Maybe Int) + !numberI = fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ numericArgs)::Maybe Int) + !xs = unwords . take 1 . prepareText . unwords $ textualArgs + if compare numberI 2 == LT then printUniquenessG1List (I1 H) . fst . get22 . uniqNProperties2GN " 01-" K arg0 1 (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) . unwords . prepareText $ xs + else do + let !intervalNmbrs = (\zs -> if null zs then V.singleton numberI else V.uniq . V.fromList $ zs) . sort . filter (<= numberI) . map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs + (!maxE,!minE) = runEval ((parTuple2 rpar rpar) ((\k -> if k == 0 then 1.0 else int2Float k) . (\rs -> if null rs then 0 else head rs) . firstFrom3 . + maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . + aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) $ xs), (\k -> if k == 0 then 1.0 else int2Float k) . abs . (\rs -> if null rs then 0 else head rs) . + firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) + (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . negate . diverse2) $ xs))) + printUniquenessG1ListStr (I1 H) . fst . get22 . uniqNProperties2GN " 01-" K arg0 1 (V.singleton (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs . + oneProperty)) (uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian) (justOneValue2Property . int2Float . diverse2) $ xs diff --git a/uniqueness-periods-vector-examples.cabal b/uniqueness-periods-vector-examples.cabal --- a/uniqueness-periods-vector-examples.cabal +++ b/uniqueness-periods-vector-examples.cabal @@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/ name: uniqueness-periods-vector-examples -version: 0.9.1.0 +version: 0.10.0.0 synopsis: Usage examples for the uniqueness-periods-vector series of packages description: Usage examples for the uniqueness-periods-vector series of packages. Several executables are planned to demonstrate the libraries work. homepage: https://hackage.haskell.org/package/uniqueness-periods-vector-examples @@ -20,16 +20,18 @@ executable lineVariants main-is: Main.hs -- other-modules: - -- other-extensions: - build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.5 && < 1, uniqueness-periods-vector-common >=0.4.1 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.3 && <1 + other-extensions: BangPatterns + build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.6 && < 1, uniqueness-periods-vector-common >=0.4.1 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.3 && <1, parallel >=3.2.0.6 && <4, uniqueness-periods-vector-filters >=0.3 && <1 + ghc-options: -threaded -rtsopts hs-source-dirs: Simple default-language: Haskell2010 executable rewritePoem main-is: Main.hs -- other-modules: - -- other-extensions: - build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.5 && < 1, uniqueness-periods-vector-common >=0.4.1 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.3 && <1, lists-flines >=0.1.1 && <1 + other-extensions: BangPatterns + build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.6 && < 1, uniqueness-periods-vector-common >=0.4.1 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.3 && <1, parallel >=3.2.0.6 && <4, uniqueness-periods-vector-filters >=0.3 && <1 + ghc-options: -threaded -rtsopts hs-source-dirs: Lines default-language: Haskell2010 @@ -37,7 +39,7 @@ main-is: Main.hs -- other-modules: other-extensions: CPP, BangPatterns, FlexibleInstances, MultiParamTypeClasses - build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.5 && < 1, uniqueness-periods-vector-common >=0.4.1 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.3 && <1, uniqueness-periods-vector-filters >=0.2 && <1, uniqueness-periods-vector-stats >=0.1.2 && <1, parallel >=3.2.0.6 && <4, lists-flines >=0.1.1 && <1 + build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.6 && < 1, uniqueness-periods-vector-common >=0.4.1 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.3 && <1, uniqueness-periods-vector-filters >=0.3 && <1, uniqueness-periods-vector-stats >=0.1.2 && <1, parallel >=3.2.0.6 && <4, lists-flines >=0.1.1 && <1 ghc-options: -threaded -rtsopts hs-source-dirs: Proportion default-language: Haskell2010