-- |
-- 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 (EncodedContraints a b -> EncodedContraints a b -> Bool
(EncodedContraints a b -> EncodedContraints a b -> Bool)
-> (EncodedContraints a b -> EncodedContraints a b -> Bool)
-> Eq (EncodedContraints a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
/= :: EncodedContraints a b -> EncodedContraints a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
== :: EncodedContraints a b -> EncodedContraints a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
Eq, Eq (EncodedContraints a b)
Eq (EncodedContraints a b)
-> (EncodedContraints a b -> EncodedContraints a b -> Ordering)
-> (EncodedContraints a b -> EncodedContraints a b -> Bool)
-> (EncodedContraints a b -> EncodedContraints a b -> Bool)
-> (EncodedContraints a b -> EncodedContraints a b -> Bool)
-> (EncodedContraints a b -> EncodedContraints a b -> Bool)
-> (EncodedContraints a b
    -> EncodedContraints a b -> EncodedContraints a b)
-> (EncodedContraints a b
    -> EncodedContraints a b -> EncodedContraints a b)
-> Ord (EncodedContraints a b)
EncodedContraints a b -> EncodedContraints a b -> Bool
EncodedContraints a b -> EncodedContraints a b -> Ordering
EncodedContraints a b
-> EncodedContraints a b -> EncodedContraints a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (EncodedContraints a b)
forall a b.
(Ord a, Ord b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
forall a b.
(Ord a, Ord b) =>
EncodedContraints a b -> EncodedContraints a b -> Ordering
forall a b.
(Ord a, Ord b) =>
EncodedContraints a b
-> EncodedContraints a b -> EncodedContraints a b
min :: EncodedContraints a b
-> EncodedContraints a b -> EncodedContraints a b
$cmin :: forall a b.
(Ord a, Ord b) =>
EncodedContraints a b
-> EncodedContraints a b -> EncodedContraints a b
max :: EncodedContraints a b
-> EncodedContraints a b -> EncodedContraints a b
$cmax :: forall a b.
(Ord a, Ord b) =>
EncodedContraints a b
-> EncodedContraints a b -> EncodedContraints a b
>= :: EncodedContraints a b -> EncodedContraints a b -> Bool
$c>= :: forall a b.
(Ord a, Ord b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
> :: EncodedContraints a b -> EncodedContraints a b -> Bool
$c> :: forall a b.
(Ord a, Ord b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
<= :: EncodedContraints a b -> EncodedContraints a b -> Bool
$c<= :: forall a b.
(Ord a, Ord b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
< :: EncodedContraints a b -> EncodedContraints a b -> Bool
$c< :: forall a b.
(Ord a, Ord b) =>
EncodedContraints a b -> EncodedContraints a b -> Bool
compare :: EncodedContraints a b -> EncodedContraints a b -> Ordering
$ccompare :: forall a b.
(Ord a, Ord b) =>
EncodedContraints a b -> EncodedContraints a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (EncodedContraints a b)
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 :: Int -> String -> Maybe EncodedCnstrs
readMaybeEC Int
n String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = Maybe EncodedCnstrs
forall a. Maybe a
Nothing
 | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 =
     let h :: String
h = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
xs
         ts :: String
ts = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& [Char
x] String -> String -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> String
forall a. Show a => a -> String
show Int
n) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs in
      case String
h of
       String
"E" -> EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> EncodedCnstrs
forall a b. a -> EncodedContraints a b
E (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
tail (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs)::Maybe Int)))
       String
"F" -> let (Maybe Int
y,Maybe Int
z) = (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int, String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
ts)) in
         case (Maybe Int
y,Maybe Int
z) of
          (Maybe Int
Nothing,Maybe Int
_) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
Nothing) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2) -> EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> EncodedContraints a b
F Int
forall a. HasCallStack => a
undefined Int
x1 Int
x2)
       String
"T" -> let (Maybe Int
y,Maybe Int
z,Maybe Int
u) = (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int, String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int, String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int) in
         case (Maybe Int
y,Maybe Int
z,Maybe Int
u) of
          (Maybe Int
Nothing,Maybe Int
_,Maybe Int
_) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
Nothing,Maybe Int
_) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
_,Maybe Int
Nothing) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2, Just Int
x3) -> EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> a -> EncodedContraints a b
T Int
forall a. HasCallStack => a
undefined Int
x1 Int
x2 Int
x3)
       String
