{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}

module PropaFP.VarMap where

import MixedTypesNumPrelude
import Data.List as L
import AERN2.BoxFun.Optimisation
import AERN2.MP.Ball (MPBall, endpoints, fromEndpointsAsIntervals, mpBallP)
import AERN2.BoxFun.TestFunctions (fromListDomain)
import AERN2.BoxFun.Box (Box)
import qualified AERN2.Linear.Vector.Type as V
import Data.Tuple.Extra

import Debug.Trace as T
import Prelude (Ord)
import qualified Prelude as P
import qualified Data.Functor.Contravariant as P
import qualified Data.Functor.Contravariant as P
import AERN2.MP.Precision
import Data.Ratio
-- data VarType = Integer | Real 
  -- deriving (Show, P.Eq, P.Ord) 

-- TODO: Add VarType to VarMap, or make new VarMap type
-- | An assosciation list mapping variable names to rational interval domains
data VarType = Real | Integer
  deriving (Int -> VarType -> ShowS
[VarType] -> ShowS
VarType -> String
(Int -> VarType -> ShowS)
-> (VarType -> String) -> ([VarType] -> ShowS) -> Show VarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarType] -> ShowS
$cshowList :: [VarType] -> ShowS
show :: VarType -> String
$cshow :: VarType -> String
showsPrec :: Int -> VarType -> ShowS
$cshowsPrec :: Int -> VarType -> ShowS
Show, VarType -> VarType -> Bool
(VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool) -> Eq VarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarType -> VarType -> Bool
$c/= :: VarType -> VarType -> Bool
== :: VarType -> VarType -> Bool
$c== :: VarType -> VarType -> Bool
P.Eq, Eq VarType
Eq VarType
-> (VarType -> VarType -> Ordering)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> Bool)
-> (VarType -> VarType -> VarType)
-> (VarType -> VarType -> VarType)
-> Ord VarType
VarType -> VarType -> Bool
VarType -> VarType -> Ordering
VarType -> VarType -> VarType
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
min :: VarType -> VarType -> VarType
$cmin :: VarType -> VarType -> VarType
max :: VarType -> VarType -> VarType
$cmax :: VarType -> VarType -> VarType
>= :: VarType -> VarType -> Bool
$c>= :: VarType -> VarType -> Bool
> :: VarType -> VarType -> Bool
$c> :: VarType -> VarType -> Bool
<= :: VarType -> VarType -> Bool
$c<= :: VarType -> VarType -> Bool
< :: VarType -> VarType -> Bool
$c< :: VarType -> VarType -> Bool
compare :: VarType -> VarType -> Ordering
$ccompare :: VarType -> VarType -> Ordering
P.Ord)

type VarInterval = (String, (Rational, Rational))

data TypedVarInterval = TypedVar VarInterval VarType
  deriving (Int -> TypedVarInterval -> ShowS
[TypedVarInterval] -> ShowS
TypedVarInterval -> String
(Int -> TypedVarInterval -> ShowS)
-> (TypedVarInterval -> String)
-> ([TypedVarInterval] -> ShowS)
-> Show TypedVarInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypedVarInterval] -> ShowS
$cshowList :: [TypedVarInterval] -> ShowS
show :: TypedVarInterval -> String
$cshow :: TypedVarInterval -> String
showsPrec :: Int -> TypedVarInterval -> ShowS
$cshowsPrec :: Int -> TypedVarInterval -> ShowS
Show, TypedVarInterval -> TypedVarInterval -> Bool
(TypedVarInterval -> TypedVarInterval -> Bool)
-> (TypedVarInterval -> TypedVarInterval -> Bool)
-> Eq TypedVarInterval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypedVarInterval -> TypedVarInterval -> Bool
$c/= :: TypedVarInterval -> TypedVarInterval -> Bool
== :: TypedVarInterval -> TypedVarInterval -> Bool
$c== :: TypedVarInterval -> TypedVarInterval -> Bool
P.Eq, Eq TypedVarInterval
Eq TypedVarInterval
-> (TypedVarInterval -> TypedVarInterval -> Ordering)
-> (TypedVarInterval -> TypedVarInterval -> Bool)
-> (TypedVarInterval -> TypedVarInterval -> Bool)
-> (TypedVarInterval -> TypedVarInterval -> Bool)
-> (TypedVarInterval -> TypedVarInterval -> Bool)
-> (TypedVarInterval -> TypedVarInterval -> TypedVarInterval)
-> (TypedVarInterval -> TypedVarInterval -> TypedVarInterval)
-> Ord TypedVarInterval
TypedVarInterval -> TypedVarInterval -> Bool
TypedVarInterval -> TypedVarInterval -> Ordering
TypedVarInterval -> TypedVarInterval -> TypedVarInterval
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
min :: TypedVarInterval -> TypedVarInterval -> TypedVarInterval
$cmin :: TypedVarInterval -> TypedVarInterval -> TypedVarInterval
max :: TypedVarInterval -> TypedVarInterval -> TypedVarInterval
$cmax :: TypedVarInterval -> TypedVarInterval -> TypedVarInterval
>= :: TypedVarInterval -> TypedVarInterval -> Bool
$c>= :: TypedVarInterval -> TypedVarInterval -> Bool
> :: TypedVarInterval -> TypedVarInterval -> Bool
$c> :: TypedVarInterval -> TypedVarInterval -> Bool
<= :: TypedVarInterval -> TypedVarInterval -> Bool
$c<= :: TypedVarInterval -> TypedVarInterval -> Bool
< :: TypedVarInterval -> TypedVarInterval -> Bool
$c< :: TypedVarInterval -> TypedVarInterval -> Bool
compare :: TypedVarInterval -> TypedVarInterval -> Ordering
$ccompare :: TypedVarInterval -> TypedVarInterval -> Ordering
P.Ord)

type VarMap = [VarInterval]

type TypedVarMap = [TypedVarInterval]


-- instance P.Contravariant VarInterval where

-- | Get the width of the widest interval
-- Fixme: maxWidth
maxWidth :: VarMap -> Rational
maxWidth :: [(String, (Rational, Rational))] -> Rational
maxWidth [] = Rational
0.0
maxWidth [(String, (Rational, Rational))]
vMap = [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
L.maximum (((String, (Rational, Rational)) -> Rational)
-> [(String, (Rational, Rational))] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_, (Rational, Rational)
ds) -> (Rational, Rational) -> Rational
forall a b. (a, b) -> b
snd (Rational, Rational)
ds Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Rational, Rational) -> Rational
forall a b. (a, b) -> a
fst (Rational, Rational)
ds) [(String, (Rational, Rational))]
vMap)

