math-programming-glpk 0.4.0 → 0.4.1

raw patch · 4 files changed

+40/−27 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• math-programming-glpk.cabal +1/−1
• src/Math/Programming/Glpk/Internal.hs +7/−22
• test/RegressionTests.hs +25/−4

@@ -1,5 +1,12 @@ # Changelog for math-programming-glpk +## [0.4.1] -- 5 July 2020++### Fixed++- Infeasible problems now produce an `Infeasible` status rather than+  an `Error` status.+ ## [0.4.0] -- 5 July 2020  ### Changed

@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               math-programming-glpk-version:            0.4.0+version:            0.4.1 license:            BSD3 license-file:       LICENSE copyright:          2018 Patrick Steele

@@ -363,15 +363,7 @@     Nothing            -> glp_get_obj_val problem -- There's been no solve, so who cares  optimizeLP' :: Glpk SolutionStatus-optimizeLP' =-  let-    convertResult :: Ptr Problem -> GlpkSimplexStatus -> IO SolutionStatus-    convertResult problem result-      | result == glpkSimplexSuccess =-          glp_get_status problem >>= return . solutionStatus-      | otherwise =-          return Error-  in do+optimizeLP' = do     -- Note that we've run an LP solve     solveTypeRef <- asks _glpkLastSolveType     liftIO $ writeIORef solveTypeRef (Just LP)@@ -383,19 +375,11 @@       control <- readIORef controlRef       alloca $ \controlPtr -> do         poke controlPtr control-        result <- glp_simplex problem controlPtr-        convertResult problem result+        _<- glp_simplex problem controlPtr+        glp_get_status problem >>= pure . solutionStatus  optimizeIP' :: Glpk SolutionStatus-optimizeIP' =-  let-    convertResult :: Ptr Problem -> GlpkMIPStatus -> IO SolutionStatus-    convertResult problem result-      | result == glpkMIPSuccess =-        glp_mip_status problem >>= return . solutionStatus-      | otherwise =-        return Error-  in do+optimizeIP' = do     -- Note that we've run a MIP solve     solveTypeRef <- asks _glpkLastSolveType     liftIO $ writeIORef solveTypeRef (Just MIP)@@ -406,8 +390,8 @@       control <- readIORef controlRef       alloca $ \controlPtr -> do         poke controlPtr control-        result <- glp_intopt problem controlPtr-        convertResult problem result+        _ <- glp_intopt problem controlPtr+        glp_mip_status problem >>= pure . solutionStatus  setVariableBounds' :: Variable Glpk -> Bounds Double -> Glpk () setVariableBounds' variable bounds =@@ -524,6 +508,7 @@   | status == glpkInfeasible = Infeasible   | status == glpkNoFeasible = Infeasible   | status == glpkUnbounded  = Unbounded+  | status == glpkUndefined  = Infeasible   | otherwise                = Error  -- | Write out the current formulation to a file.

@@ -1,7 +1,6 @@ module RegressionTests where  import           Control.Monad.IO.Class- import           Test.Tasty import           Test.Tasty.HUnit @@ -12,6 +11,8 @@ test_tree = testGroup "Regression tests"             [ testCase "Free variables (LP)" testFreeVariablesLP             , testCase "Free variables (IP)" testFreeVariablesIP+            , testCase "Infeasible (LP)" testInfeasibleLP+            , testCase "Infeasible (IP)" testInfeasibleIP             ]  assertFeasible :: SolutionStatus -> Glpk ()@@ -22,14 +23,14 @@       Infeasible -> assertFailure "Infeasible program"       _          -> pure () -assertRunGlpk :: Glpk a -> IO ()+assertRunGlpk :: Glpk a -> Assertion assertRunGlpk program = do   eResult <- runGlpk program   case eResult of     Left err -> assertFailure ("Error solving program: " <> show err)     Right _  -> pure () -testFreeVariablesLP :: IO ()+testFreeVariablesLP :: Assertion testFreeVariablesLP = assertRunGlpk $ do   x <- free   y <- free@@ -49,7 +50,7 @@   liftIO $ 3.1 @=? vy   liftIO $ -3.1 @=? vz -testFreeVariablesIP :: IO ()+testFreeVariablesIP :: Assertion testFreeVariablesIP = assertRunGlpk $ do   x <- integer   y <- integer@@ -68,3 +69,23 @@   liftIO $ 0 @=? vx   liftIO $ 3 @=? vy   liftIO $ -3 @=? vz++testInfeasibleLP :: Assertion+testInfeasibleLP = assertRunGlpk $ do+  x <- free+  _ <- x @>=# 2+  _ <- x @<=# 1++  status <- optimizeLP++  liftIO $ Infeasible @=? status++testInfeasibleIP :: Assertion+testInfeasibleIP = assertRunGlpk $ do+  x <- integer+  _ <- x @>=# 2+  _ <- x @<=# 1++  status <- optimizeIP++  liftIO $ Infeasible @=? status