dobutokO-poetry 0.4.0.0 → 0.5.0.0

raw patch · 5 files changed

+157/−16 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• DobutokO/Poetry.hs +25/−4
• DobutokO/Poetry/Norms.hs +41/−9
• DobutokO/Poetry/UniquenessPeriodsG.hs +82/−0
• dobutokO-poetry.cabal +3/−3

@@ -25,3 +25,9 @@  * Fourth version. Changed the module structure to simplify the usage in research purposes. Added new generalized variants of the functions with different norms and different String -> [Int] conversion functions. Some documentation improvements.++## 0.5.0.0 -- 2020-06-04++* Fifth version. Fixed issues with inappropriate message information in some functions. Added new norms and possibility to use non-negative lists and to+split them to make possible a technique of multiple metrics united in one function. Added generalized variant of the 'uniquenessPeriods' and some additional +functions to work with String data in Ukrainian. Some minor code improvements.

@@ -6,7 +6,8 @@ -- 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.+-- 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 #-} @@ -39,18 +40,22 @@   -- ** Main ones   , uniqNPoetical2GN   , uniqNPoetical2VGN+  , uniqNPoeticalUGN_+  , uniqNPoeticalUGN+  , uniqNPoeticalUGN51_+  , uniqNPoeticalUGN51   -- ** Additional functions   , uniquenessVariants2GN   , uniqMaxPoetical2GN ) where -import Control.Monad 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  type Uniqueness = ([Int],V.Vector Int,String) @@ -249,7 +254,7 @@ -- minus 1, then less significant is the next to the left norm and so on. uniqMaxPoetical2GN :: Int -> V.Vector ([Int] -> Int) ->  (String -> [Int]) -> String -> Uniqueness uniqMaxPoetical2GN k vN g xs - | compare k (V.length vN) == GT = error "DobutokO.Poetry.Uniqueness.uniqMaxPoetical2GN: undefined for that amount of norms. "+ | compare k (V.length vN) == GT = error "DobutokO.Poetry.uniqMaxPoetical2GN: undefined for that amount of norms. "  | compare k 0 == GT =     let vM = uniquenessVariants2GN vN g xs        maxK = V.maximumBy (\(_,vN0,_) (_,vN1,_) -> compare (V.unsafeIndex vN0 (k - 1)) (V.unsafeIndex vN1 (k - 1))) vM@@ -260,7 +265,7 @@ -- | The same as 'uniqMaxPoetical2GN' but applied to the other last argument. Is used inside the former one. uniqMaxPoeticalGNV :: Int -> V.Vector ([Int] -> Int) ->  V.Vector Uniqueness -> Uniqueness uniqMaxPoeticalGNV k vN vM - | compare k (V.length vN) == GT = error "DobutokO.Poetry.Uniqueness.uniqMaxPoeticalGNV: undefined for that amount of norms. "+ | compare k (V.length vN) == GT = error "DobutokO.Poetry.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))) vM        vK = V.filter (\(_,vN2,_) -> V.unsafeIndex vN2 (k - 1) == ((\(_,vNk,_) -> V.unsafeIndex vNk (k - 1)) maxK)) vM in @@ -284,3 +289,19 @@  | otherwise = do     let v = uniquenessVariants2GN vN g xs    if compare (V.length v) n == LT then return v else uniqNPoeticalVN n k vN v++-- | Variant of the 'uniqNPoetical2GN', which uses as a function 'uniquenessPeriods2' with the first argument equal to the first 'Int' argument.+uniqNPoeticalUGN_ :: Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO ()+uniqNPoeticalUGN_ x n k vN = uniqNPoetical2GN n k vN (uniquenessPeriods2 x) ++-- | Variant of the 'uniqNPoetical2VGN', which uses as a function 'uniquenessPeriods2' with the first argument equal to the first 'Int' argument.+uniqNPoeticalUGN :: Int -> Int -> Int -> V.Vector ([Int] -> Int) -> String -> IO (V.Vector Uniqueness)+uniqNPoeticalUGN x n k vN = uniqNPoetical2VGN n k vN (uniquenessPeriods2 x)++-- | Variant of the 'uniqNPoeticalUGN_', which uses as a single norm 'norm51'.+uniqNPoeticalUGN51_ :: Int -> Int -> String -> IO ()+uniqNPoeticalUGN51_ x n = uniqNPoeticalUGN_ x n 1 (V.singleton norm51)++-- | Variant of the 'uniqNPoeticalUGN', which uses as a single norm 'norm51'.+uniqNPoeticalUGN51 :: Int -> Int -> String -> IO (V.Vector Uniqueness)+uniqNPoeticalUGN51 x n = uniqNPoeticalUGN x n 1 (V.singleton norm51)

