{-# 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
  , isV
  , isW
  , isH
  , isR
) where

import GHC.Base
import GHC.List
import GHC.Num ((-),abs)
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 | V a a | W a a | H a a a | R a a a deriving (EncodedContraints a b -> EncodedContraints a b -> Bool
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, EncodedContraints a b -> EncodedContraints a b -> Ordering
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
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
 | forall a. [a] -> Bool
null String
xs = forall a. Maybe a
Nothing
 | Int
n forall a. Ord a => a -> a -> Bool
>=Int
0 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
9 =
     let h :: Char
h = forall a. [a] -> a
head String
xs
         ts :: String
ts = forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
x -> Char
x forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& [Char
x] forall a. Ord a => a -> a -> Bool
<= forall a. Show a => a -> String
show Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ String
xs in
      case Char
h of
       Char
'E' -> forall a. a -> Maybe a
Just (forall a b. a -> EncodedContraints a b
E (forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ String
xs)::Maybe Int)))
       Char
'F' -> let (Maybe Int
y,Maybe Int
z) = (forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int, forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ String
ts)) in
         case (Maybe Int
y,Maybe Int
z) of
          (Maybe Int
Nothing,Maybe Int
_) -> forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
Nothing) -> forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2) -> forall a. a -> Maybe a
Just (forall a b. a -> a -> a -> EncodedContraints a b
F forall a. HasCallStack => a
undefined Int
x1 Int
x2)
       Char
'T' -> let (Maybe Int
y,Maybe Int
z,Maybe Int
u) = (forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int, forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int, forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 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
_) -> forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
Nothing,Maybe Int
_) -> forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
_,Maybe Int
Nothing) -> forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2, Just Int
x3) -> forall a. a -> Maybe a
Just (forall a b. a -> a -> a -> a -> EncodedContraints a b
T forall a. HasCallStack => a
undefined Int
x1 Int
x2 Int
x3)
       Char
'A' -> let y :: Maybe Int
y = forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int in
               if forall a. Maybe a -> Bool
isJust Maybe Int
y then
                let y0 :: Int
y0 = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
y
                    zs :: [Int]
zs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Int
y0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
t -> forall a. Read a => String -> Maybe a
readMaybe [Char
t]::Maybe Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ String
ts in
                     case [Int]
zs of
                       [] -> forall a. Maybe a
Nothing
                       ~[Int]
x2 -> forall a. a -> Maybe a
Just (forall a b. a -> a -> b -> EncodedContraints a b
SA forall a. HasCallStack => a
undefined Int
y0 (forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. [a] -> Int
length [Int]
x2 forall a. Num a => a -> a -> a
- Int
1) [Int]
x2))
               else forall a. Maybe a
Nothing
       Char
'B' -> let y :: Maybe Int
y = forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int in
               if forall a. Maybe a -> Bool
isJust Maybe Int
y then
                let y0 :: Int
y0 = forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
y
                    zs :: [Int]
zs = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Int
y0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
t -> forall a. Read a => String -> Maybe a
readMaybe [Char
t]::Maybe Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ String
ts in
                     case [Int]
zs of
                       [] -> forall a. Maybe a
Nothing
                       ~[Int]
x2 -> forall a. a -> Maybe a
Just (forall a b. a -> a -> b -> EncodedContraints a b
SB forall a. HasCallStack => a
undefined Int
y0 (forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,forall a. [a] -> Int
length [Int]
x2 forall a. Num a => a -> a -> a
- Int
1) [Int]
x2))
               else forall a. Maybe a
Nothing
       Char
'Q' -> let (Maybe Int
y,Maybe Int
z,Maybe Int
u,Maybe Int
w) = (forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 String
ts)::Maybe Int, forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int, forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall a b. (a -> b) -> a -> b
$ String
ts)::Maybe Int,
                    forall a. Read a => String -> Maybe a
readMaybe (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
3 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
_) -> forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
Nothing,Maybe Int
_,Maybe Int
_) -> forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
_,Maybe Int
Nothing,Maybe Int
_) -> forall a. Maybe a
Nothing
          (Maybe Int
_,Maybe Int
_,Maybe Int
_,Maybe Int
Nothing) -> forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2, Just Int
x3, Just Int
x4) -> forall a. a -> Maybe a
Just (forall a b. a -> a -> a -> a -> a -> EncodedContraints a b
Q forall a. HasCallStack => a
undefined Int
x1 Int
x2 Int
x3 Int
x4)
       Char