typedMaxWidth :: TypedVarMap -> Rational
typedMaxWidth :: [TypedVarInterval] -> Rational
typedMaxWidth [] = Rational
0.0
typedMaxWidth [TypedVarInterval]
vMap = [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
L.maximum ((TypedVarInterval -> Rational) -> [TypedVarInterval] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\(TypedVar (String
_, (Rational, Rational)
ds) VarType
_) -> (Rational, Rational) -> Rational
forall a b. (a, b) -> b
snd (Rational, Rational)
ds Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Rational, Rational) -> Rational
forall a b. (a, b) -> a
fst (Rational, Rational)
ds) [TypedVarInterval]
vMap)

-- | Get the sum of the width of each interval
taxicabWidth :: VarMap -> Rational
taxicabWidth :: [(String, (Rational, Rational))] -> Rational
taxicabWidth [(String, (Rational, Rational))]
vMap = [Rational] -> Rational
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
L.sum (((String, (Rational, Rational)) -> Rational)
-> [(String, (Rational, Rational))] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_, (Rational, Rational)
ds) -> (Rational, Rational) -> Rational
forall a b. (a, b) -> b
snd (Rational, Rational)
ds Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (Rational, Rational) -> Rational
forall a b. (a, b) -> a
fst (Rational, Rational)
ds) [(String, (Rational, Rational))]
vMap)

