{-# LANGUAGE LambdaCase #-}
module LPPaver.Constraint.Util where
import MixedTypesNumPrelude
import LPPaver.Constraint.Type
import Data.List (nub)
import qualified Linear.Simplex.Types as LT
import qualified Data.Map as M
import Data.Maybe
import Linear.Simplex.Types (PolyConstraint)
constraintLeftSide :: Constraint -> [(String, Rational)]
constraintLeftSide :: Constraint -> [(String, Rational)]
constraintLeftSide (GEQ [(String, Rational)]
lhs Rational
_) = [(String, Rational)]
lhs
constraintLeftSide (LEQ [(String, Rational)]
lhs Rational
_) = [(String, Rational)]
lhs
constraintRightSide :: Constraint -> Rational
constraintRightSide :: Constraint -> Rational
constraintRightSide (GEQ [(String, Rational)]
_ Rational
rhs) = Rational
rhs
constraintRightSide (LEQ [(String, Rational)]
_ Rational
rhs) = Rational
rhs
constraintVars :: [Constraint] -> [String]
constraintVars :: [Constraint] -> [String]
constraintVars [Constraint]
cs = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [Constraint] -> [String]
aux [Constraint]
cs
where
aux :: [Constraint] -> [String]
aux :: [Constraint] -> [String]
aux [] = []
aux (Constraint
x : [Constraint]
xs) = ((String, Rational) -> String) -> [(String, Rational)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Rational) -> String
forall a b. (a, b) -> a
fst (Constraint -> [(String, Rational)]
constraintLeftSide Constraint
x) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Constraint] -> [String]
aux [Constraint]
xs
constraintsToSimplexConstraints :: [Constraint] -> ([LT.PolyConstraint], M.Map String Integer)
constraintsToSimplexConstraints :: [Constraint] -> ([PolyConstraint], Map String Integer)
constraintsToSimplexConstraints [Constraint]
constraints =
(
(Constraint -> PolyConstraint) -> [Constraint] -> [PolyConstraint]
forall a b. (a -> b) -> [a] -> [b]
map
(\case
GEQ [(String, Rational)]
varsWithCoeffs Rational
rhs -> VarConstMap -> Rational -> PolyConstraint
LT.GEQ (((String, Rational) -> (Integer, Rational))
-> [(String, Rational)] -> VarConstMap
forall a b. (a -> b) -> [a] -> [b]
map (\(String
stringVar, Rational
coeff) -> (Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Map String Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
stringVar Map String Integer
stringIntVarMap), Rational
coeff)) [(String, Rational)]
varsWithCoeffs) Rational
rhs
LEQ [(String, Rational)]
varsWithCoeffs Rational
rhs -> VarConstMap -> Rational -> PolyConstraint
LT.LEQ (((String, Rational) -> (Integer, Rational))
-> [(String, Rational)] -> VarConstMap
forall a b. (a -> b) -> [a] -> [b]
map (\(String
stringVar, Rational
coeff) -> (Maybe Integer -> Integer
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Map String Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
stringVar Map String Integer
stringIntVarMap), Rational
coeff)) [(String, Rational)]
varsWithCoeffs) Rational
rhs
)
[Constraint]
constraints,
Map String Integer
stringIntVarMap
)
where
stringVars :: [String]
stringVars = [Constraint] -> [String]
constraintVars [Constraint]
constraints
stringIntVarMap :: Map String Integer
stringIntVarMap = [(String, Integer)] -> Map String Integer
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Integer)] -> Map String Integer)
-> [(String, Integer)] -> Map String Integer
forall a b. (a -> b) -> a -> b
$ [String] -> [Integer] -> [(String, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
stringVars [Integer
1..]