diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..360bc7b --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,38 @@ +# Revision history for uniqueness-periods-vector-common + +## 0.1.0.0 -- 2020-08-30 + +* First version. Released on an unsuspecting world. + +## 0.2.0.0 -- 2020-09-09 + +* Second version. Fixed issue with the wrong arguments order in the Languages.UniquenessPeriods.Vector.StrictV.uniquenessVariants2GN function. + +## 0.3.0.0 -- 2020-09-12 + +* Third version. Changed the Languages.UniquenessPeriods.Vector.Data module so that the uniqueness-periods-vector-general package can be fixed and rewritten to +follow the requirements. These changes break the previous behaviour, so check the code. + +## 0.4.0.0 -- 2020-09-28 + +* Fourth version. Simplified the uniquenessVariants2GNP function so that it does not use backpermute function from Data.Vector and permutations from Data.List simultanously. + +## 0.4.1.0 -- 2020-10-06 + +* Fourth version revised A. Fixed issue with being concatenated lists without whitespaces in the Languages.UniquenessPeriods.Vector.StrictV.uniquenessVariants2GNP function. + +## 0.5.0.0 -- 2020-10-09 + +* Fifth version. Added a new data type FuncRep a b c to Languages.UniquenessPeriods.Vector.Data module to avoid significant code duplication with further usage. Switched the +needed functionality to the new data type variant. + +## 0.5.1.0 -- 2020-10-12 + +* Fifth version revised A. Fixed issue with unnecessary application of the Data.List.intercalate function in the Languages.UniquenessPeriods.Vector.StrictV module that led to +inconsistency and (some) divergence in the functions with applied uniquenessVariants2GNP. + +## 0.5.1.1 -- 2020-10-14 + + +* Fifth version revised B. Some minor code improvements. + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..2eaab6b --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Languages/UniquenessPeriods/Vector/Auxiliary.hs b/Languages/UniquenessPeriods/Vector/Auxiliary.hs new file mode 100644 index 0000000..1abcd54 --- /dev/null +++ b/Languages/UniquenessPeriods/Vector/Auxiliary.hs @@ -0,0 +1,31 @@ +-- | +-- Module : Languages.UniquenessPeriods.Vector.Auxiliary +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Is from the @dobutokO-poetry-general@ package. Is included here +-- to minimize dependencies of the package. +-- Similar functionality is provided by the packages MissingH, extra, ghc +-- and other packages, but they have a lot of dependencies, so here there are +-- less dependencies module and package. + +module Languages.UniquenessPeriods.Vector.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 #-} diff --git a/Languages/UniquenessPeriods/Vector/Data.hs b/Languages/UniquenessPeriods/Vector/Data.hs new file mode 100644 index 0000000..2c8e3cb --- /dev/null +++ b/Languages/UniquenessPeriods/Vector/Data.hs @@ -0,0 +1,79 @@ +-- | +-- Module : Languages.UniquenessPeriods.Vector.Data +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Is a generalization of the DobutokO.Poetry.Data module +-- functionality from the @dobutokO-poetry-general@ package. +-- + +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module Languages.UniquenessPeriods.Vector.Data where + +import Data.Maybe (fromJust) +import qualified Data.Vector as V +import Languages.UniquenessPeriods.Vector.Auxiliary (lastFrom3) + +type UniquenessG1 a b = ([b],V.Vector b,[a]) + +-- | The list in the 'PA' variant represent the prepending @[a]@ and the postpending one respectively. 'K' constuctor actually means no prepending and +-- postpending (usually of the text). Are used basically to control the behaviour of the functions. +data PreApp a = K | PA [a] [a] deriving Eq + +class UGG1 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 Eq a => UGG1 (PreApp a) a 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 a = PreApp a + +isPA :: PreApp a -> Bool +isPA K = False +isPA _ = True + +isK :: PreApp a -> Bool +isK K = True +isK _ = False + +data UniquenessG2 a b = UL2 ([a],b) deriving Eq + +instance (Show a, Show b) => Show (UniquenessG2 (UniquenessG1 a b) (V.Vector (UniquenessG1 a b))) where + show (UL2 (ws,_)) = show ws + +type UniqG2 a b = UniquenessG2 (UniquenessG1 a b) (V.Vector (UniquenessG1 a b)) + +get22 :: UniqG2 a b -> ([UniquenessG1 a b], V.Vector (UniquenessG1 a b)) +get22 (UL2 (ws, x)) = (ws, x) + +-- | Is used to avoid significant code duplication. +data FuncRep a b c = U1 (a -> c) | D2 (a -> b) (b -> c) + +getAC :: FuncRep a b c -> (a -> c) +getAC (U1 f) = f +getAC (D2 g1 g2) = g2 . g1 + +isU1 :: FuncRep a b c -> Bool +isU1 (U1 _) = True +isU1 _ = False + +isD2 :: FuncRep a b c -> Bool +isD2 (D2 _ _) = True +isD2 _ = False + diff --git a/Languages/UniquenessPeriods/Vector/StrictV.hs b/Languages/UniquenessPeriods/Vector/StrictV.hs new file mode 100644 index 0000000..930750e --- /dev/null +++ b/Languages/UniquenessPeriods/Vector/StrictV.hs @@ -0,0 +1,102 @@ +-- | +-- Module : Languages.UniquenessPeriods.Vector.StrictV +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- Generalization of the DobutokO.Poetry.StrictV module functionality from +-- the @dobutokO-poetry-general@ package. +-- Can be used to get possible permutations of no more than 7 sublists +-- in the list separated with the elements of the \"whitespace symbols\" +-- list. + +{-# LANGUAGE CPP, BangPatterns #-} + +module Languages.UniquenessPeriods.Vector.StrictV ( + uniquenessVariants2GN + , uniquenessVariants2GNP + , sublistsG + , preAppend +) 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 +#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 qualified Data.List as L (permutations) +import Languages.UniquenessPeriods.Vector.Data + +#ifdef __GLASGOW_HASKELL__ +#if __GLASGOW_HASKELL__==708 +/* code that applies only to GHC 7.8.* */ +mconcat = concat +#endif +#endif + +-- | Given a [a] consisting of no more than 7 sublists interspersed with the elements of the first argument, +-- it returns a 'V.Vector' of possible combinations without repeating of the sublists in different order and for each of them appends also +-- the information about generalized \"uniqueness periods\" (see @uniqueness-periods-vector@ package) to it and finds out +-- some different metrics -- named \"properties\". +-- +-- Afterwards, depending on these norms some (usually phonetic for the words) properties of the sublists can be specified that +-- allow to use them for special cases of repetitions (usually, for the words -- poetically or to create a varied melody with them). +uniquenessVariants2GN :: + (Eq a, Ord b) => [a] + -> V.Vector ([b] -> b) + -> FuncRep [a] (V.Vector c) [b] -- ^ Since version 0.5.0.0 it includes the previous variant with data constructor 'D2', but additionally allows to use just single argument with data constructor 'U1' + -> [a] + -> V.Vector ([b],V.Vector b, [a]) +uniquenessVariants2GN whspss vN frep !xs = uniquenessVariants2GNP [] [] whspss vN frep xs +{-# INLINE uniquenessVariants2GN #-} + +-- | Generalized variant of 'uniquenessVariants2GN' with prepending and appending @[a]@ (given as the first and the second argument). +uniquenessVariants2GNP :: + (Eq a, Ord b) => [a] + -> [a] + -> [a] + -> V.Vector ([b] -> b) + -> FuncRep [a] (V.Vector c) [b] -- ^ Since version 0.5.0.0 it includes the previous variant with data constructor 'D2', but additionally allows to use just single argument with data constructor 'U1' + -> [a] + -> V.Vector ([b],V.Vector b, [a]) +uniquenessVariants2GNP !ts !us whspss vN frep !xs + | null . sublistsG whspss $ xs = V.empty + | not . null $ whspss = + let !hd = head whspss + !ns = take 8 . sublistsG whspss $ xs + !uss = [hd:us] in + V.fromList . map ((\vs -> let !rs = getAC frep $ vs in (rs, (V.map (\f -> f rs) vN), vs)) . mconcat . preAppend ts uss) . + L.permutations . map (hd:) $ ns + | otherwise = error "Languages.UniquenessPeriods.Vector.StrictV.uniquenessVariants2GNP: undefined for the empty third argument. " + +-- | Inspired by: https://hackage.haskell.org/package/base-4.14.0.0/docs/src/Data.OldList.html#words +sublistsG :: Eq a => [a] -> [a] -> [[a]] +sublistsG whspss xs = + case dropWhile (`elem` whspss) xs of + [] -> [] + s' -> w : sublistsG whspss s'' + where (w, s'') = break (`elem` whspss) s' + +-- | Prepends and appends the given two first arguments to the third one. +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 #-} diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/uniqueness-periods-vector-common.cabal b/uniqueness-periods-vector-common.cabal new file mode 100644 index 0000000..6bac81e --- /dev/null +++ b/uniqueness-periods-vector-common.cabal @@ -0,0 +1,25 @@ +-- Initial uniqueness-periods-vector-common.cabal generated by cabal init. +-- For further documentation, see http://haskell.org/cabal/users-guide/ + +name: uniqueness-periods-vector-common +version: 0.5.1.1 +synopsis: Generalization of the dobutokO-poetry-general package functionality +description: Generalization of the dobutokO-poetry-general package functionality. Can be used to rearrange 7 sublists in the list to obtain somewhat more suitable list for some purposes. +homepage: https://hackage.haskell.org/package/uniqueness-periods-vector-common +license: MIT +license-file: LICENSE +author: OleksandrZhabenko +maintainer: olexandr543@yahoo.com +copyright: Oleksandr Zhabenko +category: Language, Game, Math +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +library + exposed-modules: Languages.UniquenessPeriods.Vector.StrictV, Languages.UniquenessPeriods.Vector.Data, Languages.UniquenessPeriods.Vector.Auxiliary + -- other-modules: + other-extensions: CPP, BangPatterns, FlexibleInstances, MultiParamTypeClasses + build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14 + -- hs-source-dirs: + default-language: Haskell2010