math-programming-tests 0.4.0 → 0.5.0

raw patch · 9 files changed

+396/−260 lines, 9 filesdep +QuickCheckdep +containersdep +hspecdep −tastydep −tasty-hunitdep −tasty-quickcheckdep ~basedep ~math-programmingdep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, containers, hspec, microlens, microlens-mtl, microlens-th, mtl, random

Dependencies removed: tasty, tasty-hunit, tasty-quickcheck

Dependency ranges changed: base, math-programming, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• LICENSE +1/−1
• README.md +0/−4
• math-programming-tests.cabal +36/−40
• src/Math/Programming/Tests.hs +25/−20
• src/Math/Programming/Tests/Api.hs +23/−70
• src/Math/Programming/Tests/Fuzz.hs +190/−0
• src/Math/Programming/Tests/IP.hs +25/−27
• src/Math/Programming/Tests/LP.hs +91/−98

@@ -1,5 +1,10 @@ # Changelog for math-programming-api-tests +## [0.5.0] -- 18 January 2023+### Added++- Fuzz testing of APIs+ ## [0.4.0] -- 5 July 2020  Update version bounds.

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

@@ -1,4 +0,0 @@-# math-programming-tests--This library provides utility functions for testing backends to the-`math-programming` library.

@@ -1,44 +1,40 @@-cabal-version:      1.12-name:               math-programming-tests-version:            0.4.0-license:            BSD3-license-file:       LICENSE-copyright:          2018 Patrick Steele-maintainer:         steele.pat@gmail.com-author:             Patrick Steele-homepage:           https://github.com/prsteele/math-programming-tests#readme-bug-reports:        https://github.com/prsteele/math-programming-tests/issues-synopsis:-    Utility functions for testing implementations of the math-programming library.--description:-    Please see the README on GitHub at <https://github.com/prsteele/math-programming-api-tests#readme>--category:           Math-build-type:         Simple-extra-source-files:-    README.md-    ChangeLog.md+cabal-version:       2.4+name:                math-programming-tests+version:             0.5.0+synopsis:            Utility functions for testing implementations of the math-programming library.+description:         Please see the <https://github.com/prsteele/math-programming/blob/main/README.md README on GitHub>.+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:  ChangeLog.md  source-repository head-    type:     git-    location: https://github.com/prsteele/math-programming-tests+  type:     git+  location: https://github.com/prsteele/math-programming  library-    exposed-modules:-        Math.Programming.Tests-        Math.Programming.Tests.Api-        Math.Programming.Tests.IP-        Math.Programming.Tests.LP--    hs-source-dirs:   src-    other-modules:    Paths_math_programming_tests-    default-language: Haskell2010-    ghc-options:      -Wall-    build-depends:-        base >=4.12.0.0 && <4.13,-        math-programming >=0.4.0 && <0.5,-        tasty >=1.2.3 && <1.3,-        tasty-hunit >=0.10.0.2 && <0.11,-        tasty-quickcheck >=0.10.1.1 && <0.11,-        text >=1.2.3.1 && <1.3+  default-language:  Haskell2010+  hs-source-dirs:    src+  exposed-modules:   Math.Programming.Tests+                   , Math.Programming.Tests.Api+                   , Math.Programming.Tests.LP+                   , Math.Programming.Tests.IP+                   , Math.Programming.Tests.Fuzz+  other-modules:+  ghc-options:       -Wall+  build-depends:     base             <5+                   , containers       ^>=0.6+                   , math-programming ^>=0.5+                   , microlens        ^>=0.4+                   , microlens-th     ^>=0.4+                   , microlens-mtl    ^>=0.2+                   , hspec            ^>=2.8+                   , QuickCheck       ^>=2.14+                   , random           ^>=1.2+                   , mtl              ^>=2.2+                   , text             ^>=1.2

