diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012-2016, Greg Horn, Stefan Jacholke, Herwig Stuetz + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Greg Horn nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cplex-hs.cabal b/cplex-hs.cabal new file mode 100644 --- /dev/null +++ b/cplex-hs.cabal @@ -0,0 +1,37 @@ +name: cplex-hs +version: 0.2.0.1 +synopsis: high-level CPLEX interface +-- description: +License: BSD3 +License-file: LICENSE +Copyright: (c) Greg Horn 2012-2013, Stefan Jacholke 2016 +Author: Greg Horn, Stefan Jacholke +Maintainer: Stefan Jacholke +Homepage: https://github.com/stefan-j/cplex-haskell +Bug-Reports: https://github.com/stefan-j/cplex-haskell/issues +Category: Math +Stability: Experimental +Description: + High level interface to CPLEX + +build-type: Simple +cabal-version: >=1.8 +Library + exposed-modules: CPLEX, + CPLEX.Param + CPLEX.Bindings + -- other-modules: + Build-depends: base >= 4 && < 5 + , containers + , mtl + , primitive >= 0.6.1.0 + , transformers >= 0.4.2.0 + , vector + hs-source-dirs: src + + if os(linux) + Extra-lib-dirs: /opt/ibm/ILOG/CPLEX_Studio_Community1263/cplex/lib/x86-64_linux/static_pic/ + Extra-libraries: cplex, m, pthread + Include-dirs: /opt/ibm/ILOG/CPLEX_Studio_Community1263/cplex/include/ + cc-options: -Wall -Wextra + diff --git a/src/CPLEX.hs b/src/CPLEX.hs new file mode 100644 --- /dev/null +++ b/src/CPLEX.hs @@ -0,0 +1,813 @@ +{-# 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 new file mode 100644 --- /dev/null +++ b/src/CPLEX/Bindings.hs @@ -0,0 +1,289 @@ +{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module CPLEX.Bindings ( CpxEnv' + , CpxLp' + , c_CPXopenCPLEX + , c_CPXcloseCPLEX + , c_CPXcreateprob + , c_CPXfreeprob + , c_CPXnewrows + , c_CPXaddrows + , c_CPXnewcols + , c_CPXaddcols + , c_CPXchgcoeflist + , c_CPXchgrhs + , c_CPXchgrngval + , c_CPXchgbds + , c_CPXchgobj + , c_CPXchgsense + , c_CPXchgqpcoef + , c_CPXchgprobtype + , c_CPXcopyctype + , c_CPXgeterrorstring + , c_CPXgetstatstring + , c_CPXsetintparam + , c_CPXsetdblparam + , c_CPXgetnumcols + , c_CPXgetnumrows + , c_CPXgetobjval + , c_CPXgetx + , c_CPXgetstat + , c_CPXgetslack + , c_CPXcopylp +-- , c_CPXcheckcopylp + , c_CPXcopyquad +-- , c_CPXcheckcopyquad + , c_CPXqpopt + , c_CPXlpopt + , c_CPXmipopt + , c_CPXprimopt + , c_CPXdualopt + , c_CPXhybnetopt + , c_CPXsiftopt + , c_CPXsolution + , c_CPXwriteprob + -- Callbacks + , CIncumbentCallback + , CCutCallback + , c_createIncumbentCallbackPtr + , c_createCutCallbackPtr + , c_CPXsetincumbentcallbackfunc + , c_CPXsetcutcallbackfunc + -- MIP cuts + , c_CPXcutcallbackadd + , c_CPXaddusercuts + , c_CPXaddlazyconstraints + , c_CPXgetcallbacknodex + , c_CPXgetcallbacknodelp + ) where + +import Foreign.C (CChar (..), CDouble (..), CInt (..)) +import Foreign.Ptr (Ptr, FunPtr) + +data CpxEnv' +data CpxLp' + +foreign import ccall safe "cplex.h CPXopenCPLEX" c_CPXopenCPLEX :: Ptr CInt -> IO (Ptr CpxEnv') +foreign import ccall safe "cplex.h CPXcloseCPLEX" c_CPXcloseCPLEX :: Ptr (Ptr CpxEnv') -> IO CInt + +foreign import ccall safe "cplex.h CPXcreateprob" c_CPXcreateprob :: + Ptr CpxEnv' -> Ptr CInt -> Ptr CChar -> IO (Ptr CpxLp') +foreign import ccall safe "cplex.h CPXfreeprob" c_CPXfreeprob :: + Ptr CpxEnv' -> Ptr (Ptr CpxLp') -> IO CInt + +foreign import ccall safe "cplex.h CPXnewrows" c_CPXnewrows :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CDouble -> Ptr CChar -> Ptr CDouble -> Ptr (Ptr CChar) -> IO CInt + + -- int CPXaddrows (CPXENVptr env, + -- CPXLPptr lp, + -- int ccnt, + -- int rcnt, + -- int nzcnt, + -- double *rhs, + -- char *sense, + -- int *rmatbeg, + -- int *rmatind, + -- double *rmatval, + -- char **colname, + -- char **rowname); +foreign import ccall safe "cplex.h CPXaddrows" c_CPXaddrows :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> CInt -> CInt -> Ptr CDouble -> Ptr CChar -> Ptr CInt -> Ptr CInt -> Ptr CDouble -> Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> IO CInt + +foreign import ccall safe "cplex.h CPXnewcols" c_CPXnewcols :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr CChar -> Ptr (Ptr CChar) -> IO CInt + +foreign import ccall safe "cplex.h CPXaddcols" c_CPXaddcols :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> CInt -> Ptr CDouble -> Ptr CInt -> Ptr CInt -> Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> Ptr (Ptr CChar) -> IO CInt + +foreign import ccall safe "cplex.h CPXchgcoeflist" c_CPXchgcoeflist :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CInt -> Ptr CInt -> Ptr CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXchgrhs" c_CPXchgrhs :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CInt -> Ptr CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXchgobj" c_CPXchgobj :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CInt -> Ptr CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXchgbds" c_CPXchgbds :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CInt -> Ptr CChar -> Ptr CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXchgrngval" c_CPXchgrngval :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CInt -> Ptr CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXchgsense" c_CPXchgsense :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> Ptr CInt -> Ptr CChar -> IO CInt + +foreign import ccall safe "cplex.h CPXchgqpcoef" c_CPXchgqpcoef :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> CInt -> CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXchgprobtype" c_CPXchgprobtype :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> IO CInt + +foreign import ccall safe "cplex.h CPXcopyctype" c_CPXcopyctype :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CChar -> IO CInt + +foreign import ccall safe "cplex.h CPXgeterrorstring" c_CPXgeterrorstring :: + Ptr CpxEnv' -> CInt -> Ptr CChar -> IO (Ptr CChar) + +foreign import ccall safe "cplex.h CPXgetstatstring" c_CPXgetstatstring :: + Ptr CpxEnv' -> CInt -> Ptr CChar -> IO (Ptr CChar) + +foreign import ccall safe "cplex.h CPXsetintparam" c_CPXsetintparam :: + Ptr CpxEnv' -> CInt -> CInt -> IO CInt + +foreign import ccall safe "cplex.h CPXsetdblparam" c_CPXsetdblparam :: + Ptr CpxEnv' -> CInt -> CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXgetnumcols" c_CPXgetnumcols :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXgetnumrows" c_CPXgetnumrows :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXgetobjval" c_CPXgetobjval :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXgetx" c_CPXgetx :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CDouble -> CInt -> CInt -> IO CInt + +foreign import ccall safe "cplex.h CPXgetstat" c_CPXgetstat :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CDouble -> IO CInt + +foreign import ccall safe "cplex.h CPXgetslack" c_CPXgetslack :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CDouble -> CInt -> CInt -> IO CInt + +foreign import ccall safe "cplex.h CPXcopylp" c_CPXcopylp :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> -- (CPXCENVptr env, CpxLp'ptr lp, int numcols, + CInt -> CInt -> Ptr CDouble -> -- int numrows, int objsense, const double *objective, + Ptr CDouble -> Ptr CChar -> -- const double *rhs, const char *sense, + Ptr CInt -> Ptr CInt -> -- const int *matbeg, const int *matcnt, + Ptr CInt -> Ptr CDouble -> -- const int *matind, const double *matval, + Ptr CDouble -> Ptr CDouble -> -- const double *lb, const double *ub, + Ptr CDouble -- const double *rngval); + -> IO CInt + +--foreign import ccall safe "cplexcheck.h CPXcheckcopylp" c_CPXcheckcopylp :: +-- "CPXcheckcopylp" +-- Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> -- (CPXCENVptr env, CpxLp'ptr lp, int numcols, +-- CInt -> CInt -> Ptr CDouble -> -- int numrows, int objsense, const double *objective, +-- Ptr CDouble -> Ptr CChar -> -- const double *rhs, const char *sense, +-- Ptr CInt -> Ptr CInt -> -- const int *matbeg, const int *matcnt, +-- Ptr CInt -> Ptr CDouble -> -- const int *matind, const double *matval, +-- Ptr CDouble -> Ptr CDouble -> -- const double *lb, const double *ub, +-- Ptr CDouble -- const double *rngval); +-- -> IO CInt + + +foreign import ccall safe "cplex.h CPXcopyquad" c_CPXcopyquad :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CInt -> -- (CPXCENVptr env, CpxLp'ptr lp, const int *qmatbeg, + Ptr CInt -> Ptr CInt -> -- const int *qmatcnt, const int *qmatind, + Ptr CDouble -> -- const double *qmatval); + IO CInt + +--foreign import ccall safe "cplexcheck.h CPXcheckcopyquad" c_CPXcheckcopyquad :: +-- Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CInt -> -- (CPXCENVptr env, CpxLp'ptr lp, const int *qmatbeg, +-- Ptr CInt -> Ptr CInt -> -- const int *qmatcnt, const int *qmatind, +-- Ptr CDouble -> -- const double *qmatval); +-- IO CInt + +foreign import ccall safe "cplex.h CPXqpopt" c_CPXqpopt :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXlpopt" c_CPXlpopt :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXmipopt" c_CPXmipopt :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXprimopt" c_CPXprimopt :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXdualopt" c_CPXdualopt :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXhybnetopt" c_CPXhybnetopt :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> IO CInt + +foreign import ccall safe "cplex.h CPXsiftopt" c_CPXsiftopt :: + Ptr CpxEnv' -> Ptr CpxLp' -> IO CInt + +foreign import ccall safe "cplex.h CPXsolution" c_CPXsolution :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CInt -> -- (CPXCENVptr env, CPXCLPptr lp, int *lpstat_p, + Ptr CDouble -> Ptr CDouble -> Ptr CDouble -> -- double *objval_p, double *x, double *pi, + Ptr CDouble -> Ptr CDouble -> IO CInt -- double *slack, double *dj); + +foreign import ccall safe "cplex.h CPXwriteprob" c_CPXwriteprob :: + Ptr CpxEnv' -> Ptr CpxLp' -> Ptr CChar -> Ptr CChar -> IO CInt + + + +--int CPXgetcallbacknodelp(CPXCENVptr env, void * cbdata, int wherefrom, CPXLPptr * nodelp_p) +foreign import ccall safe "cplex.h CPXgetcallbacknodelp" c_CPXgetcallbacknodelp :: + Ptr CpxEnv' -> Ptr () -> CInt -> Ptr (Ptr CpxLp') -> IO CInt + +--int CPXgetcallbacknodex(CPXCENVptr env, void * cbdata, int wherefrom, double * x, int begin, int end) +foreign import ccall safe "cplex.h CPXgetcallbacknodex" c_CPXgetcallbacknodex :: + Ptr CpxEnv' -> Ptr () -> CInt -> Ptr CDouble -> CInt -> CInt -> 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 :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> -- env, lp, rcnt + CInt -> Ptr CDouble -> Ptr CChar -> -- nzcnt, rhs, sense + Ptr CInt -> Ptr CInt -> Ptr CDouble -> --matbeg, matbind, rmatval + Ptr (Ptr CChar) -> -- rowname + IO CInt + -- int CPXaddusercuts(CPXCENVptr env, CPXLPptr lp, int rcnt, int nzcnt, const double * rhs, const char * sense, const int * rmatbeg, const int * rmatind, const double * rmatval, char ** rowname) + +foreign import ccall safe "cplex.h CPXaddlazyconstraints" c_CPXaddlazyconstraints :: + Ptr CpxEnv' -> Ptr CpxLp' -> CInt -> -- env, lp, rcnt + CInt -> Ptr CDouble -> Ptr CChar -> -- nzcnt, rhs, sense + Ptr CInt -> Ptr CInt -> Ptr CDouble -> --matbeg, matbind, rmatval + Ptr (Ptr CChar) -> -- rowname + IO CInt + +-- int CPXcutcallbackadd(CPXCENVptr env, void * cbdata, int wherefrom, int nzcnt, double rhs, int sense, int const * cutind, double const * cutval, int purgeable) +foreign import ccall safe "cplex.h CPXcutcallbackadd" c_CPXcutcallbackadd :: + Ptr CpxEnv' -> Ptr () -> CInt -> -- env, cbdata lp, wherefrom + CInt -> CDouble -> CInt -> -- nzcnt, rhs, sense + Ptr CInt -> Ptr CDouble -> --cutind, cutval + CInt -> -- purgable + IO CInt +------------------------- CALLBACKS -------------------------------------------- + +foreign import ccall safe "cplex.h CPXsetincumbentcallbackfunc" c_CPXsetincumbentcallbackfunc:: + Ptr CpxEnv' -> FunPtr CIncumbentCallback -> Ptr () -> IO CInt + +foreign import ccall safe "cplex.h CPXsetcutcallbackfunc" c_CPXsetcutcallbackfunc:: + Ptr CpxEnv' -> FunPtr CCutCallback -> Ptr () -> IO CInt + + + -- int callback (CPXCENVptr env, + -- void *cbdata, + -- int wherefrom, + -- void *cbhandle, + -- double objval, + -- double *x, + -- int *isfeas_p, + -- int *useraction_p); +type CIncumbentCallback = Ptr CpxEnv' -> --CPXCENVptr env + Ptr () -> CInt -> Ptr () -> -- void *cbdata, int wherefrom, void *cbhandle + CDouble -> Ptr CDouble -> -- double objval, double *x + Ptr Int -> Ptr Int -> -- int *iseaf_p, int *useraction_p + IO Int + +type CCutCallback = Ptr CpxEnv' -> --CPXCENVptr env + Ptr () -> CInt -> Ptr () -> -- void *cbdata, int wherefrom, void *cbhandle + Ptr Int -> -- int *useraction_p + IO Int + +--foreign import ccal safe "wrapper" c_createIncumbentCallbackPtr :: (CIncumbentCallback) -> IO (FunPtr (CIncumbentCallback)) + +foreign import ccall "wrapper" + c_createIncumbentCallbackPtr :: CIncumbentCallback -> IO (FunPtr (CIncumbentCallback)) + +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/Param.hs b/src/CPLEX/Param.hs new file mode 100644 --- /dev/null +++ b/src/CPLEX/Param.hs @@ -0,0 +1,194 @@ +{-# OPTIONS_GHC -Wall #-} + +module CPLEX.Param ( CPX_PARAM(..) + , CPX_PROB_TYPE(..) + , CPX_CUT_TYPE(..) + , cutToInt + , paramToInt + , typeToInt + , intToType + ) where + +import Foreign.C(CInt) + + + +data CPX_PARAM = CPX_PARAM_ADVIND + | CPX_PARAM_AGGFILL + | CPX_PARAM_AGGIND + | CPX_PARAM_BASINTERVAL + | CPX_PARAM_CFILEMUL + | CPX_PARAM_CLOCKTYPE + | CPX_PARAM_CRAIND + | CPX_PARAM_DEPIND + | CPX_PARAM_DPRIIND + | CPX_PARAM_PRICELIM + | CPX_PARAM_EPMRK + | CPX_PARAM_EPOPT + | CPX_PARAM_EPPER + | CPX_PARAM_EPRHS + | CPX_PARAM_FASTMIP + | CPX_PARAM_SIMDISPLAY + | CPX_PARAM_ITLIM + | CPX_PARAM_ROWREADLIM + | CPX_PARAM_NETFIND + | CPX_PARAM_COLREADLIM + | CPX_PARAM_NZREADLIM + | CPX_PARAM_OBJLLIM + | CPX_PARAM_OBJULIM + | CPX_PARAM_PERIND + | CPX_PARAM_PERLIM + | CPX_PARAM_PPRIIND + | CPX_PARAM_PREIND + | CPX_PARAM_REINV + | CPX_PARAM_REVERSEIND + | CPX_PARAM_RFILEMUL + | CPX_PARAM_SCAIND + | CPX_PARAM_SCRIND + | CPX_PARAM_SINGLIM + | CPX_PARAM_SINGTOL + | CPX_PARAM_TILIM + | CPX_PARAM_XXXIND + | CPX_PARAM_PREDUAL + | CPX_PARAM_EPOPT_H + | CPX_PARAM_EPRHS_H + | CPX_PARAM_PREPASS + | CPX_PARAM_DATACHECK + | CPX_PARAM_REDUCE + | CPX_PARAM_PRELINEAR + | CPX_PARAM_LPMETHOD + | CPX_PARAM_QPMETHOD + | CPX_PARAM_WORKDIR + | CPX_PARAM_WORKMEM + | CPX_PARAM_THREADS + | CPX_PARAM_CONFLICTDISPLAY + | CPX_PARAM_SIFTDISPLAY + | CPX_PARAM_SIFTALG + | CPX_PARAM_SIFTITLIM + | CPX_PARAM_MPSLONGNUM + | CPX_PARAM_MEMORYEMPHASIS + | CPX_PARAM_NUMERICALEMPHASIS + | CPX_PARAM_FEASOPTMODE + | CPX_PARAM_PARALLELMODE + | CPX_PARAM_TUNINGMEASURE + | CPX_PARAM_TUNINGREPEAT + | CPX_PARAM_TUNINGTILIM + | CPX_PARAM_TUNINGDISPLAY + | CPX_PARAM_WRITELEVEL + | CPX_PARAM_DETTILIM + | CPX_PARAM_FILEENCODING + | CPX_PARAM_APIENCODING + | CPX_PARAM_SOLUTIONTARGET + | CPX_PARAM_CLONELOG + | CPX_PARAM_MIPCBREDLP + deriving Show + +paramToInt :: Num a => CPX_PARAM -> a +paramToInt CPX_PARAM_ADVIND = 1001 +paramToInt CPX_PARAM_AGGFILL = 1002 +paramToInt CPX_PARAM_AGGIND = 1003 +paramToInt CPX_PARAM_BASINTERVAL = 1004 +paramToInt CPX_PARAM_CFILEMUL = 1005 +paramToInt CPX_PARAM_CLOCKTYPE = 1006 +paramToInt CPX_PARAM_CRAIND = 1007 +paramToInt CPX_PARAM_DEPIND = 1008 +paramToInt CPX_PARAM_DPRIIND = 1009 +paramToInt CPX_PARAM_PRICELIM = 1010 +paramToInt CPX_PARAM_EPMRK = 1013 +paramToInt CPX_PARAM_EPOPT = 1014 +paramToInt CPX_PARAM_EPPER = 1015 +paramToInt CPX_PARAM_EPRHS = 1016 +paramToInt CPX_PARAM_FASTMIP = 1017 +paramToInt CPX_PARAM_SIMDISPLAY = 1019 +paramToInt CPX_PARAM_ITLIM = 1020 +paramToInt CPX_PARAM_ROWREADLIM = 1021 +paramToInt CPX_PARAM_NETFIND = 1022 +paramToInt CPX_PARAM_COLREADLIM = 1023 +paramToInt CPX_PARAM_NZREADLIM = 1024 +paramToInt CPX_PARAM_OBJLLIM = 1025 +paramToInt CPX_PARAM_OBJULIM = 1026 +paramToInt CPX_PARAM_PERIND = 1027 +paramToInt CPX_PARAM_PERLIM = 1028 +paramToInt CPX_PARAM_PPRIIND = 1029 +paramToInt CPX_PARAM_PREIND = 1030 +paramToInt CPX_PARAM_REINV = 1031 +paramToInt CPX_PARAM_REVERSEIND = 1032 +paramToInt CPX_PARAM_RFILEMUL = 1033 +paramToInt CPX_PARAM_SCAIND = 1034 +paramToInt CPX_PARAM_SCRIND = 1035 +paramToInt CPX_PARAM_SINGLIM = 1037 +paramToInt CPX_PARAM_SINGTOL = 1038 +paramToInt CPX_PARAM_TILIM = 1039 +paramToInt CPX_PARAM_XXXIND = 1041 +paramToInt CPX_PARAM_PREDUAL = 1044 +paramToInt CPX_PARAM_EPOPT_H = 1049 +paramToInt CPX_PARAM_EPRHS_H = 1050 +paramToInt CPX_PARAM_PREPASS = 1052 +paramToInt CPX_PARAM_DATACHECK = 1056 +paramToInt CPX_PARAM_REDUCE = 1057 +paramToInt CPX_PARAM_PRELINEAR = 1058 +paramToInt CPX_PARAM_LPMETHOD = 1062 +paramToInt CPX_PARAM_QPMETHOD = 1063 +paramToInt CPX_PARAM_WORKDIR = 1064 +paramToInt CPX_PARAM_WORKMEM = 1065 +paramToInt CPX_PARAM_THREADS = 1067 +paramToInt CPX_PARAM_CONFLICTDISPLAY = 1074 +paramToInt CPX_PARAM_SIFTDISPLAY = 1076 +paramToInt CPX_PARAM_SIFTALG = 1077 +paramToInt CPX_PARAM_SIFTITLIM = 1078 +paramToInt CPX_PARAM_MPSLONGNUM = 1081 +paramToInt CPX_PARAM_MEMORYEMPHASIS = 1082 +paramToInt CPX_PARAM_NUMERICALEMPHASIS = 1083 +paramToInt CPX_PARAM_FEASOPTMODE = 1084 +paramToInt CPX_PARAM_PARALLELMODE = 1109 +paramToInt CPX_PARAM_TUNINGMEASURE = 1110 +paramToInt CPX_PARAM_TUNINGREPEAT = 1111 +paramToInt CPX_PARAM_TUNINGTILIM = 1112 +paramToInt CPX_PARAM_TUNINGDISPLAY = 1113 +paramToInt CPX_PARAM_WRITELEVEL = 1114 +paramToInt CPX_PARAM_DETTILIM = 1127 +paramToInt CPX_PARAM_FILEENCODING = 1129 +paramToInt CPX_PARAM_APIENCODING = 1130 +paramToInt CPX_PARAM_SOLUTIONTARGET = 1131 +paramToInt CPX_PARAM_CLONELOG = 1132 +paramToInt CPX_PARAM_MIPCBREDLP = 2055 + +data CPX_PROB_TYPE = CPX_PROB_LP + | CPX_PROB_MILP + | CPX_PROB_FIXEDMILP + | CPX_PROB_QP + | CPX_PROB_MIQP + | CPX_PROB_FIXEDMIQP + | CPX_PROB_QCP + | CPX_PROB_MIQCP + deriving Show + +typeToInt :: Num a => CPX_PROB_TYPE -> a +typeToInt CPX_PROB_LP = 0 +typeToInt CPX_PROB_MILP = 1 +typeToInt CPX_PROB_FIXEDMILP = 3 +typeToInt CPX_PROB_QP = 5 +typeToInt CPX_PROB_MIQP = 7 +typeToInt CPX_PROB_FIXEDMIQP = 8 +typeToInt CPX_PROB_QCP = 10 +typeToInt CPX_PROB_MIQCP = 11 + +data CPX_CUT_TYPE = CPX_USECUT_FORCE + | CPX_USECUT_PURGE + | CPX_USECUT_FILTER + +cutToInt :: CPX_CUT_TYPE -> CInt +cutToInt CPX_USECUT_FORCE = 0 +cutToInt CPX_USECUT_PURGE = 1 +cutToInt CPX_USECUT_FILTER = 2 + +intToType :: (Eq a, Num a) => a -> Maybe CPX_PROB_TYPE +intToType 0 = Just CPX_PROB_LP +intToType 1 = Just CPX_PROB_MILP +intToType 3 = Just CPX_PROB_FIXEDMILP +intToType 5 = Just CPX_PROB_QP +intToType 7 = Just CPX_PROB_MIQP +intToType 8 = Just CPX_PROB_FIXEDMIQP +intToType 10 = Just CPX_PROB_QCP +intToType 11 = Just CPX_PROB_MIQCP +intToType _ = Nothing