dobutokO-poetry-general-languages (empty) → 0.1.0.0

raw patch · 8 files changed

+889/−0 lines, 8 filesdep +basedep +dobutokO-poetry-generaldep +mmsyn3setup-changed

Dependencies added: base, dobutokO-poetry-general, mmsyn3, mmsyn6ukr, uniqueness-periods-general, vector

Files

ChangeLog.md +5/−0
DobutokO/Poetry/Languages/General.hs +460/−0
DobutokO/Poetry/Languages/General/Debug.hs +249/−0
DobutokO/Poetry/Languages/UniquenessPeriodsG.hs +80/−0
LICENSE +20/−0
README.md +47/−0
Setup.hs +2/−0
dobutokO-poetry-general-languages.cabal +26/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Revision history for dobutokO-poetry-general-languages++## 0.1.0.0 -- 2020-08-18++* First version. Released on an unsuspecting world.

+ DobutokO/Poetry/Languages/General.hs view

@@ -0,0 +1,460 @@+-- |+-- Module      :  DobutokO.Poetry.Languages.General+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Helps to order the 7 or less words (or their concatenations) +-- to obtain (to some extent) suitable for poetry or music text. +-- 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.+-- For all the used conversion functions of the type @h :: String -> Vector String@ +-- it is important that they are stable for the repeated application (their result after +-- the first application cannon be changed by the rules in the function into new variants). +-- Otherwise, the recursive scheme of the functions in the module will lead to wrong results.+-- So the conversion function should work the following way (@xs@ denotes a word in the language) in GHCi: +--+-- > let v = h xs+-- > let ys = concat . toList $ v +-- > let v2 = h ys+-- > v == v2+-- > True+-- +-- Or in the other words, for the single word, @h . concat . toList . h = h@;+-- ++module DobutokO.Poetry.Languages.General where++import Data.Maybe (fromJust)+import Data.Char (isPunctuation)+import qualified Data.Vector as V+import String.UniquenessPeriodsG (uniquenessPeriods)+import DobutokO.Poetry.Norms+import DobutokO.Poetry.Norms.Extended+import DobutokO.Poetry.Auxiliary+import DobutokO.Poetry.Languages.UniquenessPeriodsG+import DobutokO.Poetry.StrictV+import DobutokO.Poetry.Data++-- | 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.Languages.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 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. +-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniquenessVariantsGN :: [String] -> (String -> V.Vector String) -> Preapp -> V.Vector ([Int] -> Int) -> String -> V.Vector Uniqueness+uniquenessVariantsGN whspss h (PA ts us) vN = uniquenessVariants2GNP ts us vN (uniquenessPeriods whspss h)+uniquenessVariantsGN whspss h K vN = uniquenessVariants2GN vN (uniquenessPeriods whspss h)+{-# 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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqMaxPoeticalGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) ->  String -> Uniqueness+uniqMaxPoeticalGN whspss h x k vN = uniqMaxPoetical2GN whspss h x k vN (uniquenessPeriods whspss h)+{-# INLINE uniqMaxPoeticalGN #-}++-- | Variant of 'uniqMaxPoeticalGN' where all the elements in the norms 'V.Vector' are used as norms from right to left.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqMaxPoeticalGNL :: [String] -> (String -> V.Vector String) -> Preapp -> V.Vector ([Int] -> Int) ->  String -> Uniqueness+uniqMaxPoeticalGNL whspss h x vN = uniqMaxPoeticalGN whspss h x (V.length vN) vN+{-# INLINE uniqMaxPoeticalGNL #-}++-- | A variant of the 'uniqNPoeticalGN' with only one norm.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalG :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> ([Int] -> Int) -> String -> IO ()+uniqNPoeticalG whspss h x n g = uniqNPoeticalGN whspss h x n 1 (V.singleton g)+{-# INLINE uniqNPoeticalG #-}++-- | A variant of the 'uniqNPoeticalG' function with the @n@ equal to 10.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniq10PoeticalG :: [String] -> (String -> V.Vector String) -> Preapp -> ([Int] -> Int) -> String -> IO ()+uniq10PoeticalG whspss h x = uniqNPoeticalG whspss h 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. +-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniq10Poetical4 :: [String] -> (String -> V.Vector String) -> Preapp -> String -> IO ()+uniq10Poetical4 whspss h x = uniq10PoeticalG whspss h 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. +-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniq10Poetical5 :: [String] -> (String -> V.Vector String) -> Preapp -> String -> IO ()+uniq10Poetical5 whspss h x = uniq10PoeticalG whspss h x norm5+{-# INLINE uniq10Poetical5 #-}++-- | A variant of the 'uniqNPoetical2GN' with the conversion (\"uniquenessPeriods\" function) function 'uniquenessPeriods'.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalGN whspss h x n k vN = uniqNPoetical2GN x n k vN (uniquenessPeriods whspss h)+{-# INLINE uniqNPoeticalGN #-}++-- | Variant of 'uniqNPoeticalGN' where all the elements in the norms 'V.Vector' are used as norms from right to left. +-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalGNL :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalGNL whspss h x n vN = uniqNPoetical2GNL x n vN (uniquenessPeriods whspss h)+{-# INLINE uniqNPoeticalGNL #-}++-- | Generalized variant of the 'uniqNPoeticalVG' with usage of several norms. +-- 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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalVGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalVGN whspss h x n k vN = uniqNPoetical2VGN x n k vN (uniquenessPeriods whspss h)+{-# INLINE uniqNPoeticalVGN #-}++-- | Variant of 'uniqNPoeticalVGN' where all the elements in the norms 'V.Vector' are used as norms from right to left.+-- 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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalVGNL :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalVGNL whspss h x n vN = uniqNPoetical2VGN x n (V.length vN) vN (uniquenessPeriods whspss h)+{-# 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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqMaxPoetical2GN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) ->  (String -> [Int]) -> String -> Uniqueness+uniqMaxPoetical2GN whspss h rr k vN g xs+ | compare k (V.length vN) == GT = error "DobutokO.Poetry.Languages.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 whspss h rr vN $ xs++-- | Variant of 'uniqMaxPoetical2GN' where all the elements in the norms 'V.Vector' are used as norms from right to left.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqMaxPoetical2GNL :: [String] -> (String -> V.Vector String) -> Preapp -> V.Vector ([Int] -> Int) ->  (String -> [Int]) -> String -> Uniqueness+uniqMaxPoetical2GNL whspss h rr vN = uniqMaxPoetical2GN whspss h 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@). +-- 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.+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.+-- 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.+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. +-- 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.+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.+-- 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.+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'.+-- 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.+-- 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.+-- 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.+-- 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.+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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalUGN_ :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalUGN_ whspss h rr x n k vN = uniqNPoetical2GN rr n k vN (uniquenessPeriods2 whspss h x)+{-# INLINE uniqNPoeticalUGN_ #-}++-- | Variant of 'uniqNPoeticalUGN_' where all the elements in the norms 'V.Vector' are used as norms from right to left.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalUGNL_ :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalUGNL_ whspss h rr x n vN = uniqNPoetical2GNL rr n vN (uniquenessPeriods2 whspss h x)+{-# INLINE uniqNPoeticalUGNL_ #-}++-- | Variant of the 'uniqNPoetical2VGN', which uses as a function 'uniquenessPeriods2' with the first argument equal to the first 'Int' argument.+-- 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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalUGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalUGN whspss h rr x n k vN = uniqNPoetical2VGN rr n k vN (uniquenessPeriods2 whspss h x)+{-# INLINE uniqNPoeticalUGN #-}++-- | Variant of 'uniqNPoeticalUGN' where all the elements in the norms 'V.Vector' are used as norms from right to left.+-- 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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalUGNL :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalUGNL whspss h rr x n vN = uniqNPoetical2VGN rr n (V.length vN) vN (uniquenessPeriods2 whspss h x)+{-# INLINE uniqNPoeticalUGNL #-}++-- | Variant of the 'uniqNPoeticalUGN_', which uses as a single norm 'norm51'.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalUGN51_ :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> String -> IO ()+uniqNPoeticalUGN51_ whspss h rr x n = uniqNPoeticalUGN_ whspss h rr x n 1 (V.singleton norm51)+{-# INLINE uniqNPoeticalUGN51_ #-}++-- | Variant of the 'uniqNPoeticalUGN', which uses as a single norm 'norm51'.+-- 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.+-- 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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniqNPoeticalUGN51 :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> UniqG -> String -> IO UniqG+uniqNPoeticalUGN51 whspss h rr x n = uniqNPoeticalUGN whspss h rr x n 1 (V.singleton norm51)+{-# INLINE uniqNPoeticalUGN51 #-}+

+ DobutokO/Poetry/Languages/General/Debug.hs view

@@ -0,0 +1,249 @@+-- |+-- Module      :  DobutokO.Poetry.Languages.General.Debug+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Helps to order the 7 or less words (or their concatenations) +-- to obtain (to some extent) suitable for poetry or music text. +-- Functions in this module behaves just like their corresponding from the +-- 'DobutokO.Poetry.Languages.General' module with that difference of being more +-- informative and printing more output with the lists and 'V.Vector'.+-- Because of that, printing the output on the one line is not needed and +-- therefore the corresponding one line functions are omitted.+-- Can be useful for debugging and exploration purposes. +-- For all the used conversion functions of the type @g :: String -> Vector String@ +-- it is important that they are stable for the repeated application (their result after +-- the first application cannon be changed by the rules in the function into new variants). +-- Otherwise, the recursive scheme of the functions in the module will lead to wrong results.+-- So the conversion function should work the following way (@xs@ denotes a word in the language) in GHCi: +--+-- > let v = g xs+-- > let ys = concat . toList $ v +-- > let v2 = g ys+-- > v == v2+-- > True+-- +-- Or in the other words, for the single word, @g . concat . toList . g = g@;+-- ++module DobutokO.Poetry.Languages.General.Debug where++import Data.Maybe (fromJust)+import Data.Char (isPunctuation)+import qualified Data.Vector as V+import String.UniquenessPeriodsG (uniquenessPeriods)+import DobutokO.Poetry.Norms+import DobutokO.Poetry.Norms.Extended+import DobutokO.Poetry.Auxiliary+import DobutokO.Poetry.Languages.UniquenessPeriodsG+import DobutokO.Poetry.StrictV+import DobutokO.Poetry.Data++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqInMaxPoeticalN', but prints more information for debugging and tuning purposes. +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 #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.inner1', but prints more information for debugging and tuning purposes. +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+  putStrLn (filter (not . isPunctuation) . lastFrom3 $ uniq)+  putStrLn . show . firstFrom3 $ uniq+  putStrLn . show . secondFrom3 $ uniq+  return (fsT,x)+{-# INLINE inner1 #-}  ++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqInMaxPoeticalNL', but prints more information for debugging and tuning purposes. +uniqInMaxPoeticalNL :: V.Vector ([Int] -> Int) -> UniqG -> IO UniqG+uniqInMaxPoeticalNL vN x = uniqInMaxPoeticalN (V.length vN) vN x+{-# INLINE uniqInMaxPoeticalNL #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalN', but prints more information for debugging and tuning purposes. +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 -> do +   { putStrLn (filter (not . isPunctuation) . lastFrom3 $ x) +   ; putStrLn . show . firstFrom3 $ x+   ; putStrLn . show . secondFrom3 $ x}) . snd . get2 $ y+ | otherwise = (uniqInMaxPoeticalN k vN y >>= uniqNPoeticalN (n - 1) k vN)+{-# INLINE uniqNPoeticalN #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalNL', but prints more information for debugging and tuning purposes. +uniqNPoeticalNL :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO ()+uniqNPoeticalNL n vN = uniqNPoeticalN n (V.length vN) vN+{-# INLINE uniqNPoeticalNL #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalVN', but prints more information for debugging and tuning purposes. +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 #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalVNL', but prints more information for debugging and tuning purposes. +uniqNPoeticalVNL :: Int -> V.Vector ([Int] -> Int) -> UniqG -> IO UniqG+uniqNPoeticalVNL n vN = uniqNPoeticalVN n (V.length vN) vN+{-# INLINE uniqNPoeticalVNL #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqMaxPoeticalGNV', but prints more information for debugging and tuning purposes. +uniqMaxPoeticalGNV :: Int -> V.Vector ([Int] -> Int) ->  UniqG -> Uniqueness+uniqMaxPoeticalGNV k vN y+ | compare k (V.length vN) == GT = error "DobutokO.Poetry.Languages.General.Debug.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 #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqMaxPoeticalGNVL', but prints more information for debugging and tuning purposes. +uniqMaxPoeticalGNVL :: V.Vector ([Int] -> Int) ->  UniqG -> Uniqueness+uniqMaxPoeticalGNVL vN = uniqMaxPoeticalGNV (V.length vN) vN+{-# INLINE uniqMaxPoeticalGNVL #-}++---------------------------------------------------------------------------------++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniquenessVariantsGN', but prints more information for debugging and tuning purposes. +uniquenessVariantsGN :: [String] -> (String -> V.Vector String) -> Preapp -> V.Vector ([Int] -> Int) -> String -> V.Vector Uniqueness+uniquenessVariantsGN whspss g (PA ts us) vN = uniquenessVariants2GNP ts us vN (uniquenessPeriods whspss g)+uniquenessVariantsGN whspss g K vN = uniquenessVariants2GN vN (uniquenessPeriods whspss g)+{-# INLINE uniquenessVariantsGN #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqMaxPoeticalGN', but prints more information for debugging and tuning purposes. +uniqMaxPoeticalGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) ->  String -> Uniqueness+uniqMaxPoeticalGN whspss g x k vN = uniqMaxPoetical2GN whspss g x k vN (uniquenessPeriods whspss g)+{-# INLINE uniqMaxPoeticalGN #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqMaxPoeticalGNL', but prints more information for debugging and tuning purposes. +uniqMaxPoeticalGNL :: [String] -> (String -> V.Vector String) -> Preapp -> V.Vector ([Int] -> Int) ->  String -> Uniqueness+uniqMaxPoeticalGNL whspss g x vN = uniqMaxPoeticalGN whspss g x (V.length vN) vN+{-# INLINE uniqMaxPoeticalGNL #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalG', but prints more information for debugging and tuning purposes. +uniqNPoeticalG :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> ([Int] -> Int) -> String -> IO ()+uniqNPoeticalG whspss g x n h = uniqNPoeticalGN whspss g x n 1 (V.singleton h)+{-# INLINE uniqNPoeticalG #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniq10PoeticalG', but prints more information for debugging and tuning purposes. +uniq10PoeticalG :: [String] -> (String -> V.Vector String) -> Preapp -> ([Int] -> Int) -> String -> IO ()+uniq10PoeticalG whspss g x = uniqNPoeticalG whspss g x 10+{-# INLINE uniq10PoeticalG #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniq10Poetical4', but prints more information for debugging and tuning purposes. +uniq10Poetical4 :: [String] -> (String -> V.Vector String) -> Preapp -> String -> IO ()+uniq10Poetical4 whspss g x = uniq10PoeticalG whspss g x norm4+{-# INLINE uniq10Poetical4 #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniq10Poetical5', but prints more information for debugging and tuning purposes. +uniq10Poetical5 :: [String] -> (String -> V.Vector String) -> Preapp -> String -> IO ()+uniq10Poetical5 whspss g x = uniq10PoeticalG whspss g x norm5+{-# INLINE uniq10Poetical5 #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalGN', but prints more information for debugging and tuning purposes. +uniqNPoeticalGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalGN whspss g x n k vN = uniqNPoetical2GN x n k vN (uniquenessPeriods whspss g)+{-# INLINE uniqNPoeticalGN #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalGNL', but prints more information for debugging and tuning purposes. +uniqNPoeticalGNL :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalGNL whspss g x n vN = uniqNPoetical2GNL x n vN (uniquenessPeriods whspss g)+{-# INLINE uniqNPoeticalGNL #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalVGN', but prints more information for debugging and tuning purposes. +uniqNPoeticalVGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalVGN whspss g x n k vN = uniqNPoetical2VGN x n k vN (uniquenessPeriods whspss g)+{-# INLINE uniqNPoeticalVGN #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalVGNL', but prints more information for debugging and tuning purposes. +uniqNPoeticalVGNL :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalVGNL whspss g x n vN = uniqNPoetical2VGN x n (V.length vN) vN (uniquenessPeriods whspss g)+{-# INLINE uniqNPoeticalVGNL #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqMaxPoetical2GN', but prints more information for debugging and tuning purposes. +uniqMaxPoetical2GN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> V.Vector ([Int] -> Int) ->  (String -> [Int]) -> String -> Uniqueness+uniqMaxPoetical2GN whspss h rr k vN g xs+ | compare k (V.length vN) == GT = error "DobutokO.Poetry.Languages.General.Debug.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 whspss h rr vN $ xs++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqMaxPoetical2GNL', but prints more information for debugging and tuning purposes. +uniqMaxPoetical2GNL :: [String] -> (String -> V.Vector String) -> Preapp -> V.Vector ([Int] -> Int) ->  (String -> [Int]) -> String -> Uniqueness+uniqMaxPoetical2GNL whspss g rr vN = uniqMaxPoetical2GN whspss g rr (V.length vN) vN+{-# INLINE uniqMaxPoetical2GNL #-}+  +-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoetical2GN', but prints more information for debugging and tuning purposes. +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 -> do +       { putStrLn ((filter (not . isPunctuation) . lastFrom3 $ x)) +       ; putStrLn . show . firstFrom3 $ x+       ; putStrLn . show . secondFrom3 $ x}) v+     else (uniqInMaxPoeticalN k vN (U v) >>= uniqNPoeticalN (n - 1) k vN)++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoetical2GNL', but prints more information for debugging and tuning purposes. +uniqNPoetical2GNL :: Preapp -> Int -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> IO ()+uniqNPoetical2GNL rr n vN = uniqNPoetical2GN rr n (V.length vN) vN+{-# INLINE uniqNPoetical2GNL #-}+ +-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoetical2VGN', but prints more information for debugging and tuning purposes. +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))++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoetical2VGNL', but prints more information for debugging and tuning purposes. +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 #-}+ +-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalUGN_', but prints more information for debugging and tuning purposes. +uniqNPoeticalUGN_ :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalUGN_ whspss g rr x n k vN = uniqNPoetical2GN rr n k vN (uniquenessPeriods2 whspss g x)+{-# INLINE uniqNPoeticalUGN_ #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalUGNL_', but prints more information for debugging and tuning purposes. +uniqNPoeticalUGNL_ :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalUGNL_ whspss g rr x n vN = uniqNPoetical2GNL rr n vN (uniquenessPeriods2 whspss g x)+{-# INLINE uniqNPoeticalUGNL_ #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalUGN', but prints more information for debugging and tuning purposes. +uniqNPoeticalUGN :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalUGN whspss g rr x n k vN = uniqNPoetical2VGN rr n k vN (uniquenessPeriods2 whspss g x)+{-# INLINE uniqNPoeticalUGN #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalUGNL', but prints more information for debugging and tuning purposes. +uniqNPoeticalUGNL :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> V.Vector ([Int] -> Int) -> UniqG -> String -> IO UniqG+uniqNPoeticalUGNL whspss g rr x n vN = uniqNPoetical2VGN rr n (V.length vN) vN (uniquenessPeriods2 whspss g x)+{-# INLINE uniqNPoeticalUGNL #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalUGN51_', but prints more information for debugging and tuning purposes. +uniqNPoeticalUGN51_ :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> String -> IO ()+uniqNPoeticalUGN51_ whspss g rr x n = uniqNPoeticalUGN_ whspss g rr x n 1 (V.singleton norm51)+{-# INLINE uniqNPoeticalUGN51_ #-}++-- | Behaves like the function 'DobutokO.Poetry.Languages.General.uniqNPoeticalUGN51', but prints more information for debugging and tuning purposes. +uniqNPoeticalUGN51 :: [String] -> (String -> V.Vector String) -> Preapp -> Int -> Int -> UniqG -> String -> IO UniqG+uniqNPoeticalUGN51 whspss g rr x n = uniqNPoeticalUGN whspss g rr x n 1 (V.singleton norm51)+{-# INLINE uniqNPoeticalUGN51 #-}

+ DobutokO/Poetry/Languages/UniquenessPeriodsG.hs view

@@ -0,0 +1,80 @@+-- |+-- Module      :  DobutokO.Poetry.Languages.UniquenessPeriodsG+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Helps to order the 7 or less words (or their concatenations) +-- to obtain (to some extent) suitable for poetry or music text. This module +-- provides a functionality to define more complex uniquenessPeriods functions.+-- For all the used conversion functions of the type @g :: String -> Vector String@ +-- it is important that they are stable for the repeated application (their result after +-- the first application cannon be changed by the rules in the function into new variants). +-- Otherwise, the recursive scheme of the functions in the module will lead to wrong results.+-- So the conversion function should work the following way (@xs@ denotes a word in the language) in GHCi: +--+-- > let v = g xs+-- > let ys = concat . toList $ v +-- > let v2 = g ys+-- > v == v2+-- > True+-- +-- Or in the other words, for the single word, @g . concat . toList . g = g@;+-- ++{-# LANGUAGE CPP #-}++module DobutokO.Poetry.Languages.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 String.UniquenessPeriodsG++#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 '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.+-- The first argument must be a list of 'String', +-- each of which is a representation for the white space (or more generally, non-sound symbol representation). The second argument is a function that +-- converts a 'String' of the text into the 'V.Vector' of sound representations for that language. +uniquenessPeriods2 :: [String] -> (String -> V.Vector String) -> Int -> String -> [Int]+uniquenessPeriods2 whspss g x = uniqueness2n (show7snc whspss) (length) x . uniqueness2 (show7s6 whspss g) (uniquenessP2)++-- | Parameterized way to prepare the result that can be used with 'uniqueness2n'. +uniqueness2 :: (String -> [[String]]) -> ([[String]] -> [[String]]) -> String -> ([[String]],[String])+uniqueness2 f h xs + | null xs = ([],[])+ | otherwise = +    let ys = f xs+        y2s = mconcat . h $ 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.Poetry.Norms.splitNorm'.+uniqueness2n :: ([String] -> [Int]) -> ([String] -> Int) -> Int -> ([[String]], [String]) -> [Int]+uniqueness2n h f2 x (ys,y2s) + | x == 0 = fmap f2 ys ++ (0:h y2s)+ | otherwise = fmap f2 ys ++ h y2s++-- | Filters a given arguments so that each element 'String' in the result is filtered from the element, which is doubled the first in the next 'String' +-- (usually, it equals to the head of it, if used as expected). Can be interpreted as a preparation to the second application of the 'uniquenessPeriods' +-- function because it removes the elements that splitted the input into lists and can be seen as a second deeper (so, probably less significant) factor +-- of the uniqueness phonetical structure. +uniquenessP2 :: [[String]] -> [[String]]+uniquenessP2 (yss:ysss) +  | null ysss = [yss]+  | otherwise = if length yss == 1 then uniquenessP2 ysss else (yss \\ [mconcat . take 1 . mconcat . take 1 $ ysss]):uniquenessP2 ysss+uniquenessP2 _ = []

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2020 OleksandrZhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ README.md view

@@ -0,0 +1,47 @@+The package is a generalisation for the functionality of the library of +the [https://hackage.haskell.org/package/dobutokO-poetry](dobutokO-poetry) +package not only for the Ukrainian, but also for other languages (may be +for some of them because of their peculiarities it is not suitable).++-----------------------------------------------------------++There are different languages. They have different structure and rules. +But there is a possibility to create and use the "phonetic" language more suitable +for poetry and music. Even there can be different variants of the phonetic +language. This work proposes to create at least two +new "phonetic" languages on the another known one 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) +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 phonetic +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 valuable.++Ukrainian (for which the functionality here is provided first of all, see+the mentioned dobutokO-poetry package) 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 "phonetic" languages +where phonetics is of more importance than the grammar, then you +can evaluate the phonetic 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ dobutokO-poetry-general-languages.cabal view

@@ -0,0 +1,26 @@+-- Initial dobutokO-poetry.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                dobutokO-poetry-general-languages+version:             0.1.0.0+synopsis:            Helps to order the 7 or less words to obtain somewhat suitable for poetry or music text+description:         Helps to order the 7 or less words (or their concatenations) to obtain somewhat suitable for poetry or music text. Can be also used as a research instrument with generalized functions.++homepage:            https://hackage.haskell.org/package/dobutokO-poetry-general-languages+license:             MIT+license-file:        LICENSE+author:              OleksandrZhabenko+maintainer:          olexandr543@yahoo.com+copyright:           Oleksandr Zhabenko+category:            Language, Game+build-type:          Simple+extra-source-files:  ChangeLog.md, README.md+cabal-version:       >=1.10++library+  exposed-modules:     DobutokO.Poetry.Languages.UniquenessPeriodsG, DobutokO.Poetry.Languages.General, DobutokO.Poetry.Languages.General.Debug+  -- other-modules:+  other-extensions:    CPP+  build-depends:       base >=4.7 && <4.15, vector >=0.11 && <0.14, mmsyn3 >=0.1.5 && <1, mmsyn6ukr >=0.8 && <1, uniqueness-periods-general >=0.1 && <1, dobutokO-poetry-general >=0.1 && <1+  -- hs-source-dirs:+  default-language:    Haskell2010