"A" -> let y :: Maybe Int
y = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int in
               if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
y then
                let y0 :: Int
y0 = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
y
                    zs :: [Int]
zs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y0) ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Int] -> [Int])
-> (String -> [Maybe Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Int) -> String -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
t -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe [Char
t]::Maybe Int) (String -> [Maybe Int])
-> (String -> String) -> String -> [Maybe Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> [Int]) -> String -> [Int]
forall a b. (a -> b) -> a -> b
$ String
ts in
                     case [Int]
zs of
                       [] -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
                       ~[Int]
x2 -> EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Vector Int -> EncodedCnstrs
forall a b. a -> a -> b -> EncodedContraints a b
SA Int
forall a. HasCallStack => a
undefined Int
y0 ([Int] -> Vector Int
forall a. [a] -> Vector a
VB.fromList [Int]
x2))
               else Maybe EncodedCnstrs
forall a. Maybe a
Nothing
       String
"B" -> let y :: Maybe Int
y = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int in
               if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
y then
                let y0 :: Int
y0 = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
y
                    zs :: [Int]
zs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y0) ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Int] -> [Int])
-> (String -> [Maybe Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe Int) -> String -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
t -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe [Char
t]::Maybe Int) (String -> [Maybe Int])
-> (String -> String) -> String -> [Maybe Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> [Int]) -> String -> [Int]
forall a b. (a -> b) -> a -> b
$ String
ts in
                     case [Int]
zs of
                       [] -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
                       ~[Int]
x2 -> EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Vector Int -> EncodedCnstrs
forall a b. a -> a -> b -> EncodedContraints a b
SB Int
forall a. HasCallStack => a
undefined Int
y0 ([Int] -> Vector Int
forall a. [a] -> Vector a
VB.fromList [Int]
x2))
               else Maybe EncodedCnstrs
forall a. Maybe a
Nothing
       String
"Q" -> let (Maybe Int
y,Maybe Int
z,Maybe Int
u,Maybe Int
w) = (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int, String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int, String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int,
                    String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
3 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int) in
         case (Maybe Int
y,Maybe Int
z,Maybe Int
u,Maybe Int
w) of
          (Maybe Int
Nothing,Maybe Int
_,Maybe Int
_,Maybe Int
_) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
Nothing,Maybe Int
_,Maybe Int
_) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
_,Maybe Int
Nothing,Maybe Int
_) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
_,Maybe Int
_,Maybe Int
Nothing) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2, Just Int
x3, Just Int
x4) -> EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> a -> a -> EncodedContraints a b
Q Int
forall a. HasCallStack => a
undefined Int
x1 Int
x2 Int
x3 Int
x4)
       String
_   -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
 | Bool
otherwise = Maybe EncodedCnstrs
forall a. Maybe a
Nothing

-- | Is used inside 'readMaybeECG' to remove the 'undefined' inside the 'EncodedCnstrs'.
setWordsN :: Int -> Maybe EncodedCnstrs -> Maybe EncodedCnstrs
setWordsN :: Int -> Maybe EncodedCnstrs -> Maybe EncodedCnstrs
setWordsN Int
_ Maybe EncodedCnstrs
Nothing = Maybe EncodedCnstrs
forall a. Maybe a
Nothing
setWordsN Int
_ (Just (E Int
x)) = EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> EncodedCnstrs
forall a b. a -> EncodedContraints a b
E Int
x)
setWordsN Int
n (Just (T Int
_ Int
i Int
j Int
k)) = EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> a -> EncodedContraints a b
T Int
n Int
i Int
j Int
k)
setWordsN Int
n (Just (Q Int
_ Int
i Int
j Int
k Int
l)) = EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> a -> a -> EncodedContraints a b
Q Int
n Int
i Int
j Int
k Int
l)
setWordsN Int
n (Just (SA Int
_ Int
i Vector Int
v)) = EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Vector Int -> EncodedCnstrs
forall a b. a -> a -> b -> EncodedContraints a b
SA Int
n Int
i Vector Int
v)
setWordsN Int
n (Just (SB Int
_ Int
i Vector Int
v)) = EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Vector Int -> EncodedCnstrs
forall a b. a -> a -> b -> EncodedContraints a b
SB Int
n Int
i Vector Int
v)
setWordsN Int
n (Just (F Int
_ Int
i Int
j)) = EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> EncodedContraints a b
F Int
n Int
i Int
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 :: Int -> String -> Maybe EncodedCnstrs
readMaybeECG Int
n String
xs
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0 = Int -> Maybe EncodedCnstrs -> Maybe EncodedCnstrs
setWordsN Int
n (Maybe EncodedCnstrs -> Maybe EncodedCnstrs)
-> (String -> Maybe EncodedCnstrs) -> String -> Maybe EncodedCnstrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> Maybe EncodedCnstrs
readMaybeEC Int
n (String -> Maybe EncodedCnstrs) -> String -> Maybe EncodedCnstrs
forall a b. (a -> b) -> a -> b
$ String
xs
  | Bool