-- | Increase the diameter of all variables in a varMap by the given rational
increaseDiameter :: VarMap -> Rational -> VarMap
increaseDiameter :: [(String, (Rational, Rational))]
-> Rational -> [(String, (Rational, Rational))]
increaseDiameter [] Rational
_ = []
increaseDiameter ((String
v, (Rational
l, Rational
r)) : [(String, (Rational, Rational))]
vs) Rational
d = ((String
v, (Rational
l Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Rational
d, Rational
r Rational -> Rational -> AddType Rational Rational
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Rational
d)) (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
vs)

-- | Increase the radius of all variables in a varMap by the given rational
increaseRadius :: VarMap -> Rational -> VarMap
increaseRadius :: [(String, (Rational, Rational))]
-> Rational -> [(String, (Rational, Rational))]
increaseRadius [(String, (Rational, Rational))]
vm Rational
r = [(String, (Rational, Rational))]
-> Rational -> [(String, (Rational, Rational))]
increaseDiameter [(String, (Rational, Rational))]
vm (Rational
rRational -> Integer -> DivType Rational Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)

-- | Bisect all elements in a given VarMap
fullBisect :: VarMap -> [VarMap]
fullBisect :: [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
fullBisect [(String, (Rational, Rational))]
vMap = case [(String, (Rational, Rational))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(String, (Rational, Rational))]
vMap of
        Int
0 -> [[(String, (Rational, Rational))]
vMap]
        Int
l ->
            -- y is the dimension bisected in the current iteration
            -- x is a bisection of the previous dimension (tail recursion)
            ([(String, (Rational, Rational))]
 -> [[(String, (Rational, Rational))]])
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[(String, (Rational, Rational))]
x -> ((String, (Rational, Rational))
 -> [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, (Rational, Rational))
y -> [(String, (Rational, Rational))]
x [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. [a] -> [a] -> [a]
++ [(String, (Rational, Rational))
y]) (Integer -> [(String, (Rational, Rational))]
bisectDimension (Int
lInt -> Integer -> SubType Int Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1))) ([(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
fullBisect (Int
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. Int -> [a] -> [a]
L.take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
lInt -> Integer -> SubType Int Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1)) [(String, (Rational, Rational))]
vMap))

            where
                bisectDimension :: Integer -> [(String, (Rational, Rational))]
bisectDimension Integer
n = [([(String, (Rational, Rational))],
 [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
forall a b. (a, b) -> a
fst ([(String, (Rational, Rational))],
 [(String, (Rational, Rational))])
bn [(String, (Rational, Rational))]
-> Int -> (String, (Rational, Rational))
forall a. [a] -> Int -> a
L.!! (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
n), ([(String, (Rational, Rational))],
 [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
forall a b. (a, b) -> b
snd ([(String, (Rational, Rational))],
 [(String, (Rational, Rational))])
bn [(String, (Rational, Rational))]
-> Int -> (String, (Rational, Rational))
forall a. [a] -> Int -> a
L.!! (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
n)]
                    where bn :: ([(String, (Rational, Rational))],
 [(String, (Rational, Rational))])
bn = Integer
-> [(String, (Rational, Rational))]
-> ([(String, (Rational, Rational))],
    [(String, (Rational, Rational))])
bisectN Integer
n [(String, (Rational, Rational))]
vMap

-- | Bisect the domain of the given interval, resulting in a pair
-- Vars
bisectInterval :: (String, (Rational, Rational)) -> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectInterval :: (String, (Rational, Rational))
-> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectInterval (String
var, (Rational
lower, Rational
upper)) = ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectedVar
  where
    varCentre :: DivType Rational Integer
varCentre = (Rational
lower Rational -> Rational -> AddType Rational Rational
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Rational
upper) Rational -> Integer -> DivType Rational Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ Integer
2
    bisectedVar :: ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectedVar = ((String
var, (Rational
lower, Rational
DivType Rational Integer
varCentre)), (String
var, (Rational
DivType Rational Integer
varCentre, Rational
upper)))

bisectTypedInterval :: (String, (Rational, Rational)) -> VarType -> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectTypedInterval :: (String, (Rational, Rational))
-> VarType
-> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectTypedInterval (String
var, (Rational
lower, Rational
upper)) VarType
Real = ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectedVar
  where
    varCentre :: DivType Rational Integer
varCentre = (Rational
lower Rational -> Rational -> AddType Rational Rational
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Rational
upper) Rational -> Integer -> DivType Rational Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ Integer
2
    bisectedVar :: ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectedVar = ((String
var, (Rational
lower, Rational
DivType Rational Integer
varCentre)), (String
var, (Rational
DivType Rational Integer
varCentre, Rational
upper)))
bisectTypedInterval (String
var, (Rational
lower, Rational
upper)) VarType
Integer = ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectedVar
  where
    varCentre :: DivType Rational Integer
varCentre = (Rational
lower Rational -> Rational -> AddType Rational Rational
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Rational
upper) Rational -> Integer -> DivType Rational Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ Integer
2
    bisectedVar :: ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectedVar = ((String
var, (Rational
lower, Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
floor Rational
DivType Rational Integer
varCentre Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)), (String
var, (Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
ceiling Rational
DivType Rational Integer
varCentre Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1, Rational
upper)))

-- | Bisect the given dimension of the given VarMap,
-- resulting in a pair of VarMaps
bisectN :: Integer ->  VarMap -> (VarMap, VarMap)
bisectN :: Integer
-> [(String, (Rational, Rational))]
-> ([(String, (Rational, Rational))],
    [(String, (Rational, Rational))])
bisectN Integer
n [(String, (Rational, Rational))]
vMap =
  (
    ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, (Rational, Rational))
v -> if (String, (Rational, Rational)) -> String
forall a b. (a, b) -> a
fst (String, (Rational, Rational))
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== (String, (Rational, Rational)) -> String
forall a b. (a, b) -> a
fst (String, (Rational, Rational))
fstBisect then (String, (Rational, Rational))
fstBisect else (String, (Rational, Rational))
v) [(String, (Rational, Rational))]
vMap,
    ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, (Rational, Rational))
v -> if (String, (Rational, Rational)) -> String
forall a b. (a, b) -> a
fst (String, (Rational, Rational))
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== (String, (Rational, Rational)) -> String
forall a b. (a, b) -> a
fst (String, (Rational, Rational))
sndBisect then (String, (Rational, Rational))
sndBisect else (String, (Rational, Rational))
v) [(String, (Rational, Rational))]
vMap
  )
  where
    ((String, (Rational, Rational))
fstBisect, (String, (Rational, Rational))
sndBisect) = (String, (Rational, Rational))
-> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectInterval ([(String, (Rational, Rational))]
vMap [(String, (Rational, Rational))]
-> Int -> (String, (Rational, Rational))
forall a. [a] -> Int -> a
L.!! (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
n))

bisectVar :: VarMap -> String -> (VarMap, VarMap)
bisectVar :: [(String, (Rational, Rational))]
-> String
-> ([(String, (Rational, Rational))],
    [(String, (Rational, Rational))])
bisectVar [] String
_ = ([], [])
bisectVar (v :: (String, (Rational, Rational))
v@(String
currentVar, (Rational
_, Rational
_)) : [(String, (Rational, Rational))]
vm) String
bisectionVar =
  if String
currentVar String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== String
bisectionVar
    then ((String, (Rational, Rational))
leftBisection (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
vm, (String, (Rational, Rational))
rightBisection (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
vm)
    else ((String, (Rational, Rational))
v (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
leftList, (String, (Rational, Rational))
v (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
rightList)
  where
    ((String, (Rational, Rational))
leftBisection, (String, (Rational, Rational))
rightBisection) = (String, (Rational, Rational))
-> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectInterval (String, (Rational, Rational))
v
    ([(String, (Rational, Rational))]
leftList, [(String, (Rational, Rational))]
rightList) = [(String, (Rational, Rational))]
-> String
-> ([(String, (Rational, Rational))],
    [(String, (Rational, Rational))])
bisectVar [(String, (Rational, Rational))]
vm String
bisectionVar

bisectTypedVar :: TypedVarMap -> String -> (TypedVarMap, TypedVarMap)
bisectTypedVar :: [TypedVarInterval]
-> String -> ([TypedVarInterval], [TypedVarInterval])
bisectTypedVar [] String
_ = ([], [])
bisectTypedVar (v :: TypedVarInterval
v@((TypedVar i :: (String, (Rational, Rational))
i@(String
currentVar, (Rational
_, Rational
_)) VarType
Real)) : [TypedVarInterval]
vm) String
bisectionVar =
  if String
currentVar String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== String
bisectionVar
    then ((String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String, (Rational, Rational))
leftBisection VarType
Real TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
vm, (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String, (Rational, Rational))
rightBisection VarType
Real TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
vm)
    else (TypedVarInterval
v TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
leftList, TypedVarInterval
v TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
rightList)
  where
    ((String, (Rational, Rational))
leftBisection, (String, (Rational, Rational))
rightBisection) = (String, (Rational, Rational))
-> VarType
-> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectTypedInterval (String, (Rational, Rational))
i VarType
Real
    ([TypedVarInterval]
leftList, [TypedVarInterval]
rightList) = [TypedVarInterval]
-> String -> ([TypedVarInterval], [TypedVarInterval])
bisectTypedVar [TypedVarInterval]
vm String
bisectionVar
bisectTypedVar (v :: TypedVarInterval
v@((TypedVar i :: (String, (Rational, Rational))
i@(String
currentVar, (Rational
_, Rational
_)) VarType
Integer)) : [TypedVarInterval]
vm) String
bisectionVar =
  if String
currentVar String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== String
bisectionVar
    then ((String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String, (Rational, Rational))
leftBisection VarType
Integer TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
vm, (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String, (Rational, Rational))
rightBisection VarType
Integer TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
vm)
    else (TypedVarInterval
v TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
leftList, TypedVarInterval
v TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
rightList)
  where
    ((String, (Rational, Rational))
leftBisection, (String, (Rational, Rational))
rightBisection) = (String, (Rational, Rational))
-> VarType
-> ((String, (Rational, Rational)), (String, (Rational, Rational)))
bisectTypedInterval (String, (Rational, Rational))
i VarType
Integer
    ([TypedVarInterval]
leftList, [TypedVarInterval]
rightList) = [TypedVarInterval]
-> String -> ([TypedVarInterval], [TypedVarInterval])
bisectTypedVar [TypedVarInterval]
vm String
bisectionVar


-- | Check whether or not v1 contain v2.
contains :: VarMap -> VarMap -> Bool
contains :: [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))] -> Bool
contains [(String, (Rational, Rational))]
v1 [(String, (Rational, Rational))]
v2 =
  (((String, (Rational, Rational)), (String, (Rational, Rational)))
 -> Bool)
-> [((String, (Rational, Rational)),
     (String, (Rational, Rational)))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.all (\((String
v1v, (Rational
v1l, Rational
v1r)), (String
v2v, (Rational
v2l, Rational
v2r))) -> String
v1v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== String
v2v Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Rational
v1l Rational -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Rational
v2l Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Rational
v2r Rational -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Rational
v1r) ([(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
-> [((String, (Rational, Rational)),
     (String, (Rational, Rational)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, (Rational, Rational))]
v1' [(String, (Rational, Rational))]
v2')
  where
    v1' :: [(String, (Rational, Rational))]
v1' = [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. Ord a => [a] -> [a]
sort [(String, (Rational, Rational))]
v1
    v2' :: [(String, (Rational, Rational))]
v2' = [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. Ord a => [a] -> [a]
sort [(String, (Rational, Rational))]
v2

-- | Convert VarMap to SearchBox with the provided minimum
toSearchBox :: VarMap -> CN MPBall -> SearchBox
toSearchBox :: [(String, (Rational, Rational))] -> CN MPBall -> SearchBox
toSearchBox [(String, (Rational, Rational))]
vMap = Box -> CN MPBall -> SearchBox
SearchBox ([(Rational, Rational)] -> Box
fromListDomain (((String, (Rational, Rational)) -> (Rational, Rational))
-> [(String, (Rational, Rational))] -> [(Rational, Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Rational, Rational)) -> (Rational, Rational)
forall a b. (a, b) -> b
snd [(String, (Rational, Rational))]
vMap))

centre :: VarMap -> VarMap
centre :: [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
centre = ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,(Rational
dL,Rational
dR)) -> (String
x, ((Rational
dRRational -> Rational -> AddType Rational Rational
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Rational
dL)Rational -> Integer -> DivType Rational Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2,(Rational
dRRational -> Rational -> AddType Rational Rational
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Rational
dL)Rational -> Integer -> DivType Rational Integer
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/Integer
2)))

varMapToBox :: VarMap -> Precision -> Box
varMapToBox :: [(String, (Rational, Rational))] -> Precision -> Box
varMapToBox [(String, (Rational, Rational))]
vs Precision
p = [CN MPBall] -> Box
forall a. [a] -> Vector a
V.fromList ([CN MPBall] -> Box) -> [CN MPBall] -> Box
forall a b. (a -> b) -> a -> b
$ ((String, (Rational, Rational)) -> CN MPBall)
-> [(String, (Rational, Rational))] -> [CN MPBall]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_,(Rational
l,Rational
r)) -> CN MPBall -> CN MPBall -> CN MPBall
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals (MPBall -> CN MPBall
forall v. v -> CN v
cn (Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Rational
l)) (MPBall -> CN MPBall
forall v. v -> CN v
cn (Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Rational
r))) [(String, (Rational, Rational))]
vs

typedVarMapToBox :: TypedVarMap -> Precision -> Box
typedVarMapToBox :: [TypedVarInterval] -> Precision -> Box
typedVarMapToBox [TypedVarInterval]
vs Precision
p = [CN MPBall] -> Box
forall a. [a] -> Vector a
V.fromList ([CN MPBall] -> Box) -> [CN MPBall] -> Box
forall a b. (a -> b) -> a -> b
$ (TypedVarInterval -> CN MPBall)
-> [TypedVarInterval] -> [CN MPBall]
forall a b. (a -> b) -> [a] -> [b]
map
  (\case
    TypedVar (String
_,(Rational
l,Rational
r)) VarType
_ -> CN MPBall -> CN MPBall -> CN MPBall
forall i.
(IsInterval i, CanMinMaxSameType (IntervalEndpoint i)) =>
i -> i -> i
fromEndpointsAsIntervals (MPBall -> CN MPBall
forall v. v -> CN v
cn (Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Rational
l)) (MPBall -> CN MPBall
forall v. v -> CN v
cn (Precision -> Rational -> MPBall
forall t. CanBeMPBallP t => Precision -> t -> MPBall
mpBallP Precision
p Rational
r)))
  [TypedVarInterval]
vs

-- Precondition, box and varNames have same length
boxToVarMap :: Box -> [String] -> VarMap
boxToVarMap :: Box -> [String] -> [(String, (Rational, Rational))]
boxToVarMap Box
box [String]
varNames = [String]
-> [(Rational, Rational)] -> [(String, (Rational, Rational))]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
varNames ([(Rational, Rational)] -> [(String, (Rational, Rational))])
-> [(Rational, Rational)] -> [(String, (Rational, Rational))]
forall a b. (a -> b) -> a -> b
$ Vector (Rational, Rational) -> [(Rational, Rational)]
forall a. Vector a -> [a]
V.toList (Vector (Rational, Rational) -> [(Rational, Rational)])
-> Vector (Rational, Rational) -> [(Rational, Rational)]
forall a b. (a -> b) -> a -> b
$ (CN MPBall -> (Rational, Rational))
-> Box -> Vector (Rational, Rational)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((CN MPFloat -> Rational)
-> (CN MPFloat, CN MPFloat) -> (Rational, Rational)
forall a b. (a -> b) -> (a, a) -> (b, b)
both (MPFloat -> Rational
forall t. CanBeRational t => t -> Rational
rational (MPFloat -> Rational)
-> (CN MPFloat -> MPFloat) -> CN MPFloat -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CN MPFloat -> MPFloat
forall p. CN p -> p
unCN) ((CN MPFloat, CN MPFloat) -> (Rational, Rational))
-> (CN MPBall -> (CN MPFloat, CN MPFloat))
-> CN MPBall
-> (Rational, Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CN MPBall -> (CN MPFloat, CN MPFloat)
forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints) Box
box

unsafeBoxToTypedVarMap :: Box -> [(String, VarType)] -> TypedVarMap
unsafeBoxToTypedVarMap :: Box -> [(String, VarType)] -> [TypedVarInterval]
unsafeBoxToTypedVarMap Box
box [(String, VarType)]
varNamesWithTypes =
  ((String, VarType) -> (Rational, Rational) -> TypedVarInterval)
-> [(String, VarType)]
-> [(Rational, Rational)]
-> [TypedVarInterval]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
  (\(String
varName, VarType
varType) (Rational, Rational)
varBounds ->
    case VarType
varType of
      VarType
Real -> (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
varName, (Rational, Rational)
varBounds) VarType
Real
      VarType
Integer -> (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
varName, (\(Rational
l,Rational
r) -> (Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
ceiling Rational
l Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1, Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
floor Rational
r Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)) (Rational, Rational)
varBounds) VarType
Integer -- FIXME: may result in inverted interval
  )
  [(String, VarType)]
varNamesWithTypes ([(Rational, Rational)] -> [TypedVarInterval])
-> [(Rational, Rational)] -> [TypedVarInterval]
forall a b. (a -> b) -> a -> b
$ Vector (Rational, Rational) -> [(Rational, Rational)]
forall a. Vector a -> [a]
V.toList (Vector (Rational, Rational) -> [(Rational, Rational)])
-> Vector (Rational, Rational) -> [(Rational, Rational)]
forall a b. (a -> b) -> a -> b
$ (CN MPBall -> (Rational, Rational))
-> Box -> Vector (Rational, Rational)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((CN MPFloat -> Rational)
-> (CN MPFloat, CN MPFloat) -> (Rational, Rational)
forall a b. (a -> b) -> (a, a) -> (b, b)
both (MPFloat -> Rational
forall t. CanBeRational t => t -> Rational
rational (MPFloat -> Rational)
-> (CN MPFloat -> MPFloat) -> CN MPFloat -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CN MPFloat -> MPFloat
forall p. CN p -> p
unCN) ((CN MPFloat, CN MPFloat) -> (Rational, Rational))
-> (CN MPBall -> (CN MPFloat, CN MPFloat))
-> CN MPBall
-> (Rational, Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CN MPBall -> (CN MPFloat, CN MPFloat)
forall i.
IsInterval i =>
i -> (IntervalEndpoint i, IntervalEndpoint i)
endpoints) Box
box

safeBoxToTypedVarMap :: Box -> [(String, VarType)] -> Maybe TypedVarMap
safeBoxToTypedVarMap :: Box -> [(String, VarType)] -> Maybe [TypedVarInterval]
safeBoxToTypedVarMap Box
box [(String, VarType)]
varNamesWithTypes =
  if (TypedVarInterval -> Bool) -> [TypedVarInterval] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(TypedVar (String
_,(Rational
l, Rational
r)) VarType
_) -> Rational
l Rational -> Rational -> OrderCompareType Rational Rational
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Rational
r) [TypedVarInterval]
unsafeTypedVarMap then Maybe [TypedVarInterval]
forall a. Maybe a
Nothing else [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a. a -> Maybe a
Just [TypedVarInterval]
unsafeTypedVarMap
  where
    unsafeTypedVarMap :: [TypedVarInterval]
unsafeTypedVarMap = Box -> [(String, VarType)] -> [TypedVarInterval]
unsafeBoxToTypedVarMap Box
box [(String, VarType)]
varNamesWithTypes

typedVarMapToVarMap :: TypedVarMap -> VarMap
typedVarMapToVarMap :: [TypedVarInterval] -> [(String, (Rational, Rational))]
typedVarMapToVarMap =
  (TypedVarInterval -> (String, (Rational, Rational)))
-> [TypedVarInterval] -> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map
  (\case TypedVar (String, (Rational, Rational))
vm VarType
_ -> (String, (Rational, Rational))
vm)

unsafeVarMapToTypedVarMap :: VarMap -> [(String, VarType)] -> TypedVarMap
unsafeVarMapToTypedVarMap :: [(String, (Rational, Rational))]
-> [(String, VarType)] -> [TypedVarInterval]
unsafeVarMapToTypedVarMap [] [(String, VarType)]
_ = []
unsafeVarMapToTypedVarMap ((String
v, (Rational
l, Rational
r)) : [(String, (Rational, Rational))]
vs) [(String, VarType)]
varTypes =
  case String -> [(String, VarType)] -> Maybe VarType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
v [(String, VarType)]
varTypes of
    Just VarType
Real    -> (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
v, (Rational
l, Rational
r)) VarType
Real TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
-> [(String, VarType)] -> [TypedVarInterval]
unsafeVarMapToTypedVarMap [(String, (Rational, Rational))]
vs [(String, VarType)]
varTypes
    Just VarType
Integer -> (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
v, (Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
ceiling Rational
l Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1, Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
floor Rational
r Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)) VarType
Integer TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
-> [(String, VarType)] -> [TypedVarInterval]
unsafeVarMapToTypedVarMap [(String, (Rational, Rational))]
vs [(String, VarType)]
varTypes
    Maybe VarType
Nothing      -> (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
v, (Rational
l, Rational
r)) VarType
Real TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [(String, (Rational, Rational))]
-> [(String, VarType)] -> [TypedVarInterval]
unsafeVarMapToTypedVarMap [(String, (Rational, Rational))]
vs [(String, VarType)]
varTypes

safeVarMapToTypedVarMap :: VarMap -> [(String, VarType)] -> Maybe TypedVarMap
safeVarMapToTypedVarMap :: [(String, (Rational, Rational))]
-> [(String, VarType)] -> Maybe [TypedVarInterval]
safeVarMapToTypedVarMap [] [(String, VarType)]
_ = [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a. a -> Maybe a
Just []
safeVarMapToTypedVarMap ((String
v, (Rational
l, Rational
r)) : [(String, (Rational, Rational))]
vs) [(String, VarType)]
varTypes =
  case String -> [(String, VarType)] -> Maybe VarType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
v [(String, VarType)]
varTypes of
    Just VarType
Real    ->
      case [(String, (Rational, Rational))]
-> [(String, VarType)] -> Maybe [TypedVarInterval]
safeVarMapToTypedVarMap [(String, (Rational, Rational))]
vs [(String, VarType)]
varTypes of
        Just [TypedVarInterval]
rs -> [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a. a -> Maybe a
Just ([TypedVarInterval] -> Maybe [TypedVarInterval])
-> [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a b. (a -> b) -> a -> b
$ (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
v, (Rational
l, Rational
r)) VarType
Real TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
rs
        Maybe [TypedVarInterval]
Nothing -> Maybe [TypedVarInterval]
forall a. Maybe a
Nothing
    Just VarType
Integer ->
      if Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
ceiling Rational
l Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
floor Rational
r
        then Maybe [TypedVarInterval]
forall a. Maybe a
Nothing
        else
          case [(String, (Rational, Rational))]
-> [(String, VarType)] -> Maybe [TypedVarInterval]
safeVarMapToTypedVarMap [(String, (Rational, Rational))]
vs [(String, VarType)]
varTypes of
            Just [TypedVarInterval]
rs -> [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a. a -> Maybe a
Just ([TypedVarInterval] -> Maybe [TypedVarInterval])
-> [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a b. (a -> b) -> a -> b
$ (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
v, (Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
ceiling Rational
l Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1, Rational -> RoundType Rational
forall t. CanRound t => t -> RoundType t
floor Rational
r Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1)) VarType
Integer TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
rs
            Maybe [TypedVarInterval]
Nothing -> Maybe [TypedVarInterval]
forall a. Maybe a
Nothing
    Maybe VarType
Nothing      ->
      case [(String, (Rational, Rational))]
-> [(String, VarType)] -> Maybe [TypedVarInterval]
safeVarMapToTypedVarMap [(String, (Rational, Rational))]
vs [(String, VarType)]
varTypes of
        Just [TypedVarInterval]
rs -> [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a. a -> Maybe a
Just ([TypedVarInterval] -> Maybe [TypedVarInterval])
-> [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a b. (a -> b) -> a -> b
$ (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
v, (Rational
l, Rational
r)) VarType
Real TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval]
rs
        Maybe [TypedVarInterval]
Nothing -> Maybe [TypedVarInterval]
forall a. Maybe a
Nothing

safeIntersectVarMap :: TypedVarMap -> TypedVarMap -> Maybe TypedVarMap
safeIntersectVarMap :: [TypedVarInterval]
-> [TypedVarInterval] -> Maybe [TypedVarInterval]
safeIntersectVarMap [TypedVarInterval]
vm1 [TypedVarInterval]
vm2 = 
  if [TypedVarInterval] -> Bool
isTypedVarMapInverted [TypedVarInterval]
intersectedVm then Maybe [TypedVarInterval]
forall a. Maybe a
Nothing else [TypedVarInterval] -> Maybe [TypedVarInterval]
forall a. a -> Maybe a
Just [TypedVarInterval]
intersectedVm
  where
    -- Sort varMaps by varNames
    sortedVm1 :: [TypedVarInterval]
sortedVm1 = (TypedVarInterval -> TypedVarInterval -> Ordering)
-> [TypedVarInterval] -> [TypedVarInterval]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(TypedVar (String
v1, (Rational, Rational)
_) VarType
_ ) (TypedVar (String
v2, (Rational, Rational)
_) VarType
_ ) -> String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare String
v1 String
v2) [TypedVarInterval]
vm1
    sortedVm2 :: [TypedVarInterval]
sortedVm2 = (TypedVarInterval -> TypedVarInterval -> Ordering)
-> [TypedVarInterval] -> [TypedVarInterval]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(TypedVar (String
v1, (Rational, Rational)
_) VarType
_ ) (TypedVar (String
v2, (Rational, Rational)
_) VarType
_ ) -> String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare String
v1 String
v2) [TypedVarInterval]
vm1
    intersectedVm :: [TypedVarInterval]
intersectedVm = [TypedVarInterval] -> [TypedVarInterval] -> [TypedVarInterval]
unsafeIntersectVarMap [TypedVarInterval]
sortedVm1 [TypedVarInterval]
sortedVm2

-- |Assumes varMaps have vars appearing in the same order
unsafeIntersectVarMap :: TypedVarMap -> TypedVarMap -> TypedVarMap
unsafeIntersectVarMap :: [TypedVarInterval] -> [TypedVarInterval] -> [TypedVarInterval]
unsafeIntersectVarMap [] [] = []
unsafeIntersectVarMap [] [TypedVarInterval]
_ = [TypedVarInterval]
forall a. HasCallStack => a
undefined
unsafeIntersectVarMap [TypedVarInterval]
_ [] = [TypedVarInterval]
forall a. HasCallStack => a
undefined
unsafeIntersectVarMap ((TypedVar (String
v1, (Rational
l1, Rational
r1)) VarType
t1) : [TypedVarInterval]
vm1) ((TypedVar (String
v2, (Rational
l2, Rational
r2)) VarType
t2) : [TypedVarInterval]
vm2) =
  if String
v1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
P./= String
v2 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
|| VarType
t1 VarType -> VarType -> Bool
forall a. Eq a => a -> a -> Bool
P./= VarType
t2
    then String -> [TypedVarInterval]
forall a. HasCallStack => String -> a
error (String -> [TypedVarInterval]) -> String -> [TypedVarInterval]
forall a b. (a -> b) -> a -> b
$ 
      String
"unsafeIntersectVarMap : varMaps have a different variable/variable type in the same position; vm1: " 
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarType -> String
forall a. Show a => a -> String
show VarType
t1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", vm2: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarType -> String
forall a. Show a => a -> String
show VarType
t2
    else (String, (Rational, Rational)) -> VarType -> TypedVarInterval
TypedVar (String
v1, (Rational
MinMaxType Rational Rational
newL, Rational
MinMaxType Rational Rational
newR)) VarType
t1 TypedVarInterval -> [TypedVarInterval] -> [TypedVarInterval]
forall a. a -> [a] -> [a]
: [TypedVarInterval] -> [TypedVarInterval] -> [TypedVarInterval]
unsafeIntersectVarMap [TypedVarInterval]
vm1 [TypedVarInterval]
vm2
  where
    newL :: MinMaxType Rational Rational
newL = Rational -> Rational -> MinMaxType Rational Rational
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Rational
l1 Rational
l2
    newR :: MinMaxType Rational Rational
newR = Rational -> Rational -> MinMaxType Rational Rational
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min Rational
r1 Rational
r2

isVarMapInverted :: VarMap -> Bool
isVarMapInverted :: [(String, (Rational, Rational))] -> Bool
isVarMapInverted []                 = Bool
False
isVarMapInverted ((String
_, (Rational
l, Rational
r)) : [(String, (Rational, Rational))]
vs) = Rational
l Rational -> Rational -> OrderCompareType Rational Rational
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Rational
r Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
|| [(String, (Rational, Rational))] -> Bool
isVarMapInverted [(String, (Rational, Rational))]
vs

isTypedVarMapInverted :: TypedVarMap -> Bool
isTypedVarMapInverted :: [TypedVarInterval] -> Bool
isTypedVarMapInverted []                              = Bool
False
isTypedVarMapInverted ((TypedVar (String
_, (Rational
l, Rational
r)) VarType
_) : [TypedVarInterval]
vs) = Rational
l Rational -> Rational -> OrderCompareType Rational Rational
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Rational
r Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
|| [TypedVarInterval] -> Bool
isTypedVarMapInverted [TypedVarInterval]
vs

getVarNamesWithTypes :: TypedVarMap -> [(String, VarType)]
getVarNamesWithTypes :: [TypedVarInterval] -> [(String, VarType)]
getVarNamesWithTypes = (TypedVarInterval -> (String, VarType))
-> [TypedVarInterval] -> [(String, VarType)]
forall a b. (a -> b) -> [a] -> [b]
map
  (\case
    TypedVar (String
v, (Rational
_,Rational
_)) VarType
t -> (String
v,VarType
t)
  )

getCorners :: VarMap -> [VarMap]
getCorners :: [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
getCorners [(String, (Rational, Rational))]
vm =
  [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a. Eq a => [a] -> [a]
nub ([[(String, (Rational, Rational))]]
 -> [[(String, (Rational, Rational))]])
-> ([[(String, (Rational, Rational))]]
    -> [[(String, (Rational, Rational))]])
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, (Rational, Rational))]
 -> [(String, (Rational, Rational))])
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. Ord a => [a] -> [a]
sort ([[(String, (Rational, Rational))]]
 -> [[(String, (Rational, Rational))]])
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> a -> b
$ ((String, (Rational, Rational))
 -> [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map (\vm' :: (String, (Rational, Rational))
vm'@(String
v,(Rational, Rational)
_) -> (String, (Rational, Rational))
vm' (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: ((String, (Rational, Rational)) -> Bool)
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
v',(Rational, Rational)
_) -> String
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= String
v') [(String, (Rational, Rational))]
rights)  [(String, (Rational, Rational))]
lefts
                   [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a. [a] -> [a] -> [a]
++ ((String, (Rational, Rational))
 -> [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map (\vm' :: (String, (Rational, Rational))
vm'@(String
v,(Rational, Rational)
_) -> (String, (Rational, Rational))
vm' (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: ((String, (Rational, Rational)) -> Bool)
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
v',(Rational, Rational)
_) -> String
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= String
v') [(String, (Rational, Rational))]
lefts)  [(String, (Rational, Rational))]
lefts
                   [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a. [a] -> [a] -> [a]
++ ((String, (Rational, Rational))
 -> [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map (\vm' :: (String, (Rational, Rational))
vm'@(String
v,(Rational, Rational)
_) -> (String, (Rational, Rational))
vm' (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: ((String, (Rational, Rational)) -> Bool)
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
v',(Rational, Rational)
_) -> String
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= String
v') [(String, (Rational, Rational))]
rights) [(String, (Rational, Rational))]
rights
                   [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a. [a] -> [a] -> [a]
++ ((String, (Rational, Rational))
 -> [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map (\vm' :: (String, (Rational, Rational))
vm'@(String
v,(Rational, Rational)
_) -> (String, (Rational, Rational))
vm' (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: ((String, (Rational, Rational)) -> Bool)
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
v',(Rational, Rational)
_) -> String
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= String
v') [(String, (Rational, Rational))]
lefts)  [(String, (Rational, Rational))]
rights
  where
    lefts :: [(String, (Rational, Rational))]
lefts  = ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
v,(Rational
l,Rational
_)) -> (String
v,(Rational
l,Rational
l))) [(String, (Rational, Rational))]
vm
    rights :: [(String, (Rational, Rational))]
rights = ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
v,(Rational
_,Rational
r)) -> (String
v,(Rational
r,Rational
r))) [(String, (Rational, Rational))]
vm

-- Order for two dimension VarMap, left bottom right top
getEdges :: VarMap -> [VarMap]
getEdges :: [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
getEdges [(String, (Rational, Rational))]
vm =
  [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a. Eq a => [a] -> [a]
nub ([[(String, (Rational, Rational))]]
 -> [[(String, (Rational, Rational))]])
-> ([[(String, (Rational, Rational))]]
    -> [[(String, (Rational, Rational))]])
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, (Rational, Rational))]
 -> [(String, (Rational, Rational))])
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. Ord a => [a] -> [a]
sort ([[(String, (Rational, Rational))]]
 -> [[(String, (Rational, Rational))]])
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> a -> b
$ ((String, (Rational, Rational))
 -> [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map (\vm' :: (String, (Rational, Rational))
vm'@(String
v,(Rational, Rational)
_) -> (String, (Rational, Rational))
vm' (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: ((String, (Rational, Rational)) -> Bool)
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
v',(Rational, Rational)
_) -> String
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= String
v') [(String, (Rational, Rational))]
vm)  [(String, (Rational, Rational))]
lefts
                [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
-> [[(String, (Rational, Rational))]]
forall a. [a] -> [a] -> [a]
++ ((String, (Rational, Rational))
 -> [(String, (Rational, Rational))])
-> [(String, (Rational, Rational))]
-> [[(String, (Rational, Rational))]]
forall a b. (a -> b) -> [a] -> [b]
map (\vm' :: (String, (Rational, Rational))
vm'@(String
v,(Rational, Rational)
_) -> (String, (Rational, Rational))
vm' (String, (Rational, Rational))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. a -> [a] -> [a]
: ((String, (Rational, Rational)) -> Bool)
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
v',(Rational, Rational)
_) -> String
v String -> String -> EqCompareType String String
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= String
v') [(String, (Rational, Rational))]
vm) [(String, (Rational, Rational))]
rights
  where
    lefts :: [(String, (Rational, Rational))]
lefts  = ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
v,(Rational
l,Rational
_)) -> (String
v,(Rational
l,Rational
l))) [(String, (Rational, Rational))]
vm
    rights :: [(String, (Rational, Rational))]
rights = ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
v,(Rational
_,Rational
r)) -> (String
v,(Rational
r,Rational
r))) [(String, (Rational, Rational))]
vm

upperbound :: VarMap -> VarMap
upperbound :: [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
upperbound = ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
v,(Rational
_,Rational
r)) -> (String
v, (Rational
r, Rational
r)))

lowerbound :: VarMap -> VarMap
lowerbound :: [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
lowerbound = ((String, (Rational, Rational)) -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
v,(Rational
l,Rational
_)) -> (String
v, (Rational
l, Rational
l)))


-- |Intersect two varMaps
-- This assumes that both VarMaps have the same variables in the same order
intersectVarMap :: VarMap -> VarMap -> VarMap
intersectVarMap :: [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
intersectVarMap =
  ((String, (Rational, Rational))
 -> (String, (Rational, Rational))
 -> (String, (Rational, Rational)))
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
    (\(String
v, (Rational
l1, Rational
r1)) (String
_, (Rational
l2, Rational
r2)) ->
      (String
v,
      (
        Rational -> Rational -> MinMaxType Rational Rational
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Rational
l1 Rational
l2,
        Rational -> Rational -> MinMaxType Rational Rational
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min Rational
r1 Rational
r2
      )
      )
    )

-- | Returns the widest interval in the given VarMap
widestInterval :: VarMap -> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestInterval :: [(String, (Rational, Rational))]
-> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestInterval [] (String, (Rational, Rational))
widest = (String, (Rational, Rational))
widest
widestInterval (current :: (String, (Rational, Rational))
current@(String
_, (Rational
cL, Rational
cR)) : [(String, (Rational, Rational))]
vm) widest :: (String, (Rational, Rational))
widest@(String
_, (Rational
wL, Rational
wR)) =
  if Rational
AbsType Rational
widestDist Rational -> Rational -> OrderCompareType Rational Rational
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Rational
AbsType Rational
currentDist then [(String, (Rational, Rational))]
-> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestInterval [(String, (Rational, Rational))]
vm (String, (Rational, Rational))
widest else [(String, (Rational, Rational))]
-> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestInterval [(String, (Rational, Rational))]
vm (String, (Rational, Rational))
current
  where
    widestDist :: AbsType Rational
widestDist = Rational -> AbsType Rational
forall t. CanAbs t => t -> AbsType t
abs(Rational
wR Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Rational
wL)
    currentDist :: AbsType Rational
currentDist = Rational -> AbsType Rational
forall t. CanAbs t => t -> AbsType t
abs(Rational
cR Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Rational
cL)

widestTypedInterval :: TypedVarMap -> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestTypedInterval :: [TypedVarInterval]
-> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestTypedInterval [] (String, (Rational, Rational))
widest = (String, (Rational, Rational))
widest
widestTypedInterval (TypedVar current :: (String, (Rational, Rational))
current@(String
_, (Rational
cL,Rational
cR)) VarType
_ : [TypedVarInterval]
vm) widest :: (String, (Rational, Rational))
widest@(String
_, (Rational
wL, Rational
wR)) =
  if Rational
AbsType Rational
widestDist Rational -> Rational -> OrderCompareType Rational Rational
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Rational
AbsType Rational
currentDist then [TypedVarInterval]
-> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestTypedInterval [TypedVarInterval]
vm (String, (Rational, Rational))
widest else [TypedVarInterval]
-> (String, (Rational, Rational)) -> (String, (Rational, Rational))
widestTypedInterval [TypedVarInterval]
vm (String, (Rational, Rational))
current
  where
    widestDist :: AbsType Rational
widestDist = Rational -> AbsType Rational
forall t. CanAbs t => t -> AbsType t
abs(Rational
wR Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Rational
wL)
    currentDist :: AbsType Rational
currentDist = Rational -> AbsType Rational
forall t. CanAbs t => t -> AbsType t
abs(Rational
cR Rational -> Rational -> SubType Rational Rational
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Rational
cL)

typedVarIntervalToVarInterval :: TypedVarInterval -> VarInterval
typedVarIntervalToVarInterval :: TypedVarInterval -> (String, (Rational, Rational))
typedVarIntervalToVarInterval (TypedVar (String, (Rational, Rational))
vi VarType
_) = (String, (Rational, Rational))
vi

prettyShowVarMap :: VarMap -> String
prettyShowVarMap :: [(String, (Rational, Rational))] -> String
prettyShowVarMap [] = []
prettyShowVarMap ((String
v, (Rational
l, Rational
r)) : [(String, (Rational, Rational))]
vs) = ShowS
forall a. Show a => a -> String
show String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": \n\t" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(String, (Rational, Rational))] -> String
prettyShowVarMap [(String, (Rational, Rational))]
vs

prettyShowTypedVarMap :: TypedVarMap -> String
prettyShowTypedVarMap :: [TypedVarInterval] -> String
prettyShowTypedVarMap [] = []
prettyShowTypedVarMap (TypedVar (String
v, (Rational
l, Rational
r)) VarType
t : [TypedVarInterval]
vs) = ShowS
forall a. Show a => a -> String
show String
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ VarType -> String
forall a. Show a => a -> String
show VarType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): \n\t" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
l) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TypedVarInterval] -> String
prettyShowTypedVarMap [TypedVarInterval]
vs
-- | Get all the possible edges of a given VarMap as a list of VarMaps
-- Examples:
-- edges [("x", (0.5, 2.0))]                    = 
--   [[("x",(1 % 2,1 % 2))],[("x",(2 % 1,2 % 1))]]
-- edges [("x", (0.5, 2.0)), ("y", (0.8, 1.8))] = 
--   [[("x",(1 % 2,1 % 2)),("y",(4 % 5,4 % 5))],
--   [("x",(1 % 2,1 % 2)),("y",(9 % 5,9 % 5))],
--   [("x",(2 % 1,2 % 1)),("y",(4 % 5,4 % 5))],
--   [("x",(2 % 1,2 % 1)),("y",(9 % 5,9 % 5))]]

