packages feed

dobutokO-poetry-general (empty) → 0.1.0.0

raw patch · 10 files changed

+513/−0 lines, 10 filesdep +basedep +mmsyn3dep +mmsyn6ukrsetup-changed

Dependencies added: base, mmsyn3, mmsyn6ukr, mmsyn7s, vector

Files

+ ChangeLog.md view
@@ -0,0 +1,6 @@+# Revision history for dobutokO-poetry-general++## 0.1.0.0 -- 2020-08-16++* First version. Released on an unsuspecting world.+
+ DobutokO/Poetry/Auxiliary.hs view
@@ -0,0 +1,31 @@+-- |+-- Module      :  DobutokO.Poetry.Auxiliary+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Helps to order the 7 or less (in the first version Ukrainian) words (or their concatenations) +-- to obtain (to some extent) suitable for poetry or music text. +-- Similar functionality is provided by the packages MissingH, extra, ghc +-- and other packages, but they have a lot of dependencies, so here there are +-- lessel dependencies module and package.++module DobutokO.Poetry.Auxiliary (+  -- * Help functions+  lastFrom3+  , firstFrom3+  , secondFrom3+) where++lastFrom3 :: (a,b,c) -> c+lastFrom3 (_,_,z) = z+{-# INLINE lastFrom3 #-}++firstFrom3 :: (a, b, c) -> a+firstFrom3 (x, _, _) = x+{-# INLINE firstFrom3 #-}++secondFrom3 :: (a, b, c) -> b+secondFrom3 (_, y, _) = y+{-# INLINE secondFrom3 #-}
+ DobutokO/Poetry/Data.hs view
@@ -0,0 +1,84 @@+-- |+-- Module      :  DobutokO.Poetry.Data+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Helps to order the 7 or less (in the first version Ukrainian) words (or their concatenations) +-- to obtain (to some extent) suitable for poetry or music text. +-- This module contains data types needed for some generalizations.+-- ++{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++module DobutokO.Poetry.Data where++import Data.Maybe (fromJust)+import Data.Char (isPunctuation)+import qualified Data.Vector as V+import DobutokO.Poetry.Auxiliary (lastFrom3)++type Uniqueness = ([Int],V.Vector Int,String)++-- | 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+
+ DobutokO/Poetry/Norms.hs view
@@ -0,0 +1,182 @@+-- |+-- Module      :  DobutokO.Poetry.Norms+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Helps to order the 7 or less (in the first version the Ukrainian) words (or their concatenations) +-- 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+  norm1+  , norm2+  , norm3+  , norm4+  , norm5+  , norm51+  , norm513+  , norm54+  , norm6+  , norm6r+  , norm8+  -- * Norms combining+  , splitNorm+  -- ** More complex combining+  , combineNorms+  , flSplitNorms+  , normSplit+  , normSplitWeighted+  , normSplitShifted+  , normSplitWeightedG+) where++import qualified Data.Vector as V+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 +  | 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+{-# 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 + | 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 + | null xs = 0+ | length xs == 1 = head xs+ | 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 + | null xs = 0+ | length xs == 1 = head xs+ | minimum xs == 0 = norm5 . filter (/= 0) $ xs+ | otherwise = sum xs `quot` (minimum xs + minimum (xs \\ [minimum xs]))+{-# INLINE norm5 #-} ++-- | 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 +    case length ys of+      0 -> sum xs+      1 -> (3 * sum xs) `quot` (minimum ys + maximum ys)+      _ -> (3 * sum xs) `quot` (minimum ys + minimum (ys \\ [minimum ys]))+ | length xs == 1 = 1+ | 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 + | null xs = 0+ | compare (minimum xs) 1 /= GT = +   let ys = filter (\t -> compare t 1 == GT) xs in +     case length ys of +       0 -> sum xs+       1 -> (3 * sum xs) `quot` (minimum ys + maximum ys)+       2 -> let zs = ys \\ [minimum ys] in (3 * sum xs) `quot` (minimum ys + 2 * minimum zs)+       _ -> let zs = ys \\ [minimum ys] in (3 * sum xs) `quot` (minimum ys + minimum zs + minimum (zs \\ [minimum zs]))+ | otherwise = +   let zs = xs \\ [minimum xs] in +     case length zs of +       0 -> sum xs+       1 -> (3 * sum xs) `quot` (minimum zs + maximum zs)+       2 -> let ts = zs \\ [minimum zs] in (3 * sum xs) `quot` (minimum zs + 2 * minimum ts)+       _ -> let ts = zs \\ [minimum zs] in (3 * sum xs) `quot` (minimum zs + minimum ts + minimum (ts \\ [minimum ts]))+{-# INLINE norm513 #-}   ++-- | The sixth norm for the list of non-negative 'Int'.+norm6 :: [Int] -> Int+norm6 xs = (norm5 xs * sum xs) `quot` norm3 xs+{-# INLINE norm6 #-}++-- | The sixth modified norm for the list of non-negative 'Int'.+norm6r :: [Int] -> Int+norm6r xs = (norm513 xs * norm3 xs) `quot` sum xs+{-# INLINE norm6r #-}++-- | The fifth-fourth norm for the list of non-negative 'Int'. Tries to generate more suitable for poetry text.+norm54 :: [Int] -> Int+norm54 xs = (norm513 xs * norm6r xs) `quot` norm4 xs+{-# INLINE norm54 #-}++-- | The eigth norm for the list of the non-negative 'Int'. Similarly to 'norm4' is used to quickly evaluate the possibly more diverse texts, +-- which are not simple to quickly pronounce. Is not informative (and therefore, is not intended to be used) for the lists of no more than 1 element.+norm8 :: [Int] -> Int+norm8 xs + | null xs = 0+ | length xs == 1 = 1+ | otherwise =  (5040 * maximum xs) `quot` minimum xs+{-# INLINE norm8 #-} ++-- | 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)+        +-- | Applies all the given norms in the 'V.Vector' to the first argument and collects the result as a list.+combineNorms :: [Int] -> V.Vector ([Int] -> Int) -> [Int]+combineNorms xs vN + | null xs = []+ | otherwise = V.toList . V.map (\f -> f xs) $ vN++-- | The flipped variant of the 'combineNorms' (can be more convenient for applications).+flSplitNorms :: V.Vector ([Int] -> Int) -> [Int] -> [Int]+flSplitNorms = flip combineNorms+{-# INLINE flSplitNorms #-}++-- | Using 'combineNorms' and given a group of norms (represented as a 'V.Vector') returns the sum of their applications. These norms are equally important +-- and their order can be volatile.+normSplit :: V.Vector ([Int] -> Int) -> ([Int] -> Int)+normSplit v = sum . flSplitNorms v+{-# INLINE normSplit #-}++-- | Using 'combineNorms' and given a group of norms (represented as a 'V.Vector') returns the sum of their applications. The importance of these norms can be +-- easily controlled by the first function argument. The corresponding greater numbers in the first argument list signify the greater importance of the +-- norm in the 'V.Vector' of norms all being applied (so these numbers are multiplicative weights in the sum). If some of the numbers are equal to zero then +-- the corresponding norm is not taken into account. If some of the numbers are negative then the corresponding norms are weightly subtracted from the sum.+normSplitWeighted :: [Int] -> V.Vector ([Int] -> Int) -> ([Int] -> Int)+normSplitWeighted = normSplitWeightedG (*)+{-# INLINE normSplitWeighted #-}++-- | Similar to 'normSplitWeighted', but uses more complex modification instead of multiplication. +-- Using 'splitNorm' and given a group of norms (represented as a 'V.Vector') returns the sum of their applications. The importance of these norms can be +-- controlled by the first function argument. The corresponding greater numbers in the first argument list signify the greater importance of the +-- norm in the 'V.Vector' of norms all being applied. If some of the numbers are negative then the corresponding norms reduces the sum in some way.+normSplitShifted :: [Int] -> V.Vector ([Int] -> Int) -> ([Int] -> Int)+normSplitShifted = normSplitWeightedG (\x y -> x * (x + y))+{-# INLINE normSplitShifted #-}++-- | Generalization for the 'normSplitWeighted' and 'normSplitShifted' with the possibility to define and use the volatile function that influences the +-- weights for the norms in the 'V.Vector'. This function used in the 'zipWith' is given as the first argument.+normSplitWeightedG :: (Int -> Int -> Int) -> [Int] -> V.Vector ([Int] -> Int) -> ([Int] -> Int)+normSplitWeightedG h xs v+ | null xs = \ys -> 0+ | otherwise = let g ts = zipWith h (flSplitNorms v ts) xs in sum . g
+ DobutokO/Poetry/Norms/Extended.hs view
@@ -0,0 +1,55 @@+-- |+-- Module      :  DobutokO.Poetry.Norms.Extended+-- 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. The norms here +-- are more complex and/or use other ones and can be controlled by some additional +-- parameters.++module DobutokO.Poetry.Norms.Extended (+  norm7+  , norm7n+  , norm54n+  , norm45n+) where++import qualified Data.Vector as V+import Data.List ((\\),sort)+import DobutokO.Poetry.Norms++-- | The seventh norm 'norm7' has more complex behaviour. The possible range of the first argument is [1..100]. Is provided for exploration.+norm7 :: Int -> [Int] -> Int+norm7 l xs + | null xs = 0+ | otherwise = +    let n = ((abs l `rem` 101) * length xs) `quot` 10+        m = abs ((length xs `quot` 3) - (n `quot` 2))+        ys = if compare (minimum xs) 1 /= GT then filter (\t -> compare t 1 == GT) xs else xs \\ [minimum xs] in +     if null ys then sum xs else (n * sum xs) `quot` ((sum . take n . sort $ xs) + m * maximum xs)+{-# INLINE norm7 #-}   ++-- | The seventh norm 'norm7n' (the variant of the 'norm7' without the maximum evaluation) has more complex behaviour. The possible range of the +-- first argument is [1..100]. Is provided for exploration.+norm7n :: Int -> [Int] -> Int+norm7n l xs + | null xs = 0+ | otherwise = +    let n = ((abs l `rem` 101) * length xs) `quot` 10 +        ys = if compare (minimum xs) 1 /= GT then filter (\t -> compare t 1 == GT) xs else xs \\ [minimum xs] in +     if null ys then sum xs else (n * sum xs) `quot` (sum . take n . sort $ xs)+{-# INLINE norm7n #-}   ++-- | The fifth-fourth norm for the list of non-negative 'Int'. Is provided for exploration.+norm54n :: Int -> Int -> [Int] -> Int+norm54n n m xs = (norm513 xs ^ n * norm6r xs) `quot` (norm4 xs ^ m)+{-# INLINE norm54n #-}++-- | The fourth-fifth norm for the list of non-negative 'Int'. Is provided for exploration.+norm45n :: Int -> Int -> [Int] -> Int+norm45n n m xs = (norm4 xs ^ n * norm6r xs) `quot` (norm513 xs ^ m)+{-# INLINE norm45n #-}+
+ DobutokO/Poetry/StrictV.hs view
@@ -0,0 +1,59 @@+-- |+-- Module      :  DobutokO.Poetry.StrictV+-- 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. ++{-# LANGUAGE CPP, BangPatterns #-}++module DobutokO.Poetry.StrictV where++#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__>=804+/* code that applies only to GHC 8.4.* and higher versions */+import Data.Semigroup ((<>))+import Prelude hiding ((<>))+#endif+#endif++import qualified Data.Vector as V+import qualified Data.List as L (permutations)++-- | Given a 'String' consisting of no more than 7 words [some of them can be created by concatenation with preserving the +-- pronunciation of the parts, e. g. \"так як\" (actually two correct Ukrainian words and a single conjunction) can be written \"такйак\" +-- (one phonetical Ukrainian word transformed literally with preserving phonetical structure), if you would not like to treat them separately], +-- 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 \"uniqueness periods\" (see @uniqueness-periods-general@ and @uniqueness-periods@ packages) to it and finds out +-- three different metrics -- named \"norms\". +-- +-- 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 +{-# INLINE uniquenessVariants2GN #-}+        +-- | Generalized variant of 'uniquenessVariants2GN' with prepending and appending 'String' (given as the first and the second argument). +uniquenessVariants2GNP :: String -> String -> V.Vector ([Int] -> Int) -> (String -> [Int]) -> String -> V.Vector ([Int],V.Vector 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 . 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__>=804+preAppend ts !uss tss = ts:tss <> uss+#endif+#endif+#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__<804+preAppend ts !uss tss = ts:tss ++ uss+#endif+#endif+{-# INLINE preAppend #-}
+ 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,48 @@+Is a part of previous version of the +[https://hackage.haskell.org/package/dobutokO-poetry-0.11.0.0](dobutokO-poetry) package +version 0.11.0.0. Now is provided as a general package because of the +possibility using the uniqueness-periods and uniqueness-periods-general +packages provide the same functionality for both cases of Ukrainian and +similar languages.++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 spread languages basis, in this work, +the Ukrainian one) 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 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) +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 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.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+version:             0.1.0.0+synopsis:            Helps to order the 7 or less words (first of all the Ukrainian ones) 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+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.StrictV, DobutokO.Poetry.Auxiliary, DobutokO.Poetry.Norms, DobutokO.Poetry.Norms.Extended, DobutokO.Poetry.Data+  -- other-modules:+  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.8 && <1, mmsyn6ukr >=0.8 && <1+  -- hs-source-dirs:+  default-language:    Haskell2010