**diff options**

author | OleksandrZhabenko <> | 2020-07-31 19:49:00 (GMT) |
---|---|---|

committer | hdiff <hdiff@hdiff.luite.com> | 2020-07-31 19:49:00 (GMT) |

commit | 2ae406962bda8f4beb0187b15c0f268a78f2e433 (patch) | |

tree | dcece7b7df8585d79d3dc7e591dd30a31612ce4a | |

parent | 31219117fe96396cc48b9c977071202c8c3a9b26 (diff) |

version 0.8.0.00.8.0.0

-rw-r--r-- | ChangeLog.md | 5 | ||||

-rw-r--r-- | DobutokO/Poetry.hs | 7 | ||||

-rw-r--r-- | DobutokO/Poetry/Basic.hs | 10 | ||||

-rw-r--r-- | DobutokO/Poetry/General.hs | 452 | ||||

-rw-r--r-- | DobutokO/Poetry/Norms.hs | 26 | ||||

-rw-r--r-- | DobutokO/Poetry/PrependAppend.hs | 303 | ||||

-rw-r--r-- | DobutokO/Poetry/StrictV.hs | 36 | ||||

-rw-r--r-- | DobutokO/Poetry/UniquenessPeriodsG.hs | 18 | ||||

-rw-r--r-- | Main.hs | 16 | ||||

-rw-r--r-- | README.md | 39 | ||||

-rw-r--r-- | dobutokO-poetry.cabal | 14 |

11 files changed, 574 insertions, 352 deletions