'P' -> if forall a. [a] -> Bool
null String
ts then forall a. a -> Maybe a
Just (forall a b. a -> EncodedContraints a b
E Int
0) else let l :: Int
l = forall a. [a] -> Int
length String
ts in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> EncodedContraints a b
P Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
lforall a. Num a => a -> a -> a
-Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> case (forall a. HasCallStack => Maybe a -> a
fromJust (forall a. Read a => String -> Maybe a
readMaybe [Char
x]::Maybe Int)) of {Int
0 -> Int
9; Int
n -> Int
n forall a. Num a => a -> a -> a
- Int
1}) forall a b. (a -> b) -> a -> b
$ String
ts
       Char
'W' -> if forall a. [a] -> Int
length String
ts forall a. Eq a => a -> a -> Bool
/= Int
2 then forall a. a -> Maybe a
Just (forall a b. a -> EncodedContraints a b
E Int
0) else let [Int
k,Int
t] = forall a b. (a -> b) -> [a] -> [b]
map  (\Char
x -> case (forall a. HasCallStack => Maybe a -> a
fromJust (forall a. Read a => String -> Maybe a
readMaybe [Char
x]::Maybe Int)) of {Int
0 -> Int
9; Int
n -> Int
n forall a. Num a => a -> a -> a
- Int
1}) forall a b. (a -> b) -> a -> b
$ String
ts in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> a -> EncodedContraints a b
W Int
k forall a b. (a -> b) -> a -> b
$ Int
t
       Char
'V' -> if forall a. [a] -> Int
length String
ts forall a. Eq a => a -> a -> Bool
/= Int
2 then forall a. a -> Maybe a
Just (forall a b. a -> EncodedContraints a b
E Int
0) else let [Int
k,Int
t] = forall a b. (a -> b) -> [a] -> [b]
map  (\Char
x -> case (forall a. HasCallStack => Maybe a -> a
fromJust (forall a. Read a => String -> Maybe a
readMaybe [Char
x]::Maybe Int)) of {Int
0 -> Int
9; Int
n -> Int
n forall a. Num a => a -> a -> a
- Int
1}) forall a b. (a -> b) -> a -> b
$ String
ts in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> a -> EncodedContraints a b
V Int
k forall a b. (a -> b) -> a -> b
$ Int
t
       Char
'H' -> if forall a. [a] -> Int
length String
ts forall a. Eq a => a -> a -> Bool
/= Int
3 then forall a. a -> Maybe a
Just (forall a b. a -> EncodedContraints a b
E Int
0) else let [Int
k,Int
t,Int
w] = forall a b. (a -> b) -> [a] -> [b]
map  (\Char
x -> case (forall a. HasCallStack => Maybe a -> a
fromJust (forall a. Read a => String -> Maybe a
readMaybe [Char
x]::Maybe Int)) of {Int
0 -> Int
9; Int
n -> Int
n forall a. Num a => a -> a -> a
- Int
1}) forall a b. (a -> b) -> a -> b
$ String
ts in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> a -> a -> EncodedContraints a b
H Int
k Int
t forall a b. (a -> b) -> a -> b
$ Int
w 
       Char
'R' -> if forall a. [a] -> Int
length String
ts forall a. Eq a => a -> a -> Bool
/= Int
3 then forall a. a -> Maybe a
Just (forall a b. a -> EncodedContraints a b
E Int
0) else let [Int
k,Int
t,Int
w] = forall a b. (a -> b) -> [a] -> [b]
map  (\Char
x -> case (forall a. HasCallStack => Maybe a -> a
fromJust (forall a. Read a => String -> Maybe a
readMaybe [Char
x]::Maybe Int)) of {Int
0 -> Int
9; Int
n -> Int
n forall a. Num a => a -> a -> a
- Int
1}) forall a b. (a -> b) -> a -> b
$ String
ts in forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> a -> a -> EncodedContraints a b
R Int
k Int
t forall a b. (a -> b) -> a -> b
$ Int
w 
       Char
_   -> forall a. Maybe a
Nothing
 | Bool
