diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..fab2b34 --- /dev/null +++ b/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. 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/Constraints.hs b/Languages/UniquenessPeriods/Vector/Constraints.hs new file mode 100644 index 0000000..aa6398c --- /dev/null +++ b/Languages/UniquenessPeriods/Vector/Constraints.hs @@ -0,0 +1,81 @@ +-- | +-- Module : Languages.UniquenessPeriods.Vector.Constraints +-- Copyright : (c) OleksandrZhabenko 2020 +-- License : MIT +-- Stability : Experimental +-- Maintainer : olexandr543@yahoo.com +-- +-- 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 + diff --git a/Languages/UniquenessPeriods/Vector/Constraints/Encoded.hs b/Languages/UniquenessPeriods/Vector/Constraints/Encoded.hs new file mode 100644 index 0000000..343d7c1 --- /dev/null +++ b/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 : olexandr543@yahoo.com +-- +-- 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 + + 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/phonetic-languages-constraints.cabal b/phonetic-languages-constraints.cabal new file mode 100644 index 0000000..9eab4cd --- /dev/null +++ b/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: olexandr543@yahoo.com +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