-- |
-- Module      :  Languages.UniquenessPeriods.Vector.ConstraintsG.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 #-}

module Languages.UniquenessPeriods.Vector.ConstraintsG.Encoded where

import Data.Monoid (mappend)
import Text.Read (readMaybe)
import Data.Maybe
import qualified Data.Vector as VB
import Data.List (intercalate,sort,nub)
import Languages.UniquenessPeriods.Vector.ConstraintsG

data EncodedContraints a b = E a | T a a a | SA a b | SB a b | F 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
readMaybeEC :: String -> Maybe EncodedCnstrs
readMaybeEC :: String -> Maybe EncodedCnstrs
readMaybeEC String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> EncodedCnstrs
forall a b. a -> EncodedContraints a b
E Int
0)
 | Bool
otherwise =
     let (String
h,String
ts) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 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
r2) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
r1,Maybe Int
Nothing) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2) -> if Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 Bool -> Bool -> Bool
&& Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 then EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> EncodedCnstrs
forall a b. a -> a -> EncodedContraints a b
F Int
x1 Int
x2) else Maybe EncodedCnstrs
forall a. Maybe a
Nothing
       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
r2,Maybe Int
r3) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
r1,Maybe Int
Nothing,Maybe Int
r3) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
r1,Maybe Int
r2,Maybe Int
Nothing) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          ~(Just Int
x1, Just Int
x2, Just Int
x3) -> if Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 Bool -> Bool -> Bool
&& Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 Bool -> Bool -> Bool
&& Int
x3 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 then EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> EncodedContraints a b
T Int
x1 Int
x2 Int
x3) else Maybe EncodedCnstrs
forall a. Maybe a
Nothing
       String
"A" -> let (Maybe Int
y,[Int]
zs) = (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, (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7) ([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 (Maybe Int
y,[Int]
zs) of
          (Maybe Int
Nothing,[Int]
r2) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,[]) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          ~(Just Int
x1, [Int]
x2) -> if Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 then EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Vector Int -> EncodedCnstrs
forall a b. a -> b -> EncodedContraints a b
SA Int
x1 ([Int] -> Vector Int
forall a. [a] -> Vector a
VB.fromList [Int]
x2)) else Maybe EncodedCnstrs
forall a. Maybe a
Nothing
       String
"B" -> let (Maybe Int
y,[Int]
zs) = (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, (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7) ([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 (Maybe Int
y,[Int]
zs) of
          (Maybe Int
Nothing,[Int]
r2) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          (Maybe Int
_,[]) -> Maybe EncodedCnstrs
forall a. Maybe a
Nothing
          ~(Just Int
x1, [Int]
x2) -> if Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
7 then EncodedCnstrs -> Maybe EncodedCnstrs
forall a. a -> Maybe a
Just (Int -> Vector Int -> EncodedCnstrs
forall a b. a -> b -> EncodedContraints a b
SB Int
x1 ([Int] -> Vector Int
forall a. [a] -> Vector a
VB.fromList [Int]
x2)) else Maybe EncodedCnstrs
forall a. Maybe a
Nothing
       String
_   -> 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).
decodeConstraint1 :: EncodedCnstrs -> VB.Vector (VB.Vector Int) -> VB.Vector (VB.Vector Int)
decodeConstraint1 :: EncodedCnstrs -> Vector (Vector Int) -> Vector (Vector Int)
decodeConstraint1 (E Int
_) = Vector (Vector Int) -> Vector (Vector Int)
forall a. a -> a
id
decodeConstraint1 (T Int
i Int
j Int
k) = Int -> Int -> Int -> Vector (Vector Int) -> Vector (Vector Int)
unsafeTriples Int
i Int
j Int
k
decodeConstraint1 (SA Int
i Vector Int
v) = Int -> Vector Int -> Vector (Vector Int) -> Vector (Vector Int)
unsafeSeveralA Int
i Vector Int
v
decodeConstraint1 (SB Int
i Vector Int
v) = Int -> Vector Int -> Vector (Vector Int) -> Vector (Vector Int)
unsafeSeveralB Int
i Vector Int
v
decodeConstraint1 (F Int
i Int
j) = Int -> Int -> Vector (Vector Int) -> Vector (Vector Int)
filterOrderIJ Int
i Int
j

decodeLConstraints :: [EncodedCnstrs] -> VB.Vector (VB.Vector Int) -> VB.Vector (VB.Vector Int)
decodeLConstraints :: [EncodedCnstrs] -> Vector (Vector Int) -> Vector (Vector Int)
decodeLConstraints (EncodedCnstrs
x:[EncodedCnstrs]
xs) Vector (Vector Int)
v = [EncodedCnstrs] -> Vector (Vector Int) -> Vector (Vector Int)
decodeLConstraints [EncodedCnstrs]
ys (Vector (Vector Int) -> Vector (Vector Int))
-> (Vector (Vector Int) -> Vector (Vector Int))
-> Vector (Vector Int)
-> Vector (Vector Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncodedCnstrs -> Vector (Vector Int) -> Vector (Vector Int)
decodeConstraint1 EncodedCnstrs
y (Vector (Vector Int) -> Vector (Vector Int))
-> Vector (Vector Int) -> Vector (Vector Int)
forall a b. (a -> b) -> a -> b
$ Vector (Vector Int)
v
  where (EncodedCnstrs
y:[EncodedCnstrs]
ys) = [EncodedCnstrs] -> [EncodedCnstrs]
forall a. Ord a => [a] -> [a]
sort (EncodedCnstrs
xEncodedCnstrs -> [EncodedCnstrs] -> [EncodedCnstrs]
forall a. a -> [a] -> [a]
:[EncodedCnstrs]
xs)
decodeLConstraints [] Vector (Vector Int)
v = Vector (Vector Int)
v

getIEl :: EncodedCnstrs -> Int
getIEl :: EncodedCnstrs -> Int
getIEl (E Int
i) = Int
i
getIEl (T Int
i Int
_ Int
_) = Int
i
getIEl (SA Int
i Vector Int
_) = Int
i
getIEl (SB Int
i Vector Int
_) = Int
i
getIEl (F 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 (T Int
_ Int
j Int
k) = Int -> Int -> Int -> EncodedCnstrs
forall a b. a -> a -> a -> EncodedContraints a b
T Int
i Int
j Int
k
setIEl Int
i (SA Int
_ Vector Int
v) = Int -> Vector Int -> EncodedCnstrs
forall a b. a -> b -> EncodedContraints a b
SA Int
i Vector Int
v
setIEl Int
i (SB Int
_ Vector Int
v) = Int -> Vector Int -> EncodedCnstrs
forall a b. a -> b -> EncodedContraints a b
SB Int
i Vector Int
v
setIEl Int
i (F Int
_ Int
j) = Int -> Int -> EncodedCnstrs
forall a b. a -> a -> EncodedContraints a b
F Int
i Int
j