otherwise = 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 = forall a. Maybe a
Nothing
setWordsN Int
_ (Just (E Int
x)) = forall a. a -> Maybe a
Just (forall a b. a -> EncodedContraints a b
E Int
x)
setWordsN Int
n (Just (P Int
_ Array Int Int
v)) = forall a. a -> Maybe a
Just (forall a b. a -> b -> EncodedContraints a b
P Int
n Array Int Int
v)
setWordsN Int
n (Just (T Int
_ Int
i Int
j Int
k)) = forall a. a -> Maybe a
Just (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)) = forall a. a -> Maybe a
Just (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 Array Int Int
v)) = forall a. a -> Maybe a
Just (forall a b. a -> a -> b -> EncodedContraints a b
SA Int
n Int
i Array Int Int
v)
setWordsN Int
n (Just (SB Int
_ Int
i Array Int Int
v)) = forall a. a -> Maybe a
Just (forall a b. a -> a -> b -> EncodedContraints a b
SB Int
n Int
i Array Int Int
v)
setWordsN Int
n (Just (F Int
_ Int
i Int
j)) = forall a. a -> Maybe a
Just (forall a b. a -> a -> a -> EncodedContraints a b
F Int
n Int
i Int
j)
setWordsN Int
_ Maybe EncodedCnstrs
cnstr = Maybe EncodedCnstrs
cnstr

-- | 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 forall a. Ord a => a -> a -> Bool
<= Int
9 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
>=Int
0 = Int -> Maybe EncodedCnstrs -> Maybe EncodedCnstrs
setWordsN Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> Maybe EncodedCnstrs
readMaybeEC Int
n forall a b. (a -> b) -> a -> b
$ String
xs
  | Bool
otherwise = forall a. Maybe a
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 :: forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)
decodeConstraint1 (E Int
_) = forall a. a -> a
id
decodeConstraint1 (P Int
_ Array Int Int
v) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Array Int Int -> t (Array Int Int) -> t (Array Int Int)
fixedPointsS Array Int Int
v
decodeConstraint1 (Q Int
_ Int
i Int
j Int
k Int
l) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int -> Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
unsafeQuadruples Int
i Int
j Int
k Int
l
decodeConstraint1 (T Int
_ Int
i Int
j Int
k) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
unsafeTriples Int
i Int
j Int
k
decodeConstraint1 (SA Int
_ Int
i Array Int Int
v) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)
unsafeSeveralA Int
i Array Int Int
v
decodeConstraint1 (SB Int
_ Int
i Array Int Int
v) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int -> Array Int Int -> t (Array Int Int) -> t (Array Int Int)
unsafeSeveralB Int
i Array Int Int
v
decodeConstraint1 (F Int
_ Int
i Int
j) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterOrderIJ Int
i Int
j
decodeConstraint1 (V Int
i Int
j) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterSignDistanceIJ Int
i Int
j (Int
j forall a. Num a => a -> a -> a
- Int
i)
decodeConstraint1 (W Int
i Int
j) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int -> Int -> Int -> t (Array Int Int) -> t (Array Int Int)
filterUnsignDistanceIJ Int
i Int
j (forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ Int
j forall a. Num a => a -> a -> a
- Int
i)
decodeConstraint1 (H Int
i Int
j Int
k) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int
-> Int
-> Int
-> Int
-> Int
-> t (Array Int Int)
-> t (Array Int Int)
filterSignDistanceIJK3 Int
i Int
j Int
k (Int
j forall a. Num a => a -> a -> a
- Int
i) (Int
k forall a. Num a => a -> a -> a
- Int
j)
decodeConstraint1 (R Int
i Int
j Int
k) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
Int
-> Int
-> Int
-> Int
-> Int
-> t (Array Int Int)
-> t (Array Int Int)
filterUnsignDistanceIJK3 Int
i Int
j Int
k (forall a. Num a => a -> a
abs (Int
j forall a. Num a => a -> a -> a
- Int
i)) (forall a. Num a => a -> a
abs (Int
k forall a. Num a => a -> a -> a
- Int
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 :: forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints (EncodedCnstrs
x:[EncodedCnstrs]
xs) = forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
[EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints' [EncodedCnstrs]
ys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)
decodeConstraint1 EncodedCnstrs
y
  where y :: EncodedCnstrs
y = forall a. Ord a => [a] -> a
minimum (EncodedCnstrs
xforall a. a -> [a] -> [a]
:[EncodedCnstrs]
xs)
        ys :: [EncodedCnstrs]
ys = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= EncodedCnstrs
y) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. [EncodedContraints a b] -> [EncodedContraints a b]
g forall a b. (a -> b) -> a -> b
$ (EncodedCnstrs
xforall 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 forall a. a -> [a] -> [a]
: [EncodedContraints a b] -> [EncodedContraints a b]
g [EncodedContraints a b]
zs
        g [EncodedContraints a b]
_ = []
        decodeLConstraints' :: [EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints' (EncodedCnstrs
z:[EncodedCnstrs]
zs) = [EncodedCnstrs] -> t (Array Int Int) -> t (Array Int Int)
decodeLConstraints' [EncodedCnstrs]
zs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)
decodeConstraint1 EncodedCnstrs
z
        decodeLConstraints' [EncodedCnstrs]
_ = forall a. a -> a
id
decodeLConstraints [EncodedCnstrs]
_ = forall a. a -> a
id

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

isP :: EncodedCnstrs -> Bool
isP :: EncodedCnstrs -> Bool
isP (P Int
_ Array Int Int
_) = Bool
True
isP 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
_ Array Int Int
_) = Bool
True
isSA EncodedCnstrs
_ = Bool
False

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