-- [("x", (0.5, 2.0)), ("y" (0.8, 0.8))]
-- [("x", (0.5, 2.0)), ("y" (1.8, 1.8))]
-- [("x", (0.5, 0.5)), ("y" (0.8, 1.8))]
-- [("x", (2.0, 2.0)), ("y" (0.8, 1.8))]
-- edges :: VarMap -> [VarMap]
-- edges vs =  (map (\(v, d) -> (filter (\(v', _) -> v /= v') vs)) vs)
-- where
--   points = []
--   points ([(v, (l, r))] : vs = [(v ((l, l), (r, r)))] ++ points vs

-- edges :: VarMap -> [VarMap]
-- edges vs = 
--   case L.length vs of
--     0 -> [[]]
--     1 -> concatTuple (endpoints (head vs)) []
--     _ -> 
--       -- concatMap ((\eps@((v, _), _) -> concatTuple eps (filter (\(v',_) -> v /= v') vs)) . endpoints) vs
--       -- trace (show (map endpoints vs)) $
--       -- map (\(l@(v,_), r) -> (filterOutVar v vsEdges)) vsEdges
--       -- map (\(l@, r)) vsEndpoints
--       -- joinEdges . sortAllEdges $ map endpoints vs
--       -- trace (show vsEndpoints) $
--       [l : leftEndpoints] ++ [r : leftEndpoints] ++ [l : rightEndpoints] ++ [r : rightEndpoints]

--   where
--     leftEndpoints = map fst (tail vsEndpoints)
--     rightEndpoints = map snd (tail vsEndpoints)
--     vsEndpoints = map endpoints vs
--     (l, r) = head vsEndpoints

--     -- fun [] = []
--     -- fun xs@(l',r') = case L.length xs of
--       -- 0 -> []
--       -- 1 -> [l, r]


--     -- vsEdges = (map (\v -> [endpoints v]) vs)
--     filterOutVar x xs = filter (\(x',_) -> x /= x') xs

--     -- joinVM vm (l, r) = (l : vm)

--     endpoints (v, (l, r)) = ((v, (l, l)), (v, (r, r)))

--     concatTuple (l, r) xs = [l : xs, r : xs]

--     joinEdges [] = []
--     joinEdges ((v, d) : es) = 
--       case filterOutSameVars of
--         [] -> []
--         es' ->
--           (map (\vd -> (v, d) : [vd])) es' ++ joinEdges es
--       where
--         filterOutSameVars = (filter (\(v',_) -> v /= v') es)

--     sortAllEdges es = sort . concat $ ls : [rs]
--       where
--         ls = map fst es
--         rs = map snd es

-- [0.5, 0.8, 3.0]
-- [2.0, 1.8]