glpk-headers 0.4.1 → 0.5.0

raw patch · 9 files changed

+194/−210 lines, 9 filesdep +hspecdep −tastydep −tasty-discoverdep −tasty-hunitdep ~basedep ~derive-storablePVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependencies removed: tasty, tasty-discover, tasty-hunit

Dependency ranges changed: base, derive-storable

API changes (from Hackage documentation)

Files

• ChangeLog.md +19/−2
• LICENSE +1/−1
• README.md +4/−0
• glpk-headers.cabal +32/−46
• src/Math/Programming/Glpk/Header.hsc +20/−22
• test/Diet.hs +0/−129
• test/Driver.hs +0/−10
• test/Math/Programming/Glpk/HeadersSpec.hs +115/−0
• test/Spec.hs +3/−0

@@ -1,3 +1,20 @@-# Changelog for GlpkHs+# Changelog for `glpk-headers` -## Unreleased changes+## [Unreleased]++- The `mkHaskellErrorHook` function was added to+  `Math.Programming.Glpk.Headers` to support writing GLPK error+  handlers.++- The `mkHaskellTermHook` function was added to+  `Math.Programming.Glpk.Headers` to support writing GLPK terminal+  callback hooks.++- The `mkHaskellMIPCallback` function was added to+  `Math.Programming.Glpk.Headers` to support writing MIP callback+  functions.++## [0.5.0] -- 2021-03-07++* Switch from Stack to Cabal (and Nix).+* Update to GHC 8.8.4

@@ -1,4 +1,4 @@-Copyright Patrick Steele (c) 2018+Copyright (c) 2018-2023, Patrick Steele  All rights reserved. 