isV :: EncodedCnstrs -> Bool
isV :: EncodedCnstrs -> Bool
isV (V Int
_ Int
_) = Bool
True
isV EncodedCnstrs
_ = Bool
False

isW :: EncodedCnstrs -> Bool
isW :: EncodedCnstrs -> Bool
isW (W Int
_ Int
_) = Bool
True
isW EncodedCnstrs
_ = Bool
False

isH :: EncodedCnstrs -> Bool
isH :: EncodedCnstrs -> Bool
isH (H Int
_ Int
_ Int
_) = Bool
True
isH EncodedCnstrs
_ = Bool
False

isR :: EncodedCnstrs -> Bool
isR :: EncodedCnstrs -> Bool
isR (R Int
_ Int
_ Int
_) = Bool
True
isR EncodedCnstrs
_ = Bool
False

{-| Works only with the correctly defined argument though it is not checked. Use with this caution.
-}
getIEl :: EncodedCnstrs -> Int
getIEl :: EncodedCnstrs -> Int
getIEl (E Int
i) = Int
i
getIEl (P Int
_ Array Int Int
arr) = forall i e. Array i e -> Int -> e
unsafeAt Array Int Int
arr Int
0
getIEl (Q Int
_ Int
i Int
_ Int
_ Int
_) = Int
i
getIEl (T Int
_ Int
i Int
_ Int
_) = Int
i
getIEl (SA Int
_ Int
i Array Int Int
_) = Int
i
getIEl (SB Int
_ Int
i Array Int Int
_) = Int
i
getIEl (F Int
_ Int
i Int
_) = Int
i
getIEl (V Int
i Int
_) = Int
i
getIEl (W Int
i Int
_) = Int
i
getIEl (H Int
i Int
_ Int
_) = Int
i
getIEl (R Int
i Int
_ Int
_) = Int
i

{-| Works only with the correctly defined arguments though it is not checked. Use with this caution.
-}
setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs
setIEl :: Int -> EncodedCnstrs -> EncodedCnstrs
setIEl Int
i (E Int
_) = forall a b. a -> EncodedContraints a b
E Int
i
setIEl Int
i (P Int
n Array Int Int
arr) = forall a b. a -> b -> EncodedContraints a b
P Int
n (Array Int Int
arr forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [(Int
0,Int
i)])
setIEl Int
i (Q Int
n Int
_ Int
j Int
k Int
l) = 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) = 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
_ Array Int Int
v) = forall a b. a -> a -> b -> EncodedContraints a b
SA Int
n Int
i Array Int Int
v
setIEl Int
i (SB Int
n Int
_ Array Int Int
v) = forall a b. a -> a -> b -> EncodedContraints a b
SB Int
n Int
i Array Int Int
v
setIEl Int
i (F Int
n Int
_ Int
j) = forall a b. a -> a -> a -> EncodedContraints a b
F Int
n Int
i Int
j
setIEl Int
i (V Int
_ Int
j) = forall a b. a -> a -> EncodedContraints a b
V Int
i Int
j
setIEl Int
i (W Int
_ Int
j) = forall a b. a -> a -> EncodedContraints a b
W Int
i Int
j
setIEl Int
i (H Int
_ Int
j Int
k) = forall a b. a -> a -> a -> EncodedContraints a b
H Int
i Int
j Int
k
setIEl Int
i (R Int
_ Int
j Int
k) = forall a b. a -> a -> a -> EncodedContraints a b
R Int
i Int
j Int
k