msakai / haskell-MIP / 238

Committed 28 Jan 2025 03:10PM UTC coverage: 76.66% (+0.5%) from 76.168%

Build # 238

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #56 from msakai/feature/solve-tol

Add solveTol field to SolveOptions to specify tolerance used by solvers

Run Details

37 of 41 new or added lines in 6 files covered. (90.24%)

1501 of 1958 relevant lines covered (76.66%)

0.77 hits per line

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

78.79

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

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

import Data.Default.Class
import qualified Data.Text.Lazy.IO as TLIO
import System.IO
import System.IO.Temp
import qualified Numeric.Optimization.MIP.LPFile as LPFile
import qualified Numeric.Optimization.MIP.Base as MIP
import Numeric.Optimization.MIP.Solver.Base
import qualified Numeric.Optimization.MIP.Solution.HiGHS as HiGHSSol
import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)

data HiGHS
  = HiGHS
  { highsPath :: String
  , highsArgs :: [String]
  }

instance Default HiGHS where
  def = highs

highs :: HiGHS
highs = HiGHS "highs" []

instance IsSolver HiGHS IO where
  solve' solver opt prob = do
    case LPFile.render def prob of
      Left err -> ioError $ userError err
      Right lp -> do
        withSystemTempFile "highs.lp" $ \fname1 h1 -> do
          TLIO.hPutStr h1 lp
          hClose h1

          withSystemTempFile "highs.sol" $ \fname2 h2 -> do
            hClose h2

            withSystemTempFile "highs_options.txt" $ \fname3 h3 -> do
              -- XXX: HiGHS does not support multiple options files
              options_args <-
                case solveTol opt of
                  Nothing -> return []
                  Just tol -> do
                    hPutStrLn h3 $ "mip_feasibility_tolerance = " ++ show (MIP.integralityTol tol)
                    hPutStrLn h3 $ "primal_feasibility_tolerance = " ++ show (MIP.feasibilityTol tol)
                    hPutStrLn h3 $ "dual_feasibility_tolerance = " ++ show (MIP.optimalityTol tol)
                    return ["--options_file", fname3]
              hClose h3

              let args = highsArgs solver ++
                         ["--model_file", fname1, "--solution_file", fname2] ++
                         options_args ++
                         (case solveTimeLimit opt of
                            Nothing -> []
                            Just sec -> ["--time_limit", show sec])
                  onGetLine s = solveLogger opt s
                  onGetErrorLine = solveErrorLogger opt
              _exitcode <- runProcessWithOutputCallback (highsPath solver) args Nothing "" onGetLine onGetErrorLine
              HiGHSSol.readFile fname2

1	{-# OPTIONS_GHC -Wall #-}
2	{-# OPTIONS_HADDOCK show-extensions #-}
3	{-# LANGUAGE MultiParamTypeClasses #-}
4	-----------------------------------------------------------------------------
5	-- \|
6	-- Module : Numeric.Optimization.MIP.Solver.HiGHS
7	-- Copyright : (c) Masahiro Sakai 2025
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.HiGHS
16	( HiGHS (..)
17	, highs
18	) where
19
20	import Data.Default.Class
21	import qualified Data.Text.Lazy.IO as TLIO
22	import System.IO
23	import System.IO.Temp
24	import qualified Numeric.Optimization.MIP.LPFile as LPFile
25	import qualified Numeric.Optimization.MIP.Base as MIP
26	import Numeric.Optimization.MIP.Solver.Base
27	import qualified Numeric.Optimization.MIP.Solution.HiGHS as HiGHSSol
28	import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)
29
30	data HiGHS
31	= HiGHS
32	{ highsPath :: String	1✔
33	, highsArgs :: [String]	1✔
34	}
35
36	instance Default HiGHS where
37	def = highs	×
38
39	highs :: HiGHS
40	highs = HiGHS "highs" []	1✔
41
42	instance IsSolver HiGHS IO where	1✔
43	solve' solver opt prob = do	1✔
44	case LPFile.render def prob of	×
45	Left err -> ioError $ userError err	×
46	Right lp -> do	1✔
47	withSystemTempFile "highs.lp" $ \fname1 h1 -> do	1✔
48	TLIO.hPutStr h1 lp	1✔
49	hClose h1	1✔
50
51	withSystemTempFile "highs.sol" $ \fname2 h2 -> do	1✔
52	hClose h2	1✔
53
54	withSystemTempFile "highs_options.txt" $ \fname3 h3 -> do	1✔
55	-- XXX: HiGHS does not support multiple options files
56	options_args <-
57	case solveTol opt of	1✔
58	Nothing -> return []	1✔
59	Just tol -> do	1✔
60	hPutStrLn h3 $ "mip_feasibility_tolerance = " ++ show (MIP.integralityTol tol)	1✔
61	hPutStrLn h3 $ "primal_feasibility_tolerance = " ++ show (MIP.feasibilityTol tol)	1✔
62	hPutStrLn h3 $ "dual_feasibility_tolerance = " ++ show (MIP.optimalityTol tol)	1✔
63	return ["--options_file", fname3]	1✔
64	hClose h3	1✔
65
66	let args = highsArgs solver ++	1✔
67	["--model_file", fname1, "--solution_file", fname2] ++	1✔
68	options_args ++	1✔
69	(case solveTimeLimit opt of	1✔
70	Nothing -> []	1✔
NEW 71	Just sec -> ["--time_limit", show sec])	×
NEW 72	onGetLine s = solveLogger opt s	×
NEW 73	onGetErrorLine = solveErrorLogger opt	×
NEW 74	_exitcode <- runProcessWithOutputCallback (highsPath solver) args Nothing "" onGetLine onGetErrorLine	×
75	HiGHSSol.readFile fname2	1✔

msakai / haskell-MIP / 238

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