packages feed

phonetic-languages-constraints-array 0.5.0.0 → 0.6.0.0

raw patch · 5 files changed

+291/−36 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Phladiprelio.Constraints: isFixedPoint :: Array Int Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isFixedPointTup :: Array Int (Int, Int) -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isMixedDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isQuadrupleOrdered :: Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isSeveralAOrdered :: Int -> Array Int Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isSeveralBOrdered :: Int -> Array Int Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isSignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isTripleOrdered :: Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: isUnsignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notFixedPoint :: Array Int Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notFixedPointTup :: Array Int (Int, Int) -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notMixedDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notQuadrupleOrdered :: Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notSeveralAOrdered :: Int -> Array Int Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notSeveralBOrdered :: Int -> Array Int Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notSignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notTripleOrdered :: Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.Constraints: notUnsignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool
+ Phladiprelio.ConstraintsEncoded: generalConversion :: Int -> String -> Array Int Int -> Bool
+ Phladiprelio.ConstraintsEncoded: instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (Phladiprelio.ConstraintsEncoded.EncodedContraints a b)
+ Phladiprelio.ConstraintsEncoded: isConstraint1 :: Bool -> Array Int Int -> EncodedCnstrs -> Bool

Files

CHANGELOG.md view
@@ -37,3 +37,11 @@ * Fifth version. Changed representation in the EncodedCnstr data type. Removed the readMaybeEC function. Reduced code duplication. Switched the way of counting -- moved all to one natural base of 1 and more.++## 0.6.0.0 -- 2023-05-22 ++* Sixth version. Added new functions to the Phladiprelio.Constraints module for negated constraints. +Added some boolean algebra interpeter for constraints to Phladiprelio.ConstraintsEncoded module. +Added README.md file and devotion of the project to Foundation Gastrostars. ++
Phladiprelio/Constraints.hs view
@@ -20,8 +20,28 @@ {-# LANGUAGE BangPatterns, FlexibleContexts, NoImplicitPrelude #-}  module Phladiprelio.Constraints (-  -- * Basic predicate+  -- * Predicates   unsafeOrderIJ+  , unsafeSignDistanceIJ+  , unsafeUnsignDistanceIJ+  , isSignDistIJK3+  , isUnsignDistIJK3+  , isMixedDistIJK3+  , isTripleOrdered+  , isQuadrupleOrdered+  , isSeveralAOrdered+  , isSeveralBOrdered+  , isFixedPointTup+  , isFixedPoint+  , notSignDistIJK3 +  , notUnsignDistIJK3+  , notMixedDistIJK3 +  , notTripleOrdered +  , notQuadrupleOrdered+  , notSeveralAOrdered +  , notSeveralBOrdered +  , notFixedPointTup +  , notFixedPoint    -- * Functions to work with permutations with basic constraints ('Array'-based)   , filterOrderIJ   , unsafeTriples@@ -33,8 +53,6 @@   , fixedPointsG   , fixedPointsS   -- * Distances between elements-  , unsafeSignDistanceIJ-  , unsafeUnsignDistanceIJ   , filterSignDistanceIJ   , filterUnsignDistanceIJ   , filterSignDistanceIJK3@@ -47,7 +65,7 @@ import Data.Maybe (fromJust) import Data.SubG (InsertLeft(..),filterG) import GHC.Arr-import Data.Foldable (all, foldr)+import Data.Foldable (all, foldr, any)  -- | 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@@ -63,16 +81,17 @@ {-# INLINE helpG #-}  -- | Being given the data satisfying the constraints in the module header checks whether in the--- 'Array' the distance between positions of the first two arguments values is equal to the signed +-- 'Array' the distance between positions of the first two arguments values is equal to the signed -- third argument.-unsafeSignDistanceIJ -  :: Int -  -> Int +unsafeSignDistanceIJ+  :: Int+  -> Int   -> Int -- ^ Can be of both signs, but not equal to 0. The positive value gives 'True' for the first argument being find earlier in the 'Array' than the second and the distance between their positions are equal to 'abs' @d@ (this argument). The negative value gives 'True' for the second argument  being earlier in the 'Array' than the first one and the distance between their positions are equal to 'abs' @d@ (this argument).-  -> Array Int Int +  -> Array Int Int   -> Bool unsafeSignDistanceIJ i j d = (\(_,_,r) -> if r > 100 then (100 - r) == d else r == d) . foldr helpG2 (j, i, -1) + helpG2 z (t, u, n)   | n < 0 = if (z /= t && z /= u) then (t, u, n) else (t, u, if z == t then 1 else 101)   | z /= u && z /= t && t >= 0 = (t, u, n + 1)@@ -109,15 +128,15 @@  -- | Being given the data satisfying the constraints in the module header returns the elements that pairwisely (1 and 2, 2 and 3) satisfy 'unsafeSignDistanceIJ' as a predicate. filterSignDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)-filterSignDistanceIJK3 i j k d1 d2 = filterG (\arr -> unsafeSignDistanceIJ i j d1 arr && unsafeSignDistanceIJ j k d2 arr)+filterSignDistanceIJK3 i j k d1 d2 = filterG (isSignDistIJK3 i j k d1 d2)  -- | Being given the data satisfying the constraints in the module header returns the elements that pairwisely (1 and 2, 2 and 3) satisfy 'unsafeUnsignDistanceIJ' as a predicate. filterUnsignDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)-filterUnsignDistanceIJK3 i j k d1 d2 = filterG (\arr -> unsafeUnsignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr)+filterUnsignDistanceIJK3 i j k d1 d2 = filterG (isUnsignDistIJK3 i j k d1 d2)  -- | Being given the data satisfying the constraints in the module header returns the elements that satisfy both 'unsafeSignDistanceIJ' with the 1st, 2nd and 4th arguments and 'unsafeUnsignDistanceIJ' with the 2nd, 3rd and 5th arguments as predicates. filterMixedDistanceIJK3 :: (InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) => Int -> Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)-filterMixedDistanceIJK3 i j k d1 d2 = filterG (\arr -> unsafeSignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr)+filterMixedDistanceIJK3 i j k d1 d2 = filterG (isMixedDistIJK3 i j k d1 d2)  -- | 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-1] without duplication if the@@ -125,7 +144,7 @@ -- 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)+unsafeTriples i j k = filterG (isTripleOrdered i j k)  -- | 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-1] without duplication if the@@ -133,7 +152,7 @@ -- 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)+unsafeQuadruples i j k l = filterG (isQuadrupleOrdered i j k l)  -- | 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-1] without duplication.@@ -142,8 +161,7 @@ -- is 'Array' 'Int' of indices that are in the range [0..n-1]. 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+unsafeSeveralA !i0 arr = filterG (isSeveralAOrdered i0 arr)  -- | 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-1] without duplication.@@ -152,8 +170,7 @@ -- is 'Array' of indices that are in the range [0..n-1]. 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+unsafeSeveralB !i0 arr = filterG (isSeveralBOrdered i0 arr)  -------------------------------------------------------------------------------- @@ -161,12 +178,84 @@ -- 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+fixedPointsG arr = filterG (isFixedPointTup arr)  -- | 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+fixedPointsS arr = filterG (isFixedPoint arr)++------------------------------------------++isSignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+isSignDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ i j d1 arr && unsafeSignDistanceIJ j k d2 arr+{-# INLINE isSignDistIJK3 #-}++isUnsignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+isUnsignDistIJK3 i j k d1 d2 arr = unsafeUnsignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr+{-# INLINE isUnsignDistIJK3 #-}++isMixedDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+isMixedDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ i j d1 arr && unsafeUnsignDistanceIJ j k d2 arr+{-# INLINE isMixedDistIJK3 #-}++isTripleOrdered :: Int -> Int -> Int -> Array Int Int -> Bool+isTripleOrdered i j k arr = unsafeOrderIJ i j arr && unsafeOrderIJ j k arr+{-# INLINE isTripleOrdered #-}++isQuadrupleOrdered :: Int -> Int -> Int -> Int -> Array Int Int -> Bool+isQuadrupleOrdered i j k l arr = unsafeOrderIJ i j arr && unsafeOrderIJ j k arr && unsafeOrderIJ k l arr+{-# INLINE isQuadrupleOrdered #-}++isSeveralAOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+isSeveralAOrdered !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ i0 k arr2) arr1+{-# INLINE isSeveralAOrdered #-}++isSeveralBOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+isSeveralBOrdered !i0 !arr1 arr2 = all (\k -> unsafeOrderIJ k i0 arr2) arr1+{-# INLINE isSeveralBOrdered #-}++isFixedPointTup :: Array Int (Int, Int) -> Array Int Int -> Bool+isFixedPointTup arr1 arr2 = all (\(k,j) -> unsafeAt arr2 k == j) arr1+{-# INLINE isFixedPointTup #-}++isFixedPoint :: Array Int Int -> Array Int Int -> Bool+isFixedPoint arr1 arr2 = all (\k -> unsafeAt arr2 k == k) arr1+{-# INLINE isFixedPoint #-}++notSignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+notSignDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ j i d1 arr || unsafeSignDistanceIJ k j d2 arr+{-# INLINE notSignDistIJK3 #-}++notUnsignDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+notUnsignDistIJK3 i j k d1 d2 = not . isUnsignDistIJK3 i j k d1 d2+{-# INLINE notUnsignDistIJK3 #-}++notMixedDistIJK3 :: Int -> Int -> Int -> Int -> Int -> Array Int Int -> Bool+notMixedDistIJK3 i j k d1 d2 arr = unsafeSignDistanceIJ j i d1 arr || not (unsafeUnsignDistanceIJ j k d2 arr)+{-# INLINE notMixedDistIJK3 #-}++notTripleOrdered :: Int -> Int -> Int -> Array Int Int -> Bool+notTripleOrdered i j k arr = unsafeOrderIJ j i arr || unsafeOrderIJ k j arr+{-# INLINE notTripleOrdered #-}++notQuadrupleOrdered :: Int -> Int -> Int -> Int -> Array Int Int -> Bool+notQuadrupleOrdered i j k l arr = unsafeOrderIJ j i arr || unsafeOrderIJ k j arr || unsafeOrderIJ l k arr+{-# INLINE notQuadrupleOrdered #-}++notSeveralAOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+notSeveralAOrdered !i0 !arr1 = not . isSeveralAOrdered i0 arr1+{-# INLINE notSeveralAOrdered #-}++notSeveralBOrdered :: Int -> Array Int Int -> Array Int Int -> Bool+notSeveralBOrdered !i0 !arr1 = not . isSeveralBOrdered i0 arr1+{-# INLINE notSeveralBOrdered #-}++notFixedPointTup :: Array Int (Int, Int) -> Array Int Int -> Bool+notFixedPointTup arr1 arr2 = any (\(k,j) -> unsafeAt arr2 k /= j) arr1+{-# INLINE notFixedPointTup #-}++notFixedPoint :: Array Int Int -> Array Int Int -> Bool+notFixedPoint arr1 arr2 = any (\k -> unsafeAt arr2 k /= k) arr1+{-# INLINE notFixedPoint #-} 
Phladiprelio/ConstraintsEncoded.hs view
@@ -22,6 +22,7 @@   -- ** Process-encoding functions   , decodeConstraint1   , decodeLConstraints+  , isConstraint1   -- ** Modifiers and getters   , getIEl   , setIEl@@ -38,18 +39,22 @@   , isH   , isR   , isM+  -- * Algebraic general conversion+  , generalConversion ) where  import GHC.Base import GHC.List-import GHC.Num ((-),abs)-import Text.Show (show)+import GHC.Num ((+),(-),abs)+import Text.Show (show, Show(..)) import Text.Read (readMaybe) import Data.Maybe-import Data.List (nub)+import Data.List (nub, words, groupBy) import GHC.Arr+import Data.Char (isDigit, isLetter) import Phladiprelio.Constraints import Data.SubG (InsertLeft(..))+import Data.Tuple (fst)  data EncodedContraints a b = E                             | P a b @@ -63,8 +68,129 @@                            | H a a a a                             | R a a a a                             | M a a a a -                           deriving (Eq, Ord)+                           deriving (Eq, Ord, Show) +validOrdStr0 +  :: String +  -> Int -- ^ Number of seen so far \'(\' parentheses+  -> Int -- ^ Number of seen so far \')\' parentheses+  -> Bool+validOrdStr0 xs@('E':ys) n m = validOrdStr0 ys n m+validOrdStr0 xs@(' ':y:t:ys) n m+  | y `elem` "ABFHMPQRTVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) n m+  | y `elem` "-(E" = validOrdStr0 (y:t:ys) n m+  | otherwise = False  +validOrdStr0 xs@('(':y:t:ys) n m+  | y `elem` "ABFHMPQRTVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) (n + 1) m+  | y `elem` "-(E" = validOrdStr0 (y:t:ys) (n + 1) m+  | otherwise = False  +validOrdStr0 xs@(')':y:t:ys) n m+  | y `elem` "ABFHMPQRTVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) n (m + 1)+  | y `elem` "-()E" = validOrdStr0 (y:t:ys) n (m + 1)+  | otherwise = False  +validOrdStr0 xs@('-':y:t:ys) n m+  | y `elem` "ABFHMPQRTVW" && isDigit t = validOrdStr0 (dropWhile isDigit ys) n m +  | y `elem` "-)" || isDigit y = False+  | otherwise = validOrdStr0 (y:t:ys) n m +validOrdStr0 xs@(x:y:t:ys) n m +  | x `elem` "ABFHMPQRTVW" = if isDigit y then validOrdStr0 (dropWhile isDigit (t:ys)) n m else False+  | otherwise = validOrdStr0 (y:t:ys) n (m + 1) +validOrdStr0 xs@(x:')':ys) n m +  | isDigit x || x == ')' = validOrdStr0 ys n (if x == ')' then m + 2 else m + 1) +  | otherwise = False+validOrdStr0 xs@(x:y:ys) n m +  | x `elem` "(ABFHMQRTVW" = False+  | y `elem` " -(ABFHMPQRTVW" = False+  | x == 'P' && not (isDigit y) = False+  | x == ')' && y `notElem` ")E" = False+  | x == 'P' && n == m = True+  | x == ')' && y == ')' = n == (m + 2)+  | x == ')' && y == 'E' = n == (m + 1)+  | (x `elem` "E -") && y == 'E' = n == m +  | x == 'E' && y == ')' = n == (m + 1)+  | otherwise = False+validOrdStr0 xs@(x:ys) n m +  | isDigit x || (x `elem` ")E") = if x == ')' then n == (m + 1) else n == m +  | otherwise = False+validOrdStr0 _ n m  = n == m++validOrdStr :: String -> Bool+validOrdStr xs = validOrdStr0 xs 0 0 +{-# INLINE validOrdStr #-}++stage1Parsing :: String -> [String]+stage1Parsing =  groupBy (\x y -> x == '(' && y == '(' || isLetter x && isDigit y || x == ')' && y == ')')+{-# INLINE stage1Parsing #-}++convertToBools +  :: Int +  -> Array Int Int +  -> [String] +  -> String -- ^ The result is a 'String' that Haskell can evaluate to 'Bool' (some logical expression).+convertToBools n arr xss@("-":yss) = "not " `mappend` (convertToBools n arr yss)+convertToBools n arr xss@(" ":yss) = " || " `mappend` (convertToBools n arr yss)+convertToBools n arr xss@(xs:yss@(ys:tss))+  | any (== '(') xs = xs `mappend` " " `mappend` convertToBools n arr yss+  | any (== ')') xs = xs `mappend` (if ys == " " then "" else " && ") `mappend` convertToBools n arr yss+  | xs `elem` ["True","False"] = xs `mappend` (case ys of +                                                 ')':_ -> " " +                                                 " "   -> " "+                                                 _     -> " && ") `mappend` convertToBools n arr yss +  | otherwise = let cnstrs = fromMaybe E . readMaybeECG n $ xs in +                      show (isConstraint1 True arr cnstrs) +                      `mappend` (case ys of +                                   ')':_ -> " " +                                   " "   -> " "+                                   _     -> " && ") `mappend` convertToBools n arr yss +convertToBools n arr xss@(xs:yss) +  | any (== ')') xs = xs +  | xs `elem` ["True","False"] = xs+  | otherwise = (show . isConstraint1 True arr . fromMaybe E . readMaybeECG n $ xs) -- `mappend` "!!!!!"+convertToBools n arr _ = ""++noParenString :: [String] -> Bool +noParenString xss@(xs:ys:ts:yss) +  | xs == "not" = +      case ys of +        "True" -> if ts == "&&" then False +                                else noParenString yss +        "False" -> if ts == "&&" then noParenString yss +                                 else True +  | otherwise = +      case xs of+        "True" -> if ys == "&&" then noParenString (ts:yss)+                                else True +        "False" -> if ys == "&&" then False +                                 else noParenString (ts:yss)+noParenString xss@("not":ys:yss) = if ys == "True" then False else True +noParenString xss@(xs:yss) +  | xs == "True" = True +  | otherwise = False +noParenString _ = True++oneChange :: Int -> Array Int Int -> [String] -> [String]+oneChange m arr xss +  | null wss = [show . noParenString . words . convertToBools m arr $ xss]+  | otherwise = ((\(jss, m, qss) -> jss `mappend` [show . noParenString . words . convertToBools m arr $ qss]) . +                  foldr (\xs uss@(tss, n, rss) -> if xs == "(" && n == 0 +                                                      then (tss, 1, rss) +                                                      else if any (== '(') xs && n == 0+                                                               then (drop 1 xs:tss, n, rss)+                                                               else case n of +                                                                      0 -> (tss, 0, xs:rss)+                                                                      1 -> (xs:tss, 1, rss)) ([], 0, []) $ yss) `mappend` kss+  where (yss,wss) = break (any (== ')')) xss+        kss = case wss of+                ws:vss -> if length ws == 1 then vss else drop 1 ws : vss+                _      -> wss++generalConversion :: Int -> String -> Array Int Int -> Bool+generalConversion m xs arr+  | validOrdStr xs =  (\ks -> if ks == "True" || ks == "E" then True else False) . +      head . head . dropWhile ((/= 1) . length)  . drop 1 . iterate (oneChange m arr) . stage1Parsing $ xs +  | otherwise = False+{-# INLINE generalConversion #-}+ -- | 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'.  -- It is up to user to check whether the parameters are in the correct form, the function does@@ -105,8 +231,7 @@ 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.+-- 'EncodedCnstrs' must be in the range [0..n-1] where @n@ corresponds to the maximum element in the permutation 'Array' 'Int' 'Int'.  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@@ -115,15 +240,14 @@ decodeConstraint1 (SA _ i v) = unsafeSeveralA i v decodeConstraint1 (SB _ i v) = unsafeSeveralB i v decodeConstraint1 (F _ i j) = filterOrderIJ i j-decodeConstraint1 (V _ i j) = filterSignDistanceIJ i j (j - i)+decodeConstraint1 (V _ i j) = filterSignDistanceIJ i j (abs $ j - i) decodeConstraint1 (W _ i j) = filterUnsignDistanceIJ i j (abs $ j - i)-decodeConstraint1 (H _ i j k) = filterSignDistanceIJK3 i j k (j - i) (k - j)-decodeConstraint1 (R _ i j k) = filterUnsignDistanceIJK3 i j k (abs (j - i)) (abs (k - j))-decodeConstraint1 (M _ i j k) = filterMixedDistanceIJK3 i j k (j - i) (abs (k - j))+decodeConstraint1 (H _ i j k) = filterSignDistanceIJK3 i j k (abs $ j - i) (abs $ k - j)+decodeConstraint1 (R _ i j k) = filterUnsignDistanceIJK3 i j k (abs $ j - i) (abs $ k - j)+decodeConstraint1 (M _ i j k) = filterMixedDistanceIJK3 i j k (abs $ j - i) (abs $ k - 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.+-- 'EncodedCnstrs' must be in the range [0..n-1] where @n@ corresponds to the maximum element in the permutation 'Array' 'Int' 'Int'. 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)@@ -134,6 +258,31 @@         decodeLConstraints' (z:zs) = decodeLConstraints' zs . decodeConstraint1 z         decodeLConstraints' _ = id decodeLConstraints _ = id++isConstraint1 :: Bool -> Array Int Int -> EncodedCnstrs -> Bool+isConstraint1 bool arr E = bool+isConstraint1 True arr (F _ i j) = unsafeOrderIJ i j arr +isConstraint1 True arr (T _ i j k) = isTripleOrdered i j k arr +isConstraint1 True arr (Q _ i j k l) = isQuadrupleOrdered i j k l arr +isConstraint1 True arr (SA _ i arr2) = isSeveralAOrdered i arr2 arr +isConstraint1 True arr (SB _ i arr2) = isSeveralBOrdered i arr2 arr +isConstraint1 True arr (P _ arr2) = isFixedPoint arr2 arr +isConstraint1 True arr (H _ i j k) = isSignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 True arr (M _ i j k) = isMixedDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 True arr (R _ i j k) = isUnsignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 True arr (V _ i j) = unsafeSignDistanceIJ i j (abs $ j - i) arr +isConstraint1 True arr (W _ i j) = unsafeUnsignDistanceIJ i j (abs $ j - i) arr +isConstraint1 False arr (F _ i j) = unsafeOrderIJ j i arr +isConstraint1 False arr (T _ i j k) = notTripleOrdered i j k arr +isConstraint1 False arr (Q _ i j k l) = notQuadrupleOrdered i j k l arr +isConstraint1 False arr (SA _ i arr2) = notSeveralAOrdered i arr2 arr +isConstraint1 False arr (SB _ i arr2) = notSeveralBOrdered i arr2 arr +isConstraint1 False arr (P _ arr2) = notFixedPoint arr2 arr +isConstraint1 False arr (H _ i j k) = notSignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 False arr (M _ i j k) = notMixedDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 False arr (R _ i j k) = notUnsignDistIJK3 i j k (abs $ j - i) (abs $ k - j) arr +isConstraint1 False arr (V _ i j) = unsafeSignDistanceIJ j i (abs $ j - i) arr +isConstraint1 False arr (W _ i j) = not . unsafeUnsignDistanceIJ i j (abs $ j - i) $ arr   isE :: EncodedCnstrs -> Bool isE E = True
+ README.md view
@@ -0,0 +1,9 @@+ Devotion+ ========++Since the 0.6.0.0 version, the author would like to devote this project to support the Foundation Gastrostars.+If you would like to share some financial support, please, contact the foundation+using the URL:++[Contact Foundation GASTROSTARS](https://gastrostars.nl/hou-mij-op-de-hoogte)+
phonetic-languages-constraints-array.cabal view
@@ -2,7 +2,7 @@ -- For further documentation, see http://haskell.org/cabal/users-guide/  name:                phonetic-languages-constraints-array-version:             0.5.0.0+version:             0.6.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@@ -13,7 +13,7 @@ copyright:           Oleksandr Zhabenko category:            Language, Math build-type:          Simple-extra-source-files:  CHANGELOG.md+extra-source-files:  CHANGELOG.md, README.md cabal-version:       >=1.10  library