cplex-hs 0.2.0.1 → 0.2.0.2
raw patch · 5 files changed
+1008/−815 lines, 5 files
Files
- cplex-hs.cabal +2/−2
- src/CPLEX.hs +0/−813
- src/CPLEX/Bindings.hs +14/−0
- src/CPLEX/Core.hs +863/−0
- src/CPLEX/Param.hs +129/−0
cplex-hs.cabal view
@@ -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:
− src/CPLEX.hs
@@ -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
src/CPLEX/Bindings.hs view
@@ -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)++
+ src/CPLEX/Core.hs view
@@ -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
src/CPLEX/Param.hs view
@@ -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