Internal.hs

-- {-# 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)