MIP-glpk 0.1.1.0 → 0.2.0.0
raw patch · 9 files changed
+209/−15 lines, 9 filesdep +HUnitdep +data-default-classdep ~MIPdep ~base
Dependencies added: HUnit, data-default-class
Dependency ranges changed: MIP, base
Files
- ChangeLog.md +6/−0
- MIP-glpk.cabal +13/−9
- README.md +4/−0
- samples/lp/infeasible.lp +10/−0
- samples/lp/test.lp +13/−0
- samples/lp/unbounded-ip.lp +10/−0
- src/Numeric/Optimization/MIP/Solver/GLPK.hs +7/−4
- test/IsClose.hs +142/−0
- test/TestSuite.hs +4/−2
ChangeLog.md view
@@ -2,6 +2,12 @@ ## Unreleased changes +## 0.2.0.0 (2025-02-03)++* Dependencies+ * Support `MIP-0.2.*`+ * Require `base >=4.12` (i.e. GHC `>=8.6`)+ ## 0.1.1.0 * initial release
MIP-glpk.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack------ hash: 91bd2c285320628b724f46bca19099aeaa4b2006d6014a41bff9810b3fe57882 name: MIP-glpk-version: 0.1.1.0+version: 0.2.0.0 synopsis: A GLPK backend to the MIP library. description: Please see the README on GitHub at <https://github.com/msakai/haskell-MIP/tree/master/MIP-glpk#readme> category: Math, Algorithms, Optimisation, Optimization@@ -22,6 +20,9 @@ extra-source-files: README.md ChangeLog.md+ samples/lp/infeasible.lp+ samples/lp/test.lp+ samples/lp/unbounded-ip.lp source-repository head type: git@@ -37,8 +38,8 @@ extra-libraries: glpk build-depends:- MIP >=0.1.1.0 && <0.2- , base >=4.7 && <5+ MIP >=0.2.0.0 && <0.3+ , base >=4.12 && <5 , bytestring , bytestring-encoding , containers@@ -53,21 +54,24 @@ type: exitcode-stdio-1.0 main-is: TestSuite.hs other-modules:+ IsClose Paths_MIP_glpk hs-source-dirs: test ghc-options: -threaded build-depends:- MIP >=0.1.1.0 && <0.2+ HUnit+ , MIP >=0.2.0.0 && <0.3 , MIP-glpk , async- , base >=4.7 && <5+ , base >=4.12 && <5 , containers+ , data-default-class , extended-reals >=0.1 && <1.0 , glpk-headers >=0.4.1 , scientific , tasty >=0.10.1 , tasty-hunit >=0.9 && <0.11- , tasty-quickcheck >=0.8 && <0.11+ , tasty-quickcheck >=0.8 && <0.12 , tasty-th default-language: Haskell2010
README.md view
@@ -1,5 +1,9 @@ # MIP-glpk +[](https://hackage.haskell.org/package/MIP-glpk)+[](https://packdeps.haskellers.com/feed?needle=MIP-glpk)+[](https://www.gnu.org/licenses/gpl-3.0)+ This provides [GLPK](https://www.gnu.org/software/glpk/) backend for `MIP` package. `MIP` package already have the ability to invoke GLPK's command-line solver `glpsol`,
+ samples/lp/infeasible.lp view
@@ -0,0 +1,10 @@+Minimize+ 0 x+Subject To+ 3 x >= 1+ 3 x <= 2+Bounds+ -inf <= x <= +inf+General+ x+End
+ samples/lp/test.lp view
@@ -0,0 +1,13 @@+\...+Maximize+ obj: x1 + 2 x2 + 3 x3 + x4+Subject To+ c1: - x1 + x2 + x3 + 10 x4 <= 20+ c2: x1 - 3 x2 + x3 <= 30+ c3: x2 - 3.5 x4 = 0+Bounds+ 0 <= x1 <= 40+ 2 <= x4 <= 3+General+ x4+End
+ samples/lp/unbounded-ip.lp view
@@ -0,0 +1,10 @@+Maximize+ obj: x + y+Subject To+ c1: y - 2 x >= 0+Bounds + 1 <= x+ 0 <= y+General+ x y+End
src/Numeric/Optimization/MIP/Solver/GLPK.hs view
@@ -22,7 +22,6 @@ import Control.Monad import qualified Data.ByteString as B import Data.ByteString.Encoding (encode, localeEncoding)-import Data.Interned (unintern) import qualified Data.Map.Strict as Map import Data.Scientific (Scientific, fromFloatDigits, toRealFloat) import qualified Data.Set as Set@@ -36,17 +35,21 @@ import Numeric.Optimization.MIP.Solver.Base import qualified Math.Programming.Glpk.Header as Raw +-- | A solver instance for using [GLPK (GNU Linear Programming Kit)](https://www.gnu.org/software/glpk/) as a library data GLPK = GLPK instance Default GLPK where def = GLPK +-- | Default value of t'GLPK' glpk :: GLPK glpk = GLPK instance IsSolver GLPK IO where- solve _solver opt prob =+ solve = solve'+ + solve' _solver opt prob = (if rtsSupportsBoundThreads then runInBoundThread else id) $ bracket Raw.glp_init_env (\ret -> when (ret == 0) $ Raw.glp_free_env >> return ()) $ \_ -> do bracket Raw.glp_create_prob Raw.glp_delete_prob $ \prob' -> do@@ -65,10 +68,10 @@ Just name -> useTextAsCString name (Raw.glp_set_prob_name prob') -- Variables- _ <- Raw.glp_add_cols prob' $ fromIntegral $ Map.size $ MIP.varType prob+ _ <- Raw.glp_add_cols prob' $ fromIntegral $ Map.size $ MIP.varDomains prob forM_ (Map.toList varToCol) $ \(v, col) -> do let (lb, ub) = MIP.getBounds prob v- useTextAsCString (unintern v) (Raw.glp_set_col_name prob' col)+ useTextAsCString (MIP.varName v) (Raw.glp_set_col_name prob' col) Raw.glp_set_col_kind prob' col $ case MIP.getVarType prob v of MIP.SemiContinuousVariable -> error "GLPK does not support semi-continuous variables"
+ test/IsClose.hs view
@@ -0,0 +1,142 @@+{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module IsClose+ (+ -- Tolerance type+ Tol (..)++ -- AllClose class+ , AllClose (..)+ , allCloseRawUnit+ , allCloseRawRealFrac+ , allCloseRawRealFloat++ -- * Re-exports+ , Default (..)++ -- * HUnit+ , assertAllClose+ ) where++import Data.Default.Class+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Monoid+import Data.Semigroup+import qualified Numeric.Optimization.MIP as MIP+import GHC.Stack (HasCallStack)+import Test.HUnit+import Text.Printf++-- ------------------------------------------------------------------------++-- | Tolerance+--+-- Values @a@ and @b@ are considered /close/ if @abs (a - b) <= atol + rtol * abs b@.+data Tol a+ = Tol+ { rtol :: a -- ^ The relative tolerance parameter (default: @1e-05@)+ , atol :: a -- ^ The absolute tolerance parameter (default: @1e-08@)+ , equalNan :: Bool -- ^ Whether to compare NaN’s as equal (default: @False@)+ } deriving (Show)++instance RealFrac a => Default (Tol a) where+ def = Tol+ { rtol = 1e-05+ , atol = 1e-08+ , equalNan = False+ }++-- ------------------------------------------------------------------------++class Real r => AllClose r a where+ -- | Returns number of mismatches, number of elements, maximal absolute difference, and maximal relative difference.+ -- Returns @'Ap' 'Nothing'@ if given values are incomparable.+ allCloseRaw :: Tol r -> a -> a -> Ap Maybe (Sum Int, Sum Int, Max r, Max r)++ -- | Returns 'True' if the two arrays are equal within the given tolerance; 'False' otherwise.+ allClose :: Tol r -> a -> a -> Bool+ allClose tol x y =+ case getAp (allCloseRaw tol x y) of+ Nothing -> False+ Just (Sum numMismatched, _, _, _) -> numMismatched == 0++allCloseRawRealFrac :: RealFrac r => Tol r -> r -> r -> Ap Maybe (Sum Int, Sum Int, Max r, Max r)+allCloseRawRealFrac t a b = Ap $ Just $+ ( Sum $ if abs (a - b) <= atol t + rtol t * abs b then 0 else 1+ , Sum 1+ , Max (abs (a - b))+ , Max (abs (a - b) / abs b)+ )++allCloseRawRealFloat :: RealFloat r => Tol r -> r -> r -> Ap Maybe (Sum Int, Sum Int, Max r, Max r)+allCloseRawRealFloat t a b+ | isNaN a /= isNaN b = Ap Nothing+ | otherwise = Ap $ Just $+ ( Sum $ if (equalNan t && isNaN a && isNaN b) || a == b || abs (a - b) <= atol t + rtol t * abs b then 0 else 1+ , Sum 1+ , Max (abs (a - b))+ , Max (abs (a - b) / abs b)+ )++allCloseRawUnit :: Num r => Ap Maybe (Sum Int, Sum Int, Max r, Max r)+allCloseRawUnit = Ap (Just (Sum 0, Sum 0, Max 0, Max 0))++instance AllClose Rational Rational where+ allCloseRaw = allCloseRawRealFrac++instance AllClose Double Double where+ allCloseRaw = allCloseRawRealFloat++instance (AllClose r a) => AllClose r (Maybe a) where+ allCloseRaw tol (Just a) (Just b) = allCloseRaw tol a b+ allCloseRaw _ Nothing Nothing = allCloseRawUnit+ allCloseRaw _ _ _ = Ap Nothing++instance (AllClose r v) => AllClose r [v] where+ allCloseRaw tol xs ys+ | length xs == length ys = sconcat (allCloseRawUnit :| [allCloseRaw tol a b | (a,b) <- zip xs ys])+ | otherwise = Ap Nothing++instance (Ord k, AllClose r v) => AllClose r (Map k v) where+ allCloseRaw tol m1 m2+ | Map.keys m1 == Map.keys m2 = sconcat (allCloseRawUnit :| [allCloseRaw tol a b | (a,b) <- zip (Map.elems m1) (Map.elems m2)])+ | otherwise = Ap Nothing++instance (Real r, AllClose r r) => AllClose r (MIP.Solution r) where+ allCloseRaw tol a b+ | MIP.solStatus a == MIP.solStatus b =+ allCloseRaw tol (MIP.solObjectiveValue a) (MIP.solObjectiveValue b) <>+ allCloseRaw tol (MIP.solVariables a) (MIP.solVariables b)+ | otherwise = Ap Nothing++-- ------------------------------------------------------------------------++-- | Assert that two objects are equal up to desired tolerance.+assertAllClose+ :: (HasCallStack, AllClose r a, Show r, Show a)+ => Tol r+ -> a -- ^ actual+ -> a -- ^ desired+ -> Assertion+assertAllClose tol a b =+ case getAp (allCloseRaw tol a b) of+ Nothing ->+ assertString $ unlines $ header ++ ["x and y nan location mismatch:"] ++ footer+ Just (Sum numMismatch, Sum numTotal, Max absDiff, Max relDiff)+ | numMismatch == 0 -> return ()+ | otherwise ->+ assertString $ unlines $+ header +++ [ printf "Mismatched elements: %d / %d (%f%%)" numMismatch numTotal (fromIntegral numMismatch * 100 / fromIntegral numTotal :: Double)+ , " Max absolute difference: " ++ show absDiff+ , " Max relative difference: " ++ show relDiff+ ] ++ footer+ where+ header, footer :: [String]+ header = [printf "Not equal to tolerance rtol=%s, atol=%s" (show (rtol tol)) (show (atol tol)), ""]+ footer = [" x: " ++ show a, " y: " ++ show b]++-- ------------------------------------------------------------------------
test/TestSuite.hs view
@@ -16,13 +16,15 @@ import Numeric.Optimization.MIP.Solver import Numeric.Optimization.MIP.Solver.GLPK +import IsClose+ -- ------------------------------------------------------------------------ case_glpk :: Assertion case_glpk = do prob <- MIP.readFile MIP.def "samples/lp/test.lp"- sol <- solve glpk MIP.def prob- sol @?=+ sol <- solve glpk MIP.def{ solveTol = Just def } prob+ assertAllClose (def :: Tol Rational) (fmap toRational sol) MIP.Solution { MIP.solStatus = MIP.StatusOptimal , MIP.solObjectiveValue = Just 122.5