phonetic-languages-constraints-array 0.1.2.0 → 0.2.0.0

raw patch · 7 files changed

+313/−304 lines, 7 filesdep ~basedep ~subGPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, subG

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• LICENSE +1/−1
• Languages/UniquenessPeriods/Array/Constraints.hs +0/−106
• Languages/UniquenessPeriods/Array/Constraints/Encoded.hs +0/−192
• Phladiprelio/Constraints.hs +108/−0
• Phladiprelio/ConstraintsEncoded.hs +195/−0
• phonetic-languages-constraints-array.cabal +5/−5

@@ -13,3 +13,7 @@  * First version revised B. Added the new constraint P functionality. +## 0.2.0.0 -- 2023-01-31++* Second version. Switched to NoImplicitPrelude extension. Changed the names of the modules. Updated the dependencies boundaries.+

@@ -1,4 +1,4 @@-Copyright (c) 2020 OleksandrZhabenko+Copyright (c) 2020-2023 Oleksandr Zhabenko  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the

@@ -1,106 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Languages.UniquenessPeriods.Array.Constraints--- Copyright   :  (c) OleksandrZhabenko 2020-2022--- License     :  MIT--- Stability   :  Experimental--- Maintainer  :  olexandr543@yahoo.com------ Provides several the most important variants of constraints for the--- permutations. All the 'Array'--- 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.--- Uses arrays instead of vectors.--{-# LANGUAGE BangPatterns, FlexibleContexts #-}--module Languages.UniquenessPeriods.Array.Constraints (-  -- * Basic predicate-  unsafeOrderIJ-  -- * Functions to work with permutations with basic constraints ('Array'-based)-  , filterOrderIJ-  , unsafeTriples-  , unsafeQuadruples-  -- ** With multiple elements specified-  , unsafeSeveralA-  , unsafeSeveralB-  -- ** With fixed points-  , fixedPointsG-  , fixedPointsS-) where--import Data.Maybe (fromJust)-import Data.SubG (InsertLeft(..),filterG)-import GHC.Arr-import Data.Foldable (foldl')---- | Being given the data satisfying the constraints in the module header checks whether in the 'Array' the first argument stands before the second one.-unsafeOrderIJ :: Int -> Int -> Array Int Int -> Bool-unsafeOrderIJ i j = (\(_,_,r) -> if r == 0 then True else False) . foldl' helpG (i,j,0)--helpG (t,u,n) z-  | z == t = (t,u,1)-  | z == u =-     case n of-      0 -> (t,u,2)-      _ -> (t,u,n - 1)-  | otherwise = (t,u,n)-{-# INLINE helpG #-}---- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeOrderIJ' as a predicate.-filterOrderIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> t (Array Int Int) -> t (Array Int 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 'Array' 'Int' 'Int' where the elements 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 (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int 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 'Array' 'Int' 'Int' where the elements 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 (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int 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 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication.--- The first argument--- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument--- is 'Array' 'Int' of indices that are in the range [0..n]. Filters (and reduces further complex computations) the permutations so that only the--- variants with the indices in the second argument all stand AFTER the element with the index equal to the first argument.-unsafeSeveralA :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)-unsafeSeveralA !i0 arr x = filterG (g i0 arr) x-   where g !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ i0 k arr2) arr1---- | 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 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication.--- The first argument--- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument--- is 'Array' of indices that are in the range [0..n]. Filters (and reduces further complex computations) the permutations so that only the--- variants with the indices in the second argument all stand BEFORE the element with the index equal to the first argument.-unsafeSeveralB :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)-unsafeSeveralB !i0 arr x = filterG (g i0 arr) x-   where g !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ k i0 arr2) arr1-------------------------------------------------------------------------------------- | Reduces the number of permutations using filtering leaving just those ones permutations where elements on the--- first elements in the tuples in the first argument 'Array' places are moved to the places indexed with the second--- elements in the tuples respectively.-fixedPointsG :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int (Int,Int) -> t (Array Int Int) -> t (Array Int Int)-fixedPointsG arr xs = filterG (f arr) xs-   where f arr1 arr2 = all (\(k,j) -> unsafeAt arr2 k == j) arr1---- | A simplified variant of the 'fixedPointsG' function where the specified elements stay on their place and that is--- why are 'fixed points' in the permutation specified.-fixedPointsS :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int Int -> t (Array Int Int) -> t (Array Int Int)-fixedPointsS arr xs = filterG (f arr) xs-   where f arr1 arr2 = all (\k -> unsafeAt arr2 k == k) arr1-

@@ -1,192 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Languages.UniquenessPeriods.Array.Constraints.Encoded--- Copyright   :  (c) OleksandrZhabenko 2020-2022--- License     :  MIT--- Stability   :  Experimental--- Maintainer  :  olexandr543@yahoo.com------ Provides a way to encode the needed constraint with possibly less symbols.--- Uses arrays instead of vectors.--{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}--module Languages.UniquenessPeriods.Array.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-  , isP-  , isF-  , isQ-  , isT-  , isSA-  , isSB-) where--import Data.Monoid (mappend)-import Text.Read (readMaybe)-import Data.Maybe-import GHC.Arr-import Languages.UniquenessPeriods.Array.Constraints-import Data.SubG (InsertLeft(..))--data EncodedContraints a b = E a | P a b | 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 (listArray (0,length x2 - 1) 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 (listArray (0,length x2 - 1) 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)-       "P" -> if null ts then Just (E 0) else let l = length ts in Just . P n . listArray (0,l-1) . map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts-       _   -> 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 (P _ v)) = Just (P n v)-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 <= 9 && n >=0 = setWordsN n . readMaybeEC n $ xs-  | otherwise = Nothing--type EncodedCnstrs = EncodedContraints Int (Array Int Int)---- | Must be applied to the correct array 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 'Array' 'Int' 'Int'. Besides,--- @n@ is (probably must be) not greater than 6.-decodeConstraint1 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)-decodeConstraint1 (E _) = id-decodeConstraint1 (P _ v) = fixedPointsS v-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 array 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 'Array' 'Int' 'Int'. Besides,--- @n@ is (probably must be) not greater than 6.-decodeLConstraints :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => [EncodedCnstrs] -> t (Array Int Int) -> t (Array Int 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--isP :: EncodedCnstrs -> Bool-isP (P _ _) = True-isP _ = 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--{-| Works only with the correctly defined argument though it is not checked. Use with this caution.--}-getIEl :: EncodedCnstrs -> Int-getIEl (E i) = i-getIEl (P _ arr) = unsafeAt arr 0-getIEl (Q _ i _ _ _) = i-getIEl (T _ i _ _) = i-getIEl (SA _ i _) = i-getIEl (SB _ i _) = i-getIEl (F _ i _) = i--{-| Works only with the correctly defined arguments though it is not checked. Use with this caution.--}-setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs-setIEl i (E _) = E i-setIEl i (P n arr) = P n (arr // [(0,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

@@ -0,0 +1,108 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Pladiprelio.Constraints+-- Copyright   :  (c) OleksandrZhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Provides several the most important variants of constraints for the+-- permutations. All the 'Array'+-- 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.+-- Uses arrays instead of vectors.++{-# LANGUAGE BangPatterns, FlexibleContexts, NoImplicitPrelude #-}++module Phladiprelio.Constraints (+  -- * Basic predicate+  unsafeOrderIJ+  -- * Functions to work with permutations with basic constraints ('Array'-based)+  , filterOrderIJ+  , unsafeTriples+  , unsafeQuadruples+  -- ** With multiple elements specified+  , unsafeSeveralA+  , unsafeSeveralB+  -- ** With fixed points+  , fixedPointsG+  , fixedPointsS+) where++import GHC.Base+import GHC.Num ((-))+import Data.Maybe (fromJust)+import Data.SubG (InsertLeft(..),filterG)+import GHC.Arr+import Data.Foldable (foldl', all)++-- | Being given the data satisfying the constraints in the module header checks whether in the 'Array' the first argument stands before the second one.+unsafeOrderIJ :: Int -> Int -> Array Int Int -> Bool+unsafeOrderIJ i j = (\(_,_,r) -> if r == 0 then True else False) . foldl' helpG (i,j,0)++helpG (t,u,n) z+  | z == t = (t,u,1)+  | z == u =+     case n of+      0 -> (t,u,2)+      _ -> (t,u,n - 1)+  | otherwise = (t,u,n)+{-# INLINE helpG #-}++-- | Being given the data satisfying the constraints in the module header returns the elements that satisfy 'unsafeOrderIJ' as a predicate.+filterOrderIJ :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> t (Array Int Int) -> t (Array Int 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 'Array' 'Int' 'Int' where the elements 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 (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> t (Array Int Int) -> t (Array Int 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 'Array' 'Int' 'Int' where the elements 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 (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int 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 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication.+-- The first argument+-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument+-- is 'Array' 'Int' of indices that are in the range [0..n]. Filters (and reduces further complex computations) the permutations so that only the+-- variants with the indices in the second argument all stand AFTER the element with the index equal to the first argument.+unsafeSeveralA :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)+unsafeSeveralA !i0 arr x = filterG (g i0 arr) x+   where g !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ i0 k arr2) arr1++-- | 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 'Array' 'Int' 'Int' where the elements are all the numbers in the range [0..n] without duplication.+-- The first argument+-- is the index of the the element (a word or their concatenated combination in the @phonetic-languages@ series of packages), the second argument+-- is 'Array' of indices that are in the range [0..n]. Filters (and reduces further complex computations) the permutations so that only the+-- variants with the indices in the second argument all stand BEFORE the element with the index equal to the first argument.+unsafeSeveralB :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)+unsafeSeveralB !i0 arr x = filterG (g i0 arr) x+   where g !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ k i0 arr2) arr1++--------------------------------------------------------------------------------++-- | Reduces the number of permutations using filtering leaving just those ones permutations where elements on the+-- first elements in the tuples in the first argument 'Array' places are moved to the places indexed with the second+-- elements in the tuples respectively.+fixedPointsG :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int (Int,Int) -> t (Array Int Int) -> t (Array Int Int)+fixedPointsG arr xs = filterG (f arr) xs+   where f arr1 arr2 = all (\(k,j) -> unsafeAt arr2 k == j) arr1++-- | A simplified variant of the 'fixedPointsG' function where the specified elements stay on their place and that is+-- why are 'fixed points' in the permutation specified.+fixedPointsS :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Array Int Int -> t (Array Int Int) -> t (Array Int Int)+fixedPointsS arr xs = filterG (f arr) xs+   where f arr1 arr2 = all (\k -> unsafeAt arr2 k == k) arr1+

@@ -0,0 +1,195 @@+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module      :  Phladiprelio.ConstraintsEncoded+-- Copyright   :  (c) OleksandrZhabenko 2020-2023+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  oleksandr.zhabenko@yahoo.com+--+-- Provides a way to encode the needed constraint with possibly less symbols.+-- Uses arrays instead of vectors.++{-# LANGUAGE FlexibleInstances, FlexibleContexts, NoImplicitPrelude #-}++module Phladiprelio.ConstraintsEncoded (+  -- * 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+  , isP+  , isF+  , isQ+  , isT+  , isSA+  , isSB+) where++import GHC.Base+import GHC.List+import GHC.Num ((-))+import Text.Show (show)+import Text.Read (readMaybe)+import Data.Maybe+import GHC.Arr+import Phladiprelio.Constraints+import Data.SubG (InsertLeft(..))++data EncodedContraints a b = E a | P a b | 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 = head xs+         ts = filter (\x -> x >= '0' && [x] <= show n) . tail $ 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 (listArray (0,length x2 - 1) 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 (listArray (0,length x2 - 1) 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)+       'P' -> if null ts then Just (E 0) else let l = length ts in Just . P n . listArray (0,l-1) . map (\x -> case (fromJust (readMaybe [x]::Maybe Int)) of {0 -> 9; n -> n - 1}) $ ts+       _   -> 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 (P _ v)) = Just (P n v)+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 <= 9 && n >=0 = setWordsN n . readMaybeEC n $ xs+  | otherwise = Nothing++type EncodedCnstrs = EncodedContraints Int (Array Int Int)++-- | Must be applied to the correct array 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 'Array' 'Int' 'Int'. Besides,+-- @n@ is (probably must be) not greater than 6.+decodeConstraint1 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)+decodeConstraint1 (E _) = id+decodeConstraint1 (P _ v) = fixedPointsS v+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 array 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 'Array' 'Int' 'Int'. Besides,+-- @n@ is (probably must be) not greater than 6.+decodeLConstraints :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => [EncodedCnstrs] -> t (Array Int Int) -> t (Array Int 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++isP :: EncodedCnstrs -> Bool+isP (P _ _) = True+isP _ = 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++{-| Works only with the correctly defined argument though it is not checked. Use with this caution.+-}+getIEl :: EncodedCnstrs -> Int+getIEl (E i) = i+getIEl (P _ arr) = unsafeAt arr 0+getIEl (Q _ i _ _ _) = i+getIEl (T _ i _ _) = i+getIEl (SA _ i _) = i+getIEl (SB _ i _) = i+getIEl (F _ i _) = i++{-| Works only with the correctly defined arguments though it is not checked. Use with this caution.+-}+setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs+setIEl i (E _) = E i+setIEl i (P n arr) = P n (arr // [(0,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

@@ -2,14 +2,14 @@ -- For further documentation, see http://haskell.org/cabal/users-guide/  name:                phonetic-languages-constraints-array-version:             0.1.2.0+version:             0.2.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. Instead of vectors, uses arrays. homepage:            https://hackage.haskell.org/package/phonetic-languages-constraints-array license:             MIT license-file:        LICENSE author:              OleksandrZhabenko-maintainer:          olexandr543@yahoo.com+maintainer:          oleksandr.zhabenko@yahoo.com copyright:           Oleksandr Zhabenko category:            Language, Math build-type:          Simple@@ -17,9 +17,9 @@ cabal-version:       >=1.10  library-  exposed-modules:     Languages.UniquenessPeriods.Array.Constraints, Languages.UniquenessPeriods.Array.Constraints.Encoded+  exposed-modules:     Phladiprelio.Constraints, Phladiprelio.ConstraintsEncoded   -- other-modules:-  other-extensions:    BangPatterns, FlexibleInstances, FlexibleContexts-  build-depends:       base >=4.8 && <5, subG == 0.5.3.0+  other-extensions:    BangPatterns, FlexibleInstances, FlexibleContexts, NoImplicitPrelude+  build-depends:       base >=4.13 && <5, subG == 0.6.1.0   -- hs-source-dirs:   default-language:    Haskell2010