{-# 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 = 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]
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)
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)
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)
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)
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 ->
([(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
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)))
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
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
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
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
)
[(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
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
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
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)))
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
)
)
)
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