@@ -6,9 +6,9 @@ -- 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.--+-- to obtain (to some extent) suitable for poetry or music text. This module +-- provides several different norms that allow to research the text and +-- to create interesting sequences.  module DobutokO.Poetry.Norms (   -- * Different norms@@ -17,40 +17,72 @@   , norm3   , norm4   , norm5+  , norm51+  , norm513   , norm6+  , splitNorm ) where  import qualified Data.Vector as V import Data.List ((\\)) --- | The first norm for the list of positive 'Int'. For not empty lists equals to the maximum element.+-- | The first norm for the list of non-negative 'Int'. For not empty lists equals to the maximum element. norm1 :: [Int] -> Int  norm1 xs    | null xs = 0   | otherwise = maximum xs --- | The second norm for the list of positive 'Int'. For not empty lists equals to the sum of the elements.+-- | 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  --- | The third norm for the list of positive 'Int'. For not empty lists equals to the sum of the doubled maximum element and the rest elements of the list.+-- | 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   | null xs = 0  | otherwise = maximum xs + sum xs --- | The fourth norm for the list of positive 'Int'. Equals to the sum of the 'norm3' and 'norm2'.+-- | The fourth norm for the list of non-negative 'Int'. Equals to the sum of the 'norm3' and 'norm2'. norm4 :: [Int] -> Int norm4 xs   | null xs = 0  | otherwise = maximum xs + sum xs + maximum (xs \\ [maximum xs]) --- | The fifth norm for the list of positive 'Int'. For not empty lists equals to the sum of the elements quoted with sum of the two most minimum elements.+-- | 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   | null xs = 0+ | minimum xs == 0 = let ys = filter (/= 0) xs in norm5 ys  | otherwise = sum xs `quot` (minimum xs + minimum (xs \\ [minimum xs])) --- | The sixth norm for the list of positive 'Int'.+-- | 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 + | 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]))+ | otherwise = (3 * sum xs) `quot` (minimum xs + minimum (xs \\ [minimum xs]))++-- | 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 + | 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]))+ | otherwise = +   let zs = xs \\ [minimum xs] in (3 * sum xs) `quot` (minimum xs + minimum zs + minimum (zs \\ [minimum zs]))++-- | The sixth norm for the list of non-negative 'Int'. norm6 :: [Int] -> Int norm6 xs = floor (fromIntegral (norm5 xs * sum xs) / fromIntegral (norm3 xs))++-- | 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 +-- from the last element in the vector right-to-left.+splitNorm :: [Int] -> V.Vector ([Int] -> Int) -> [Int]+splitNorm xs vN + | null (filter (/=0) xs) || V.length vN /= length (filter (== 0) xs) + 1 = []+ | otherwise = +    let (ys,zs) = break (== 0) xs +        zzs = drop 1 zs+        in (V.unsafeIndex vN (V.length vN - 1)) ys:splitNorm zzs (V.unsafeSlice 0 (V.length vN - 1) vN)