@@ -4,3 +4,7 @@ [GLPK](https://www.gnu.org/software/glpk/). No attempt is made to make these bindings conform to Haskell norms --- they are a direct translation from the GLPK header file.++## Requirements++* GLPK >=4.65

@@ -1,51 +1,37 @@-cabal-version:      1.12-name:               glpk-headers-version:            0.4.1-license:            BSD3-license-file:       LICENSE-copyright:          2018 Patrick Steele-maintainer:         steele.pat@gmail.com-author:             Patrick Steele-homepage:           https://github.com/prsteele/glpk-headers-haskell#readme-bug-reports:        https://github.com/prsteele/glpk-headers-haskell/issues-synopsis:           Low-level Haskell bindings to GLPK.-description:-    Please see the README on GitHub at <https://github.com/prsteele/glpk-headers-haskell#readme>--category:           Math-build-type:         Simple-extra-source-files:-    README.md-    ChangeLog.md+cabal-version:       2.4+name:                glpk-headers+version:             0.5.0+synopsis:            Low-level Haskell bindings to the GLPK library+description:         Please see the README on GitHub at <https://github.com/prsteele/math-programming/blob/main/glpk-headers/README.md>+bug-reports:         https://github.com/prsteele/math-programming/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Patrick Steele+maintainer:          steele.pat@gmail.com+copyright:           2018-2023, Patrick Steele+category:            Math+build-type:          Simple+extra-source-files:  README.md, ChangeLog.md  source-repository head-    type:     git-    location: https://github.com/prsteele/glpk-headers-haskell+  type:     git+  location: https://github.com/prsteele/math-programming  library-    exposed-modules:  Math.Programming.Glpk.Header-    hs-source-dirs:   src-    other-modules:    Paths_glpk_headers-    default-language: Haskell2010-    build-depends:-        base >=4.7 && <5,-        derive-storable >=0.1.2.0 && <0.3--test-suite GlpkHs-test-    type:             exitcode-stdio-1.0-    main-is:          Driver.hs-    hs-source-dirs:   test-    other-modules:-        Diet-        Paths_glpk_headers+  default-language:  Haskell2010+  hs-source-dirs:    src+  exposed-modules:   Math.Programming.Glpk.Header+  extra-libraries:   glpk+  build-depends:     base            <5+                   , derive-storable ^>=0.3 -    default-language: Haskell2010-    extra-libraries:  glpk-    ghc-options:      -threaded -rtsopts -with-rtsopts=-N-    build-depends:-        base >=4.7 && <5,-        derive-storable >=0.1.2.0 && <0.3,-        glpk-headers -any,-        tasty >=1.2.3 && <1.3,-        tasty-discover >=4.2.1 && <4.3,-        tasty-hunit >=0.10.0.2 && <0.11+test-suite glpk-headers-haskell-test-suite+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  main-is:           Spec.hs+  hs-source-dirs:    test+  ghc-options:       -threaded -with-rtsopts=-N+  other-modules:     Math.Programming.Glpk.HeadersSpec+  build-depends:     glpk-headers+                   , base  <5+                   , hspec ^>=2.8

@@ -399,6 +399,11 @@   , glp_config   , glp_term_out   , glp_term_hook+  , glp_error_hook+  -- ** Helper functions+  , mkHaskellErrorHook+  , mkHaskellTermHook+  , mkHaskellMIPCallback   ) where  import Data.Typeable@@ -805,7 +810,6 @@   = GlpkVariableType { fromGlpkVariableType :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -929,7 +933,6 @@   = GlpkMessageLevel { fromGlpkMessageLevel :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -951,7 +954,6 @@   = GlpkSimplexMethod { fromGlpkSimplexMethod :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -971,7 +973,6 @@   = GlpkPricing { fromGlpkPricing :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -991,7 +992,6 @@   = GlpkRatioTest { fromGlpkRatioTest :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1010,7 +1010,6 @@   = GlpkPreCholeskyOrdering { fromGlpkPreCholeskyOrdering :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1031,7 +1030,6 @@   = GlpkBranchingTechnique { fromGlpkBranchingTechnique :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1053,7 +1051,6 @@   = GlpkBacktrackingTechnique { fromGlpkBacktrackingTechnique :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1074,7 +1071,6 @@   = GlpkPreProcessingTechnique { fromGlpkPreProcessingTechnique :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1094,7 +1090,6 @@   = GlpkFeasibilityPump { fromGlpkFeasibilityPump :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1113,7 +1108,6 @@   = GlpkProximitySearch { fromGlpkProximitySearch :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1132,7 +1126,6 @@   = GlpkGomoryCuts { fromGlpkGomoryCuts :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1151,7 +1144,6 @@   = GlpkMIRCuts { fromGlpkMIRCuts :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1170,7 +1162,6 @@   = GlpkCoverCuts { fromGlpkCoverCuts :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1189,7 +1180,6 @@   = GlpkCliqueCuts { fromGlpkCliqueCuts :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1208,7 +1198,6 @@   = GlpkPresolve { fromGlpkPresolve :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1227,7 +1216,6 @@   = GlpkBinarization { fromGlpkBinarization :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1246,7 +1234,6 @@   = GlpkSimpleRounding { fromGlpkSimpleRounding :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1265,7 +1252,7 @@   = GlpkConstraintOrigin { fromGlpkConstraintOrigin :: CInt }   deriving     ( Eq-    , GStorable+    , Generic     , Ord     , Read     , Show@@ -1285,7 +1272,6 @@   = GlpkCutType { fromGlpkCutType :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1306,7 +1292,6 @@   = GlpkControl { fromGlpkControl :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -1500,7 +1485,6 @@   = GlpkFactorizationType { fromGlpkFactorizationType :: CInt }   deriving     ( Eq-    , GStorable     , Ord     , Read     , Show@@ -2760,3 +2744,17 @@   :: FunPtr (Ptr a -> CString -> IO CInt)   -> Ptr a   -> IO ()++foreign import ccall "glp_error_hook" glp_error_hook+  :: FunPtr (Ptr a -> IO CInt)+  -> Ptr a+  -> IO ()++foreign import ccall "wrapper"+  mkHaskellErrorHook :: (Ptr a -> IO CInt) -> IO (FunPtr (Ptr a -> IO CInt))++foreign import ccall "wrapper"+  mkHaskellTermHook :: (Ptr a -> IO CInt) -> IO (FunPtr (Ptr a -> IO CInt))++foreign import ccall "wrapper"+  mkHaskellMIPCallback :: (Ptr (GlpkTree a) -> Ptr a -> IO ()) -> IO (FunPtr (Ptr (GlpkTree a) -> Ptr a -> IO ()))

@@ -1,129 +0,0 @@-module Diet where--import           Control.Monad-import           Foreign.C.Types-import           Foreign.Ptr-import           Test.Tasty-import           Test.Tasty.HUnit-import           Text.Printf--import           Math.Programming.Glpk.Header--test_diet :: TestTree-test_diet = testGroup "Diet problem"-  [ testCase "Basic diet problem" basicDiet-  ]--data Food = Corn | Milk | Bread-  deriving-    ( Eq-    , Ord-    , Read-    , Show-    )--data Nutrient = Calories | VitaminA-  deriving-    ( Eq-    , Ord-    , Read-    , Show-    )--basicDiet :: Assertion-basicDiet =-  let-    cost :: Food -> CDouble-    cost Corn  = 0.18-    cost Milk  = 0.23-    cost Bread = 0.05--    nutrition :: Nutrient -> Food -> CDouble-    nutrition Calories Corn  = 72-    nutrition VitaminA Corn  = 107-    nutrition Calories Milk  = 121-    nutrition VitaminA Milk  = 500-    nutrition Calories Bread = 65-    nutrition VitaminA Bread = 0--    foods :: [Food]-    foods = [Corn, Milk, Bread]--    nutrients :: [Nutrient]-    nutrients = [Calories, VitaminA]--    maxServings :: CDouble-    maxServings = 10--    nutrientBounds :: Nutrient -> (CDouble, CDouble)-    nutrientBounds Calories = (2000, 2250)-    nutrientBounds VitaminA = (5000, 50000)--    numAmountVariables :: CInt-    numAmountVariables = fromIntegral $ length foods--    numNutrientConstraints :: CInt-    numNutrientConstraints = fromIntegral (length nutrients)--    expected :: Food -> CDouble-    expected Corn  = 1.94-    expected Milk  = 10-    expected Bread = 10--    expectedCost :: CDouble-    expectedCost = 3.15-  in do-    _ <- glp_term_out glpkOff-    problem <- glp_create_prob--    -- Create the decision variables-    amountStart <- glp_add_cols problem numAmountVariables-    let amounts = zip foods [amountStart..]--    -- Create the nutrient constraints-    nutrientConStart <- glp_add_rows problem numNutrientConstraints-    let nutrientConstraints = zip nutrients [nutrientConStart..]--    -- Set the objective-    glp_set_obj_dir problem glpkMin-    forM_ amounts $ \(food, column) ->-      glp_set_obj_coef problem column (cost food)--    -- Set the right-hand side of the nutrient constraints-    forM_ nutrientConstraints $ \(nutrient, row) -> do-      let (lower, upper) = nutrientBounds nutrient-      glp_set_row_bnds problem row  glpkBounded lower upper--    -- Set the body of the nutrient constraints-    forM_ nutrientConstraints $ \(nutrient, row) ->-      allocaGlpkArray (map snd amounts) $ \indices ->-        allocaGlpkArray (map (nutrition nutrient . fst) amounts) $ \coefs ->-          glp_set_mat_row problem row numAmountVariables indices coefs--    -- Ensure we don't have too many servings of any one food-    forM_ amounts $ \(_, column) ->-      glp_set_col_bnds problem column glpkBounded 0 maxServings--    -- Check that we reached optimality-    status <- glp_simplex problem nullPtr-    status @?= glpkSimplexSuccess--    -- Check the variable values-    forM_ amounts $ \(food, column) -> do-      x <- glp_get_col_prim problem column--      let correct = expected food-          msg = printf-                "Amount of %s should be about %.2f, but is %.3f"-                (show food)-                (realToFrac correct :: Double)-                (realToFrac x :: Double)-      assertBool msg (abs (x - correct) <= 1e-1)--    -- Check the objective value-    objective <- glp_get_obj_val problem-    let msg = printf-              "Objective should be about %.2f, but is %.3f"-              (realToFrac expectedCost :: Double)-              (realToFrac objective :: Double)-    assertBool msg (abs (objective - expectedCost) < 1e-1)

@@ -1,10 +0,0 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}-{-|-Module : Main--The entry point for tests. We use tasty-discover to automatically-discover test functions in this directory, so simply preface tasty-tests with test_ for tasty TestTrees, or prop_ for QuickCheck-properties.--}-module Main where

@@ -0,0 +1,115 @@+module Math.Programming.Glpk.HeadersSpec where++import Control.Monad+import Foreign.C.Types+import Foreign.Ptr+import Math.Programming.Glpk.Header+import Test.Hspec+import Text.Printf++spec :: Spec+spec =+  describe "GPLK bindings" $ do+    it "can solve the diet problem" basicDiet++data Food = Corn | Milk | Bread+  deriving+    ( Eq,+      Ord,+      Read,+      Show+    )++data Nutrient = Calories | VitaminA+  deriving+    ( Eq,+      Ord,+      Read,+      Show+    )++basicDiet :: IO ()+basicDiet =+  let cost :: Food -> CDouble+      cost Corn = 0.18+      cost Milk = 0.23+      cost Bread = 0.05++      nutrition :: Nutrient -> Food -> CDouble+      nutrition Calories Corn = 72+      nutrition VitaminA Corn = 107+      nutrition Calories Milk = 121+      nutrition VitaminA Milk = 500+      nutrition Calories Bread = 65+      nutrition VitaminA Bread = 0++      foods :: [Food]+      foods = [Corn, Milk, Bread]++      nutrients :: [Nutrient]+      nutrients = [Calories, VitaminA]++      maxServings :: CDouble+      maxServings = 10++      nutrientBounds :: Nutrient -> (CDouble, CDouble)+      nutrientBounds Calories = (2000, 2250)+      nutrientBounds VitaminA = (5000, 50000)++      numAmountVariables :: CInt+      numAmountVariables = fromIntegral $ length foods++      numNutrientConstraints :: CInt+      numNutrientConstraints = fromIntegral (length nutrients)++      expected :: Food -> CDouble+      expected Corn = 1.94+      expected Milk = 10+      expected Bread = 10++      expectedCost :: CDouble+      expectedCost = 3.15+   in do+        _ <- glp_term_out glpkOff+        problem <- glp_create_prob++        -- Create the decision variables+        amountStart <- glp_add_cols problem numAmountVariables+        let amounts = zip foods [amountStart ..]++        -- Create the nutrient constraints+        nutrientConStart <- glp_add_rows problem numNutrientConstraints+        let nutrientConstraints = zip nutrients [nutrientConStart ..]++        -- Set the objective+        glp_set_obj_dir problem glpkMin+        forM_ amounts $ \(food, column) ->+          glp_set_obj_coef problem column (cost food)++        -- Set the right-hand side of the nutrient constraints+        forM_ nutrientConstraints $ \(nutrient, row) -> do+          let (lower, upper) = nutrientBounds nutrient+          glp_set_row_bnds problem row glpkBounded lower upper++        -- Set the body of the nutrient constraints+        forM_ nutrientConstraints $ \(nutrient, row) ->+          allocaGlpkArray (map snd amounts) $ \indices ->+            allocaGlpkArray (map (nutrition nutrient . fst) amounts) $ \coefs ->+              glp_set_mat_row problem row numAmountVariables indices coefs++        -- Ensure we don't have too many servings of any one food+        forM_ amounts $ \(_, column) ->+          glp_set_col_bnds problem column glpkBounded 0 maxServings++        -- Check that we reached optimality+        status <- glp_simplex problem nullPtr+        status `shouldBe` glpkSimplexSuccess++        -- Check the variable values+        forM_ amounts $ \(food, column) -> do+          x <- glp_get_col_prim problem column+          abs (x - expected food) `shouldSatisfy` (<= 1e-1)++        -- Check the objective value+        objective <- glp_get_obj_val problem+        abs (objective - expectedCost) `shouldSatisfy` (<= 1e-1)

@@ -0,0 +1,3 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}++module Spec where