msakai / haskell-MIP / 344

Committed 04 Jan 2026 03:39PM UTC coverage: 76.98% (+0.3%) from 76.66%

Build # 344

Build Type

push

github

Committed by

web-flow

Commit Message

Merge cc7d6067e into 9f1c6930b

Run Details

1565 of 2033 relevant lines covered (76.98%)

0.77 hits per line

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

70.0

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

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

import Control.Monad
import Data.Default.Class
import Data.IORef
import Data.List (stripPrefix)
import qualified Data.Map as Map
import Data.String
import qualified Data.Text.Lazy.IO as TLIO
import System.Exit
import System.IO
import System.IO.Temp
import qualified Numeric.Optimization.MIP.Base as MIP
import qualified Numeric.Optimization.MIP.MPSFile as MPSFile
import Numeric.Optimization.MIP.Solver.Base
import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)

-- | A solver instance for calling @lp_solve@ command from [lp_solve](https://lpsolve.sourceforge.net/5.5/) package.
--
-- Use 'lpSolve' and record update syntax to modify its field.
data LPSolve
  = LPSolve
  { lpSolvePath :: String
  , lpSolveArgs :: [String]
  }

instance Default LPSolve where
  def = lpSolve

-- | Default value of t'LPSolve'
lpSolve :: LPSolve
lpSolve = LPSolve "lp_solve" []

instance IsSolver LPSolve IO where
  solve' solver opt prob = do
    case MPSFile.render def prob of
      Left err -> ioError $ userError err
      Right lp -> do
        withSystemTempFile "lp_solve.mps" $ \fname1 h1 -> do
          TLIO.hPutStr h1 lp
          hClose h1
          objRef <- newIORef Nothing
          solRef <- newIORef []
          flagRef <- newIORef False
          let args = lpSolveArgs solver
                  ++ (case solveTimeLimit opt of
                        Nothing -> []
                        Just sec -> ["-timeout", show sec])
                  ++ (case solveTol opt of
                        Nothing -> []
                        Just tol ->
                          [ "-e", show (MIP.integralityTol tol)
                          , "-epsb", show (MIP.feasibilityTol tol)
                          , "-epsd", show (MIP.optimalityTol tol)
                          ])
                  ++ ["-fmps", fname1]
              onGetLine s = do
                case s of
                  "Actual values of the variables:" -> writeIORef flagRef True
                  _ | Just v <- stripPrefix "Value of objective function: " s -> do
                    writeIORef objRef (Just (read v))
                  _ -> do
                    flag <- readIORef flagRef
                    when flag $ do
                      case words s of
                        [var,val] -> modifyIORef solRef ((fromString var, read val) :)
                        _ -> return ()
                    return ()
                solveLogger opt s
              onGetErrorLine = solveErrorLogger opt
          exitcode <- runProcessWithOutputCallback (lpSolvePath solver) args Nothing "" onGetLine onGetErrorLine
          status <-
            case exitcode of
              ExitSuccess      -> return MIP.StatusOptimal
              ExitFailure (-2) -> return MIP.StatusUnknown               -- NOMEMORY
              ExitFailure 1    -> return MIP.StatusFeasible              -- SUBOPTIMAL
              ExitFailure 2    -> return MIP.StatusInfeasible            -- INFEASIBLE
              ExitFailure 3    -> return MIP.StatusInfeasibleOrUnbounded -- UNBOUNDED
              ExitFailure 4    -> return MIP.StatusUnknown               -- DEGENERATE
              ExitFailure 5    -> return MIP.StatusUnknown               -- NUMFAILURE
              ExitFailure 6    -> return MIP.StatusUnknown               -- USERABORT
              ExitFailure 7    -> return MIP.StatusUnknown               -- TIMEOUT
              ExitFailure 9    -> return MIP.StatusOptimal               -- PRESOLVED
              ExitFailure 25   -> return MIP.StatusUnknown               -- NUMFAILURE
              ExitFailure n    -> ioError $ userError $ "unknown exit code: " ++ show n
          obj <- readIORef objRef
          sol <- readIORef solRef
          return $
            MIP.Solution
            { MIP.solStatus = status
            , MIP.solObjectiveValue = obj
            , MIP.solVariables = Map.fromList sol
            }

1	{-# OPTIONS_GHC -Wall #-}
2	{-# OPTIONS_HADDOCK show-extensions #-}
3	{-# LANGUAGE MultiParamTypeClasses #-}
4	-----------------------------------------------------------------------------
5	-- \|
6	-- Module : Numeric.Optimization.MIP.Solver.LPSolve
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.LPSolve
16	( LPSolve (..)
17	, lpSolve
18	) where
19
20	import Control.Monad
21	import Data.Default.Class
22	import Data.IORef
23	import Data.List (stripPrefix)
24	import qualified Data.Map as Map
25	import Data.String
26	import qualified Data.Text.Lazy.IO as TLIO
27	import System.Exit
28	import System.IO
29	import System.IO.Temp
30	import qualified Numeric.Optimization.MIP.Base as MIP
31	import qualified Numeric.Optimization.MIP.MPSFile as MPSFile
32	import Numeric.Optimization.MIP.Solver.Base
33	import Numeric.Optimization.MIP.Internal.ProcessUtil (runProcessWithOutputCallback)
34
35	-- \| A solver instance for calling @lp_solve@ command from [lp_solve](https://lpsolve.sourceforge.net/5.5/) package.
36	--
37	-- Use 'lpSolve' and record update syntax to modify its field.
38	data LPSolve
39	= LPSolve
40	{ lpSolvePath :: String	1✔
41	, lpSolveArgs :: [String]	1✔
42	}
43
44	instance Default LPSolve where
45	def = lpSolve	×
46
47	-- \| Default value of t'LPSolve'
48	lpSolve :: LPSolve
49	lpSolve = LPSolve "lp_solve" []	1✔
50
51	instance IsSolver LPSolve IO where	1✔
52	solve' solver opt prob = do	1✔
53	case MPSFile.render def prob of	1✔
54	Left err -> ioError $ userError err	×
55	Right lp -> do	1✔
56	withSystemTempFile "lp_solve.mps" $ \fname1 h1 -> do	1✔
57	TLIO.hPutStr h1 lp	1✔
58	hClose h1	1✔
59	objRef <- newIORef Nothing	×
60	solRef <- newIORef []	1✔
61	flagRef <- newIORef False	1✔
62	let args = lpSolveArgs solver	1✔
63	++ (case solveTimeLimit opt of	1✔
64	Nothing -> []	1✔
65	Just sec -> ["-timeout", show sec])	×
66	++ (case solveTol opt of	1✔
67	Nothing -> []	1✔
68	Just tol ->
69	[ "-e", show (MIP.integralityTol tol)	1✔
70	, "-epsb", show (MIP.feasibilityTol tol)	1✔
71	, "-epsd", show (MIP.optimalityTol tol)	1✔
72	])
73	++ ["-fmps", fname1]	1✔
74	onGetLine s = do	1✔
75	case s of	1✔
76	"Actual values of the variables:" -> writeIORef flagRef True	1✔
77	_ \| Just v <- stripPrefix "Value of objective function: " s -> do	1✔
78	writeIORef objRef (Just (read v))	1✔
79	_ -> do	1✔
80	flag <- readIORef flagRef	1✔
81	when flag $ do	1✔
82	case words s of	1✔
83	[var,val] -> modifyIORef solRef ((fromString var, read val) :)	1✔
84	_ -> return ()	×
85	return ()	×
86	solveLogger opt s	×
87	onGetErrorLine = solveErrorLogger opt	×
88	exitcode <- runProcessWithOutputCallback (lpSolvePath solver) args Nothing "" onGetLine onGetErrorLine	×
89	status <-
90	case exitcode of	1✔
91	ExitSuccess -> return MIP.StatusOptimal	1✔
92	ExitFailure (-2) -> return MIP.StatusUnknown -- NOMEMORY	×
93	ExitFailure 1 -> return MIP.StatusFeasible -- SUBOPTIMAL	×
94	ExitFailure 2 -> return MIP.StatusInfeasible -- INFEASIBLE	1✔
95	ExitFailure 3 -> return MIP.StatusInfeasibleOrUnbounded -- UNBOUNDED	1✔
96	ExitFailure 4 -> return MIP.StatusUnknown -- DEGENERATE	×
97	ExitFailure 5 -> return MIP.StatusUnknown -- NUMFAILURE	×
98	ExitFailure 6 -> return MIP.StatusUnknown -- USERABORT	×
99	ExitFailure 7 -> return MIP.StatusUnknown -- TIMEOUT	×
100	ExitFailure 9 -> return MIP.StatusOptimal -- PRESOLVED	×
101	ExitFailure 25 -> return MIP.StatusUnknown -- NUMFAILURE	×
102	ExitFailure n -> ioError $ userError $ "unknown exit code: " ++ show n	×
103	obj <- readIORef objRef	1✔
104	sol <- readIORef solRef	1✔
105	return $	1✔
106	MIP.Solution	1✔
107	{ MIP.solStatus = status	1✔
108	, MIP.solObjectiveValue = obj	1✔
109	, MIP.solVariables = Map.fromList sol	1✔
110	}

msakai / haskell-MIP / 344

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