diff --git a/cplex-hs.cabal b/cplex-hs.cabal --- a/cplex-hs.cabal +++ b/cplex-hs.cabal @@ -1,5 +1,5 @@ name: cplex-hs -version: 0.2.0.1 +version: 0.2.0.2 synopsis: high-level CPLEX interface -- description: License: BSD3 @@ -17,7 +17,7 @@ build-type: Simple cabal-version: >=1.8 Library - exposed-modules: CPLEX, + exposed-modules: CPLEX.Core, CPLEX.Param CPLEX.Bindings -- other-modules: diff --git a/src/CPLEX.hs b/src/CPLEX.hs deleted file mode 100644 --- a/src/CPLEX.hs +++ /dev/null @@ -1,813 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module CPLEX ( CpxEnv(..) - , CpxLp - , ObjSense(..) - , Sense(..) - , Bound(..) - , Type(..) - , Row(..) - , Col(..) - , CpxSolution(..) - -- * high level bindings - , openCPLEX - , closeCPLEX - , createProb - , freeProb - , setIntParam - , setDoubleParam - , copyLp - --, checkCopyLp - , copyQuad - --, checkCopyQuad - , copyMip - , qpopt - , lpopt - , mipopt - , primopt - , dualopt - , siftopt - , hybnetopt - , getSolution - , getMIPSolution - -- * change things - , changeCoefList - , changeObj - , changeRhs - , changeBds - , changeRngVal - , changeSens - , changeQpCoef - -- * low level stuff - , getNumCols - , getNumRows - , getErrorString - , getStatString - -- MIP - , setIncumbentCallback - , setCutCallback - , addCuts - , addRows - , addLazyConstraints - , getCallbackLP - , getCallbackNodeX - , addCutFromCallback - -- * convenience wrappers - , withEnv - , withLp - ) where - --- import Control.Monad.Error -import Control.Monad.IO.Class -import qualified Control.Monad.Primitive as Prim --- import Control.Monad.Trans --- import Control.Monad.Trans.Maybe -import qualified Data.Map as M -import qualified Data.Vector as V -import Data.Vector.Storable (Vector) -import qualified Data.Vector.Storable as VS -import qualified Data.Vector.Storable.Mutable as VSM -import Foreign.C -import Foreign.Marshal -import Foreign.Ptr -import Foreign.Storable - -import CPLEX.Bindings -import CPLEX.Param -import Data.Char(ord) - -newtype CpxEnv = CpxEnv (Ptr CpxEnv') -newtype CpxLp = CpxLp (Ptr CpxLp') - -data ObjSense = CPX_MIN | CPX_MAX deriving Show -instance Enum ObjSense where - fromEnum CPX_MIN = 1 - fromEnum CPX_MAX = -1 - toEnum 1 = CPX_MIN - toEnum (-1) = CPX_MAX - toEnum k = error $ "ObjSense: toEnum: unhandled value: " ++ show k - -data Sense = L Double - | E Double - | G Double - | R Double Double - deriving (Eq, Show) - -data Bound = L' Double - | E' Double - | U' Double - deriving (Eq, Show) - -data Type = CPX_CONTINUOUS - | CPX_BINARY - | CPX_INTEGER - deriving (Eq, Show) - -cpx_INFBOUND :: CDouble -cpx_INFBOUND = 1.1e20 - -newtype CpxRet = CpxRet CInt - -getErrorString :: CpxEnv -> CpxRet -> IO String -getErrorString (CpxEnv env) (CpxRet status) = do - msgPtr <- mallocArray 4096 - _ <- c_CPXgeterrorstring env status msgPtr - msg <- peekCString msgPtr - free msgPtr - return msg - -getStatString :: CpxEnv -> CpxRet -> IO String -getStatString (CpxEnv env) (CpxRet status) = do - msgPtr <- mallocArray 510 - _ <- c_CPXgetstatstring env status msgPtr - msg <- peekCString msgPtr - free msgPtr - return msg - - -openCPLEX :: IO (Either String CpxEnv) -openCPLEX = do - statusPtr <- malloc - env <- c_CPXopenCPLEX statusPtr - status <- peek statusPtr - free statusPtr - - if env == nullPtr - then do - -- env is NULL, throw error - msg <- getErrorString (CpxEnv env) (CpxRet status) - return (Left msg) - else do - return (Right (CpxEnv env)) - -closeCPLEX :: CpxEnv -> IO () -closeCPLEX env@(CpxEnv env') = do - -- free env - envPtr <- new env' - status <- c_CPXcloseCPLEX envPtr - free envPtr - case status of - -- closed successfully - 0 -> do - return () - -- close failed, print error message - k -> do - msg <- getErrorString env (CpxRet k) - error $ "error calling CPXcloseCPLEX: " ++ msg - -createProb :: CpxEnv -> String -> IO (Either String CpxLp) -createProb env@(CpxEnv env') name = do - statusPtr <- malloc - namePtr <- newCString name - lp <- c_CPXcreateprob env' statusPtr namePtr - status <- peek statusPtr - free statusPtr - free namePtr - - if lp == nullPtr - then do - -- lp is NULL, return error message - msg <- getErrorString env (CpxRet status) - return (Left msg) - else return (Right (CpxLp lp)) - - -freeProb :: CpxEnv -> CpxLp -> IO () -freeProb env@(CpxEnv env') (CpxLp lp) = do - -- free env - lpPtr <- new lp - status <- c_CPXfreeprob env' lpPtr - free lpPtr - - case status of - -- freed successfully - 0 -> return () - -- freeing failed, print error message - k -> do - msg <- getErrorString env (CpxRet k) - error $ "error calling CPXfreeprob: " ++ msg - - -getNumCols :: CpxEnv -> CpxLp -> IO Int -getNumCols (CpxEnv env) (CpxLp lp) = fmap fromIntegral (c_CPXgetnumcols env lp) - -getNumRows :: CpxEnv -> CpxLp -> IO Int -getNumRows (CpxEnv env) (CpxLp lp) = fmap fromIntegral (c_CPXgetnumrows env lp) - -data CpxSolution = CpxSolution { solObj :: Double - , solStat :: String - , solX :: Vector Double - , solPi :: Vector Double - , solSlack :: Vector Double - , solDj :: Vector Double - } deriving Show - -getSolution :: CpxEnv -> CpxLp -> IO (Either String CpxSolution) -getSolution env@(CpxEnv env') lp@(CpxLp lp') = do - lpstat' <- malloc - objval' <- malloc - - numrows <- getNumRows env lp - numcols <- getNumCols env lp - x <- VSM.new numcols - p <- VSM.new numrows - slack <- VSM.new numrows - dj <- VSM.new numcols - - status <- - VSM.unsafeWith x $ \x' -> - VSM.unsafeWith p $ \p' -> - VSM.unsafeWith slack $ \slack' -> - VSM.unsafeWith dj $ \dj' -> - c_CPXsolution env' lp' lpstat' objval' x' p' slack' dj' - - lpstat <- peek lpstat' - objval <- peek objval' - free lpstat' - free objval' - - x'' <- VS.freeze x - p'' <- VS.freeze p - slack'' <- VS.freeze slack - dj'' <- VS.freeze dj - - case status of - 0 -> do - statString <- getStatString env (CpxRet lpstat) - --- filename <- newCAString "lp.lp" --- status <- c_CPXwriteprob env' lp' filename nullPtr - - return $ Right $ CpxSolution { solObj = realToFrac objval - , solStat = statString - , solX = VS.map realToFrac x'' - , solPi = VS.map realToFrac p'' - , solSlack = VS.map realToFrac slack'' - , solDj = VS.map realToFrac dj'' - } - k -> fmap Left (getErrorString env (CpxRet k)) - -getMIPSolution :: CpxEnv -> CpxLp -> IO (Either String CpxSolution) -getMIPSolution env@(CpxEnv env') lp@(CpxLp lp') = do - status <- c_CPXchgprobtype env' lp' $ typeToInt CPX_PROB_MILP - case status of - 0 -> do --- lpstat' <- malloc - objval' <- malloc - - numrows <- getNumRows env lp - numcols <- getNumCols env lp - x <- VSM.new numcols --- p <- VSM.new numrows - slack <- VSM.new numrows --- dj <- VSM.new numcols - --- status <- c_CPXgetstat env' lp' --- statString <- getStatString env (CpxRet lpstat) - let statString = "" - - status <- c_CPXgetobjval env' lp' objval' - case status of - 0 -> do - objval <- peek objval' - status <- VSM.unsafeWith x $ \x' -> - c_CPXgetx env' lp' x' 0 $ fromIntegral (numcols - 1) - case status of - 0 -> do - x'' <- VS.freeze x - status <- VSM.unsafeWith slack $ \slack' -> - c_CPXgetslack env' lp' slack' 0 $ fromIntegral (numrows - 1) - case status of - 0 -> do - slack'' <- VS.freeze slack - --- filename <- newCAString "mip.lp" --- status <- c_CPXwriteprob env' lp' filename nullPtr - - return $ Right $ CpxSolution { solObj = realToFrac objval - , solStat = statString - , solX = VS.map realToFrac x'' - , solPi = VS.fromList $ take numcols [0.0,0.0..] - , solSlack = VS.map realToFrac slack'' - , solDj = VS.fromList $ take numcols [0.0,0.0..] - } - - k -> fmap Left (getErrorString env (CpxRet k)) - k -> fmap Left (getErrorString env (CpxRet k)) - k -> fmap Left (getErrorString env (CpxRet k)) - -toCpxError :: CpxEnv -> CInt -> IO (Maybe String) -toCpxError env 0 = return Nothing -toCpxError env k = do - msg <- liftIO $ getErrorString env (CpxRet k) - return $ Just msg - -setIntParam :: CpxEnv -> CPX_PARAM -> CInt -> IO () -setIntParam env@(CpxEnv env') param val = do - status <- c_CPXsetintparam env' (paramToInt param) val - case status of - 0 -> return () - k -> do - putStrLn $ "CPXsetintparam failure setting " ++ show param - msg <- getErrorString env (CpxRet k) - error $ "error calling CPXsetintparam: " ++ msg - -setDoubleParam :: CpxEnv -> CPX_PARAM -> CDouble -> IO () -setDoubleParam env@(CpxEnv env') param val = do - status <- c_CPXsetdblparam env' (paramToInt param) val - case status of - 0 -> return () - k -> do - putStrLn $ "CPXsetdblparam failure setting " ++ show param - msg <- getErrorString env (CpxRet k) - error $ "error calling CPXsetdblparam: " ++ msg - -newtype Row = Row {unRow :: Int} deriving (Ord, Eq, Num) -newtype Col = Col {unCol :: Int} deriving (Ord, Eq, Num) -instance Show Row where - show = show . unRow -instance Show Col where - show = show . unCol - --- for use with the adding of rows, cuts or lazy constraints -toColForm' :: [(Row,Col,Double)] -> (Vector CInt, Vector CInt, Vector CDouble) -toColForm' amat = (VS.fromList matbeg, VS.fromList matind, VS.fromList matval) - where - cols = map (\(Row a, Col b, v) -> b) amat - rows = map (\(Row a, _, _) -> a) amat - numRows = (maximum rows) - (minimum rows) + 1 - numCols = (maximum cols) - (minimum cols) + 1 - rows' = map (\q -> filter (\(Row a, Col b, v) -> a== q ) amat) [minimum rows..maximum rows] - matval = map (\(Row a, Col b, v) -> realToFrac v) $ concat rows' - matind = map (\(Row a, Col b, v) -> fromIntegral b) $ concat rows' - matbeg = map (fromIntegral . (*numCols)) [0..numRows-1] - -toColForm :: Int -> [(Row,Col,Double)] -> (Vector CInt, Vector CInt, Vector CInt, Vector CDouble) -toColForm numcols amat = (matbeg, matcnt, matind, matval) - where - matbeg = VS.fromList $ map fromIntegral begs - matcnt = VS.fromList $ map fromIntegral cnts - matind = VS.fromList $ map (fromIntegral . unRow) inds - matval = VS.fromList $ map realToFrac vals - - -- sort colMap into the from CPLEX wants - inds :: [Row] - vals :: [Double] - (inds,vals) = unzip $ concat rows - - begs :: [Int] - cnts :: [Int] - rows :: [[(Row,Double)]] - (begs,cnts,rows) = unzip3 $ colMapInfo' 0 $ M.elems colMap - - colMapInfo' :: Int -> [[(Row,Double)]] -> [(Int,Int,[(Row,Double)])] - colMapInfo' beg (row:xs) = (beg,cnt,row) : colMapInfo' (beg + cnt) xs - where - cnt = length row - colMapInfo' _ [] = [] - - -- add Columns with no entries in case some are missing - colMap = M.union colMap' emptyColMap - - emptyColMap :: M.Map Col [(Row,Double)] - emptyColMap = M.fromList $ take numcols $ zip (map Col [0..]) (repeat []) - - -- a map from Col to all (Row,Double) pairs - colMap' :: M.Map Col [(Row,Double)] - colMap' = M.fromListWith (++) preorder - - -- reorganize the (Row,Col,Double) into (Col, [(Row,Double)]) with only 1 (Row,Double) - preorder :: [(Col,[(Row,Double)])] - preorder = map (\(row,col,val) -> (col, [(row, val)])) amat - - -copyLp :: CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> IO (Maybe String) -copyLp = copyLpWithFun' c_CPXcopylp - ---checkCopyLp :: CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> IO (Maybe String) ---checkCopyLp = copyLpWithFun' c_CPXcheckcopylp - -type CopyLp = - Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> CInt -> CInt -> Ptr CDouble -> - Ptr CDouble -> Ptr CChar -> Ptr CInt -> Ptr CInt -> - Ptr CInt -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt - -copyLpWithFun' :: CopyLp -> CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> IO (Maybe String) -copyLpWithFun' copyLpFun env lp objsense objcoeffs senseRhsRngVal aMat xbnds = - copyLpWithFun copyLpFun env lp numcols numrows objsense (VS.fromList (V.toList (V.map realToFrac objcoeffs))) rhs sense matbeg matcnt matind matval lb ub rngval - where - numcols = V.length objcoeffs -- or xbnds - numrows = V.length senseRhsRngVal - - toBnds :: (Maybe Double, Maybe Double) -> (CDouble, CDouble) - toBnds (Nothing, Nothing) = (-cpx_INFBOUND, cpx_INFBOUND) - toBnds ( Just x, Nothing) = ( realToFrac x, cpx_INFBOUND) - toBnds (Nothing, Just y) = (-cpx_INFBOUND, realToFrac y) - toBnds ( Just x, Just y) = ( realToFrac x, realToFrac y) - - lb = VS.fromList $ V.toList lb' - ub = VS.fromList $ V.toList ub' - (lb',ub') = V.unzip $ V.map toBnds xbnds - - toRhs :: Sense -> (CChar, CDouble, CDouble) - toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) - toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) - toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) - toRhs (R l u) = (castCharToCChar 'R', realToFrac l, realToFrac (u-l)) - - sense = VS.fromList $ V.toList sense' - rngval = VS.fromList $ V.toList rngval' - rhs = VS.fromList $ V.toList rhs' - (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal - - (matbeg, matcnt, matind, matval) = toColForm numcols aMat - - -copyLpWithFun :: CopyLp -> CpxEnv -> CpxLp -> Int -> Int -> ObjSense -> Vector CDouble -> Vector CDouble -> Vector CChar -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CDouble -> Vector CDouble -> Vector CDouble -> Vector CDouble -> IO (Maybe String) -copyLpWithFun copylpFun env@(CpxEnv env') (CpxLp lp) numcols numrows objsense obj rhs sense matbeg matcnt matind matval lb ub rngval = do --- setIntParam env CPX_PARAM_SCRIND cpx_ON --- setIntParam env CPX_PARAM_DATACHECK cpx_ON - let objsense' = fromIntegral (fromEnum objsense) - numcols' = fromIntegral numcols - numrows' = fromIntegral numrows - - status <- - VS.unsafeWith obj $ \obj' -> - VS.unsafeWith rhs $ \rhs' -> - VS.unsafeWith sense $ \sense' -> - VS.unsafeWith matbeg $ \matbeg' -> - VS.unsafeWith matcnt $ \matcnt' -> - VS.unsafeWith matind $ \matind' -> - VS.unsafeWith matval $ \matval' -> - VS.unsafeWith lb $ \lb' -> - VS.unsafeWith ub $ \ub' -> - VS.unsafeWith rngval $ \rngval' -> - copylpFun env' lp numcols' numrows' objsense' obj' rhs' sense' matbeg' matcnt' matind' matval' lb' ub' rngval' - - case status of - 0 -> return Nothing - k -> Just <$> getErrorString env (CpxRet k) - -type CopyQuad = - Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CDouble -> IO CInt - -copyQuad :: CpxEnv -> CpxLp -> [(Row,Col,Double)] -> IO (Maybe String) -copyQuad = copyQuadWithFun' c_CPXcopyquad - -copyQuadWithFun' :: CopyQuad -> CpxEnv -> CpxLp -> [(Row,Col,Double)] -> IO (Maybe String) -copyQuadWithFun' copyQuadFun env lp aMat = do - numcols <- getNumCols env lp - let (matbeg, matcnt, matind, matval) = toColForm numcols aMat - copyQuadWithFun copyQuadFun env lp matbeg matcnt matind matval - -copyQuadWithFun :: CopyQuad -> CpxEnv -> CpxLp -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CDouble -> IO (Maybe String) -copyQuadWithFun copyQuadFun env@(CpxEnv env') (CpxLp lp) matbeg matcnt matind matval = do - status <- - VS.unsafeWith matbeg $ \matbeg' -> - VS.unsafeWith matcnt $ \matcnt' -> - VS.unsafeWith matind $ \matind' -> - VS.unsafeWith matval $ \matval' -> - copyQuadFun env' lp matbeg' matcnt' matind' matval' - - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - - -copyMip :: CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> V.Vector Type -> IO (Maybe String) -copyMip env@(CpxEnv env') lp@(CpxLp lp') objsense objcoeffs senseRhsRngVal aMat xbnds ctypes = do - status <- copyLpWithFun' c_CPXcopylp env lp objsense objcoeffs senseRhsRngVal aMat xbnds - case status of - Nothing -> do - status' <- - VS.unsafeWith ctypes' $ \ctypes'' -> - c_CPXcopyctype env' lp' ctypes'' - - case status' of - 0 -> return Nothing - k' -> fmap Just $ getErrorString env (CpxRet k') - - - Just msg -> return $ Just msg --fmap Just $ getErrorString env (CpxRet k) - - where - toCType :: Type -> CChar - toCType CPX_CONTINUOUS = castCharToCChar 'C' - toCType CPX_BINARY = castCharToCChar 'B' - toCType CPX_INTEGER = castCharToCChar 'I' - - ctypes' :: VS.Vector CChar - ctypes' = VS.fromList $ map toCType $ V.toList ctypes - - -withOptFun :: (Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt) -> CpxEnv -> CpxLp -> IO (Maybe String) -withOptFun optFun env@(CpxEnv env') (CpxLp lp') = do - status <- optFun env' lp' - case status of - 0 -> return Nothing - k -> fmap Just (getErrorString env (CpxRet k)) - -qpopt :: CpxEnv -> CpxLp -> IO (Maybe String) -qpopt = withOptFun c_CPXqpopt - -lpopt :: CpxEnv -> CpxLp -> IO (Maybe String) -lpopt = withOptFun c_CPXlpopt - -mipopt :: CpxEnv -> CpxLp -> IO (Maybe String) -mipopt = withOptFun c_CPXmipopt - -primopt :: CpxEnv -> CpxLp -> IO (Maybe String) -primopt = withOptFun c_CPXprimopt - -dualopt :: CpxEnv -> CpxLp -> IO (Maybe String) -dualopt = withOptFun c_CPXdualopt - -siftopt :: CpxEnv -> CpxLp -> IO (Maybe String) -siftopt = withOptFun c_CPXsiftopt - -hybnetopt :: CpxEnv -> CpxLp -> Int -> IO (Maybe String) -hybnetopt env lp k = withOptFun (\e l -> c_CPXhybnetopt e l (fromIntegral k)) env lp - -------------------------------------------------- - - -changeCoefList :: CpxEnv -> CpxLp -> V.Vector (Row, Col, Double) -> IO (Maybe String) -changeCoefList env@(CpxEnv env') (CpxLp lp') rcv = do - let num = fromIntegral (V.length rcv) - (rows', cols', vals') = V.unzip3 rcv - rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' - cols = VS.fromList $ V.toList $ V.map (fromIntegral . unCol) cols' - vals = VS.fromList $ V.toList $ V.map realToFrac vals' - status <- - VS.unsafeWith rows $ \rows'' -> - VS.unsafeWith cols $ \cols'' -> - VS.unsafeWith vals $ \vals'' -> - c_CPXchgcoeflist env' lp' num rows'' cols'' vals'' - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - - -changeRhs :: CpxEnv -> CpxLp -> V.Vector (Row, Double) -> IO (Maybe String) -changeRhs env@(CpxEnv env') (CpxLp lp') rv = do - let num = fromIntegral (V.length rv) - (rows', vals') = V.unzip rv - rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' - vals = VS.fromList $ V.toList $ V.map realToFrac vals' - status <- - VS.unsafeWith rows $ \rows'' -> - VS.unsafeWith vals $ \vals'' -> - c_CPXchgrhs env' lp' num rows'' vals'' - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - -changeObj :: CpxEnv -> CpxLp -> V.Vector (Col, Double) -> IO (Maybe String) -changeObj env@(CpxEnv env') (CpxLp lp') cv = do - let num = fromIntegral (V.length cv) - (cols', vals') = V.unzip cv - cols = VS.fromList $ V.toList $ V.map (fromIntegral . unCol) cols' - vals = VS.fromList $ V.toList $ V.map realToFrac vals' - status <- - VS.unsafeWith cols $ \cols'' -> - VS.unsafeWith vals $ \vals'' -> - c_CPXchgobj env' lp' num cols'' vals'' - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - - -changeBds :: CpxEnv -> CpxLp -> V.Vector (Col, Bound) -> IO (Maybe String) -changeBds env@(CpxEnv env') (CpxLp lp') cb = do - let num = fromIntegral (V.length cb) - (cols', bounds') = V.unzip cb - - fromBound :: Bound -> (CChar, CDouble) - fromBound (L' x) = (castCharToCChar 'L', realToFrac x) - fromBound (U' x) = (castCharToCChar 'U', realToFrac x) - fromBound (E' x) = (castCharToCChar 'E', realToFrac x) - - (lus', bds') = V.unzip $ V.map fromBound bounds' - - cols = VS.fromList $ V.toList $ V.map (fromIntegral . unCol) cols' - lus = VS.fromList $ V.toList $ lus' - bds = VS.fromList $ V.toList $ bds' - status <- - VS.unsafeWith cols $ \cols'' -> - VS.unsafeWith lus $ \lus'' -> - VS.unsafeWith bds $ \bds'' -> - c_CPXchgbds env' lp' num cols'' lus'' bds'' - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - -changeRngVal :: CpxEnv -> CpxLp -> V.Vector (Row, Double) -> IO (Maybe String) -changeRngVal env@(CpxEnv env') (CpxLp lp') rv = do - let num = fromIntegral (V.length rv) - (rows', vals') = V.unzip rv - rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' - vals = VS.fromList $ V.toList $ V.map realToFrac vals' - status <- - VS.unsafeWith rows $ \rows'' -> - VS.unsafeWith vals $ \vals'' -> - c_CPXchgrngval env' lp' num rows'' vals'' - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - -changeSens :: CpxEnv -> CpxLp -> V.Vector (Row, Char) -> IO (Maybe String) -changeSens env@(CpxEnv env') (CpxLp lp') rs = do - let num = fromIntegral (V.length rs) - (rows', senses') = V.unzip rs - rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' - senses = VS.fromList $ V.toList $ V.map castCharToCChar senses' - status <- - VS.unsafeWith rows $ \rows'' -> - VS.unsafeWith senses $ \senses'' -> - c_CPXchgsense env' lp' num rows'' senses'' - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - -changeQpCoef :: CpxEnv -> CpxLp -> Row -> Col -> Double -> IO (Maybe String) -changeQpCoef env@(CpxEnv env') (CpxLp lp') (Row row) (Col col) val = do - status <- c_CPXchgqpcoef env' lp' (fromIntegral row) (fromIntegral col) (realToFrac val) - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - - --------------------------------------------------- - -addCuts :: CpxEnv -> CpxLp -> Int -> V.Vector Sense -> [(Row, Col,Double)] -> IO (Maybe String) -addCuts env@(CpxEnv env') (CpxLp lp') nzcnt senseRhsRngVal aMat = do - status <- - VS.unsafeWith rhs $ \rows'' -> - VS.unsafeWith sense $ \senses'' -> - VS.unsafeWith matbeg $ \matbeg'' -> - VS.unsafeWith matind $ \matind'' -> - VS.unsafeWith matval $ \matval'' -> - - c_CPXaddusercuts env' lp' (fromIntegral numrows) (fromIntegral nzcnt) - rows'' senses'' matbeg'' matind'' matval'' nullPtr - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - where - numrows = V.length senseRhsRngVal - - toRhs :: Sense -> (CChar, CDouble, CDouble) - toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) - toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) - toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) - - (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal - sense = VS.fromList $ V.toList sense' - rhs = VS.fromList $ V.toList rhs' - - (matbeg, matind, matval) = toColForm' aMat - - -addLazyConstraints :: CpxEnv -> CpxLp -> Int -> V.Vector Sense -> [(Row, Col,Double)] -> IO (Maybe String) -addLazyConstraints env@(CpxEnv env') (CpxLp lp') nzcnt senseRhsRngVal aMat = do - status <- - VS.unsafeWith rhs $ \rows'' -> - VS.unsafeWith sense $ \senses'' -> - VS.unsafeWith matbeg $ \matbeg'' -> - VS.unsafeWith matind $ \matind'' -> - VS.unsafeWith matval $ \matval'' -> - - c_CPXaddlazyconstraints env' lp' (fromIntegral numrows) (fromIntegral nzcnt) - rows'' senses'' matbeg'' matind'' matval'' nullPtr - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - where - numrows = V.length senseRhsRngVal - - toRhs :: Sense -> (CChar, CDouble, CDouble) - toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) - toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) - toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) - - (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal - sense = VS.fromList $ V.toList sense' - rhs = VS.fromList $ V.toList rhs' - --matbeg = VS.fromList $ replicate numrows 0 - (matbeg, matind, matval) = toColForm' aMat - - -addCutFromCallback :: CpxEnv -> Ptr () -> CInt -> CInt -> Sense -> [(Col,Double)] -> CPX_CUT_TYPE -> IO (Maybe String) -addCutFromCallback env@(CpxEnv env') cbdata wherefrom nzcnt sense aMat purgable = do - status <- - VS.unsafeWith cutind $ \ind -> - VS.unsafeWith cutvals $ \vals -> - c_CPXcutcallbackadd env' cbdata wherefrom nzcnt rhs' sense' ind vals purgable' - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - where - cutind = VS.fromList $ map (\(Col a, v) -> fromIntegral a) aMat - cutvals = VS.fromList $ map (\(Col a, v) -> realToFrac v) aMat - purgable' = cutToInt purgable - senseToInt (L x) = (fromIntegral $ ord 'L', realToFrac x) - senseToInt (G x) = (fromIntegral $ ord 'G', realToFrac x) - senseToInt (E x) = (fromIntegral $ ord 'E', realToFrac x) - (sense', rhs') = senseToInt sense - - -addRows :: CpxEnv -> CpxLp -> Int -> Int -> Int -> V.Vector Sense -> [(Row, Col,Double)] -> IO (Maybe String) -addRows env@(CpxEnv env') (CpxLp lp') ccnt rcnt nzcnt senseRhsRngVal aMat = do - status <- - VS.unsafeWith rhs $ \rows'' -> - VS.unsafeWith sense $ \senses'' -> - VS.unsafeWith matbeg $ \matbeg'' -> - VS.unsafeWith matind $ \matind'' -> - VS.unsafeWith matval $ \matval'' -> - - c_CPXaddrows env' lp' (fromIntegral ccnt) (fromIntegral rcnt) (fromIntegral nzcnt) - rows'' senses'' matbeg'' matind'' matval'' nullPtr nullPtr - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - where - numrows = V.length senseRhsRngVal - - toRhs :: Sense -> (CChar, CDouble, CDouble) - toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) - toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) - toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) - - (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal - sense = VS.fromList $ V.toList sense' - rhs = VS.fromList $ V.toList rhs' - - (matbeg, matcnt, matind, matval) = toColForm nzcnt aMat - -{-# NOINLINE setIncumbentCallback #-} -setIncumbentCallback :: CpxEnv -> CIncumbentCallback -> IO (Maybe String) -setIncumbentCallback env@(CpxEnv env') callback = do - ptr <- c_createIncumbentCallbackPtr callback - status <- c_CPXsetincumbentcallbackfunc env' ptr nullPtr - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - - -{-# NOINLINE setCutCallback #-} -setCutCallback :: CpxEnv -> CCutCallback -> IO (Maybe String) -setCutCallback env@(CpxEnv env') callback = do - ptr <- c_createCutCallbackPtr callback - status <- c_CPXsetcutcallbackfunc env' ptr nullPtr - case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - - -getCallbackNodeX :: CpxEnv -> Ptr () -> Int -> Int -> Int -> IO (Maybe String, VS.Vector Double) -getCallbackNodeX env@(CpxEnv env') cbDataPtr wherefrom begin end = do - xs' <- VSM.new (end - begin + 1) - status <- VSM.unsafeWith xs' $ \ptr -> - c_CPXgetcallbacknodex env' cbDataPtr (fromIntegral wherefrom) ptr (fromIntegral begin) (fromIntegral end) - xs <- VS.freeze xs' - stat <- case status of - 0 -> return Nothing - k -> fmap Just $ getErrorString env (CpxRet k) - return (stat, VS.map realToFrac xs) - --- IMPORTANT FREE MEMORY AFTERWARDS -getCallbackLP :: CpxEnv -> Ptr () -> Int -> IO (Either String CpxLp) -getCallbackLP env@(CpxEnv env') cbDataPtr wherefrom = do - lpPtrPtr <- mallocBytes 8 - lpstat <- c_CPXgetcallbacknodelp env' cbDataPtr (fromIntegral wherefrom) lpPtrPtr - lpPtr <- peek lpPtrPtr - free lpPtrPtr - case lpstat of - 0 -> return $ Right $ CpxLp lpPtr - k -> do statString <- getErrorString env (CpxRet lpstat) - return $ Left $ statString - - - -------------------------------------------------- - -withEnv :: (CpxEnv -> IO a) -> IO a -withEnv f = do - env' <- openCPLEX - case env' of - Left msg -> error msg - Right env -> do - ret <- f env - closeCPLEX env - return ret - -withLp :: CpxEnv -> String -> (CpxLp -> IO a) -> IO a -withLp env name f = do - lp' <- createProb env name - case lp' of - Left msg -> error msg - Right lp -> do - ret <- f lp - freeProb env lp - return ret diff --git a/src/CPLEX/Bindings.hs b/src/CPLEX/Bindings.hs --- a/src/CPLEX/Bindings.hs +++ b/src/CPLEX/Bindings.hs @@ -51,7 +51,9 @@ , c_createCutCallbackPtr , c_CPXsetincumbentcallbackfunc , c_CPXsetcutcallbackfunc + , c_CPXsetlazyconstraintcallbackfunc -- MIP cuts + , c_CPXaddmipstarts , c_CPXcutcallbackadd , c_CPXaddusercuts , c_CPXaddlazyconstraints @@ -227,6 +229,14 @@ foreign import ccall safe "cplex.h CPXgetcallbacknodex" c_CPXgetcallbacknodex :: Ptr CpxEnv' -> Ptr () -> CInt -> Ptr CDouble -> CInt -> CInt -> IO CInt +-- int CPXaddmipstarts(CPXCENVptr env, CPXLPptr lp, int mcnt, int nzcnt, const +-- int * beg, const int * varindices, const double * values, const int * +-- effortlevel, char ** mipstartname) +foreign import ccall safe "cplex.h CPXaddmipstarts" c_CPXaddmipstarts :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> CInt -> Ptr CInt -> Ptr CInt -> Ptr CDouble + -> Ptr CInt -> Ptr (Ptr CChar) -> IO CInt + + --new -- http://www.ibm.com/support/knowledgecenter/SSSA5P_12.2.0/ilog.odms.cplex.help/html/refcallablelibrary/html/functions/CPXaddusercuts.html?lang=en foreign import ccall safe "cplex.h CPXaddusercuts" c_CPXaddusercuts :: @@ -259,6 +269,8 @@ foreign import ccall safe "cplex.h CPXsetcutcallbackfunc" c_CPXsetcutcallbackfunc:: Ptr CpxEnv' -> FunPtr CCutCallback -> Ptr () -> IO CInt +foreign import ccall safe "cplex.h CPXsetlazyconstraintcallbackfunc" c_CPXsetlazyconstraintcallbackfunc:: + Ptr CpxEnv' -> FunPtr CCutCallback -> Ptr () -> IO CInt -- int callback (CPXCENVptr env, -- void *cbdata, @@ -287,3 +299,5 @@ foreign import ccall "wrapper" c_createCutCallbackPtr :: CCutCallback -> IO (FunPtr (CCutCallback)) --int CPXsetincumbentcallbackfunc(CPXENVptr env, int(*)(CALLBACK_INCUMBENT_ARGS) incumbentcallback, void * cbhandle) + + diff --git a/src/CPLEX/Core.hs b/src/CPLEX/Core.hs new file mode 100644 --- /dev/null +++ b/src/CPLEX/Core.hs @@ -0,0 +1,863 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module CPLEX.Core ( CpxEnv(..) + , CpxLp + , ObjSense(..) + , Sense(..) + , Bound(..) + , Type(..) + , Row(..) + , Col(..) + , CpxSolution(..) + -- * high level bindings + , openCPLEX + , closeCPLEX + , createProb + , freeProb + , setIntParam + , setDoubleParam + , copyLp + --, checkCopyLp + , copyQuad + --, checkCopyQuad + , copyMip + , qpopt + , lpopt + , mipopt + , primopt + , dualopt + , siftopt + , hybnetopt + , getSolution + , getMIPSolution + -- * change things + , changeCoefList + , changeObj + , changeRhs + , changeBds + , changeRngVal + , changeSens + , changeQpCoef + -- * low level stuff + , getNumCols + , getNumRows + , getErrorString + , getStatString + -- MIP + , setIncumbentCallback + , setCutCallback + , setLazyConstraintCallback + , addCuts + , addRows + , addLazyConstraints + , getCallbackLP + , getCallbackNodeX + , addCutFromCallback + , addSingleMIPStart + -- * convenience wrappers + , withEnv + , withLp + ) where + +-- import Control.Monad.Error +import Control.Monad.IO.Class +import qualified Control.Monad.Primitive as Prim +-- import Control.Monad.Trans +-- import Control.Monad.Trans.Maybe +import qualified Data.Map as M +import qualified Data.Vector as V +import Data.Vector.Storable (Vector) +import qualified Data.Vector.Storable as VS +import qualified Data.Vector.Storable.Mutable as VSM +import Foreign.C +import Foreign.Marshal +import Foreign.Ptr +import Foreign.Storable +import Control.Applicative +import CPLEX.Bindings +import CPLEX.Param +import Data.Char(ord) + +newtype CpxEnv = CpxEnv (Ptr CpxEnv') +newtype CpxLp = CpxLp (Ptr CpxLp') + +data ObjSense = CPX_MIN | CPX_MAX deriving Show +instance Enum ObjSense where + fromEnum CPX_MIN = 1 + fromEnum CPX_MAX = -1 + toEnum 1 = CPX_MIN + toEnum (-1) = CPX_MAX + toEnum k = error $ "ObjSense: toEnum: unhandled value: " ++ show k + +data Sense = L Double + | E Double + | G Double + | R Double Double + deriving (Eq, Show) + +data Bound = L' Double + | E' Double + | U' Double + deriving (Eq, Show) + +data Type = CPX_CONTINUOUS + | CPX_BINARY + | CPX_INTEGER + deriving (Eq, Show) + +cpx_INFBOUND :: CDouble +cpx_INFBOUND = 1.1e20 + +newtype CpxRet = CpxRet CInt + +getErrorString :: CpxEnv -> CpxRet -> IO String +getErrorString (CpxEnv env) (CpxRet status) = do + msgPtr <- mallocArray 4096 + _ <- c_CPXgeterrorstring env status msgPtr + msg <- peekCString msgPtr + free msgPtr + return msg + +getStatString :: CpxEnv -> CpxRet -> IO String +getStatString (CpxEnv env) (CpxRet status) = do + msgPtr <- mallocArray 510 + _ <- c_CPXgetstatstring env status msgPtr + msg <- peekCString msgPtr + free msgPtr + return msg + + +openCPLEX :: IO (Either String CpxEnv) +openCPLEX = do + statusPtr <- malloc + env <- c_CPXopenCPLEX statusPtr + status <- peek statusPtr + free statusPtr + + if env == nullPtr + then do + -- env is NULL, throw error + msg <- getErrorString (CpxEnv env) (CpxRet status) + return (Left msg) + else do + return (Right (CpxEnv env)) + +closeCPLEX :: CpxEnv -> IO () +closeCPLEX env@(CpxEnv env') = do + -- free env + envPtr <- new env' + status <- c_CPXcloseCPLEX envPtr + free envPtr + case status of + -- closed successfully + 0 -> do + return () + -- close failed, print error message + k -> do + msg <- getErrorString env (CpxRet k) + error $ "error calling CPXcloseCPLEX: " ++ msg + +createProb :: CpxEnv -> String -> IO (Either String CpxLp) +createProb env@(CpxEnv env') name = do + statusPtr <- malloc + namePtr <- newCString name + lp <- c_CPXcreateprob env' statusPtr namePtr + status <- peek statusPtr + free statusPtr + free namePtr + + if lp == nullPtr + then do + -- lp is NULL, return error message + msg <- getErrorString env (CpxRet status) + return (Left msg) + else return (Right (CpxLp lp)) + + +freeProb :: CpxEnv -> CpxLp -> IO () +freeProb env@(CpxEnv env') (CpxLp lp) = do + -- free env + lpPtr <- new lp + status <- c_CPXfreeprob env' lpPtr + free lpPtr + + case status of + -- freed successfully + 0 -> return () + -- freeing failed, print error message + k -> do + msg <- getErrorString env (CpxRet k) + error $ "error calling CPXfreeprob: " ++ msg + + +getNumCols :: CpxEnv -> CpxLp -> IO Int +getNumCols (CpxEnv env) (CpxLp lp) = fmap fromIntegral (c_CPXgetnumcols env lp) + +getNumRows :: CpxEnv -> CpxLp -> IO Int +getNumRows (CpxEnv env) (CpxLp lp) = fmap fromIntegral (c_CPXgetnumrows env lp) + +data CpxSolution = CpxSolution { solObj :: Double + , solStat :: CPX_SOLUTION_CODE + , solX :: Vector Double + , solPi :: Vector Double + , solSlack :: Vector Double + , solDj :: Vector Double + } deriving Show + +getSolution :: CpxEnv -> CpxLp -> IO (Either String CpxSolution) +getSolution env@(CpxEnv env') lp@(CpxLp lp') = do + lpstat' <- malloc + objval' <- malloc + + numrows <- getNumRows env lp + numcols <- getNumCols env lp + x <- VSM.new numcols + p <- VSM.new numrows + slack <- VSM.new numrows + dj <- VSM.new numcols + + status <- + VSM.unsafeWith x $ \x' -> + VSM.unsafeWith p $ \p' -> + VSM.unsafeWith slack $ \slack' -> + VSM.unsafeWith dj $ \dj' -> + c_CPXsolution env' lp' lpstat' objval' x' p' slack' dj' + + lpstat <- peek lpstat' + objval <- peek objval' + free lpstat' + free objval' + + x'' <- VS.freeze x + p'' <- VS.freeze p + slack'' <- VS.freeze slack + dj'' <- VS.freeze dj + + case status of + 0 -> do + statString <- getStatString env (CpxRet lpstat) + +-- filename <- newCAString "lp.lp" +-- status <- c_CPXwriteprob env' lp' filename nullPtr + + return $ Right $ CpxSolution { solObj = realToFrac objval + , solStat = intToSolution lpstat + , solX = VS.map realToFrac x'' + , solPi = VS.map realToFrac p'' + , solSlack = VS.map realToFrac slack'' + , solDj = VS.map realToFrac dj'' + } + k -> fmap Left (getErrorString env (CpxRet k)) + + + + + +getMIPSolution :: CpxEnv -> CpxLp -> IO (Either String CpxSolution) +getMIPSolution env@(CpxEnv env') lp@(CpxLp lp') = do + lpstat' <- malloc + objval' <- malloc + + numrows <- getNumRows env lp + numcols <- getNumCols env lp + x <- VSM.new numcols + + status <- + VSM.unsafeWith x $ \x' -> + c_CPXsolution env' lp' lpstat' objval' x' nullPtr nullPtr nullPtr + + lpstat <- peek lpstat' + objval <- peek objval' + free lpstat' + free objval' + + x'' <- VS.freeze x + case status of + 0 -> do + statString <- getStatString env (CpxRet lpstat) + + return $ Right $ CpxSolution { solObj = realToFrac objval + , solStat = intToSolution lpstat + , solX = VS.map realToFrac x'' + , solPi = VS.empty + , solSlack = VS.empty + , solDj = VS.empty + } + k -> fmap Left (getErrorString env (CpxRet k)) + + + + + +getMIPSolution' :: CpxEnv -> CpxLp -> IO (Either String CpxSolution) +getMIPSolution' env@(CpxEnv env') lp@(CpxLp lp') = do + status <- c_CPXchgprobtype env' lp' $ typeToInt CPX_PROB_MILP + case status of + 0 -> do + objval' <- malloc + + numrows <- getNumRows env lp + numcols <- getNumCols env lp + x <- VSM.new numcols + slack <- VSM.new numrows + + let statString = "" + + status <- c_CPXgetobjval env' lp' objval' + case status of + 0 -> do + objval <- peek objval' + status <- VSM.unsafeWith x $ \x' -> + c_CPXgetx env' lp' x' 0 $ fromIntegral (numcols - 1) + case status of + 0 -> do + x'' <- VS.freeze x + status <- VSM.unsafeWith slack $ \slack' -> + c_CPXgetslack env' lp' slack' 0 $ fromIntegral (numrows - 1) + case status of + 0 -> do + slack'' <- VS.freeze slack + + + return $ Right $ CpxSolution { solObj = realToFrac objval + , solStat = intToSolution 0 + , solX = VS.map realToFrac x'' + , solPi = VS.fromList $ take numcols [0.0,0.0..] + , solSlack = VS.map realToFrac slack'' + , solDj = VS.fromList $ take numcols [0.0,0.0..] + } + + k -> fmap Left (getErrorString env (CpxRet k)) + k -> fmap Left (getErrorString env (CpxRet k)) + k -> fmap Left (getErrorString env (CpxRet k)) + +toCpxError :: CpxEnv -> CInt -> IO (Maybe String) +toCpxError env 0 = return Nothing +toCpxError env k = do + msg <- liftIO $ getErrorString env (CpxRet k) + return $ Just msg + +setIntParam :: CpxEnv -> CPX_PARAM -> CInt -> IO () +setIntParam env@(CpxEnv env') param val = do + status <- c_CPXsetintparam env' (paramToInt param) val + case status of + 0 -> return () + k -> do + putStrLn $ "CPXsetintparam failure setting " ++ show param + msg <- getErrorString env (CpxRet k) + error $ "error calling CPXsetintparam: " ++ msg + +setDoubleParam :: CpxEnv -> CPX_PARAM -> CDouble -> IO () +setDoubleParam env@(CpxEnv env') param val = do + status <- c_CPXsetdblparam env' (paramToInt param) val + case status of + 0 -> return () + k -> do + putStrLn $ "CPXsetdblparam failure setting " ++ show param + msg <- getErrorString env (CpxRet k) + error $ "error calling CPXsetdblparam: " ++ msg + +newtype Row = Row {unRow :: Int} deriving (Ord, Eq, Num) +newtype Col = Col {unCol :: Int} deriving (Ord, Eq, Num) +instance Show Row where + show = show . unRow +instance Show Col where + show = show . unCol + +-- for use with the adding of rows, cuts or lazy constraints +toColForm' :: [(Row,Col,Double)] -> (Vector CInt, Vector CInt, Vector CDouble) +toColForm' amat = (VS.fromList matbeg, VS.fromList matind, VS.fromList matval) + where + cols = map (\(Row a, Col b, v) -> b) amat + rows = map (\(Row a, _, _) -> a) amat + numRows = maximum rows - (minimum rows) + 1 + numCols = maximum cols - (minimum cols) + 1 + rows' = map (\q -> filter (\(Row a, Col b, v) -> a== q ) amat) [minimum rows..maximum rows] + matval = map (\(Row a, Col b, v) -> realToFrac v) $ concat rows' + matind = map (\(Row a, Col b, v) -> fromIntegral b) $ concat rows' + matbeg = map (fromIntegral . (*numCols)) [0..numRows-1] + +toColForm :: Int -> [(Row,Col,Double)] -> (Vector CInt, Vector CInt, Vector CInt, Vector CDouble) +toColForm numcols amat = (matbeg, matcnt, matind, matval) + where + matbeg = VS.fromList $ map fromIntegral begs + matcnt = VS.fromList $ map fromIntegral cnts + matind = VS.fromList $ map (fromIntegral . unRow) inds + matval = VS.fromList $ map realToFrac vals + + -- sort colMap into the from CPLEX wants + inds :: [Row] + vals :: [Double] + (inds,vals) = unzip $ concat rows + + begs :: [Int] + cnts :: [Int] + rows :: [[(Row,Double)]] + (begs,cnts,rows) = unzip3 $ colMapInfo' 0 $ M.elems colMap + + colMapInfo' :: Int -> [[(Row,Double)]] -> [(Int,Int,[(Row,Double)])] + colMapInfo' beg (row:xs) = (beg,cnt,row) : colMapInfo' (beg + cnt) xs + where + cnt = length row + colMapInfo' _ [] = [] + + -- add Columns with no entries in case some are missing + colMap = M.union colMap' emptyColMap + + emptyColMap :: M.Map Col [(Row,Double)] + emptyColMap = M.fromList $ take numcols $ zip (map Col [0..]) (repeat []) + + -- a map from Col to all (Row,Double) pairs + colMap' :: M.Map Col [(Row,Double)] + colMap' = M.fromListWith (++) preorder + + -- reorganize the (Row,Col,Double) into (Col, [(Row,Double)]) with only 1 (Row,Double) + preorder :: [(Col,[(Row,Double)])] + preorder = map (\(row,col,val) -> (col, [(row, val)])) amat + + +copyLp :: CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> IO (Maybe String) +copyLp = copyLpWithFun' c_CPXcopylp + +--checkCopyLp :: CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> IO (Maybe String) +--checkCopyLp = copyLpWithFun' c_CPXcheckcopylp + +type CopyLp = + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> CInt -> CInt -> Ptr CDouble -> + Ptr CDouble -> Ptr CChar -> Ptr CInt -> Ptr CInt -> + Ptr CInt -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> IO CInt + +copyLpWithFun' :: CopyLp -> CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> IO (Maybe String) +copyLpWithFun' copyLpFun env lp objsense objcoeffs senseRhsRngVal aMat xbnds = + copyLpWithFun copyLpFun env lp numcols numrows objsense (VS.fromList (V.toList (V.map realToFrac objcoeffs))) rhs sense matbeg matcnt matind matval lb ub rngval + where + numcols = V.length objcoeffs -- or xbnds + numrows = V.length senseRhsRngVal + + toBnds :: (Maybe Double, Maybe Double) -> (CDouble, CDouble) + toBnds (Nothing, Nothing) = (-cpx_INFBOUND, cpx_INFBOUND) + toBnds ( Just x, Nothing) = ( realToFrac x, cpx_INFBOUND) + toBnds (Nothing, Just y) = (-cpx_INFBOUND, realToFrac y) + toBnds ( Just x, Just y) = ( realToFrac x, realToFrac y) + + lb = VS.fromList $ V.toList lb' + ub = VS.fromList $ V.toList ub' + (lb',ub') = V.unzip $ V.map toBnds xbnds + + toRhs :: Sense -> (CChar, CDouble, CDouble) + toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) + toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) + toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) + toRhs (R l u) = (castCharToCChar 'R', realToFrac l, realToFrac (u-l)) + + sense = VS.fromList $ V.toList sense' + rngval = VS.fromList $ V.toList rngval' + rhs = VS.fromList $ V.toList rhs' + (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal + + (matbeg, matcnt, matind, matval) = toColForm numcols aMat + + +copyLpWithFun :: CopyLp -> CpxEnv -> CpxLp -> Int -> Int -> ObjSense -> Vector CDouble -> Vector CDouble -> Vector CChar -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CDouble -> Vector CDouble -> Vector CDouble -> Vector CDouble -> IO (Maybe String) +copyLpWithFun copylpFun env@(CpxEnv env') (CpxLp lp) numcols numrows objsense obj rhs sense matbeg matcnt matind matval lb ub rngval = do +-- setIntParam env CPX_PARAM_SCRIND cpx_ON +-- setIntParam env CPX_PARAM_DATACHECK cpx_ON + let objsense' = fromIntegral (fromEnum objsense) + numcols' = fromIntegral numcols + numrows' = fromIntegral numrows + -- print objsense + -- print obj + -- print rhs + -- print sense + -- print matbeg + -- print matcnt + -- print matind + -- print matval + -- print lb + -- print ub + -- print rngval + -- print numrows' + -- print numcols' + status <- + VS.unsafeWith obj $ \obj' -> + VS.unsafeWith rhs $ \rhs' -> + VS.unsafeWith sense $ \sense' -> + VS.unsafeWith matbeg $ \matbeg' -> + VS.unsafeWith matcnt $ \matcnt' -> + VS.unsafeWith matind $ \matind' -> + VS.unsafeWith matval $ \matval' -> + VS.unsafeWith lb $ \lb' -> + VS.unsafeWith ub $ \ub' -> + VS.unsafeWith rngval $ \rngval' -> + copylpFun env' lp numcols' numrows' objsense' obj' rhs' sense' matbeg' matcnt' matind' matval' lb' ub' rngval' + + case status of + 0 -> return Nothing + k -> Just <$> getErrorString env (CpxRet k) + +type CopyQuad = + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CInt -> Ptr CInt -> Ptr CInt -> Ptr CDouble -> IO CInt + +copyQuad :: CpxEnv -> CpxLp -> [(Row,Col,Double)] -> IO (Maybe String) +copyQuad = copyQuadWithFun' c_CPXcopyquad + +copyQuadWithFun' :: CopyQuad -> CpxEnv -> CpxLp -> [(Row,Col,Double)] -> IO (Maybe String) +copyQuadWithFun' copyQuadFun env lp aMat = do + numcols <- getNumCols env lp + let (matbeg, matcnt, matind, matval) = toColForm numcols aMat + copyQuadWithFun copyQuadFun env lp matbeg matcnt matind matval + +copyQuadWithFun :: CopyQuad -> CpxEnv -> CpxLp -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CDouble -> IO (Maybe String) +copyQuadWithFun copyQuadFun env@(CpxEnv env') (CpxLp lp) matbeg matcnt matind matval = do + status <- + VS.unsafeWith matbeg $ \matbeg' -> + VS.unsafeWith matcnt $ \matcnt' -> + VS.unsafeWith matind $ \matind' -> + VS.unsafeWith matval $ \matval' -> + copyQuadFun env' lp matbeg' matcnt' matind' matval' + + case status of + 0 -> return Nothing + k -> fmap Just $ getErrorString env (CpxRet k) + + +copyMip :: CpxEnv -> CpxLp -> ObjSense -> V.Vector Double -> V.Vector Sense -> [(Row,Col,Double)] -> V.Vector (Maybe Double, Maybe Double) -> V.Vector Type -> IO (Maybe String) +copyMip env@(CpxEnv env') lp@(CpxLp lp') objsense objcoeffs senseRhsRngVal aMat xbnds ctypes = do + status <- copyLpWithFun' c_CPXcopylp env lp objsense objcoeffs senseRhsRngVal aMat xbnds + case status of + Nothing -> do + status' <- + VS.unsafeWith ctypes' $ \ctypes'' -> + c_CPXcopyctype env' lp' ctypes'' + + case status' of + 0 -> return Nothing + k' -> fmap Just $ getErrorString env (CpxRet k') + + + Just msg -> return $ Just msg --fmap Just $ getErrorString env (CpxRet k) + + where + toCType :: Type -> CChar + toCType CPX_CONTINUOUS = castCharToCChar 'C' + toCType CPX_BINARY = castCharToCChar 'B' + toCType CPX_INTEGER = castCharToCChar 'I' + + ctypes' :: VS.Vector CChar + ctypes' = VS.fromList $ map toCType $ V.toList ctypes + + +withOptFun :: (Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt) -> CpxEnv -> CpxLp -> IO (Maybe String) +withOptFun optFun env@(CpxEnv env') (CpxLp lp') = do + status <- optFun env' lp' + case status of + 0 -> return Nothing + k -> fmap Just (getErrorString env (CpxRet k)) + +qpopt :: CpxEnv -> CpxLp -> IO (Maybe String) +qpopt = withOptFun c_CPXqpopt + +lpopt :: CpxEnv -> CpxLp -> IO (Maybe String) +lpopt = withOptFun c_CPXlpopt + +mipopt :: CpxEnv -> CpxLp -> IO (Maybe String) +mipopt = withOptFun c_CPXmipopt + +primopt :: CpxEnv -> CpxLp -> IO (Maybe String) +primopt = withOptFun c_CPXprimopt + +dualopt :: CpxEnv -> CpxLp -> IO (Maybe String) +dualopt = withOptFun c_CPXdualopt + +siftopt :: CpxEnv -> CpxLp -> IO (Maybe String) +siftopt = withOptFun c_CPXsiftopt + +hybnetopt :: CpxEnv -> CpxLp -> Int -> IO (Maybe String) +hybnetopt env lp k = withOptFun (\e l -> c_CPXhybnetopt e l (fromIntegral k)) env lp + +------------------------------------------------- + + +changeCoefList :: CpxEnv -> CpxLp -> V.Vector (Row, Col, Double) -> IO (Maybe String) +changeCoefList env@(CpxEnv env') (CpxLp lp') rcv = do + let num = fromIntegral (V.length rcv) + (rows', cols', vals') = V.unzip3 rcv + rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' + cols = VS.fromList $ V.toList $ V.map (fromIntegral . unCol) cols' + vals = VS.fromList $ V.toList $ V.map realToFrac vals' + status <- + VS.unsafeWith rows $ \rows'' -> + VS.unsafeWith cols $ \cols'' -> + VS.unsafeWith vals $ \vals'' -> + c_CPXchgcoeflist env' lp' num rows'' cols'' vals'' + case status of + 0 -> return Nothing + k -> fmap Just $ getErrorString env (CpxRet k) + + +changeRhs :: CpxEnv -> CpxLp -> V.Vector (Row, Double) -> IO (Maybe String) +changeRhs env@(CpxEnv env') (CpxLp lp') rv = do + let num = fromIntegral (V.length rv) + (rows', vals') = V.unzip rv + rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' + vals = VS.fromList $ V.toList $ V.map realToFrac vals' + status <- + VS.unsafeWith rows $ \rows'' -> + VS.unsafeWith vals $ \vals'' -> + c_CPXchgrhs env' lp' num rows'' vals'' + case status of + 0 -> return Nothing + k -> fmap Just $ getErrorString env (CpxRet k) + +changeObj :: CpxEnv -> CpxLp -> V.Vector (Col, Double) -> IO (Maybe String) +changeObj env@(CpxEnv env') (CpxLp lp') cv = do + let num = fromIntegral (V.length cv) + (cols', vals') = V.unzip cv + cols = VS.fromList $ V.toList $ V.map (fromIntegral . unCol) cols' + vals = VS.fromList $ V.toList $ V.map realToFrac vals' + status <- + VS.unsafeWith cols $ \cols'' -> + VS.unsafeWith vals $ \vals'' -> + c_CPXchgobj env' lp' num cols'' vals'' + case status of + 0 -> return Nothing + k -> fmap Just $ getErrorString env (CpxRet k) + + +changeBds :: CpxEnv -> CpxLp -> V.Vector (Col, Bound) -> IO (Maybe String) +changeBds env@(CpxEnv env') (CpxLp lp') cb = do + let num = fromIntegral (V.length cb) + (cols', bounds') = V.unzip cb + + fromBound :: Bound -> (CChar, CDouble) + fromBound (L' x) = (castCharToCChar 'L', realToFrac x) + fromBound (U' x) = (castCharToCChar 'U', realToFrac x) + fromBound (E' x) = (castCharToCChar 'E', realToFrac x) + + (lus', bds') = V.unzip $ V.map fromBound bounds' + + cols = VS.fromList $ V.toList $ V.map (fromIntegral . unCol) cols' + lus = VS.fromList $ V.toList $ lus' + bds = VS.fromList $ V.toList $ bds' + status <- + VS.unsafeWith cols $ \cols'' -> + VS.unsafeWith lus $ \lus'' -> + VS.unsafeWith bds $ \bds'' -> + c_CPXchgbds env' lp' num cols'' lus'' bds'' + case status of + 0 -> return Nothing + k -> fmap Just $ getErrorString env (CpxRet k) + +changeRngVal :: CpxEnv -> CpxLp -> V.Vector (Row, Double) -> IO (Maybe String) +changeRngVal env@(CpxEnv env') (CpxLp lp') rv = do + let num = fromIntegral (V.length rv) + (rows', vals') = V.unzip rv + rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' + vals = VS.fromList $ V.toList $ V.map realToFrac vals' + status <- + VS.unsafeWith rows $ \rows'' -> + VS.unsafeWith vals $ \vals'' -> + c_CPXchgrngval env' lp' num rows'' vals'' + case status of + 0 -> return Nothing + k -> fmap Just $ getErrorString env (CpxRet k) + +changeSens :: CpxEnv -> CpxLp -> V.Vector (Row, Char) -> IO (Maybe String) +changeSens env@(CpxEnv env') (CpxLp lp') rs = do + let num = fromIntegral (V.length rs) + (rows', senses') = V.unzip rs + rows = VS.fromList $ V.toList $ V.map (fromIntegral . unRow) rows' + senses = VS.fromList $ V.toList $ V.map castCharToCChar senses' + status <- + VS.unsafeWith rows $ \rows'' -> + VS.unsafeWith senses $ \senses'' -> + c_CPXchgsense env' lp' num rows'' senses'' + getErrorStatus env status + +changeQpCoef :: CpxEnv -> CpxLp -> Row -> Col -> Double -> IO (Maybe String) +changeQpCoef env@(CpxEnv env') (CpxLp lp') (Row row) (Col col) val = do + status <- c_CPXchgqpcoef env' lp' (fromIntegral row) (fromIntegral col) (realToFrac val) + getErrorStatus env status + + +-------------------------------------------------- + +addCuts :: CpxEnv -> CpxLp -> Int -> V.Vector Sense -> [(Row, Col,Double)] -> IO (Maybe String) +addCuts env@(CpxEnv env') (CpxLp lp') nzcnt senseRhsRngVal aMat = do + status <- + VS.unsafeWith rhs $ \rows'' -> + VS.unsafeWith sense $ \senses'' -> + VS.unsafeWith matbeg $ \matbeg'' -> + VS.unsafeWith matind $ \matind'' -> + VS.unsafeWith matval $ \matval'' -> + + c_CPXaddusercuts env' lp' (fromIntegral numrows) (fromIntegral nzcnt) + rows'' senses'' matbeg'' matind'' matval'' nullPtr + getErrorStatus env status + where + numrows = V.length senseRhsRngVal + + toRhs :: Sense -> (CChar, CDouble, CDouble) + toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) + toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) + toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) + + (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal + sense = VS.fromList $ V.toList sense' + rhs = VS.fromList $ V.toList rhs' + + (matbeg, matind, matval) = toColForm' aMat + + +addLazyConstraints :: CpxEnv -> CpxLp -> Int -> V.Vector Sense -> [(Row, Col,Double)] -> IO (Maybe String) +addLazyConstraints env@(CpxEnv env') (CpxLp lp') nzcnt senseRhsRngVal aMat = do + status <- + VS.unsafeWith rhs $ \rows'' -> + VS.unsafeWith sense $ \senses'' -> + VS.unsafeWith matbeg $ \matbeg'' -> + VS.unsafeWith matind $ \matind'' -> + VS.unsafeWith matval $ \matval'' -> + + c_CPXaddlazyconstraints env' lp' (fromIntegral numrows) (fromIntegral nzcnt) + rows'' senses'' matbeg'' matind'' matval'' nullPtr + getErrorStatus env status + where + numrows = V.length senseRhsRngVal + + toRhs :: Sense -> (CChar, CDouble, CDouble) + toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) + toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) + toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) + + (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal + sense = VS.fromList $ V.toList sense' + rhs = VS.fromList $ V.toList rhs' + --matbeg = VS.fromList $ replicate numrows 0 + (matbeg, matind, matval) = toColForm' aMat + + +addCutFromCallback :: CpxEnv -> Ptr () -> CInt -> CInt -> Sense -> [(Col,Double)] -> CPX_CUT_TYPE -> IO (Maybe String) +addCutFromCallback env@(CpxEnv env') cbdata wherefrom nzcnt sense aMat purgable = do + status <- + VS.unsafeWith cutind $ \ind -> + VS.unsafeWith cutvals $ \vals -> + c_CPXcutcallbackadd env' cbdata wherefrom nzcnt rhs' sense' ind vals purgable' + getErrorStatus env status + where + cutind = VS.fromList $ map (\(Col a, v) -> fromIntegral a) aMat + cutvals = VS.fromList $ map (\(Col a, v) -> realToFrac v) aMat + purgable' = cutToInt purgable + senseToInt (L x) = (fromIntegral $ ord 'L', realToFrac x) + senseToInt (G x) = (fromIntegral $ ord 'G', realToFrac x) + senseToInt (E x) = (fromIntegral $ ord 'E', realToFrac x) + (sense', rhs') = senseToInt sense + + +addRows :: CpxEnv -> CpxLp -> Int -> Int -> Int -> V.Vector Sense -> [(Row, Col,Double)] -> IO (Maybe String) +addRows env@(CpxEnv env') (CpxLp lp') ccnt rcnt nzcnt senseRhsRngVal aMat = do + status <- + VS.unsafeWith rhs $ \rows'' -> + VS.unsafeWith sense $ \senses'' -> + VS.unsafeWith matbeg $ \matbeg'' -> + VS.unsafeWith matind $ \matind'' -> + VS.unsafeWith matval $ \matval'' -> + + c_CPXaddrows env' lp' (fromIntegral ccnt) (fromIntegral rcnt) (fromIntegral nzcnt) + rows'' senses'' matbeg'' matind'' matval'' nullPtr nullPtr + getErrorStatus env status + where + numrows = V.length senseRhsRngVal + + toRhs :: Sense -> (CChar, CDouble, CDouble) + toRhs (L x) = (castCharToCChar 'L', realToFrac x, 0) + toRhs (E x) = (castCharToCChar 'E', realToFrac x, 0) + toRhs (G x) = (castCharToCChar 'G', realToFrac x, 0) + + (sense', rhs', rngval') = V.unzip3 $ V.map toRhs senseRhsRngVal + sense = VS.fromList $ V.toList sense' + rhs = VS.fromList $ V.toList rhs' + + (matbeg, matcnt, matind, matval) = toColForm nzcnt aMat + +getErrorStatus env status = case status of + 0 -> return Nothing + k -> Just <$> getErrorString env (CpxRet k) + +addSingleMIPStart :: CpxEnv -> CpxLp -> [Int] -> [Double] -> CPX_EFFORT_LEVEL -> IO (Maybe String) +addSingleMIPStart env@(CpxEnv env') (CpxLp lp') indices values effortLevel = do + let n = fromIntegral $ length indices + status <- VS.unsafeWith (VS.fromList $ fromIntegral <$> indices) $ \indices' -> + VS.unsafeWith (VS.fromList $ realToFrac <$> values) $ \values' -> + VS.unsafeWith (VS.fromList [effortLevelToInt effortLevel]) $ \effortLevels -> + VS.unsafeWith (VS.fromList [0]) $ \beg -> + c_CPXaddmipstarts env' lp' 1 n beg indices' values' effortLevels nullPtr + getErrorStatus env status + + +{-# NOINLINE setIncumbentCallback #-} +setIncumbentCallback :: CpxEnv -> CIncumbentCallback -> IO (Maybe String) +setIncumbentCallback env@(CpxEnv env') callback = do + ptr <- c_createIncumbentCallbackPtr callback + status <- c_CPXsetincumbentcallbackfunc env' ptr nullPtr + getErrorStatus env status + + +{-# NOINLINE setCutCallback #-} +setCutCallback :: CpxEnv -> CCutCallback -> IO (Maybe String) +setCutCallback env@(CpxEnv env') callback = do + ptr <- c_createCutCallbackPtr callback + status <- c_CPXsetcutcallbackfunc env' ptr nullPtr + getErrorStatus env status + +{-# NOINLINE setLazyConstraintCallback #-} +setLazyConstraintCallback :: CpxEnv -> CCutCallback -> IO (Maybe String) +setLazyConstraintCallback env@(CpxEnv env') callback = do + ptr <- c_createCutCallbackPtr callback + status <- c_CPXsetlazyconstraintcallbackfunc env' ptr nullPtr + getErrorStatus env status + +getCallbackNodeX :: CpxEnv -> Ptr () -> Int -> Int -> Int -> IO (Maybe String, VS.Vector Double) +getCallbackNodeX env@(CpxEnv env') cbDataPtr wherefrom begin end = do + xs' <- VSM.new (end - begin + 1) + status <- VSM.unsafeWith xs' $ \ptr -> + c_CPXgetcallbacknodex env' cbDataPtr (fromIntegral wherefrom) ptr (fromIntegral begin) (fromIntegral end) + xs <- VS.freeze xs' + stat <- getErrorStatus env status + return (stat, VS.map realToFrac xs) + +-- IMPORTANT FREE MEMORY AFTERWARDS +getCallbackLP :: CpxEnv -> Ptr () -> Int -> IO (Either String CpxLp) +getCallbackLP env@(CpxEnv env') cbDataPtr wherefrom = do + lpPtrPtr <- mallocBytes 8 + lpstat <- c_CPXgetcallbacknodelp env' cbDataPtr (fromIntegral wherefrom) lpPtrPtr + lpPtr <- peek lpPtrPtr + free lpPtrPtr + case lpstat of + 0 -> return $ Right $ CpxLp lpPtr + k -> do statString <- getErrorString env (CpxRet lpstat) + return $ Left statString + + + +------------------------------------------------- + +withEnv :: (CpxEnv -> IO a) -> IO a +withEnv f = do + env' <- openCPLEX + case env' of + Left msg -> error msg + Right env -> do + ret <- f env + closeCPLEX env + return ret + +withLp :: CpxEnv -> String -> (CpxLp -> IO a) -> IO a +withLp env name f = do + lp' <- createProb env name + case lp' of + Left msg -> error msg + Right lp -> do + ret <- f lp + freeProb env lp + return ret diff --git a/src/CPLEX/Param.hs b/src/CPLEX/Param.hs --- a/src/CPLEX/Param.hs +++ b/src/CPLEX/Param.hs @@ -3,6 +3,10 @@ module CPLEX.Param ( CPX_PARAM(..) , CPX_PROB_TYPE(..) , CPX_CUT_TYPE(..) + , CPX_EFFORT_LEVEL(..) + , CPX_SOLUTION_CODE(..) + , intToSolution + , effortLevelToInt , cutToInt , paramToInt , typeToInt @@ -182,6 +186,19 @@ cutToInt CPX_USECUT_PURGE = 1 cutToInt CPX_USECUT_FILTER = 2 +data CPX_EFFORT_LEVEL = CPX_MIPSTART_AUTO + | CPX_MIPSTART_CHECKFEAS + | CPX_MIPSTART_SOLVEFIXED + | CPX_MIPSTART_SOLVEMIP + | CPX_MIPSTART_REPAIR + +effortLevelToInt :: CPX_EFFORT_LEVEL -> CInt +effortLevelToInt CPX_MIPSTART_AUTO = 0 +effortLevelToInt CPX_MIPSTART_CHECKFEAS = 1 +effortLevelToInt CPX_MIPSTART_SOLVEFIXED = 2 +effortLevelToInt CPX_MIPSTART_SOLVEMIP = 3 +effortLevelToInt CPX_MIPSTART_REPAIR = 4 + intToType :: (Eq a, Num a) => a -> Maybe CPX_PROB_TYPE intToType 0 = Just CPX_PROB_LP intToType 1 = Just CPX_PROB_MILP @@ -192,3 +209,115 @@ intToType 10 = Just CPX_PROB_QCP intToType 11 = Just CPX_PROB_MIQCP intToType _ = Nothing + +data CPX_SOLUTION_CODE = CPX_STAT_OPTIMAL + | CPX_STAT_UNBOUNDED + | CPX_STAT_INFEASIBLE + | CPX_STAT_INForUNBD + | CPX_STAT_OPTIMAL_INFEAS + | CPX_STAT_NUM_BEST + | CPX_STAT_ABORT_IT_LIM + | CPX_STAT_ABORT_TIME_LIM + | CPX_STAT_ABORT_OBJ_LIM + | CPX_STAT_ABORT_USER + | CPX_STAT_FEASIBLE_RELAXED_SUM + | CPX_STAT_OPTIMAL_RELAXED_SUM + | CPX_STAT_FEASIBLE_RELAXED_INF + | CPX_STAT_OPTIMAL_RELAXED_INF + | CPX_STAT_FEASIBLE_RELAXED_QUAD + | CPX_STAT_OPTIMAL_RELAXED_QUAD + | CPX_STAT_CONFLICT_FEASIBLE + | CPX_STAT_CONFLICT_MINIMAL + | CPX_STAT_CONFLICT_ABORT_CONTRADICTION + | CPX_STAT_CONFLICT_ABORT_TIME_LIM + | CPX_STAT_CONFLICT_ABORT_IT_LIM + | CPX_STAT_CONFLICT_ABORT_NODE_LIM + | CPX_STAT_CONFLICT_ABORT_OBJ_LIM + | CPX_STAT_CONFLICT_ABORT_MEM_LIM + | CPX_STAT_CONFLICT_ABORT_USER + | CPX_STAT_OPTIMAL_FACE_UNBOUNDED + | CPX_STAT_ABORT_PRIM_OBJ_LIM + | CPX_STAT_ABORT_DUAL_OBJ_LIM + | CPXMIP_OPTIMAL + | CPXMIP_OPTIMAL_TOL + | CPXMIP_INFEASIBLE + | CPXMIP_SOL_LIM + | CPXMIP_NODE_LIM_FEAS + | CPXMIP_NODE_LIM_INFEAS + | CPXMIP_TIME_LIM_FEAS + | CPXMIP_TIME_LIM_INFEAS + | CPXMIP_FAIL_FEAS + | CPXMIP_FAIL_INFEAS + | CPXMIP_MEM_LIM_FEAS + | CPXMIP_MEM_LIM_INFEAS + | CPXMIP_ABORT_FEAS + | CPXMIP_ABORT_INFEAS + | CPXMIP_OPTIMAL_INFEAS + | CPXMIP_FAIL_FEAS_NO_TREE + | CPXMIP_FAIL_INFEAS_NO_TREE + | CPXMIP_UNBOUNDED + | CPXMIP_INForUNBD + | CPXMIP_FEASIBLE_RELAXED_SUM + | CPXMIP_OPTIMAL_RELAXED_SUM + | CPXMIP_FEASIBLE_RELAXED_INF + | CPXMIP_OPTIMAL_RELAXED_INF + | CPXMIP_FEASIBLE_RELAXED_QUAD + | CPXMIP_OPTIMAL_RELAXED_QUAD + | CPXMIP_ABORT_RELAXED + deriving (Show, Eq) + +intToSolution :: CInt -> CPX_SOLUTION_CODE +intToSolution 1 = CPX_STAT_OPTIMAL +intToSolution 2 = CPX_STAT_UNBOUNDED +intToSolution 3 = CPX_STAT_INFEASIBLE +intToSolution 4 = CPX_STAT_INForUNBD +intToSolution 5 = CPX_STAT_OPTIMAL_INFEAS +intToSolution 6 = CPX_STAT_NUM_BEST +intToSolution 10 = CPX_STAT_ABORT_IT_LIM +intToSolution 11 = CPX_STAT_ABORT_TIME_LIM +intToSolution 12 = CPX_STAT_ABORT_OBJ_LIM +intToSolution 13 = CPX_STAT_ABORT_USER +intToSolution 14 = CPX_STAT_FEASIBLE_RELAXED_SUM +intToSolution 15 = CPX_STAT_OPTIMAL_RELAXED_SUM +intToSolution 16 = CPX_STAT_FEASIBLE_RELAXED_INF +intToSolution 17 = CPX_STAT_OPTIMAL_RELAXED_INF +intToSolution 18 = CPX_STAT_FEASIBLE_RELAXED_QUAD +intToSolution 19 = CPX_STAT_OPTIMAL_RELAXED_QUAD +intToSolution 30 = CPX_STAT_CONFLICT_FEASIBLE +intToSolution 31 = CPX_STAT_CONFLICT_MINIMAL +intToSolution 32 = CPX_STAT_CONFLICT_ABORT_CONTRADICTION +intToSolution 33 = CPX_STAT_CONFLICT_ABORT_TIME_LIM +intToSolution 34 = CPX_STAT_CONFLICT_ABORT_IT_LIM +intToSolution 35 = CPX_STAT_CONFLICT_ABORT_NODE_LIM +intToSolution 36 = CPX_STAT_CONFLICT_ABORT_OBJ_LIM +intToSolution 37 = CPX_STAT_CONFLICT_ABORT_MEM_LIM +intToSolution 38 = CPX_STAT_CONFLICT_ABORT_USER +intToSolution 20 = CPX_STAT_OPTIMAL_FACE_UNBOUNDED +intToSolution 21 = CPX_STAT_ABORT_PRIM_OBJ_LIM +intToSolution 22 = CPX_STAT_ABORT_DUAL_OBJ_LIM +intToSolution 101 = CPXMIP_OPTIMAL +intToSolution 102 = CPXMIP_OPTIMAL_TOL +intToSolution 103 = CPXMIP_INFEASIBLE +intToSolution 104 = CPXMIP_SOL_LIM +intToSolution 105 = CPXMIP_NODE_LIM_FEAS +intToSolution 106 = CPXMIP_NODE_LIM_INFEAS +intToSolution 107 = CPXMIP_TIME_LIM_FEAS +intToSolution 108 = CPXMIP_TIME_LIM_INFEAS +intToSolution 109 = CPXMIP_FAIL_FEAS +intToSolution 110 = CPXMIP_FAIL_INFEAS +intToSolution 111 = CPXMIP_MEM_LIM_FEAS +intToSolution 112 = CPXMIP_MEM_LIM_INFEAS +intToSolution 113 = CPXMIP_ABORT_FEAS +intToSolution 114 = CPXMIP_ABORT_INFEAS +intToSolution 115 = CPXMIP_OPTIMAL_INFEAS +intToSolution 116 = CPXMIP_FAIL_FEAS_NO_TREE +intToSolution 117 = CPXMIP_FAIL_INFEAS_NO_TREE +intToSolution 118 = CPXMIP_UNBOUNDED +intToSolution 119 = CPXMIP_INForUNBD +intToSolution 120 = CPXMIP_FEASIBLE_RELAXED_SUM +intToSolution 121 = CPXMIP_OPTIMAL_RELAXED_SUM +intToSolution 122 = CPXMIP_FEASIBLE_RELAXED_INF +intToSolution 123 = CPXMIP_OPTIMAL_RELAXED_INF +intToSolution 124 = CPXMIP_FEASIBLE_RELAXED_QUAD +intToSolution 125 = CPXMIP_OPTIMAL_RELAXED_QUAD +intToSolution 126 = CPXMIP_ABORT_RELAXED