@@ -0,0 +1,82 @@+-- |+-- Module      :  DobutokO.Poetry.UniquenessPeriodsG+-- 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. This module +-- provides a functionality to define more complex uniquenessPeriods functions.++module DobutokO.Poetry.UniquenessPeriodsG where++import qualified Data.Vector as V+import Data.List ((\\),nubBy)+import MMSyn7s+import Melodics.Ukrainian (convertToProperUkrainian)++-- | 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.+uniquenessPeriods2 :: Int -> String -> [Int]+uniquenessPeriods2 x = uniqueness2n (show7snc) (length) x . uniqueness2 (show7sn6) (uniquenessP2)++-- | Parameterized way to prepare the result that can be used with 'uniqueness2n'.+uniqueness2 :: (String -> [[String]]) -> ([[String]] -> [[String]]) -> String -> ([[String]],[String])+uniqueness2 f g xs + | null xs = ([],[])+ | otherwise = +    let ys = f xs+        y2s = concat . 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'.+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++-- | The same as @show7s'''@, but the order of the 'String' in the first list in the tuple is preserved and corresponds to the order of +-- the sounds in the given list of 'String'.+show7sn''' :: [String] -> ([String],String)+show7sn''' zss =+  let (xss, yss) = splitAt 68 zss+      uss = xss \\ nubBy eqSnds xss+      (wss,vss) = if null uss then (xss,[]) else (takeWhile (/= head uss) xss ++ head uss:(takeWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss),+        dropWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss) in +          (filter (\x -> x /= "-" && x /= "1" && x /= "0") $ wss, listToString $ vss ++ yss)++-- | The same as @show7sn'''@, but does not concatenate the list of 'String' as the second tuple's element.+show7sn4' :: [String] -> ([String],[String])+show7sn4' zss =+  let (xss, yss) = splitAt 68 zss+      uss = xss \\ nubBy eqSnds xss+      (wss,vss) = if null uss then (xss,[]) else (takeWhile (/= head uss) xss ++ head uss:(takeWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss),+        dropWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss) in +          (filter (\x -> x /= "-" && x /= "1" && x /= "0") $ wss, vss ++ yss)          ++-- | The same as 'show7s5', but the the order of the 'String' in the first list in the tuple is preserved and corresponds to the order of +-- the sounds in the given text.+show7sn5 :: String -> ([String], String)+show7sn5 = show7sn''' . V.toList . convertToProperUkrainian++-- | The same as 'show7s6', but the the order of the 'String' in the inner list is preserved and corresponds to the order of +-- the sounds in the given text.+show7sn6 :: String -> [[String]]+show7sn6 t@(_:_) = (fst . show7sn5 $ t):(show7sn6 . snd . show7sn5 $ t)+show7sn6 _ = []++-- | Converts a list of Ukrainian 'String' each one being a Ukrainian non-silent sound representation into a list of 'Int' using recursively @show7sn4'@. +show7snc :: [String] -> [Int]+show7snc xss = let (tss,vss) = show7sn4' xss in if null vss then [length tss] else length tss:show7snc vss++-- | 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 \\ [concat . take 1 . concat . take 1 $ ysss]):uniquenessP2 ysss+uniquenessP2 _ = []

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dobutokO-poetry-version:             0.4.0.0+version:             0.5.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. @@ -18,7 +18,7 @@ cabal-version:       >=1.10  library-  exposed-modules:     DobutokO.Poetry, DobutokO.Poetry.Norms, DobutokO.Poetry.Auxiliary, Main+  exposed-modules:     DobutokO.Poetry, DobutokO.Poetry.Norms, DobutokO.Poetry.Auxiliary, DobutokO.Poetry.UniquenessPeriodsG, Main   -- other-modules:   other-extensions:    BangPatterns   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@@ -27,7 +27,7 @@  executable dobutokO-poetry   main-is:             Main.hs-  other-modules:       DobutokO.Poetry, DobutokO.Poetry.Norms, DobutokO.Poetry.Auxiliary+  other-modules:       DobutokO.Poetry, DobutokO.Poetry.Norms, DobutokO.Poetry.Auxiliary, DobutokO.Poetry.UniquenessPeriodsG   other-extensions:    BangPatterns   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: