Update on Hackage

CHANGELOG.md

@@ -0,0 +1,17 @@
+# Revision history for phonetic-languages-constraints
+
+## 0.3.0.1 -- 2020-11-12
+
+* Third version revised A. Fixed incorrect name of the package.
+
+## 0.3.1.0 -- 2020-11-12
+
+* Third version revised B. Changed the names of the modules so that now they are not ambiguous with those analogous ones from the deprecated package phonetic-languages-constaints.
+
+## 0.3.2.0 -- 2020-11-12
+
+* Third version revised C. Fixed issue with inner unneeded sorting and nubbing in the readMaybeEC function.
+
+## 0.4.0.0 -- 2020-11-26
+
+* Fourth version. Switched to more general subG functionality using InsertLeft class and instances. Added, therefore, additional dependencies.

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.

Languages/UniquenessPeriods/Vector/Constraints.hs

@@ -0,0 +1,81 @@
+-- |
+-- Module      :  Languages.UniquenessPeriods.Vector.Constraints
+-- Copyright   :  (c) OleksandrZhabenko 2020
+-- License     :  MIT
+-- Stability   :  Experimental
+-- Maintainer  :  [email protected]
+--
+-- Provides several the most important variants of constraints for the
+-- permutations. All the 'VB.Vector'
+-- here must consists of unique 'Int' starting from 0 to n and the 'Int'
+-- arguments must be in the range [0..n] though these inner constraints are
+-- not checked. It is up to user to check them.
+--
+
+{-# LANGUAGE BangPatterns, FlexibleContexts #-}
+
+module Languages.UniquenessPeriods.Vector.Constraints (
+  -- * Basic predicate
+  unsafeOrderIJ
+  -- * Functions to work with permutations with basic constraints ('VB.Vector'-based)
+  , filterOrderIJ
+  , unsafeTriples
+  , unsafeQuadruples
+  -- ** With multiple elements specified
+  , unsafeSeveralA
+  , unsafeSeveralB
+) where
+
+import qualified Data.Vector as VB
+import Data.Maybe (fromJust)
+import Data.SubG (InsertLeft(..),filterG)
+import Data.SubG.InstancesPlus
+
+-- | Being given the data satisfying the constraints in the module header checks whether in the 'VB.Vector' the first argument stands before the second one.
+unsafeOrderIJ :: Int -> Int -> VB.Vector Int -> Bool
+unsafeOrderIJ i j v = fromJust (VB.findIndex (== i) v) < fromJust (VB.findIndex (== j) v)
+
+-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeOrderIJ' as a predicate.
+filterOrderIJ :: (InsertLeft t (VB.Vector Int), Monoid (t (VB.Vector Int))) => Int -> Int -> t (VB.Vector Int) -> t (VB.Vector Int)
+filterOrderIJ i j = filterG (unsafeOrderIJ i j)
+
+-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
+-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication if the
+-- arguments are the indeces of the duplicated words or their concatenated combinations in the corresponding line.
+-- The first three arguments
+-- are the indices of the the triple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).
+unsafeTriples :: (InsertLeft t (VB.Vector Int), Monoid (t (VB.Vector Int))) => Int -> Int -> Int -> t (VB.Vector Int) -> t (VB.Vector Int)
+unsafeTriples i j k = filterG (\v -> unsafeOrderIJ i j v && unsafeOrderIJ j k v)
+
+-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
+-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication if the
+-- arguments are the indeces of the duplicated words or their concatenated combinations in the corresponding line.
+-- The first four arguments
+-- are the indices of the the quadruple duplicated elements (words or their concatenated combinations in the @phonetic-languages@ series of packages).
+unsafeQuadruples :: (InsertLeft t (VB.Vector Int), Monoid (t (VB.Vector Int))) => Int -> Int -> Int -> Int -> t (VB.Vector Int) -> t (VB.Vector Int)
+unsafeQuadruples i j k l = filterG (\v -> unsafeOrderIJ i j v && unsafeOrderIJ j k v && unsafeOrderIJ k l v)
+
+-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
+-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication.
+-- The first (VB.Vector Int)rgument
+-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument
+-- is 'VB.Vector' of indices that (VB.Vector Int)re in the range [0..n]. Filters (and reduces further complex computtions) the permutations so that only the
+-- variants with the indices in the second argument (VB.Vector Int)ll stand AFTER the element with the index equal to the first (VB.Vector Int)rgument.
+unsafeSeveralA :: (InsertLeft t (VB.Vector Int), Monoid (t (VB.Vector Int))) => Int -> VB.Vector Int -> t (VB.Vector Int) -> t (VB.Vector Int)
+unsafeSeveralA !i0 v1 v2 =
+ let j !i !v = fromJust (VB.findIndex (== i) v) in
+  filterG (\v -> g i0 j v v1) v2
+   where g !i j !v v3 = VB.all (> j i v) . VB.findIndices (`VB.elem` v3) $ v
+
+-- | Being given the data satisfying the constraints in the module header reduces the number of further computations in the foldable structure of
+-- the permutations each one being represented as 'VB.Vector' 'Int' where 'Int' are all the numbers in the range [0..n] without duplication.
+-- The first (VB.Vector Int)rgument
+-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument
+-- is 'VB.Vector' of indices that (VB.Vector Int)re in the range [0..n]. Filters (and reduces further complex computtions) the permutations so that only the
+-- variants with the indices in the second argument (VB.Vector Int)ll stand BEFORE the element with the index equal to the first (VB.Vector Int)rgument.
+unsafeSeveralB :: (InsertLeft t (VB.Vector Int), Monoid (t (VB.Vector Int))) => Int -> VB.Vector Int -> t (VB.Vector Int) -> t (VB.Vector Int)
+unsafeSeveralB !i0 v1 v2 =
+ let j !i !v = fromJust (VB.findIndex (== i) v) in
+  filterG (\v -> g i0 j v v1) v2
+   where g !i j !v v3 = VB.all (< j i v) . VB.findIndices (`VB.elem` v3) $ v
+

Languages/UniquenessPeriods/Vector/Constraints/Encoded.hs

@@ -0,0 +1,180 @@
+-- |
+-- Module      :  Languages.UniquenessPeriods.Vector.Constraints.Encoded
+-- Copyright   :  (c) OleksandrZhabenko 2020
+-- License     :  MIT
+-- Stability   :  Experimental
+-- Maintainer  :  [email protected]
+--
+-- Provides a way to encode the needed constraint with possibly less symbols.
+--
+
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+
+module Languages.UniquenessPeriods.Vector.Constraints.Encoded (
+  -- * Data types
+  EncodedContraints(..)
+  , EncodedCnstrs
+  -- * Functions to work with them
+  -- ** Read functions
+  , readMaybeEC
+  , readMaybeECG
+  -- ** Process-encoding functions
+  , decodeConstraint1
+  , decodeLConstraints
+  -- ** Modifiers and getters
+  , getIEl
+  , setIEl
+  -- ** Predicates
+  , isE
+  , isF
+  , isQ
+  , isT
+  , isSA
+  , isSB
+) where
+
+import Data.Monoid (mappend)
+import Text.Read (readMaybe)
+import Data.Maybe
+import qualified Data.Vector as VB
+--import Data.List
+import Languages.UniquenessPeriods.Vector.Constraints
+import Data.SubG (InsertLeft(..))
+import Data.SubG.InstancesPlus
+
+data EncodedContraints a b = E a | Q a a a a a | T a a a a | SA a a b | SB a a b | F a a a deriving (Eq, Ord)
+
+-- | Inspired by the: https://hackage.haskell.org/package/base-4.14.0.0/docs/Data-Maybe.html
+-- Is provided here as a more general way to read the 'String' into a 'EncodedCnstrs' than more restricted
+-- but safer 'readMaybeECG'. It is up to user to check whether the parameters are in the correct form, the function does
+-- not do the full checking. For phonetic-languages applications, it is better to use 'readMaybeECG' function instead.
+readMaybeEC :: Int -> String -> Maybe EncodedCnstrs
+readMaybeEC n xs
+ | null xs = Nothing
+ | n >=0 && n <= 9 =
+     let h = take 1 xs
+         ts = filter (\x -> x >= '0' && [x] <= show n) . drop 1 $ xs in
+      case h of
+       "E" -> Just (E (fromMaybe 0 (readMaybe (take 1 . tail $ xs)::Maybe Int)))
+       "F" -> let (y,z) = (readMaybe (take 1 ts)::Maybe Int, readMaybe (take 1 . drop 1 $ ts)) in
+         case (y,z) of
+          (Nothing,_) -> Nothing
+          (_,Nothing) -> Nothing
+          ~(Just x1, Just x2) -> Just (F undefined x1 x2)
+       "T" -> let (y,z,u) = (readMaybe (take 1 ts)::Maybe Int, readMaybe (take 1 . drop 1 $ ts)::Maybe Int, readMaybe (take 1 . drop 2 $ ts)::Maybe Int) in
+         case (y,z,u) of
+          (Nothing,_,_) -> Nothing
+          (_,Nothing,_) -> Nothing
+          (_,_,Nothing) -> Nothing
+          ~(Just x1, Just x2, Just x3) -> Just (T undefined x1 x2 x3)
+       "A" -> let y = readMaybe (take 1 ts)::Maybe Int in
+               if isJust y then
+                let y0 = fromJust y
+                    zs = filter (/= y0) . catMaybes . map (\t -> readMaybe [t]::Maybe Int) . drop 1 $ ts in
+                     case zs of
+                       [] -> Nothing
+                       ~x2 -> Just (SA undefined y0 (VB.fromList x2))
+               else Nothing
+       "B" -> let y = readMaybe (take 1 ts)::Maybe Int in
+               if isJust y then
+                let y0 = fromJust y
+                    zs = filter (/= y0) . catMaybes . map (\t -> readMaybe [t]::Maybe Int) . drop 1 $ ts in
+                     case zs of
+                       [] -> Nothing
+                       ~x2 -> Just (SB undefined y0 (VB.fromList x2))
+               else Nothing
+       "Q" -> let (y,z,u,w) = (readMaybe (take 1 ts)::Maybe Int, readMaybe (take 1 . drop 1 $ ts)::Maybe Int, readMaybe (take 1 . drop 2 $ ts)::Maybe Int,
+                    readMaybe (take 1 . drop 3 $ ts)::Maybe Int) in
+         case (y,z,u,w) of
+          (Nothing,_,_,_) -> Nothing
+          (_,Nothing,_,_) -> Nothing
+          (_,_,Nothing,_) -> Nothing
+          (_,_,_,Nothing) -> Nothing
+          ~(Just x1, Just x2, Just x3, Just x4) -> Just (Q undefined x1 x2 x3 x4)
+       _   -> Nothing
+ | otherwise = Nothing
+
+-- | Is used inside 'readMaybeECG' to remove the 'undefined' inside the 'EncodedCnstrs'.
+setWordsN :: Int -> Maybe EncodedCnstrs -> Maybe EncodedCnstrs
+setWordsN _ Nothing = Nothing
+setWordsN _ (Just (E x)) = Just (E x)
+setWordsN n (Just (T _ i j k)) = Just (T n i j k)
+setWordsN n (Just (Q _ i j k l)) = Just (Q n i j k l)
+setWordsN n (Just (SA _ i v)) = Just (SA n i v)
+setWordsN n (Just (SB _ i v)) = Just (SB n i v)
+setWordsN n (Just (F _ i j)) = Just (F n i j)
+
+-- | A safer variant of the 'readMaybeEC' more suitable for applications, e. g. for phonetic-languages series of packages.
+readMaybeECG :: Int -> String -> Maybe EncodedCnstrs
+readMaybeECG n xs
+  | n <= 6 && n >=0 = setWordsN n . readMaybeEC n $ xs
+  | otherwise = Nothing
+
+type EncodedCnstrs = EncodedContraints Int (VB.Vector Int)
+
+-- | Must be applied to the correct vector of permutation indeces. Otherwise, it gives runtime error (exception). All the integers inside the
+-- 'EncodedCnstrs' must be in the range [0..n] where @n@ corresponds to the maximum element in the permutation 'VB.Vector' 'Int'. Besides,
+-- @n@ is (probably must be) not greater than 6.
+decodeConstraint1 :: (InsertLeft t (VB.Vector Int), Monoid (t (VB.Vector Int))) => EncodedCnstrs -> t (VB.Vector Int) -> t (VB.Vector Int)
+decodeConstraint1 (E _) = id
+decodeConstraint1 (Q _ i j k l) = unsafeQuadruples i j k l
+decodeConstraint1 (T _ i j k) = unsafeTriples i j k
+decodeConstraint1 (SA _ i v) = unsafeSeveralA i v
+decodeConstraint1 (SB _ i v) = unsafeSeveralB i v
+decodeConstraint1 (F _ i j) = filterOrderIJ i j
+
+-- | Must be applied to the correct vector of permutation indeces. Otherwise, it gives runtime error (exception). All the integers inside the
+-- 'EncodedCnstrs' must be in the range [0..n] where @n@ corresponds to the maximum element in the permutation 'VB.Vector' 'Int'. Besides,
+-- @n@ is (probably must be) not greater than 6.
+decodeLConstraints :: (InsertLeft t (VB.Vector Int), Monoid (t (VB.Vector Int))) => [EncodedCnstrs] -> t (VB.Vector Int) -> t (VB.Vector Int)
+decodeLConstraints (x:xs) = decodeLConstraints' ys . decodeConstraint1 y
+  where y = minimum (x:xs)
+        ys = filter (/= y) . g $ (x:xs)
+        g ((E _):zs) = g zs
+        g (z:zs) = z : g zs
+        g _ = []
+        decodeLConstraints' (z:zs) = decodeLConstraints' zs . decodeConstraint1 z
+        decodeLConstraints' _ = id
+decodeLConstraints _ = id
+
+isE :: EncodedCnstrs -> Bool
+isE (E _) = True
+isE _ = False
+
+isF :: EncodedCnstrs -> Bool
+isF (F _ _ _) = True
+isF _ = False
+
+isT :: EncodedCnstrs -> Bool
+isT (T _ _ _ _) = True
+isT _ = False
+
+isQ :: EncodedCnstrs -> Bool
+isQ (Q _ _ _ _ _) = True
+isQ _ = False
+
+isSA :: EncodedCnstrs -> Bool
+isSA (SA _ _ _) = True
+isSA _ = False
+
+isSB :: EncodedCnstrs -> Bool
+isSB (SB _ _ _) = True
+isSB _ = False
+
+getIEl :: EncodedCnstrs -> Int
+getIEl (E i) = i
+getIEl (Q _ i _ _ _) = i
+getIEl (T _ i _ _) = i
+getIEl (SA _ i _) = i
+getIEl (SB _ i _) = i
+getIEl (F _ i _) = i
+
+setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs
+setIEl i (E _) = E i
+setIEl i (Q n _ j k l) = Q n i j k l
+setIEl i (T n _ j k) = T n i j k
+setIEl i (SA n _ v) = SA n i v
+setIEl i (SB n _ v) = SB n i v
+setIEl i (F n _ j) = F n i j
+
+

Setup.hs

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

phonetic-languages-constraints.cabal

@@ -0,0 +1,25 @@
+-- Initial phonetic-languages-constaints.cabal generated by cabal init.
+-- For further documentation, see http://haskell.org/cabal/users-guide/
+
+name:                phonetic-languages-constraints
+version:             0.4.0.0
+synopsis:            Constraints to filter the needed permutations
+description:         Provides several the most important variants of constraints. Can be used with the phonetic-languages-common series of package.
+homepage:            https://hackage.haskell.org/package/phonetic-languages-constraints
+license:             MIT
+license-file:        LICENSE
+author:              OleksandrZhabenko
+maintainer:          [email protected]
+copyright:           Oleksandr Zhabenko
+category:            Language, Math
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Languages.UniquenessPeriods.Vector.Constraints, Languages.UniquenessPeriods.Vector.Constraints.Encoded
+  -- other-modules:
+  other-extensions:    BangPatterns, FlexibleInstances, FlexibleContexts
+  build-depends:       base >=4.8 && <4.15, vector >=0.11 && <0.14, subG >= 0.4.2 && <1, subG-instances >= 0.1 && <1
+  -- hs-source-dirs:
+  default-language:    Haskell2010