msakai / haskell-MIP / 349

Committed 04 Jan 2026 10:25PM UTC coverage: 77.286% (+0.3%) from 76.98%

Build # 349

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #90 from msakai/feature/cbc-check-output-file

Produce more user-friendly error messages when the CBC solver exited with 0 but the output file was not generated

Run Details

23 of 27 new or added lines in 1 file covered. (85.19%)

1572 of 2034 relevant lines covered (77.29%)

0.77 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

84.62

/MIP/src/Numeric/Optimization/MIP/Solver/CBC.hs

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Numeric.Optimization.MIP.Solver.CBC
-- Copyright   :  (c) Masahiro Sakai 2017
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Numeric.Optimization.MIP.Solver.CBC
  ( CBC (..)
  , cbc
  ) where

import Control.Monad
import Data.Default.Class
import qualified Data.Text.Lazy.IO as TLIO
import System.Directory
import System.Exit
import System.FilePath
import System.IO.Temp
import qualified Numeric.Optimization.MIP.Base as MIP
import qualified Numeric.Optimization.MIP.LPFile as LPFile
import Numeric.Optimization.MIP.Solver.Base
import qualified Numeric.Optimization.MIP.Solution.CBC as CBCSol
import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)

-- | A solver instance for calling @cbc@ command from [CBC (COIN-OR Branch-and-Cut solver)](https://github.com/coin-or/Cbc).
--
-- Use 'cbc' and record update syntax to modify its field.
data CBC
  = CBC
  { cbcPath :: String
  , cbcArgs :: [String]
  }

instance Default CBC where
  def = cbc

-- | Default value of t'CBC'
cbc :: CBC
cbc = CBC "cbc" []

instance IsSolver CBC IO where
  solve' solver opt prob = do
    case LPFile.render def prob{ MIP.objectiveFunction = obj' } of
      Left err -> ioError $ userError err
      Right lp -> do
        withSystemTempDirectory "haskell-mip-cbc" $ \dir -> do
          let fname1 = dir </> "cbc.lp"
              fname2 = dir </> "cbc.sol"
          TLIO.writeFile fname1 lp
          let args = cbcArgs solver
                  ++ [fname1]
                  ++ (case solveTimeLimit opt of
                        Nothing -> []
                        Just sec -> ["sec", show sec])
                  ++ (case solveTol opt of
                        Nothing -> []
                        Just tol ->
                          [ "integerTolerance", show (MIP.integralityTol tol)
                          , "primalTolerance", show (MIP.feasibilityTol tol)
                          , "dualTolerance", show (MIP.optimalityTol tol)
                          ])
                  ++ ["solve", "solu", fname2]
              onGetLine = solveLogger opt
              onGetErrorLine = solveErrorLogger opt
          exitcode <- runProcessWithOutputCallback (cbcPath solver) args Nothing "" onGetLine onGetErrorLine
          case exitcode of
            ExitFailure n -> ioError $ userError $ "exit with " ++ show n
            ExitSuccess -> do
              m <- doesFileExist fname2
              unless m $ ioError $ userError "CBC returned exit code 0, but wrote no solution file. You may want to use the solveLogger or solveErrorLogger for more information"
              sol <- CBCSol.readFile fname2
              if isMax then
                return $ sol{ MIP.solObjectiveValue = fmap negate (MIP.solObjectiveValue sol) }
              else
                return sol
    where
      obj = MIP.objectiveFunction prob
      isMax = MIP.objDir obj == MIP.OptMax
      obj' = if isMax then obj{ MIP.objDir = MIP.OptMin, MIP.objExpr = - MIP.objExpr obj } else obj

1	{-# OPTIONS_GHC -Wall #-}
2	{-# OPTIONS_HADDOCK show-extensions #-}
3	{-# LANGUAGE MultiParamTypeClasses #-}
4	-----------------------------------------------------------------------------
5	-- \|
6	-- Module : Numeric.Optimization.MIP.Solver.CBC
7	-- Copyright : (c) Masahiro Sakai 2017
8	-- License : BSD-style
9	--
10	-- Maintainer : masahiro.sakai@gmail.com
11	-- Stability : provisional
12	-- Portability : non-portable
13	--
14	-----------------------------------------------------------------------------
15	module Numeric.Optimization.MIP.Solver.CBC
16	( CBC (..)
17	, cbc
18	) where
19
20	import Control.Monad
21	import Data.Default.Class
22	import qualified Data.Text.Lazy.IO as TLIO
23	import System.Directory
24	import System.Exit
25	import System.FilePath
26	import System.IO.Temp
27	import qualified Numeric.Optimization.MIP.Base as MIP
28	import qualified Numeric.Optimization.MIP.LPFile as LPFile
29	import Numeric.Optimization.MIP.Solver.Base
30	import qualified Numeric.Optimization.MIP.Solution.CBC as CBCSol
31	import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)
32
33	-- \| A solver instance for calling @cbc@ command from [CBC (COIN-OR Branch-and-Cut solver)](https://github.com/coin-or/Cbc).
34	--
35	-- Use 'cbc' and record update syntax to modify its field.
36	data CBC
37	= CBC
38	{ cbcPath :: String	1✔
39	, cbcArgs :: [String]	1✔
40	}
41
42	instance Default CBC where
43	def = cbc	×
44
45	-- \| Default value of t'CBC'
46	cbc :: CBC
47	cbc = CBC "cbc" []	1✔
48
49	instance IsSolver CBC IO where	1✔
50	solve' solver opt prob = do	1✔
51	case LPFile.render def prob{ MIP.objectiveFunction = obj' } of	1✔
52	Left err -> ioError $ userError err	×
53	Right lp -> do	1✔
54	withSystemTempDirectory "haskell-mip-cbc" $ \dir -> do	1✔
55	let fname1 = dir </> "cbc.lp"	1✔
56	fname2 = dir </> "cbc.sol"	1✔
57	TLIO.writeFile fname1 lp	1✔
58	let args = cbcArgs solver	1✔
59	++ [fname1]	1✔
60	++ (case solveTimeLimit opt of	1✔
61	Nothing -> []	1✔
NEW 62	Just sec -> ["sec", show sec])	×
63	++ (case solveTol opt of	1✔
64	Nothing -> []	1✔
65	Just tol ->
66	[ "integerTolerance", show (MIP.integralityTol tol)	1✔
67	, "primalTolerance", show (MIP.feasibilityTol tol)	1✔
68	, "dualTolerance", show (MIP.optimalityTol tol)	1✔
69	])
70	++ ["solve", "solu", fname2]	1✔
71	onGetLine = solveLogger opt	1✔
NEW 72	onGetErrorLine = solveErrorLogger opt	×
NEW 73	exitcode <- runProcessWithOutputCallback (cbcPath solver) args Nothing "" onGetLine onGetErrorLine	×
74	case exitcode of	1✔
NEW 75	ExitFailure n -> ioError $ userError $ "exit with " ++ show n	×
76	ExitSuccess -> do	1✔
77	m <- doesFileExist fname2	1✔
78	unless m $ ioError $ userError "CBC returned exit code 0, but wrote no solution file. You may want to use the solveLogger or solveErrorLogger for more information"	1✔
79	sol <- CBCSol.readFile fname2	1✔
80	if isMax then	1✔
81	return $ sol{ MIP.solObjectiveValue = fmap negate (MIP.solObjectiveValue sol) }	1✔
82	else
83	return sol	1✔
84	where
85	obj = MIP.objectiveFunction prob	1✔
86	isMax = MIP.objDir obj == MIP.OptMax	1✔
87	obj' = if isMax then obj{ MIP.objDir = MIP.OptMin, MIP.objExpr = - MIP.objExpr obj } else obj	1✔

msakai / haskell-MIP / 349

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous