-- {-# LANGUAGE NoImplicitPrelude #-}
-- import qualified Prelude as P
module Data.Internal (
Map(..),
Variable(..),
Bound(..),
Bounds(..),
Constraints(..),
Optimization(..),
Type(..),
MIPSolution(..),
LPSolution(..),
)
where
import Data.List (intercalate)
import qualified Data.Vector as V
import qualified Data.HashMap.Strict as M
import Data.Hashable
import Data.Monoid
import qualified Data.HashSet as S
type Map k v = M.HashMap k v
data Variable a = Double :# a
data Bound x = x :< Double
| x :> Double
| x := Double
deriving Show
newtype Constraints a = Constraints [ Bound [Variable a] ]
simplifyVars :: (Eq a, Hashable a) => [Variable a] -> [Variable a]
simplifyVars vars = map (\(v,c) -> c :# v) $ M.toList $
foldr (\(c :# v) m -> M.insertWith (+) v c m) M.empty vars
simplifyBounds (xs :< b) = (simplifyVars xs) :< b
simplifyBounds (xs := b) = (simplifyVars xs) := b
simplifyBounds (xs :> b) = (simplifyVars xs) :> b
simplifyConstraints :: (Eq a, Hashable a) => Constraints a -> Constraints a
simplifyConstraints (Constraints cs) = Constraints $ map simplifyBounds cs
removeEmptyConstraints :: (Eq a, Hashable a) => Constraints a -> Constraints a
removeEmptyConstraints (Constraints cs) = Constraints $ filter isNonEmpty cs
where
isNonEmpty ([] :< b) = False
isNonEmpty ([] := b) = False
isNonEmpty ([] :> b) = False
isNonEmpty _ = True
data Optimization a = Maximize [Variable a]
| Minimize [Variable a]
data Type = TContinuous | TInteger | TBinary
instance (Show a) => Show (Variable a) where
show (d :# v)
| d == (-1) = "-" ++ (show v)
| d == 1 = (show v)
| otherwise = (show d) ++ "x" ++ (show v)
instance Show a => Show (Optimization a) where
show (Minimize xs) = "Minimize\n\t" ++ (intercalate "+" $ map show xs)
show (Maximize xs) = "Maximize\n\t" ++ (intercalate "+" $ map show xs)
showVars xs = intercalate " + " $ map show $ zipWith (:#) xs [0..]
instance (Show a) => Show (Constraints a) where
show (Constraints bounds) = "\nSubject to\n" ++ (unlines $ map (\a -> "\t" ++ a) $
map getVarSigns bounds)
printVars xs = intercalate " + " $ map show xs
getVarSigns (x :< v) = (printVars x) ++ " <= " ++ (show v)
getVarSigns (x :> v) = (printVars x) ++ " >= " ++ (show v)
getVarSigns (x := v) = (printVars x) ++ " == " ++ (show v)
instance Show Type where
show TContinuous = "Continous"
show TInteger = "Integer"
show TBinary = "Binary"
type Bounds = [Bound Int]
data MIPSolution a = MIPSolution { mipOptimalSol :: Bool, mipObjVal :: Double, mipVars :: Map a Double } deriving (Show)
data LPSolution a = LPSolution { lpOptimalSol :: Bool, lpObjVal :: Double, lpVars :: Map a Double, lpDualVars :: V.Vector Double, lpBasisVars :: Maybe (S.HashSet a)} deriving (Show)