otherwise = Maybe EncodedCnstrs
forall a. Maybe a
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 :: EncodedCnstrs -> t (Vector Int) -> t (Vector Int)
decodeConstraint1 (E Int
_) = t (Vector Int) -> t (Vector Int)
forall a. a -> a
id
decodeConstraint1 (Q Int
_ Int
i Int
j Int
k Int
l) = Int -> Int -> Int -> Int -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
Int -> Int -> Int -> Int -> t (Vector Int) -> t (Vector Int)
unsafeQuadruples Int
i Int
j Int
k Int
l
decodeConstraint1 (T Int
_ Int
i Int
j Int
k) = Int -> Int -> Int -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
Int -> Int -> Int -> t (Vector Int) -> t (Vector Int)
unsafeTriples Int
i Int
j Int
k
decodeConstraint1 (SA Int
_ Int
i Vector Int
v) = Int -> Vector Int -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
Int -> Vector Int -> t (Vector Int) -> t (Vector Int)
unsafeSeveralA Int
i Vector Int
v
decodeConstraint1 (SB Int
_ Int
i Vector Int
v) = Int -> Vector Int -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
Int -> Vector Int -> t (Vector Int) -> t (Vector Int)
unsafeSeveralB Int
i Vector Int
v
decodeConstraint1 (F Int
_ Int
i Int
j) = Int -> Int -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
Int -> Int -> t (Vector Int) -> t (Vector Int)
filterOrderIJ Int
i Int
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 :: [EncodedCnstrs] -> t (Vector Int) -> t (Vector Int)
decodeLConstraints (EncodedCnstrs
x:[EncodedCnstrs]
xs) = [EncodedCnstrs] -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
[EncodedCnstrs] -> t (Vector Int) -> t (Vector Int)
decodeLConstraints' [EncodedCnstrs]
ys (t (Vector Int) -> t (Vector Int))
-> (t (Vector Int) -> t (Vector Int))
-> t (Vector Int)
-> t (Vector Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodedCnstrs -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
EncodedCnstrs -> t (Vector Int) -> t (Vector Int)
decodeConstraint1 EncodedCnstrs
y
  where y :: EncodedCnstrs
y = [EncodedCnstrs] -> EncodedCnstrs
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (EncodedCnstrs
xEncodedCnstrs -> [EncodedCnstrs] -> [EncodedCnstrs]
forall a. a -> [a] -> [a]
:[EncodedCnstrs]
xs)
        ys :: [EncodedCnstrs]
ys = (EncodedCnstrs -> Bool) -> [EncodedCnstrs] -> [EncodedCnstrs]
forall a. (a -> Bool) -> [a] -> [a]
filter (EncodedCnstrs -> EncodedCnstrs -> Bool
forall a. Eq a => a -> a -> Bool
/= EncodedCnstrs
y) ([EncodedCnstrs] -> [EncodedCnstrs])
-> ([EncodedCnstrs] -> [EncodedCnstrs])
-> [EncodedCnstrs]
-> [EncodedCnstrs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EncodedCnstrs] -> [EncodedCnstrs]
forall a b. [EncodedContraints a b] -> [EncodedContraints a b]
g ([EncodedCnstrs] -> [EncodedCnstrs])
-> [EncodedCnstrs] -> [EncodedCnstrs]
forall a b. (a -> b) -> a -> b
$ (EncodedCnstrs
xEncodedCnstrs -> [EncodedCnstrs] -> [EncodedCnstrs]
forall a. a -> [a] -> [a]
:[EncodedCnstrs]
xs)
        g :: [EncodedContraints a b] -> [EncodedContraints a b]
g ((E a
_):[EncodedContraints a b]
zs) = [EncodedContraints a b] -> [EncodedContraints a b]
g [EncodedContraints a b]
zs
        g (EncodedContraints a b
z:[EncodedContraints a b]
zs) = EncodedContraints a b
z EncodedContraints a b
-> [EncodedContraints a b] -> [EncodedContraints a b]
forall a. a -> [a] -> [a]
: [EncodedContraints a b] -> [EncodedContraints a b]
g [EncodedContraints a b]
zs
        g [EncodedContraints a b]
_ = []
        decodeLConstraints' :: [EncodedCnstrs] -> t (Vector Int) -> t (Vector Int)
decodeLConstraints' (EncodedCnstrs
z:[EncodedCnstrs]
zs) = [EncodedCnstrs] -> t (Vector Int) -> t (Vector Int)
decodeLConstraints' [EncodedCnstrs]
zs (t (Vector Int) -> t (Vector Int))
-> (t (Vector Int) -> t (Vector Int))
-> t (Vector Int)
-> t (Vector Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodedCnstrs -> t (Vector Int) -> t (Vector Int)
forall (t :: * -> *).
(InsertLeft t (Vector Int), Monoid (t (Vector Int))) =>
EncodedCnstrs -> t (Vector Int) -> t (Vector Int)
decodeConstraint1 EncodedCnstrs
z
        decodeLConstraints' [EncodedCnstrs]
_ = t (Vector Int) -> t (Vector Int)
forall a. a -> a
id
decodeLConstraints [EncodedCnstrs]
_ = t (Vector Int) -> t (Vector Int)
forall a. a -> a
id

isE :: EncodedCnstrs -> Bool
isE :: EncodedCnstrs -> Bool
isE (E Int
_) = Bool
True
isE EncodedCnstrs
_ = Bool
False

isF :: EncodedCnstrs -> Bool
isF :: EncodedCnstrs -> Bool
isF (F Int
_ Int
_ Int
_) = Bool
True
isF EncodedCnstrs
_ = Bool
False

isT :: EncodedCnstrs -> Bool
isT :: EncodedCnstrs -> Bool
isT (T Int
_ Int
_ Int
_ Int
_) = Bool
True
isT EncodedCnstrs
_ = Bool
False

isQ :: EncodedCnstrs -> Bool
isQ :: EncodedCnstrs -> Bool
isQ (Q Int
_ Int
_ Int
_ Int
_ Int
_) = Bool
True
isQ EncodedCnstrs
_ = Bool
False

isSA :: EncodedCnstrs -> Bool
isSA :: EncodedCnstrs -> Bool
isSA (SA Int
_ Int
_ Vector Int
_) = Bool
True
isSA EncodedCnstrs
_ = Bool
False

isSB :: EncodedCnstrs -> Bool
isSB :: EncodedCnstrs -> Bool
isSB (SB Int
_ Int
_ Vector Int
_) = Bool
True
isSB EncodedCnstrs
_ = Bool
False

getIEl :: EncodedCnstrs -> Int
getIEl :: EncodedCnstrs -> Int
getIEl (E Int
i) = Int
i
getIEl (Q Int
_ Int
i Int
_ Int
_ Int
_) = Int
i
getIEl (T Int
_ Int
i Int
_ Int
_) = Int
i
getIEl (SA Int
_ Int
i Vector Int
_) = Int
i
getIEl (SB Int
_ Int
i Vector Int
_) = Int
i
getIEl (F Int
_ Int
i Int
_) = Int
i

setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs
setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs
setIEl Int
i (E Int
_) = Int -> EncodedCnstrs
forall a b. a -> EncodedContraints a b
E Int
i
setIEl Int
i (Q Int
n Int
_ Int
j Int
k Int
l) = Int -> Int -> Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> a -> a -> EncodedContraints a b
Q Int
n Int
i Int
j Int
k Int
l
setIEl Int
i (T Int
n Int
_ Int
j Int
k) = Int -> Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> a -> EncodedContraints a b
T Int
n Int
i Int
j Int
k
setIEl Int
i (SA Int
n Int
_ Vector Int
v) = Int -> Int -> Vector Int -> EncodedCnstrs
forall a b. a -> a -> b -> EncodedContraints a b
SA Int
n Int
i Vector Int
v
setIEl Int
i (SB Int
n Int
_ Vector Int
v) = Int -> Int -> Vector Int -> EncodedCnstrs
forall a b. a -> a -> b -> EncodedContraints a b
SB Int
n Int
i Vector Int
v
setIEl Int
i (F Int
n Int
_ Int
j) = Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> EncodedContraints a b
F Int
n Int
i Int
j