diff --git a/ChangeLog.md b/ChangeLog.md index 87389cd..3c3c479 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -40,3 +40,8 @@ similar to the respective functions without 'Line' ending in their name but prin ## 0.7.0.0 -- 2020-07-29 * Seventh version. Changed the module structure. Added new modules and rewritten the old ones. Fixed unexact or not complete documentation for some functions. + +## 0.8.0.0 -- 2020-07-31 + +* Eigth version. Changed the module structure. Removed the module DobutokO.Poetry.PrependAppend and added the module DobutokO.Poetry.General with more extended +possibilities. Addad also README.md file with some useful information. Some code and documentation improvements. diff --git a/DobutokO/Poetry.hs b/DobutokO/Poetry.hs index 65203fd..7f9a8ee 100644 --- a/DobutokO/Poetry.hs +++ b/DobutokO/Poetry.hs @@ -8,8 +8,6 @@ -- Helps to order the 7 or less Ukrainian words (or their concatenations) -- to obtain (to some extent) suitable for poetry or music text. -{-# LANGUAGE BangPatterns #-} - module DobutokO.Poetry ( -- * Main functions uniq10Poetical4 @@ -55,13 +53,14 @@ import DobutokO.Poetry.UniquenessPeriodsG import DobutokO.Poetry.StrictV import DobutokO.Poetry.Basic --- | Generalization of the 'uniquenessVariantsG' with usage of several norms (instead of one). They constitute a 'V.Vector' of functions +-- | Returns the 'V.Vector' of all possible permutations of the 'String' that represent the Ukrainian text and the linked information with them for +-- analysis with usage of several norms (instead of one). They constitute a 'V.Vector' of functions -- @norm :: [Int] -> Int@. So the inner vector in the each resulting 'Uniqueness' has the same length as the vector of norms. uniquenessVariantsGN :: V.Vector ([Int] -> Int) -> String -> V.Vector Uniqueness uniquenessVariantsGN vN = uniquenessVariants2GN vN (uniquenessPeriods) {-# INLINE uniquenessVariantsGN #-} --- | Generalized variant of the 'uniqMaxPoeticalG' with the several norms given as a 'V.Vector' of functions and an 'Int' parameter. The function evaluates +-- | A variant of the 'uniqMaxPoetical2GN' with the several norms given as a 'V.Vector' of functions and an 'Int' parameter. The function evaluates -- the generated 'V.Vector' of 'Uniqueness' elements to retrieve the possibly maximum element in it with respect to the order and significance (principality) -- of the norms being evaluated. The most significant and principal is the norm, which index in the 'V.Vector' of them is the 'Int' argument of the function -- minus 1, then less significant is the next to the left norm and so on. diff --git a/DobutokO/Poetry/Basic.hs b/DobutokO/Poetry/Basic.hs index 7c4364d..75a086e 100644 --- a/DobutokO/Poetry/Basic.hs +++ b/DobutokO/Poetry/Basic.hs @@ -8,8 +8,6 @@ -- Helps to order the 7 or less Ukrainian words (or their concatenations) -- to obtain (to some extent) suitable for poetry or music text. -{-# LANGUAGE BangPatterns #-} - module DobutokO.Poetry.Basic ( Uniqueness -- * Main functions @@ -40,8 +38,8 @@ type Uniqueness = ([Int],V.Vector Int,String) -- which is given as the first argument. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). uniqInMaxPoeticalN :: Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> IO (V.Vector Uniqueness) uniqInMaxPoeticalN k vN v = do - let !uniq = uniqMaxPoeticalGNV k vN v - let !fsT = (\(!ys,_,_) -> ys) uniq + let uniq = uniqMaxPoeticalGNV k vN v + let fsT = (\(ys,_,_) -> ys) uniq putStr (filter (not . isPunctuation) . lastFrom3 $ uniq) >> putStrLn "" return . V.filter (\(xs,_,_) -> xs /= fsT) $ v @@ -53,8 +51,8 @@ uniqInMaxPoeticalNL vN = uniqInMaxPoeticalN (V.length vN) vN -- | Generalized variant of the 'uniqInMaxPoeticalN' with usage of the several norms and all the information is printed on the same line. uniqInMaxPoeticalNLine :: Int -> V.Vector ([Int] -> Int) -> V.Vector Uniqueness -> IO (V.Vector Uniqueness) uniqInMaxPoeticalNLine k vN v = do - let !uniq = uniqMaxPoeticalGNV k vN v - let !fsT = (\(!ys,_,_) -> ys) uniq + let uniq = uniqMaxPoeticalGNV k vN v + let fsT = (\(ys,_,_) -> ys) uniq putStr (filter (not . isPunctuation) . lastFrom3 $ uniq) >> putStr " " return . V.filter (\(xs,_,_) -> xs /= fsT) $ v diff --git a/DobutokO/Poetry/General.hs b/DobutokO/Poetry/General.hs new file mode 100644 index 0000000..ce65bba --- /dev/null +++ b/DobutokO/Poetry/General.hs @@ -0,0 +1,452 @@ +-- | +-- Module : DobutokO.Poetry.General +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Helps to order the 7 or less Ukrainian words (or their concatenations) +-- to obtain (to some extent) suitable for poetry or music text. +-- Generalization of the functionality in the 'DobutokO.Poetry.Basic' +-- and 'DobutokO.Poetry' modules. The functions can only print the needed +-- strings or also return tha data needed to interconnect and link it with +-- other functions. There is also a possibility to use prepending and +-- postpending 'String' in the 'PreApp' data type so that they are added +-- respectively to the beginning or to the end of the strings. + +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module DobutokO.Poetry.General where + +import Data.Maybe (fromJust) +import Data.Char (isPunctuation) +import qualified Data.Vector as V +import MMSyn7s +import DobutokO.Poetry.Norms +import DobutokO.Poetry.Auxiliary +import DobutokO.Poetry.UniquenessPeriodsG +import DobutokO.Poetry.StrictV +import DobutokO.Poetry.Basic (Uniqueness) + +-- | The list in the 'PA' variant represent the prepending 'String' and the postpending one respectively. 'K' constuctor actually means no prepending and +-- postpending of the text. Are used basically to control the behaviour of the functions. +data PreApp a = K | PA [a] [a] deriving Eq + +class G1 a b where + get1m :: a -> [b] + get2m :: a -> [b] + getm :: Bool -> a -> [b] + getm True = get1m + getm _ = get2m + preapp :: a -> [[b]] -> [[b]] + setm :: [b] -> [b] -> a + +instance G1 (PreApp Char) Char where + get1m K = [] + get1m (PA xs _) = xs + get2m K = [] + get2m (PA _ ys) = ys + preapp K xss = xss + preapp (PA xs ys) yss = xs:yss ++ [ys] + setm [] [] = K + setm xs ys = PA xs ys + +type Preapp = PreApp Char + +isPA :: PreApp a -> Bool +isPA K = False +isPA _ = True + +isK :: PreApp a -> Bool +isK K = True +isK _ = False + +-- | Is used to control whether to return data or only to print the needed information. The 'U' contstuctor corresponds to the information printing and 'UL' to +-- returning also data. The last one so can be further used. +data UniquenessG a b = U b | UL ([a],b) deriving Eq + +instance Show (UniquenessG String (V.Vector Uniqueness)) where + show (U v) = show . V.map (filter (not . isPunctuation) . lastFrom3) $ v + show (UL (wss,_)) = show . map (filter (not . isPunctuation)) $ wss + +type UniqG = UniquenessG String (V.Vector Uniqueness) + +-- | Decomposes the data type 'UniqG' into its components. The inverse to the 'set2'. +get2 :: UniqG -> (Maybe [String], V.Vector Uniqueness) +get2 (U v) = (Nothing,v) +get2 (UL (wss,v)) = (Just wss,v) + +-- | Compose the data type 'UniqG' from its components. The inverse to the 'get2'. +set2 :: (Maybe [String], V.Vector Uniqueness) -> UniqG +set2 (Just wss, v) = UL (wss,v) +set2 (Nothing, v) = U v + +isU :: UniqG -> Bool +isU (U _) = True +isU _ = False + +isUL :: UniqG -> Bool +isUL (UL _) = True +isUL _ = False + +-- | Prints the maximum element with respect of the @k@ norms (the most significant of which is the rightest one, then to the left less significant etc.), +-- which is given as the first argument. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). +uniqInMaxPoeticalN :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO UniqG +uniqInMaxPoeticalN k vN x = do + inner1 k vN x >>= \(fsT,x) -> + if isU x then return (U (V.filter (\(xs,_,_) -> xs /= fsT) . snd . get2 $ x)) + else return (UL ((\(v1,v2) -> ((V.toList . V.map (filter (not . isPunctuation) . lastFrom3) $ v1) ++ (fromJust . fst . get2 $ x),v2)) . + V.unstablePartition (\(xs,_,_) -> xs == fsT) . snd . get2 $ x)) +{-# INLINE uniqInMaxPoeticalN #-} + +-- | Is used internally in the 'uniqInMaxPoeticalN' to reduce duplication. +inner1 :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO ([Int],UniqG) +inner1 k vN x = do + let uniq = uniqMaxPoeticalGNV k vN x + let fsT = (\(ys,_,_) -> ys) uniq + putStr (filter (not . isPunctuation) . lastFrom3 $ uniq) >> putStrLn "" + return (fsT,x) +{-# INLINE inner1 #-} + +-- | Variant of 'uniqInMaxPoticalN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqInMaxPoeticalNL :: V.Vector ([Int] -> Int) -> UniqG -> IO UniqG +uniqInMaxPoeticalNL vN x = uniqInMaxPoeticalN (V.length vN) vN x +{-# INLINE uniqInMaxPoeticalNL #-} + +-- | Generalized variant of the 'uniqInMaxPoeticalN' with usage of the several norms and all the information is printed on the same line. +uniqInMaxPoeticalNLine :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO UniqG +uniqInMaxPoeticalNLine k vN x = do + inner2 k vN x >>= \(fsT,x) -> + if isU x then return (U (V.filter (\(xs,_,_) -> xs /= fsT) . snd . get2 $ x)) + else return (UL ((\(v1,v2) -> ((V.toList . V.map (filter (not . isPunctuation) . lastFrom3) $ v1) ++ (fromJust . fst . get2 $ x),v2)) . + V.unstablePartition (\(xs,_,_) -> xs == fsT) . snd . get2 $ x)) +{-# INLINE uniqInMaxPoeticalNLine #-} + +-- | Is used internally in the 'uniqInMaxPoeticalNLine' to reduce duplication. +inner2 :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO ([Int],UniqG) +inner2 k vN x = do + let uniq = uniqMaxPoeticalGNV k vN x + let fsT = (\(ys,_,_) -> ys) uniq + putStr (filter (not . isPunctuation) . lastFrom3 $ uniq) >> putStr " " + return (fsT,x) +{-# INLINE inner2 #-} + +-- | Variant of 'uniqInMaxPoticalNLine' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqInMaxPoeticalNLineL :: V.Vector ([Int] -> Int) -> UniqG -> IO UniqG +uniqInMaxPoeticalNLineL vN = uniqInMaxPoeticalNLine (V.length vN) vN +{-# INLINE uniqInMaxPoeticalNLineL #-} + +-- | Prints @n@ (given as the first argument) maximum elements with respect to the several norms (their quantity is the second argument) starting +-- from the right to the left. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). +uniqNPoeticalN :: Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> IO () +uniqNPoeticalN n k vN y + | n <= 0 = return () + | compare (V.length . snd . get2 $ y) n == LT = V.mapM_ (\x -> putStr (filter (not . isPunctuation) . lastFrom3 $ x) >> putStrLn "" ) . snd . get2 $ y + | otherwise = (uniqInMaxPoeticalN k vN y >>= uniqNPoeticalN (n - 1) k vN) +{-# INLINE uniqNPoeticalN #-} + +-- | Variant of 'uniqNPoeticalN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoeticalNL :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO () +uniqNPoeticalNL n vN = uniqNPoeticalN n (V.length vN) vN +{-# INLINE uniqNPoeticalNL #-} + +-- | Variant of the 'uniqNPoeticalN' with its output being printed on the same line. +uniqNPoeticalNLine :: Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> IO () +uniqNPoeticalNLine n k vN y + | n <= 0 = putStrLn "" + | compare (V.length . snd . get2 $ y) n == LT = + (V.mapM_ (\x -> putStr (filter (not . isPunctuation) . lastFrom3 $ x) >> putStr " " ) . snd . get2 $ y) >> putStrLn "" + | otherwise = (uniqInMaxPoeticalNLine k vN y >>= uniqNPoeticalNLine (n - 1) k vN) +{-# INLINE uniqNPoeticalNLine #-} + +-- | Variant of 'uniqNPoeticalNLine' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoeticalNLineL :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO () +uniqNPoeticalNLineL n vN = uniqNPoeticalNLine n (V.length vN) vN +{-# INLINE uniqNPoeticalNLineL #-} + +-- | Prints @n@ (given as the first argument) maximum elements with respect to the several norms (their quantity is the second argument) starting +-- from the right to the left. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). Contrary to its pair function +-- 'uniqNPoeticalN' returns then the rest of the given 'V.Vector' 'Uniqueness' after filtering the printed elements 'String'. +uniqNPoeticalVN :: Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> IO UniqG +uniqNPoeticalVN n k vN y + | n <= 0 || compare (V.length . snd . get2 $ y) n == LT = return y + | otherwise = (uniqInMaxPoeticalN k vN y >>= uniqNPoeticalVN (n - 1) k vN) +{-# INLINE uniqNPoeticalVN #-} + +-- | Variant of 'uniqNPoeticalVN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoeticalVNL :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO UniqG +uniqNPoeticalVNL n vN = uniqNPoeticalVN n (V.length vN) vN +{-# INLINE uniqNPoeticalVNL #-} + +-- | The function evaluates the 'V.Vector' of 'Uniqueness' elements to retrieve the possibly maximum element in it with respect to the order +-- and significance (principality) of the norms being evaluated. The most significant and principal is the norm, which index in the 'V.Vector' of them is +-- the 'Int' argument of the function minus 1, then less significant is the next to the left norm and so on. Is similar to 'DobutokO.Poetry.uniqMaxPoeticalGN' +-- function. +uniqMaxPoeticalGNV :: Int -> V.Vector ([Int] -> Int) -> UniqG -> Uniqueness +uniqMaxPoeticalGNV k vN y + | compare k (V.length vN) == GT = error "DobutokO.Poetry.General.uniqMaxPoeticalGNV: undefined for that amount of norms. " + | compare k 0 == GT = + let maxK = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 (k - 1)) (V.unsafeIndex vN1 (k - 1))) . snd . get2 $ y + vK = V.filter (\(_,vN2,_) -> V.unsafeIndex vN2 (k - 1) == ((\(_,vNk,_) -> V.unsafeIndex vNk (k - 1)) maxK)) . snd . get2 $ y in + if isU y then uniqMaxPoeticalGNV (k - 1) (V.unsafeSlice 0 (V.length vN - 1) vN) (U vK) + else uniqMaxPoeticalGNV (k - 1) (V.unsafeSlice 0 (V.length vN - 1) vN) (UL (fromJust . fst . get2 $ y,vK)) + | otherwise = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 0) (V.unsafeIndex vN1 0)) . snd . get2 $ y +{-# INLINE uniqMaxPoeticalGNV #-} + +-- | Variant of 'uniqMaxPoeticalGNV' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqMaxPoeticalGNVL :: V.Vector ([Int] -> Int) -> UniqG -> Uniqueness +uniqMaxPoeticalGNVL vN = uniqMaxPoeticalGNV (V.length vN) vN +{-# INLINE uniqMaxPoeticalGNVL #-} + +--------------------------------------------------------------------------------- + +-- | Returns the 'V.Vector' of all possible permutations of the 'String' that represent the Ukrainian text and the linked information with them for +-- analysis with usage of several norms (instead of one). They constitute a 'V.Vector' of functions +-- @norm :: [Int] -> Int@. So the inner vector in the each resulting 'Uniqueness' has the same length as the vector of norms. +-- In contrast to the the same named function from the 'DobutokO.Poetry' module uses in the processment prepending and appending 'String' that are lifted (if any) +-- to the 'PreApp' data type with the respective constuctors. The first one is prepended and the second one is appended to the processed 'String' to +-- be processed with it. This allows to create more connection with the previous and postpending text. +uniquenessVariantsGN :: Preapp -> V.Vector ([Int] -> Int) -> String -> V.Vector Uniqueness +uniquenessVariantsGN (PA ts us) vN = uniquenessVariants2GNP ts us vN (uniquenessPeriods) +uniquenessVariantsGN K vN = uniquenessVariants2GN vN (uniquenessPeriods) +{-# INLINE uniquenessVariantsGN #-} + +-- | A variant of the 'uniqMaxPoetical2GN' with the several norms given as a 'V.Vector' of functions and an 'Int' parameter. The function evaluates +-- the generated 'V.Vector' of 'Uniqueness' elements to retrieve the possibly maximum element in it with respect to the order and significance (principality) +-- of the norms being evaluated. The most significant and principal is the norm, which index in the 'V.Vector' of them is the 'Int' argument of the function +-- minus 1, then less significant is the next to the left norm and so on. +-- In contrast to the the same named function from the 'DobutokO.Poetry' module uses in the processment prepending and appending 'String' that are lifted (if any) +-- to the 'PreApp' data type with the respective constuctors. The first one is prepended and the second one is appended to the processed 'String' to +-- be processed with it. This allows to create more connection with the previous and postpending text. +uniqMaxPoeticalGN :: Preapp -> Int -> V.Vector ([Int] -> Int) -> String -> Uniqueness +uniqMaxPoeticalGN x k vN = uniqMaxPoetical2GN x k vN (uniquenessPeriods) +{-# INLINE uniqMaxPoeticalGN #-} + +-- | Variant of 'uniqMaxPoeticalGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +-- In contrast to the the same named function from the 'DobutokO.Poetry' module uses in the processment prepending and appending 'String' that are lifted (if any) +-- to the 'PreApp' data type with the respective constuctors. The first one is prepended and the second one is appended to the processed 'String' to +-- be processed with it. This allows to create more connection with the previous and postpending text. +uniqMaxPoeticalGNL :: Preapp -> V.Vector ([Int] -> Int) -> String -> Uniqueness +uniqMaxPoeticalGNL x vN = uniqMaxPoeticalGN x (V.length vN) vN +{-# INLINE uniqMaxPoeticalGNL #-} + +-- | A variant of the 'uniqNPoeticalGN' with only one norm. +uniqNPoeticalG :: Preapp -> Int -> ([Int] -> Int) -> String -> IO () +uniqNPoeticalG x n g = uniqNPoeticalGN x n 1 (V.singleton g) +{-# INLINE uniqNPoeticalG #-} + +-- | A variant of the 'uniqNPoeticalG' function with the @n@ equal to 10. +uniq10PoeticalG :: Preapp -> ([Int] -> Int) -> String -> IO () +uniq10PoeticalG x = uniqNPoeticalG x 10 +{-# INLINE uniq10PoeticalG #-} + +-- | A variant of 'uniq10PoeticalG' with the 'norm4' applied. The list is (according to some model, not universal, but a reasonable one in the most cases) the +-- most suitable for intonation changing and, therefore, for the accompaniment of the highly changable or variative melody. +uniq10Poetical4 :: Preapp -> String -> IO () +uniq10Poetical4 x = uniq10PoeticalG x norm4 +{-# INLINE uniq10Poetical4 #-} + +-- | A variant of 'uniq10PoeticalG' with the 'norm5' applied. The list is (according to some model, not universal, but a reasonable one in the most cases) the +-- most suitable for rhythmic speech and two-syllabilistic-based poetry. Therefore, it can be used to create a poetic composition or to emphasize some +-- thoughts. +uniq10Poetical5 :: Preapp -> String -> IO () +uniq10Poetical5 x = uniq10PoeticalG x norm5 +{-# INLINE uniq10Poetical5 #-} + +-- | A variant of the 'uniqNPoetical2GN' with the conversion (\"uniquenessPeriods\" function) function 'uniquenessPeriods'. +uniqNPoeticalGN :: Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO () +uniqNPoeticalGN x n k vN = uniqNPoetical2GN x n k vN (uniquenessPeriods) +{-# INLINE uniqNPoeticalGN #-} + +-- | Variant of 'uniqNPoeticalGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoeticalGNL :: Preapp -> Int -> V.Vector ([Int] -> Int) -> String -> IO () +uniqNPoeticalGNL x n vN = uniqNPoetical2GNL x n vN (uniquenessPeriods) +{-# INLINE uniqNPoeticalGNL #-} + +-- | Generalized variant of the 'uniqNPoeticalVG' with usage of several norms. +-- To specify whether the function returns also data suitable for usage with other functions or just usable mostly for printing it uses also a before 'String' +-- argument also 'UniqG' one with the 'U' data constructor corresponding to the printing (mostly) and 'UL' to possible reusage of data. +uniqNPoeticalVGN :: Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG +uniqNPoeticalVGN x n k vN = uniqNPoetical2VGN x n k vN (uniquenessPeriods) +{-# INLINE uniqNPoeticalVGN #-} + +-- | Variant of 'uniqNPoeticalVGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +-- To specify whether the function returns also data suitable for usage with other functions or just usable mostly for printing it uses also a before 'String' +-- argument also 'UniqG' one with the 'U' data constructor corresponding to the printing (mostly) and 'UL' to possible reusage of data. +uniqNPoeticalVGNL :: Preapp -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG +uniqNPoeticalVGNL x n vN = uniqNPoetical2VGN x n (V.length vN) vN (uniquenessPeriods) +{-# INLINE uniqNPoeticalVGNL #-} + +-- | The function evaluates +-- the generated 'V.Vector' of 'Uniqueness' elements to retrieve the possibly maximum element in it with respect to the order and significance (principality) +-- of the norms being evaluated. The most significant and principal is the norm, which index in the 'V.Vector' of them is the 'Int' argument of the function +-- minus 1, then less significant is the next to the left norm and so on. +uniqMaxPoetical2GN :: Preapp -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> Uniqueness +uniqMaxPoetical2GN rr k vN g xs + | compare k (V.length vN) == GT = error "DobutokO.Poetry.General.uniqMaxPoetical2GN: undefined for that amount of norms. " + | compare k 0 == GT = + let vM = uniquenessVariants2GNP (get1m rr) (get2m rr) vN g xs + maxK = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 (k - 1)) (V.unsafeIndex vN1 (k - 1))) vM + vK = V.filter (\(_,vN2,_) -> V.unsafeIndex vN2 (k - 1) == ((\(_,vNk,_) -> V.unsafeIndex vNk (k - 1)) maxK)) vM in + uniqMaxPoeticalGNV (k - 1) (V.unsafeSlice 0 (V.length vN - 1) vN) (U vK) + | otherwise = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 0) (V.unsafeIndex vN1 0)) . uniquenessVariantsGN rr vN $ xs + +-- | Variant of 'uniqMaxPoetical2GN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqMaxPoetical2GNL :: Preapp -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> Uniqueness +uniqMaxPoetical2GNL rr vN = uniqMaxPoetical2GN rr (V.length vN) vN +{-# INLINE uniqMaxPoetical2GNL #-} + +-- | Prints @n@ (given as the first 'Int' argument) maximum elements with respect to the several norms (their quantity is the second 'Int' argument) starting +-- from the right to the left. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). +uniqNPoetical2GN :: Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () +uniqNPoetical2GN rr n k vN g xs + | n <= 0 = return () + | otherwise = do + let v = uniquenessVariants2GNP (get1m rr) (get2m rr) vN g xs + if compare (V.length v) n == LT + then V.mapM_ (\x -> putStr ((filter (not . isPunctuation) . lastFrom3 $ x)) >> putStrLn "" ) v + else (uniqInMaxPoeticalN k vN (U v) >>= uniqNPoeticalN (n - 1) k vN) + +-- | Variant of 'uniqNPoetical2GN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoetical2GNL :: Preapp -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () +uniqNPoetical2GNL rr n vN = uniqNPoetical2GN rr n (V.length vN) vN +{-# INLINE uniqNPoetical2GNL #-} + +-- | Generalized variant of the 'uniqNPoeticalG' with usage of the several norms, but prints its output on the same line. +uniqNPoetical2GNLine :: Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () +uniqNPoetical2GNLine rr n k vN g xs + | n <= 0 = putStrLn "" + | otherwise = do + let v = uniquenessVariants2GNP (get1m rr) (get2m rr) vN g xs + if compare (V.length v) n == LT + then V.mapM_ (\x -> putStr ((filter (not . isPunctuation) . lastFrom3 $ x)) >> putStr " " ) v >> putStrLn "" + else (uniqInMaxPoeticalNLine k vN (U v) >>= uniqNPoeticalNLine (n - 1) k vN) + +-- | Variant of 'uniqNPoetical2GNLine' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoetical2GNLineL :: Preapp -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () +uniqNPoetical2GNLineL rr n vN = uniqNPoetical2GNLine rr n (V.length vN) vN +{-# INLINE uniqNPoetical2GNLineL #-} + +-- | Prints @n@ (given as the first 'Int' argument) maximum elements with respect to the several norms (their quantity is the second 'Int' argument) starting +-- from the right to the left. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). Contrary to its pair function +-- 'uniqNPoetical2GN' returns then the rest of the given 'V.Vector' 'Uniqueness' after filtering the printed elements 'String'. +-- To specify whether the function returns also data suitable for usage with other functions or just usable mostly for printing it uses also a before 'String' +-- argument also 'UniqG' one with the 'U' data constructor corresponding to the printing (mostly) and 'UL' to possible reusage of data. +uniqNPoetical2VGN :: Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> UniqG -> String -> IO UniqG +uniqNPoetical2VGN rr n k vN g y xs + | n <= 0 = if isU y then return (U V.empty) else return (UL ([],V.empty)) + | otherwise = do + let v = uniquenessVariants2GNP (get1m rr) (get2m rr) vN g xs + if compare (V.length v) n == LT + then if isU y then return (U v) else return (UL ([],v)) + else if isU y then uniqNPoeticalVN n k vN (U v) else uniqNPoeticalVN n k vN (UL ([],v)) + +-- | Variant of 'uniqNPoetical2VGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoetical2VGNL :: Preapp -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> UniqG -> String -> IO UniqG +uniqNPoetical2VGNL rr n vN = uniqNPoetical2VGN rr n (V.length vN) vN +{-# INLINE uniqNPoetical2VGNL #-} + +-- | Variant of the 'uniqNPoetical2GN', which uses as a function 'uniquenessPeriods2' with the first argument equal to the first 'Int' argument. +uniqNPoeticalUGN_ :: Preapp -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO () +uniqNPoeticalUGN_ rr x n k vN = uniqNPoetical2GN rr n k vN (uniquenessPeriods2 x) +{-# INLINE uniqNPoeticalUGN_ #-} + +-- | Variant of 'uniqNPoeticalUGN_' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoeticalUGNL_ :: Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO () +uniqNPoeticalUGNL_ rr x n vN = uniqNPoetical2GNL rr n vN (uniquenessPeriods2 x) +{-# INLINE uniqNPoeticalUGNL_ #-} + +-- | Variant of the 'uniqNPoetical2VGN', which uses as a function 'uniquenessPeriods2' with the first argument equal to the first 'Int' argument. +uniqNPoeticalUGN :: Preapp -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG +uniqNPoeticalUGN rr x n k vN = uniqNPoetical2VGN rr n k vN (uniquenessPeriods2 x) +{-# INLINE uniqNPoeticalUGN #-} + +-- | Variant of 'uniqNPoeticalUGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +uniqNPoeticalUGNL :: Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG +uniqNPoeticalUGNL rr x n vN = uniqNPoetical2VGN rr n (V.length vN) vN (uniquenessPeriods2 x) +{-# INLINE uniqNPoeticalUGNL #-} + +-- | Variant of the 'uniqNPoeticalUGN_', which uses as a single norm 'norm51'. +uniqNPoeticalUGN51_ :: Preapp -> Int -> Int -> String -> IO () +uniqNPoeticalUGN51_ rr x n = uniqNPoeticalUGN_ rr x n 1 (V.singleton norm51) +{-# INLINE uniqNPoeticalUGN51_ #-} + +-- | Variant of the 'uniqNPoeticalUGN', which uses as a single norm 'norm51'. +uniqNPoeticalUGN51 :: Preapp -> Int -> Int -> UniqG -> String -> IO UniqG +uniqNPoeticalUGN51 rr x n = uniqNPoeticalUGN rr x n 1 (V.singleton norm51) +{-# INLINE uniqNPoeticalUGN51 #-} + diff --git a/DobutokO/Poetry/Norms.hs b/DobutokO/Poetry/Norms.hs index 0343700..fec29f5 100644 --- a/DobutokO/Poetry/Norms.hs +++ b/DobutokO/Poetry/Norms.hs @@ -10,8 +10,6 @@ -- provides several different norms that allow to research the text and -- to create interesting sequences. -{-# LANGUAGE BangPatterns #-} - module DobutokO.Poetry.Norms ( -- * Different norms norm1 @@ -30,33 +28,33 @@ import Data.List ((\\)) -- | The first norm for the list of non-negative 'Int'. For not empty lists equals to the maximum element. norm1 :: [Int] -> Int -norm1 !xs +norm1 xs | null xs = 0 | otherwise = maximum xs {-# INLINE norm1 #-} -- | The second norm for the list of non-negative 'Int'. For not empty lists equals to the sum of the elements. norm2 :: [Int] -> Int -norm2 !xs = sum xs +norm2 xs = sum xs {-# INLINE norm2 #-} -- | The third norm for the list of non-negative 'Int'. For not empty lists equals to the sum of the doubled maximum element and the rest elements of the list. norm3 :: [Int] -> Int -norm3 !xs +norm3 xs | null xs = 0 | otherwise = maximum xs + sum xs {-# INLINE norm3 #-} -- | The fourth norm for the list of non-negative 'Int'. Equals to the sum of the 'norm3' and 'norm2'. norm4 :: [Int] -> Int -norm4 !xs +norm4 xs | null xs = 0 | otherwise = maximum xs + sum xs + maximum (xs \\ [maximum xs]) {-# INLINE norm4 #-} -- | The fifth norm for the list of non-negative 'Int'. For not empty lists equals to the sum of the elements quoted with sum of the two most minimum elements. norm5 :: [Int] -> Int -norm5 !xs +norm5 xs | null xs = 0 | minimum xs == 0 = norm5 . filter (/= 0) $ xs | otherwise = sum xs `quot` (minimum xs + minimum (xs \\ [minimum xs])) @@ -64,27 +62,27 @@ norm5 !xs -- | The fifth modified norm for the list of non-negative 'Int'. Tries to take into account doubled and prolonged sounds to reduce their influence on the 'norm5'. norm51 :: [Int] -> Int -norm51 !xs +norm51 xs | null xs = 0 - | compare (minimum xs) 1 /= GT = let !ys = filter (\t -> compare t 1 == GT) xs in (3 * sum xs) `quot` (minimum ys + minimum (ys \\ [minimum ys])) + | compare (minimum xs) 1 /= GT = let ys = filter (\t -> compare t 1 == GT) xs in (3 * sum xs) `quot` (minimum ys + minimum (ys \\ [minimum ys])) | otherwise = (3 * sum xs) `quot` (minimum xs + minimum (xs \\ [minimum xs])) {-# INLINE norm51 #-} -- | The fifth modified (with three minimums) norm for the list of non-negative 'Int'. Tries to take into account doubled and prolonged sounds -- to reduce their influence on the 'norm5'. norm513 :: [Int] -> Int -norm513 !xs +norm513 xs | null xs = 0 | compare (minimum xs) 1 /= GT = - let !ys = filter (\t -> compare t 1 == GT) xs - !zs = ys \\ [minimum ys] in (3 * sum xs) `quot` (minimum ys + minimum zs + minimum (zs \\ [minimum zs])) + let ys = filter (\t -> compare t 1 == GT) xs + zs = ys \\ [minimum ys] in (3 * sum xs) `quot` (minimum ys + minimum zs + minimum (zs \\ [minimum zs])) | otherwise = - let !zs = xs \\ [minimum xs] in (3 * sum xs) `quot` (minimum xs + minimum zs + minimum (zs \\ [minimum zs])) + let zs = xs \\ [minimum xs] in (3 * sum xs) `quot` (minimum xs + minimum zs + minimum (zs \\ [minimum zs])) {-# INLINE norm513 #-} -- | The sixth norm for the list of non-negative 'Int'. norm6 :: [Int] -> Int -norm6 !xs = floor (fromIntegral (norm5 xs * sum xs) / fromIntegral (norm3 xs)) +norm6 xs = floor (fromIntegral (norm5 xs * sum xs) / fromIntegral (norm3 xs)) {-# INLINE norm6 #-} -- | Splits a given list of non-negative integers into lists of elements not equal to zero and then applies to them the norms from the 'V.Vector' starting diff --git a/DobutokO/Poetry/PrependAppend.hs b/DobutokO/Poetry/PrependAppend.hs deleted file mode 100644 index 9d60c88..0000000 --- a/DobutokO/Poetry/PrependAppend.hs +++ /dev/null @@ -1,303 +0,0 @@ --- | --- Module : DobutokO.Poetry.PrependAppend --- Copyright : (c) OleksandrZhabenko 2020 --- License : MIT --- Stability : Experimental --- Maintainer : olexandr543@yahoo.com --- --- Helps to order the 7 or less Ukrainian words (or their concatenations) --- to obtain (to some extent) suitable for poetry or music text. --- In contrast to the the same named functions from the 'DobutokO.Poetry' module each its function uses in the processment prepending and appending 'String' given --- as the first two arguments. The first one is prepended and the second one is appended to the processed 'String' to be processed with it. --- This allows to create more connection with the previous and postpending text. - -{-# LANGUAGE BangPatterns #-} - -module DobutokO.Poetry.PrependAppend ( - -- * Main functions - uniq10Poetical4 - , uniq10Poetical5 - , uniq10PoeticalG - , uniqNPoeticalG - , uniqNPoeticalGN - , uniqNPoeticalN - , uniqNPoeticalVN - , uniqNPoeticalVGN - -- * Additional functions - , uniquenessVariantsGN - , uniqMaxPoeticalGN - , uniqMaxPoeticalGNV - , uniqInMaxPoeticalN - -- * Generalized variants - -- ** Main ones - , uniqNPoetical2GN - , uniqNPoetical2VGN - , uniqNPoeticalUGN_ - , uniqNPoeticalUGN - , uniqNPoeticalUGN51_ - , uniqNPoeticalUGN51 - -- ** Additional functions - , uniqMaxPoetical2GN - -- * On one line output - , uniqInMaxPoeticalNLine - , uniqNPoeticalNLine - , uniqNPoetical2GNLine - -- * With all the norms used - , uniqMaxPoeticalGNL - , uniqInMaxPoeticalNL - , uniqInMaxPoeticalNLineL - , uniqNPoeticalNL - , uniqNPoeticalNLineL - , uniqNPoeticalVNL - , uniqNPoeticalGNL - , uniqNPoeticalVGNL - , uniqMaxPoetical2GNL - , uniqMaxPoeticalGNVL - , uniqNPoetical2GNL - , uniqNPoetical2GNLineL - , uniqNPoetical2VGNL - , uniqNPoeticalUGNL_ - , uniqNPoeticalUGNL -) where - -import Data.Char (isPunctuation) -import qualified Data.Vector as V -import Data.List ((\\)) -import MMSyn7s -import DobutokO.Poetry.Norms -import DobutokO.Poetry.Auxiliary -import DobutokO.Poetry.UniquenessPeriodsG -import DobutokO.Poetry.StrictV -import DobutokO.Poetry.Basic - --- | Generalization of the 'uniquenessVariantsG' with usage of several norms (instead of one). They constitute a 'V.Vector' of functions --- @norm :: [Int] -> Int@. So the inner vector in the each resulting 'Uniqueness' has the same length as the vector of norms. --- In contrast to the the same named function from the 'DobutokO.Poetry' module uses in the processment prepending and appending 'String' given --- as the first two arguments. The first one is prepended and the second one is appended to the processed 'String' to be processed with it. --- This allows to create more connection with the previous and postpending text. -uniquenessVariantsGN :: String -> String -> V.Vector ([Int] -> Int) -> String -> V.Vector Uniqueness -uniquenessVariantsGN !ts !us vN = uniquenessVariants2GNP ts us vN (uniquenessPeriods) -{-# INLINE uniquenessVariantsGN #-} - --- | Generalized variant of the 'uniqMaxPoeticalG' with the several norms given as a 'V.Vector' of functions and an 'Int' parameter. The function evaluates --- the generated 'V.Vector' of 'Uniqueness' elements to retrieve the possibly maximum element in it with respect to the order and significance (principality) --- of the norms being evaluated. The most significant and principal is the norm, which index in the 'V.Vector' of them is the 'Int' argument of the function --- minus 1, then less significant is the next to the left norm and so on. --- In contrast to the the same named function from the 'DobutokO.Poetry' module uses in the processment prepending and appending 'String' given --- as the first two arguments. The first one is prepended and the second one is appended to the processed 'String' to be processed with it. --- This allows to create more connection with the previous and postpending text. -uniqMaxPoeticalGN :: String -> String -> Int -> V.Vector ([Int] -> Int) -> String -> Uniqueness -uniqMaxPoeticalGN !ts !us k vN = uniqMaxPoetical2GN ts us k vN (uniquenessPeriods) -{-# INLINE uniqMaxPoeticalGN #-} - --- | Variant of 'uniqMaxPoeticalGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- In contrast to the the same named function from the 'DobutokO.Poetry' module uses in the processment prepending and appending 'String' given --- This allows to create more connection with the previous and postpending text. -uniqMaxPoeticalGNL :: String -> String -> V.Vector ([Int] -> Int) -> String -> Uniqueness -uniqMaxPoeticalGNL !ts !us vN = uniqMaxPoeticalGN ts us (V.length vN) vN -{-# INLINE uniqMaxPoeticalGNL #-} - --- | A variant of the 'uniqNPoeticalGN' with only one norm. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalG :: String -> String -> Int -> ([Int] -> Int) -> String -> IO () -uniqNPoeticalG !ts !us n g = uniqNPoeticalGN ts us n 1 (V.singleton g) -{-# INLINE uniqNPoeticalG #-} - --- | A variant of the 'uniqNPoeticalG' function with the @n@ equal to 10. --- This allows to create more connection with the previous and postpending text. -uniq10PoeticalG :: String -> String -> ([Int] -> Int) -> String -> IO () -uniq10PoeticalG !ts !us = uniqNPoeticalG ts us 10 -{-# INLINE uniq10PoeticalG #-} - --- | A variant of 'uniq10PoeticalG' with the 'norm4' applied. The list is (according to some model, not universal, but a reasonable one in the most cases) the --- most suitable for intonation changing and, therefore, for the accompaniment of the highly changable or variative melody. --- This allows to create more connection with the previous and postpending text. -uniq10Poetical4 :: String -> String -> String -> IO () -uniq10Poetical4 !ts !us = uniq10PoeticalG ts us norm4 -{-# INLINE uniq10Poetical4 #-} - --- | A variant of 'uniq10PoeticalG' with the 'norm5' applied. The list is (according to some model, not universal, but a reasonable one in the most cases) the --- most suitable for rhythmic speech and two-syllabilistic-based poetry. Therefore, it can be used to create a poetic composition or to emphasize some --- thoughts. --- This allows to create more connection with the previous and postpending text. -uniq10Poetical5 :: String -> String -> String -> IO () -uniq10Poetical5 !ts !us = uniq10PoeticalG ts us norm5 -{-# INLINE uniq10Poetical5 #-} - --- | A variant of the 'uniqNPoetical2GN' with the conversion (\"uniquenessPeriods\" function) function 'uniquenessPeriods'. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalGN :: String -> String -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO () -uniqNPoeticalGN !ts !us n k vN = uniqNPoetical2GN ts us n k vN (uniquenessPeriods) -{-# INLINE uniqNPoeticalGN #-} - --- | Variant of 'uniqNPoeticalGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalGNL :: String -> String -> Int -> V.Vector ([Int] -> Int) -> String -> IO () -uniqNPoeticalGNL !ts !us n vN = uniqNPoetical2GNL ts us n vN (uniquenessPeriods) -{-# INLINE uniqNPoeticalGNL #-} - --- | Generalized variant of the 'uniqNPoeticalVG' with usage of several norms. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalVGN :: String -> String -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO (V.Vector Uniqueness) -uniqNPoeticalVGN !ts !us n k vN = uniqNPoetical2VGN ts us n k vN (uniquenessPeriods) -{-# INLINE uniqNPoeticalVGN #-} - --- | Variant of 'uniqNPoeticalVGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalVGNL :: String -> String -> Int -> V.Vector ([Int] -> Int) -> String -> IO (V.Vector Uniqueness) -uniqNPoeticalVGNL !ts !us n vN = uniqNPoetical2VGN ts us n (V.length vN) vN (uniquenessPeriods) -{-# INLINE uniqNPoeticalVGNL #-} - --- | The function evaluates --- the generated 'V.Vector' of 'Uniqueness' elements to retrieve the possibly maximum element in it with respect to the order and significance (principality) --- of the norms being evaluated. The most significant and principal is the norm, which index in the 'V.Vector' of them is the 'Int' argument of the function --- minus 1, then less significant is the next to the left norm and so on. --- This allows to create more connection with the previous and postpending text. -uniqMaxPoetical2GN :: String -> String -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> Uniqueness -uniqMaxPoetical2GN !ts !us k vN g !xs - | compare k (V.length vN) == GT = error "DobutokO.Poetry.PrependAppend.uniqMaxPoetical2GN: undefined for that amount of norms. " - | compare k 0 == GT = - let vM = uniquenessVariants2GNP ts us vN g xs - maxK = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 (k - 1)) (V.unsafeIndex vN1 (k - 1))) vM - vK = V.filter (\(_,vN2,_) -> V.unsafeIndex vN2 (k - 1) == ((\(_,vNk,_) -> V.unsafeIndex vNk (k - 1)) maxK)) vM in - uniqMaxPoeticalGNV (k - 1) (V.unsafeSlice 0 (V.length vN - 1) vN) vK - | otherwise = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 0) (V.unsafeIndex vN1 0)) . uniquenessVariantsGN ts us vN $ xs - --- | Variant of 'uniqMaxPoetical2GN' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqMaxPoetical2GNL :: String -> String -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> Uniqueness -uniqMaxPoetical2GNL !ts !us vN = uniqMaxPoetical2GN ts us (V.length vN) vN -{-# INLINE uniqMaxPoetical2GNL #-} - --- | Prints @n@ (given as the first 'Int' argument) maximum elements with respect to the several norms (their quantity is the second 'Int' argument) starting --- from the right to the left. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). --- This allows to create more connection with the previous and postpending text. -uniqNPoetical2GN :: String -> String -> Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () -uniqNPoetical2GN !ts !us n k vN g !xs - | n == 0 = return () - | otherwise = do - let v = uniquenessVariants2GNP ts us vN g xs - if compare (V.length v) n == LT - then V.mapM_ (\x -> putStrLn ((filter (not . isPunctuation) . lastFrom3 $ x)) >> putStrLn "" ) v - else (uniqInMaxPoeticalN k vN v >>= uniqNPoeticalN (n - 1) k vN) - --- | Variant of 'uniqNPoetical2GN' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqNPoetical2GNL :: String -> String -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () -uniqNPoetical2GNL !ts !us n vN = uniqNPoetical2GN ts us n (V.length vN) vN -{-# INLINE uniqNPoetical2GNL #-} - --- | Generalized variant of the 'uniqNPoeticalG' with usage of the several norms, but prints its output on the same line. --- This allows to create more connection with the previous and postpending text. -uniqNPoetical2GNLine :: String -> String -> Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () -uniqNPoetical2GNLine !ts !us n k vN g !xs - | n == 0 = putStrLn "" - | otherwise = do - let v = uniquenessVariants2GNP ts us vN g xs - if compare (V.length v) n == LT - then V.mapM_ (\x -> putStr ((filter (not . isPunctuation) . lastFrom3 $ x)) >> putStr " " ) v >> putStrLn "" - else (uniqInMaxPoeticalNLine k vN v >>= uniqNPoeticalNLine (n - 1) k vN) - --- | Variant of 'uniqNPoetical2GNLine' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqNPoetical2GNLineL :: String -> String -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO () -uniqNPoetical2GNLineL !ts !us n vN = uniqNPoetical2GNLine ts us n (V.length vN) vN -{-# INLINE uniqNPoetical2GNLineL #-} - --- | Prints @n@ (given as the first 'Int' argument) maximum elements with respect to the several norms (their quantity is the second 'Int' argument) starting --- from the right to the left. The last norm is the first element in the 'V.Vector' of norms (@[Int] -> Int@). Contrary to its pair function --- 'uniqNPoetical2GN' returns then the rest of the given 'V.Vector' 'Uniqueness' after filtering the printed elements 'String'. --- This allows to create more connection with the previous and postpending text. -uniqNPoetical2VGN :: String -> String -> Int -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO (V.Vector Uniqueness) -uniqNPoetical2VGN !ts !us n k vN g !xs - | n == 0 = return V.empty - | otherwise = do - let v = uniquenessVariants2GNP ts us vN g xs - if compare (V.length v) n == LT then return v else uniqNPoeticalVN n k vN v - --- | Variant of 'uniqNPoetical2VGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqNPoetical2VGNL :: String -> String -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO (V.Vector Uniqueness) -uniqNPoetical2VGNL !ts !us n vN = uniqNPoetical2VGN ts us n (V.length vN) vN -{-# INLINE uniqNPoetical2VGNL #-} - --- | Variant of the 'uniqNPoetical2GN', which uses as a function 'uniquenessPeriods2' with the first argument equal to the first 'Int' argument. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalUGN_ :: String -> String -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO () -uniqNPoeticalUGN_ !ts !us x n k vN = uniqNPoetical2GN ts us n k vN (uniquenessPeriods2 x) -{-# INLINE uniqNPoeticalUGN_ #-} - --- | Variant of 'uniqNPoeticalUGN_' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalUGNL_ :: String -> String -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO () -uniqNPoeticalUGNL_ !ts !us x n vN = uniqNPoetical2GNL ts us n vN (uniquenessPeriods2 x) -{-# INLINE uniqNPoeticalUGNL_ #-} - --- | Variant of the 'uniqNPoetical2VGN', which uses as a function 'uniquenessPeriods2' with the first argument equal to the first 'Int' argument. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalUGN :: String -> String -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO (V.Vector Uniqueness) -uniqNPoeticalUGN !ts !us x n k vN = uniqNPoetical2VGN ts us n k vN (uniquenessPeriods2 x) -{-# INLINE uniqNPoeticalUGN #-} - --- | Variant of 'uniqNPoeticalUGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalUGNL :: String -> String -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO (V.Vector Uniqueness) -uniqNPoeticalUGNL !ts !us x n vN = uniqNPoetical2VGN ts us n (V.length vN) vN (uniquenessPeriods2 x) -{-# INLINE uniqNPoeticalUGNL #-} - --- | Variant of the 'uniqNPoeticalUGN_', which uses as a single norm 'norm51'. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalUGN51_ :: String -> String -> Int -> Int -> String -> IO () -uniqNPoeticalUGN51_ !ts !us x n = uniqNPoeticalUGN_ ts us x n 1 (V.singleton norm51) -{-# INLINE uniqNPoeticalUGN51_ #-} - --- | Variant of the 'uniqNPoeticalUGN', which uses as a single norm 'norm51'. --- This allows to create more connection with the previous and postpending text. -uniqNPoeticalUGN51 :: String -> String -> Int -> Int -> String -> IO (V.Vector Uniqueness) -uniqNPoeticalUGN51 !ts !us x n = uniqNPoeticalUGN ts us x n 1 (V.singleton norm51) -{-# INLINE uniqNPoeticalUGN51 #-} diff --git a/DobutokO/Poetry/StrictV.hs b/DobutokO/Poetry/StrictV.hs index 09fbdeb..ee8f9a6 100644 --- a/DobutokO/Poetry/StrictV.hs +++ b/DobutokO/Poetry/StrictV.hs @@ -9,17 +9,20 @@ -- to obtain (to some extent) suitable for poetry or music text. The main -- module in the library that imports all other ones except Main. -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP, BangPatterns #-} module DobutokO.Poetry.StrictV where ---import Data.Maybe (fromJust) ---import Data.Char (isPunctuation) +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__>=710 +/* code that applies only to GHC 7.10.* and higher versions */ +import GHC.Base ((<>)) +import Prelude hiding ((<>)) +#endif +#endif + import qualified Data.Vector as V import qualified Data.List as L (permutations) ---import MMSyn7s ---import DobutokO.Poetry.Norms ---import DobutokO.Poetry.UniquenessPeriodsG -- | Given a 'String' consisting of no more than 7 Ukrainian words [some of them can be created by concatenation with preserving the Ukrainian -- pronunciation of the parts, e. g. \"так як\" (actually two correct Ukrainian words and a single conjunction) can be written \"такйак\" @@ -27,7 +30,7 @@ import qualified Data.List as L (permutations) -- it returns a 'V.Vector' of possible combinations without repeating of the words in different order and for each of them appends also -- the information about 'uniquenessPeriods' to it and finds out three different metrics -- named \"norms\". -- --- Afterwards, depending on these norms it can be specified some phonetical properties of the words that +-- Afterwards, depending on these norms some phonetical properties of the words can be specified that -- allow to use them poetically or to create a varied melody with them. uniquenessVariants2GN :: V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> V.Vector ([Int],V.Vector Int, String) uniquenessVariants2GN vN g !xs = uniquenessVariants2GNP [] [] vN g xs @@ -38,6 +41,19 @@ uniquenessVariants2GNP :: String -> String -> V.Vector ([Int] -> Int) -> (String uniquenessVariants2GNP !ts !us vN g !xs | null . words $ xs = V.empty | otherwise = let !v0 = V.fromList . take 8 . words $ xs in - V.fromList . map ((\vs -> let !rs = g vs in (rs, (V.map (\f -> f rs) vN), vs)) . unwords . (ts:) . (++ [us]) . V.toList . - V.backpermute v0 . V.fromList) . L.permutations $ ([0..(V.length v0 - 1)]::[Int]) -{-# INLINE uniquenessVariants2GNP #-} + V.fromList . map ((\vs -> let !rs = g vs in (rs, (V.map (\f -> f rs) vN), vs)) . unwords . preAppend ts [us] . V.toList . + V.backpermute v0 . V.fromList) . L.permutations $ ([0..(V.length v0 - 1)]::[Int]) + + +preAppend :: [a] -> [[a]] -> [[a]] -> [[a]] +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__>=710 +preAppend ts !uss tss = ts:tss <> uss +#endif +#endif +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +preAppend ts !uss tss = ts:tss ++ uss +#endif +#endif +{-# INLINE preAppend #-} diff --git a/DobutokO/Poetry/UniquenessPeriodsG.hs b/DobutokO/Poetry/UniquenessPeriodsG.hs index ffb4b89..fc2a98f 100644 --- a/DobutokO/Poetry/UniquenessPeriodsG.hs +++ b/DobutokO/Poetry/UniquenessPeriodsG.hs @@ -9,13 +9,29 @@ -- to obtain (to some extent) suitable for poetry or music text. This module -- provides a functionality to define more complex uniquenessPeriods functions. +{-# LANGUAGE CPP #-} + module DobutokO.Poetry.UniquenessPeriodsG where +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__>=710 +/* code that applies only to GHC 7.10.* and higher versions */ +import GHC.Base (mconcat) +#endif +#endif + import qualified Data.Vector as V import Data.List ((\\),nubBy) import MMSyn7s import Melodics.Ukrainian (convertToProperUkrainian) +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + -- | More complicated and longer variant of the 'MMSyn7s.uniquenessPeriods' that takes into account the second order structure of uniqueness with 'uniquenessP2' and -- can be therefore more fruitful (probably, it is a hypothesis itself that is needed to be tested). Is provided here as an example of the more complex -- \"uniqueness function\". Uses both 'uniqueness2' and 'uniqueness2n' inside and is actually their composition with some (hopefully, natural) parameter functions. @@ -28,7 +44,7 @@ uniqueness2 f g xs | null xs = ([],[]) | otherwise = let ys = f xs - y2s = concat . g $ ys in (ys,y2s) + y2s = mconcat . g $ ys in (ys,y2s) -- | Being given two functions as parameters uses them to create a longer list of 'Int' then application of only one of them. Besides, it can take into -- account the possible 0 and to create a non-negative list of 'Int' that can be used e. g. by 'DobutokO.Norms.splitNorm'. @@ -12,16 +12,17 @@ module Main where import Control.Exception (onException) import System.IO -import DobutokO.Poetry (uniq10Poetical4,uniq10Poetical5,uniqNPoeticalG) -import DobutokO.Poetry.Norms (norm4,norm5) +import DobutokO.Poetry (uniqNPoeticalG) +import DobutokO.Poetry.Norms (norm4,norm5,norm51,norm513,norm6) import System.Environment (getArgs) import Melodics.Executable (recFileName, printInfoF, rawToSoundFile) import Melodics.Ukrainian (appendS16LEFile, convertToProperUkrainian) import EndOfExe (showE) import Data.Maybe (fromJust,isJust) --- | The first command line argument specifies which function to run. If given \"4\" it runs 'uniqNPoeticalG' 'norm4', otherwise 'uniqNPoeticalG' 'norm5'. --- The second command line argument (by default is considered equal to 10::Int) is an 'Int' number of the needed printed variants. The next 7 +-- | The first command line argument specifies which function to run. If given \"4\" it runs 'uniqNPoeticalG' 'norm4', \"51\" it runs 'uniqNPoeticalG' 'norm51', +-- \"513\" it runs 'uniqNPoeticalG' 'norm513', \"6\" it runs 'uniqNPoeticalG' 'norm6', otherwise 'uniqNPoeticalG' 'norm5'. +-- The second command line argument is an 'Int' number of the needed printed variants. The next 7 -- are treated as the Ukrainian words to be ordered accordingly to the norm. For more information, please, refer to the documentation for the abovementioned -- functions. -- @@ -36,9 +37,10 @@ main = do let aa = read arg01::Int return aa) (return 10) case (arg0,arg1) of - ("4",10) -> uniq10Poetical4 word1s - (_,10) -> uniq10Poetical5 word1s - ("4",n) -> uniqNPoeticalG n norm4 word1s + ("4",n) -> uniqNPoeticalG n norm4 word1s + ("51",n) -> uniqNPoeticalG n norm51 word1s + ("513",n) -> uniqNPoeticalG n norm513 word1s + ("6",n) -> uniqNPoeticalG n norm6 word1s ~(_,n) -> uniqNPoeticalG n norm5 word1s putStrLn "What string would you like to record as a Ukrainian text sounding by mmsyn6ukr package? " str <- getLine diff --git a/README.md b/README.md new file mode 100644 index 0000000..48bab5c --- /dev/null +++ b/README.md @@ -0,0 +1,39 @@ +There are different languages. They have different structure and rules. +But there is a possibility to create and use (on the one of the existing +vastly used and well spreaded languages basis, in this work, the +Ukrainian one) the "phonetical" language more suitable for poetry and +music. Even there can be different variants of the +phonetical language. This work proposes to create at least two new +"phonetical" languages on the Ukrainian basis. + +Imagine, you can understand the information in the text no matter of +the words order and only with the most needed grammar preserved (for +example, the rule not to separate the preposition and the next word +is preserved). Understand just like you can read the text (after +some instruction and training might be) the text with the words where +only the first and the last letters are preserved on their places and +the rest are interchangeably mixed. So imagine, you can understand (and +express your thoughts, feeling, motives and so on) the message of the +text with no strict word order preserved. + +In such a case, you can rearrange words (preserving the most important +rules in this case to reduce or even completely eliminate ambiguity) so +that they can obtain more interesting phonetical sounding. You can try +to create poetic (at least somewhat rhythmic and expressive) text or +music. This can be an inspiring and developing exercise itself. But +how can you quickly find out which combinations are more or less suitable? +Besides, can the complexity of the algorithms be reduced? + +These are some of the interesting questions. The work does not at the +moment answers them, but is experimental, still may be valueable. + +Ukrainian is the language with no strict words order needed (though there +do exist some preferences in it) and have rather pleasant sounding. So it +can be a good example and instance. Besides for the author it is a native +language. + +Even if you would not like to create and use "phonetical" languages where +phonetics is of more importance than the grammar, then you can evaluate the +phonetical potential of the words used in the text in producing specially +sounding texts. This can also be helpful in poetry writing and other +probably related fields. diff --git a/dobutokO-poetry.cabal b/dobutokO-poetry.cabal index 317526e..56e9820 100644 --- a/dobutokO-poetry.cabal +++ b/dobutokO-poetry.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: dobutokO-poetry -version: 0.7.0.0 +version: 0.8.0.0 synopsis: Helps to order the 7 or less Ukrainian words to obtain somewhat suitable for poetry or music text description: Helps to order the 7 or less Ukrainian words (or their concatenations) to obtain somewhat suitable for poetry or music text. Can be also used as a research instrument with generalized functions. @@ -11,24 +11,24 @@ license: MIT license-file: LICENSE author: OleksandrZhabenko maintainer: olexandr543@yahoo.com --- copyright: +copyright: Oleksandr Zhabenko category: Language, Game build-type: Simple -extra-source-files: ChangeLog.md +extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10 library - exposed-modules: DobutokO.Poetry.Basic, DobutokO.Poetry, DobutokO.Poetry.PrependAppend, DobutokO.Poetry.StrictV, DobutokO.Poetry.Auxiliary, DobutokO.Poetry.Norms, DobutokO.Poetry.UniquenessPeriodsG, Main + exposed-modules: DobutokO.Poetry.Basic, DobutokO.Poetry, DobutokO.Poetry.StrictV, DobutokO.Poetry.Auxiliary, DobutokO.Poetry.Norms, DobutokO.Poetry.UniquenessPeriodsG, Main, DobutokO.Poetry.General -- other-modules: - other-extensions: BangPatterns + other-extensions: BangPatterns, CPP, FlexibleInstances, MultiParamTypeClasses build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn3 >=0.1.5 && <1, mmsyn7s >=0.6.7 && <1, mmsyn6ukr >=0.7.3 && <1 -- hs-source-dirs: default-language: Haskell2010 executable dobutokO-poetry main-is: Main.hs - other-modules: DobutokO.Poetry.Basic, DobutokO.Poetry, DobutokO.Poetry.PrependAppend, DobutokO.Poetry.StrictV, DobutokO.Poetry.Auxiliary, DobutokO.Poetry.Norms, DobutokO.Poetry.UniquenessPeriodsG - other-extensions: BangPatterns + other-modules: DobutokO.Poetry.Basic, DobutokO.Poetry, DobutokO.Poetry.StrictV, DobutokO.Poetry.Auxiliary, DobutokO.Poetry.Norms, DobutokO.Poetry.UniquenessPeriodsG + other-extensions: BangPatterns, CPP build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn3 >=0.1.5 && <1, mmsyn7s >=0.6.7 && <1, mmsyn6ukr >=0.7.3 && <1 -- hs-source-dirs: default-language: Haskell2010 |