@@ -1,24 +1,29 @@ {-# LANGUAGE FlexibleContexts #-}-module Math.Programming.Tests where -import           Control.Monad.IO.Class-import           Test.Tasty-import           Text.Printf+module Math.Programming.Tests where -import           Math.Programming-import           Math.Programming.Tests.Api-import           Math.Programming.Tests.IP-import           Math.Programming.Tests.LP+import Control.Monad+import Control.Monad.IO.Class+import Math.Programming+import Math.Programming.Tests.Api+import Math.Programming.Tests.Fuzz+import Math.Programming.Tests.IP+import Math.Programming.Tests.LP+import Test.Hspec+import Text.Printf -makeAllTests-  :: (PrintfArg (Numeric m), RealFrac  (Numeric m), MonadIO m, IPMonad m)-  => String           -- ^ The name of the API being tested. This will-                      -- be used to generate test group names.-  -> (m () -> IO ())  -- ^ The runner for the API being tested.-  -> TestTree         -- ^ The resulting test suite.-makeAllTests apiName runner-  = testGroup (printf "Math.Programming tests (%s)" apiName)-    [ makeApiTests runner-    , makeLPTests runner-    , makeIPTests runner-    ]+makeAllTests ::+  (MonadIO m, MonadIP v c o m) =>+  -- | The name of the API being tested. This will+  -- be used to generate test group names.+  String ->+  -- | The runner for the API being tested.+  (m () -> IO ()) ->+  -- | The resulting test suite.+  Spec+makeAllTests apiName runner =+  describe (printf "Math.Programming API tests (%s backend)" apiName) $ do+    makeApiTests runner+    makeLPTests runner+    makeIPTests runner+    makeFuzzTests (runner . void)

@@ -1,84 +1,37 @@-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Math.Programming.Tests.Api where+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} -import           Control.Monad.IO.Class-import           Test.Tasty-import           Test.Tasty.HUnit-import           Test.Tasty.QuickCheck+module Math.Programming.Tests.Api where -import           Math.Programming+import Control.Monad.IO.Class+import Math.Programming+import Test.Hspec -makeApiTests-  :: (Num (Numeric m), MonadIO m, LPMonad m)-  => (m () -> IO ())  -- ^ The runner for the API being tested.-  -> TestTree         -- ^ The resulting test suite.-makeApiTests runner = testGroup "API tests"-  [ testCase "Set/get variable names" (runner setGetVariableName)-  , testCase "Set/get constraint names" (runner setGetConstraintName)-  ]+makeApiTests ::+  (MonadIO m, MonadLP v c o m) =>+  -- | The runner for the API being tested.+  (m () -> IO ()) ->+  -- | The resulting test suite.+  Spec+makeApiTests runner =+  describe "API tests" $ do+    it "sets and gets variable names" (runner setGetVariableName)+    it "sets and gets constraint names" (runner setGetConstraintName) --- | We should be able to set and retrieve variable names-setGetVariableName :: (MonadIO m, LPMonad m) => m ()+setGetVariableName :: (MonadIO m, MonadLP v c o m) => m () setGetVariableName = do   let name = "foo"   x <- free   setVariableName x name-   vName <- getVariableName x-  liftIO $ vName @?= name+  liftIO $ vName `shouldBe` name --- | We should be able to set and retrieve constraint names-setGetConstraintName :: (Num (Numeric m), MonadIO m, LPMonad m) => m ()+setGetConstraintName :: (MonadIO m, MonadLP v c o m) => m () setGetConstraintName = do   let name = "foo"   x <- free-  c <- (x @>=# 0) `named` name+  c <- var x .>= 0+  setConstraintName c name   cName <- getConstraintName c-  liftIO $ cName @?= name--data Action-  = AddVariable-  | AddConstraint-  | AddThenDeleteVariable-  | AddThenDeleteConstraint-  deriving-    ( Enum-    , Show-    )--instance Arbitrary Action where-  arbitrary = elements actions-    where-      actions = [AddVariable .. AddThenDeleteConstraint]--newtype LPActions m = LPActions (m ())--instance LPMonad m => Arbitrary (LPActions m) where-  arbitrary = LPActions <$> sized lpActions--lpActions :: LPMonad m => Int -> Gen (m ())-lpActions remaining-  | remaining <= 0 = return (return ())-  | otherwise      = do-      action <- arbitrary-      case action of-        AddVariable-          -> return (addVariable >> return ())-        AddThenDeleteVariable-          -> bindOver addVariable removeVariable <$> lpActions (remaining - 1)-        _ -> return (return ())---- | Execute the monadic bind (>>=), with some other actions taken in--- between.-bindOver-  :: (Monad m)-  => m a         -- ^ The action providing the passed value-  -> (a -> m b)  -- ^ The function to bind to-  -> m ()        -- ^ The intermediate actions-  -> m b         -- ^ The resulting value-bindOver action fn intermediate = action >>= (\x -> intermediate >> fn x)--arbitraryLPActionsProp :: LPActions m -> m ()-arbitraryLPActionsProp (LPActions actions) = actions+  liftIO $ cName `shouldBe` name

@@ -0,0 +1,190 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Fuzz testing for math programming backends.+module Math.Programming.Tests.Fuzz where++import Control.Monad.IO.Class+import Control.Monad.State+import Control.Monad.Writer+import qualified Data.Map as M+import qualified Data.Sequence as S+import qualified Data.Text as T+import Lens.Micro+import Lens.Micro.Mtl+import Lens.Micro.TH+import Math.Programming+import System.Random+import System.Random.Stateful+import Test.Hspec hiding (focus, pending)+import Test.Hspec.QuickCheck+import Test.QuickCheck++newtype Variable = Variable Int+  deriving+    ( Show,+      Eq,+      Ord+    )++newtype Constraint = Constraint Int+  deriving+    ( Show,+      Eq,+      Ord+    )++newtype Objective = Objective Int+  deriving+    ( Show,+      Eq,+      Ord+    )++-- | The types of actions we can perform on a linear program+data LPAction+  = AddVariable Variable+  | AddThenRemoveVariable Variable+  | AddConstraint Constraint+  | AddThenRemoveConstraint Constraint+  | AddObjective Objective+  | AddThenRemoveObjective Objective+  | Optimize+  deriving (Show)++newtype LPActions = LPActions [LPAction]+  deriving (Show)++instance Arbitrary LPActions where+  arbitrary = do+    NonNegative actionCount <- arbitrary+    actions <- forM [1 .. actionCount] $ \i -> do+      d7 <- fmap (`mod` (7 :: Int)) arbitrary+      pure $ case d7 of+        0 -> AddVariable (Variable i)+        1 -> AddThenRemoveVariable (Variable i)+        2 -> AddConstraint (Constraint i)+        3 -> AddThenRemoveConstraint (Constraint i)+        4 -> AddObjective (Objective i)+        5 -> AddThenRemoveObjective (Objective i)+        _ -> Optimize+    pure (LPActions actions)++data LPState v c o = LPState+  { _variables :: M.Map Variable v,+    _variableNames :: M.Map Variable T.Text,+    _constraints :: M.Map Constraint c,+    _constraintNames :: M.Map Constraint T.Text,+    _objectives :: M.Map Objective o,+    _objectiveNames :: M.Map Objective T.Text,+    _pending :: [LPAction],+    _randomGen :: IOGenM StdGen+  }++makeLenses ''LPState++initLPState :: Int -> [LPAction] -> IO (LPState v c o)+initLPState seed todo = do+  g <- newIOGenM (mkStdGen seed)+  pure+    LPState+      { _variables = M.empty,+        _variableNames = M.empty,+        _constraints = M.empty,+        _constraintNames = M.empty,+        _objectives = M.empty,+        _objectiveNames = M.empty,+        _pending = todo,+        _randomGen = g+      }++type LPFuzz v c o m =+  ( MonadState (LPState v c o) m,+    MonadLP v c o m,+    MonadWriter (S.Seq String) m,+    MonadIO m+  )++evalPending :: LPFuzz v c o m => m ()+evalPending = do+  todo <- use pending+  case todo of+    [] -> pure ()+    (x : xs) -> do+      assign pending xs+      evalAction x+      evalPending++evalAction :: LPFuzz v c o m => LPAction -> m ()+evalAction action = tell (S.singleton (show action)) >> evalAction' action++evalAction' :: LPFuzz v c o m => LPAction -> m ()+evalAction' (AddVariable k) = add k addVariable variables+evalAction' (AddThenRemoveVariable k) = addThenRemove k addVariable deleteVariable variables+evalAction' (AddConstraint k) = add k makeConstraint constraints+evalAction' (AddThenRemoveConstraint k) = addThenRemove k makeConstraint deleteConstraint constraints+evalAction' (AddObjective k) = add k makeObjective objectives+evalAction' (AddThenRemoveObjective k) = addThenRemove k makeObjective deleteObjective objectives+evalAction' Optimize = void optimizeLP++add :: (LPFuzz v c o m, Ord k) => k -> m a -> ASetter' (LPState v c o) (M.Map k a) -> m ()+add k create focus =+  create >>= modifying focus . M.insert k++addThenRemove :: (LPFuzz v c o m, Ord k) => k -> (m a) -> (a -> m ()) -> Lens' (LPState v c o) (M.Map k a) -> m ()+addThenRemove k create destroy focus = do+  collection <- use focus+  case M.lookup k collection of+    Just v -> destroy v >> modifying focus (M.delete k)+    Nothing -> add k create focus++makeConstraint :: LPFuzz v c o m => m c+makeConstraint = do+  lhs <- chooseExpr+  rhs <- chooseExpr+  op <- chooseInequality+  lhs `op` rhs++chooseExpr :: LPFuzz v c o m => m (Expr v)+chooseExpr = do+  g <- use randomGen+  vs <- use variables+  terms <- forM (M.elems vs) $ \v -> do+    c <- liftIO (uniformRM (-1e10, 1e10) g)+    pure (c *. v)++  pure (esum terms)++chooseInequality :: LPFuzz v c o m => m (Expr v -> Expr v -> m c)+chooseInequality = do+  g <- use randomGen+  d3 <- liftIO (uniformRM (0 :: Int, 2) g)+  case d3 of+    0 -> pure (.<=.)+    1 -> pure (.>=.)+    _ -> pure (.==.)++makeObjective :: LPFuzz v c o m => m o+makeObjective = do+  g <- use randomGen+  minimizing <- liftIO (uniformM g)++  if minimizing+    then chooseExpr >>= minimize+    else chooseExpr >>= maximize++makeFuzzTests ::+  (MonadIO m, MonadLP v c o m) =>+  -- | The runner for the API being tested.+  (m (S.Seq String) -> IO ()) ->+  -- | The resulting test suite.+  Spec+makeFuzzTests runner =+  describe "Fuzz testing" $ do+    prop "finds no failures" $ \seed (LPActions todo) -> do+      initState <- liftIO (initLPState seed todo)+      runner . execWriterT+        . flip evalStateT initState+        $ evalPending

@@ -1,20 +1,20 @@ {-# LANGUAGE FlexibleContexts #-}-module Math.Programming.Tests.IP where -import           Control.Monad.IO.Class-import           Test.Tasty-import           Test.Tasty.HUnit-import           Text.Printf+module Math.Programming.Tests.IP where -import           Math.Programming+import Control.Monad.IO.Class+import Math.Programming+import Test.Hspec -makeIPTests-  :: (PrintfArg (Numeric m), RealFrac (Numeric m), MonadIO m, IPMonad m)-  => (m () -> IO ())  -- ^ The runner for the API being tested.-  -> TestTree         -- ^ The resulting test suite.-makeIPTests runner = testGroup "IP problems"-  [ testCase "Simple MIP" (runner simpleMIPTest)-  ]+makeIPTests ::+  (MonadIO m, MonadIP v c o m) =>+  -- | The runner for the API being tested.+  (m () -> IO ()) ->+  -- | The resulting test suite.+  Spec+makeIPTests runner =+  describe "IP problems" $ do+    it "solves a simple MIP" (runner simpleMIPTest)  -- | We solve a simple MIP of the form --@@ -28,29 +28,27 @@ -- @ -- -- The optimal solution to this MIP is x = 2, y = 1.1.-simpleMIPTest :: (PrintfArg (Numeric m), RealFrac (Numeric m), MonadIO m, IPMonad m) => m ()+simpleMIPTest :: (MonadIO m, MonadIP v c o m) => m () simpleMIPTest = do   x <- bounded 0 5 `asKind` Integer   y <- bounded 0 5 `asKind` Continuous-  _ <- x @>=# 1.1-  _ <- y @>=# 1.1-  objective <- minimize $ x @+@ y+  _ <- var x .>= 1.1+  _ <- var y .>= 1.1+  objective <- minimize $ var x .+. var y   status <- optimizeIP    -- Check that we reached optimality-  liftIO $ status @?= Optimal+  liftIO $ status `shouldBe` Optimal -  vx <- getVariableValue x   let expectedX = 2-      xmsg = printf "Expected x to be 2, but is %.3f" vx-  liftIO $ assertBool xmsg (abs (vx - expectedX) <= 1e-3)+      expectedY = 1.1+      expectedObj = expectedX + expectedY +  vx <- getVariableValue x+  liftIO $ abs (vx - expectedX) `shouldSatisfy` (<= 1e-3)+   vy <- getVariableValue y-  let expectedY = 1.1-      ymsg = printf "Expected y to be 1.1, but is %.3f" vy-  liftIO $ assertBool ymsg (abs (vy - expectedY) <= 1e-3)+  liftIO $ abs (vy - expectedY) `shouldSatisfy` (<= 1e-3)    vobj <- getObjectiveValue objective-  let expectedObj = expectedX + expectedY-      objMsg = printf "Expected optimal solution to be %f, but is %f" expectedObj vobj-  liftIO $ assertBool objMsg (abs (vobj - expectedObj) <= 1e-3)+  liftIO $ abs (vobj - expectedObj) `shouldSatisfy` (<= 1e-3)

@@ -1,129 +1,122 @@-{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}-module Math.Programming.Tests.LP where -import           Control.Monad-import           Control.Monad.IO.Class-import           Test.Tasty-import           Test.Tasty.HUnit-import           Text.Printf+module Math.Programming.Tests.LP where -import           Math.Programming+import Control.Monad+import Control.Monad.IO.Class+import qualified Data.Text as T+import Math.Programming+import Test.Hspec+import Text.Printf -makeLPTests-  :: (PrintfArg (Numeric m), RealFrac (Numeric m), MonadIO m, LPMonad m)-  => (m () -> IO ())  -- ^ The runner for the API being tested.-  -> TestTree         -- ^ The resulting test suite.-makeLPTests runner = testGroup "LP problems"-  [ testCase "Diet problem" (runner dietProblemTest)-  ]+makeLPTests ::+  (MonadIO m, MonadLP v c o m) =>+  -- | The runner for the API being tested.+  (m () -> IO ()) ->+  -- | The resulting test suite.+  Spec+makeLPTests runner =+  describe "LP problems" $ do+    it "solves the diet problem" (runner dietProblemTest)  data Food = Corn | Milk | Bread   deriving-    ( Eq-    , Ord-    , Read-    , Show+    ( Eq,+      Ord,+      Read,+      Show     )  data Nutrient = Calories | VitaminA   deriving-    ( Eq-    , Ord-    , Read-    , Show+    ( Eq,+      Ord,+      Read,+      Show     ) -dietProblemTest :: forall m. (PrintfArg (Numeric m), RealFrac (Numeric m), MonadIO m, LPMonad m) => m ()+dietProblemTest :: (MonadIO m, MonadLP v c o m) => m () dietProblemTest =-  let-    cost :: Food -> Numeric m-    cost Corn  = 0.18-    cost Milk  = 0.23-    cost Bread = 0.05--    nutrition :: Nutrient -> Food -> Numeric m-    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]+  let cost :: Food -> Double+      cost Corn = 0.18+      cost Milk = 0.23+      cost Bread = 0.05 -    nutrients :: [Nutrient]-    nutrients = [Calories, VitaminA]+      nutrition :: Nutrient -> Food -> Double+      nutrition Calories Corn = 72+      nutrition VitaminA Corn = 107+      nutrition Calories Milk = 121+      nutrition VitaminA Milk = 500+      nutrition Calories Bread = 65+      nutrition VitaminA Bread = 0 -    maxServings :: Numeric m-    maxServings = 10+      foods :: [Food]+      foods = [Corn, Milk, Bread] -    nutrientBounds :: Nutrient -> (Numeric m, Numeric m)-    nutrientBounds Calories = (2000, 2250)-    nutrientBounds VitaminA = (5000, 50000)+      nutrients :: [Nutrient]+      nutrients = [Calories, VitaminA] -    expected :: Food -> Numeric m-    expected Corn  = 1.94-    expected Milk  = 10-    expected Bread = 10+      maxServings :: Double+      maxServings = 10 -    expectedCost :: Numeric m-    expectedCost = 3.15+      nutrientBounds :: Nutrient -> (Double, Double)+      nutrientBounds Calories = (2000, 2250)+      nutrientBounds VitaminA = (5000, 50000) -    amountInterval :: Bounds (Numeric m)-    amountInterval = Interval 0 maxServings+      expected :: Food -> Double+      expected Corn = 1.94+      expected Milk = 10+      expected Bread = 10 -    amountName :: Food -> String-    amountName food = printf "amount[%s]" (show food)+      expectedCost :: Double+      expectedCost = 3.15 -    nutrientMaxName :: Nutrient -> String-    nutrientMaxName nutrient = printf "%s_max" (show nutrient)+      amountInterval :: Bounds+      amountInterval = Interval 0 maxServings -    nutrientMinName :: Nutrient -> String-    nutrientMinName nutrient = printf "%s_min" (show nutrient)+      amountName :: Food -> T.Text+      amountName food = T.pack $ printf "amount[%s]" (show food) -  in do-    -- Create the decision variables-    amounts <- forM foods $ \food -> do-      v <- addVariable `within` amountInterval `named` (amountName food)-      return (food, v)+      nutrientMaxName :: Nutrient -> T.Text+      nutrientMaxName nutrient = T.pack $ printf "%s_max" (show nutrient) -    -- Create the nutrient constraints-    forM_ nutrients $ \nutrient -> do-      let lhs = exprSum [nutrition nutrient food #*@ v | (food, v) <- amounts]-          (lower, upper) = nutrientBounds nutrient-      _ <- (lhs .<=# upper) `named` (nutrientMaxName nutrient)-      _ <- (lhs .>=# lower) `named` (nutrientMinName nutrient)-      pure ()+      nutrientMinName :: Nutrient -> T.Text+      nutrientMinName nutrient = T.pack $ printf "%s_min" (show nutrient)+   in do+        -- Create the decision variables+        amounts <- forM foods $ \food -> do+          v <- free `within` amountInterval+          setVariableName v (amountName food)+          return (food, v) -    -- Set the objective-    let objectiveExpr = exprSum [cost food #*@ v | (food, v) <- amounts]-    objective <- addObjective objectiveExpr-    setObjectiveSense objective Minimization+        -- Create the nutrient constraints+        forM_ nutrients $ \nutrient -> do+          let lhs = esum [nutrition nutrient food *. v | (food, v) <- amounts]+              (lower, upper) = nutrientBounds nutrient+          u <- lhs .<= upper+          setConstraintName u (nutrientMaxName nutrient)+          l <- lhs .>= lower+          setConstraintName l (nutrientMinName nutrient)+          pure () -    -- Solve the problem-    status <- optimizeLP+        -- Set the objective+        let objectiveExpr = esum [cost food *. v | (food, v) <- amounts]+        objective <- addObjective objectiveExpr+        setObjectiveSense objective Minimization -    -- Check that we reached optimality-    liftIO $ status @?= Optimal+        -- Solve the problem+        status <- optimizeLP -    -- Check the variable values-    forM_ amounts $ \(food, v) -> do-      x <- getVariableValue v+        -- Check that we reached optimality+        liftIO $ status `shouldBe` Optimal -      let correct = expected food-          msg = printf-                "Amount of %s should be about %.2f, but is %.3f"-                (show food)-                correct-                x-      liftIO $ assertBool msg (abs (x - correct) <= 1e-1)+        -- Check the variable values+        forM_ amounts $ \(food, v) -> do+          x <- getVariableValue v+          liftIO $ abs (x - expected food) `shouldSatisfy` (<= 1e-1) -    -- Check the objective value-    objectiveValue <- evalExpr objectiveExpr-    let msg = printf-              "Objective should be about %.2f, but is %.3f"-              expectedCost-              objectiveValue-    liftIO $ assertBool msg (abs (objectiveValue - expectedCost) < 1e-1)+        -- Check the objective value+        objectiveValue <- evalExpr objectiveExpr+        liftIO $ abs (objectiveValue - expectedCost) `shouldSatisfy` (<= 1e-1)