math-programming 0.4.0 → 0.5.0

raw patch · 13 files changed

+705/−786 lines, 13 filesdep +QuickCheckdep +exceptionsdep +hspecdep −tastydep −tasty-discoverdep −tasty-hunitdep ~basedep ~containersdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, exceptions, hspec, transformers

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

Dependency ranges changed: base, containers, mtl, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• LICENSE +1/−1
• README.md +0/−11
• math-programming.cabal +45/−55
• src/Math/Programming.hs +105/−238
• src/Math/Programming/Dsl.hs +96/−199
• src/Math/Programming/LinExpr.hs +96/−0
• src/Math/Programming/Types.hs +246/−198
• test/Driver.hs +0/−10
• test/Math/Programming/DslSpec.hs +21/−0
• test/Math/Programming/LinExprSpec.hs +87/−0
• test/Math/Programming/TestLinearExpression.hs +0/−74
• test/Spec.hs +3/−0

@@ -1,5 +1,10 @@ # Changelog for math-programming +## [0.5.0] -- 18 January 2023+### Changed++- The API has been made more consistent.+ ## [0.4.0] -- 5 July 2020 ### Added 

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

@@ -1,11 +0,0 @@-# math-programming--A math programming library.--This library is designed to formulate and solve math programs, in-particular linear programs and mixed-integer linear programs.--This library alone is not sufficient to solve math programs; to do so,-a solver backend implementing the `LPMonad` or `IPMonad` classes is-required, such as the [GLPK-backend](https://github.com/prsteele/math-programming-glpk).

@@ -1,60 +1,50 @@-cabal-version:      1.12-name:               math-programming-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#readme-bug-reports:        https://github.com/prsteele/math-programming/issues-synopsis:           A library for formulating and solving math programs.-description:-    Please see the README on GitHub at <https://github.com/prsteele/math-programming#readme>--category:           Math-build-type:         Simple-extra-source-files:-    README.md-    ChangeLog.md+cabal-version:       2.4+name:                math-programming+version:             0.5.0+synopsis:            A library for formulating and solving math programs.+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+  type:     git+  location: https://github.com/prsteele/math-programming  library-    exposed-modules:-        Math.Programming-        Math.Programming.Dsl-        Math.Programming.Types--    hs-source-dirs:   src-    other-modules:    Paths_math_programming-    default-language: Haskell2010-    ghc-options:      -Wall-    build-depends:-        base >=4.7 && <5,-        containers >=0.6.0.1 && <0.7,-        mtl >=2.2.2 && <2.3,-        text >=1.2.3.1 && <1.3--test-suite math-programming-test-    type:             exitcode-stdio-1.0-    main-is:          Driver.hs-    hs-source-dirs:   test-    other-modules:-        Math.Programming.TestLinearExpression-        Paths_math_programming+  default-language:  Haskell2010+  hs-source-dirs:    src+  exposed-modules:   Math.Programming+                   , Math.Programming.Types+                   , Math.Programming.Dsl+                   , Math.Programming.LinExpr+  other-modules:+  ghc-options:       -Wall+  -- Restrictions on transformers due to https://hub.darcs.net/ross/transformers/issue/90+  build-depends:     base         <5+                   , containers   ^>=0.6+                   , exceptions   ^>=0.10+                   , mtl          ^>=2.2+                   , text         ^>=1.2+                   , transformers ^>=0.5 -    default-language: Haskell2010-    ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall-    build-depends:-        base >=4.7 && <5,-        containers >=0.6.0.1 && <0.7,-        math-programming -any,-        mtl >=2.2.2 && <2.3,-        tasty >=1.2.3 && <1.3,-        tasty-discover >=4.2.1 && <4.3,-        tasty-hunit >=0.10.0.2 && <0.11,-        tasty-quickcheck >=0.10.1.1 && <0.11,-        text >=1.2.3.1 && <1.3+test-suite math-programming-test-suite+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  main-is:           Spec.hs+  hs-source-dirs:    test+  ghc-options:       -threaded -with-rtsopts=-N -Wall+  other-modules:     Math.Programming.LinExprSpec+                   , Math.Programming.DslSpec+  build-depends:     math-programming+                   , base       <5+                   , hspec      ^>=2.8+                   , mtl        ^>=2.2+                   , QuickCheck ^>=2.14+                   , text       ^>=1.2

@@ -1,273 +1,140 @@-{-| A library for modeling and solving linear and integer programs.--This library is merely a frontend to various solver backends. At the-time this was written, the only known supported backend is-<https://github.com/prsteele/math-programming-glpk GLPK>.--}+-- | A library for modeling and solving linear and integer programs.+--+-- This library is merely a frontend to various solver backends. At+-- the time this was written, the only known supported backend is+-- <https://github.com/prsteele/math-programming/blob/main/math-programming-glpk/README.md GLPK>.+--+-- This page includes a high-level overview of the model building DSL,+-- as well as a deeper dive into the core monadic interface. module Math.Programming-  ( -- * Math programs-    -- $mathprograms--    -- ** Linear programs-    LPMonad (..)-  , Expr-  , Bounds (..)-  , SolutionStatus (..)-  , Sense (..)--    -- ** Integer programs-  , IPMonad (..)-  , Domain (..)--    -- * Model-building DSL+  ( -- * Model-building DSL     -- $models      -- ** Creating variables-    -- $variables      -- *** Continuous variables-  , free-  , nonNeg-  , nonPos-  , bounded-  , within--    -- *** Integer variables-  , integer-  , binary-  , nonNegInteger-  , nonPosInteger-  , asKind--    -- ** Linear expressions-    -- $expressions-  , LinearExpression (..)-  , eval-  , simplify-  , var-  , con-  , exprSum-  , varSum--    -- *** Addition-    -- $addition-  , (.+.)-  , (@+@)-  , (.+@)-  , (@+.)-  , (@+#)-  , (#+@)-  , (#+.)-  , (.+#)--    -- *** Subtraction-    -- $subtraction-  , (.-.)-  , (@-@)-  , (.-@)-  , (@-.)-  , (@-#)-  , (#-@)-  , (#-.)-  , (.-#)+    free,+    bounded,+    nonNeg,+    nonPos, -    -- *** Multiplication-    -- $multiplication-  , (#*@)-  , (@*#)-  , (#*.)-  , (.*#)+    -- *** Discrete variables+    integer,+    binary,+    nonNegInteger,+    nonPosInteger, -    -- *** Division-    -- $division-  , (@/#)-  , (./#)+    -- *** Modifying variables+    -- $modifiers+    within,+    asKind, -    -- ** Constraints+    -- ** Creating constraints     -- $constraints-  , Inequality (..) +    -- *** Equality constraints+    (.==.),+    (==.),+    (.==),+     -- *** Less-than constraints-    -- $lt-  , (#<=@)-  , (#<=.)-  , (@<=#)-  , (@<=@)-  , (@<=.)-  , (.<=#)-  , (.<=@)-  , (.<=.)+    (.<=.),+    (<=.),+    (.<=),      -- *** Greater-than constraints-    -- $gt-  , (#>=@)-  , (#>=.)-  , (@>=#)-  , (@>=@)-  , (@>=.)-  , (.>=#)-  , (.>=@)-  , (.>=.)+    (.>=.),+    (>=.),+    (.>=), -  -- *** Equality constraints-  -- $eq-  , (#==@)-  , (#==.)-  , (@==#)-  , (@==@)-  , (@==.)-  , (.==#)-  , (.==@)-  , (.==.)+    -- ** Creating objectives+    minimize,+    maximize, -    -- ** Specifying objectives-  , minimize-  , maximize+    -- ** Creating linear expressions+    -- $expressions+    var,+    con,+    (.*),+    (*.),+    (.+.),+    (.-.),+    (./),+    eval,+    simplify,+    vsum,+    esum,+    scale, -    -- ** Utilities-  , evalExpr-  , named-  , nameOf-  ) where+    -- * Math programs+    -- $mathprograms -import           Math.Programming.Dsl-import           Math.Programming.Types+    -- ** Linear programs+    MonadLP (..), --- $mathprograms------ The 'LPMonad' provides all the primitives necessary to formulate--- and solve linear programs; the 'IPMonad' provides the same for--- integer programs. However, you should not often need to use these--- APIs directly, as we provide more user-friendly functions wrapping--- these low-level functions below.+    -- ** Integer programs+    MonadIP (..),+    Domain (..), --- $models------ The functions in the 'LPMonad' and 'IPMonad' typeclasses are--- designed to interface with low-level solver backends. We provide a--- cleaner interface in the following sections.+    -- * Other types and functions+    evalExpr,+    formatExpr,+    Expr,+    Bounds (..),+    SolutionStatus (..),+    Sense (..),+    Inequality (..),+    LinExpr (..), --- $variables------ 'LPMonad' provides 'addVariable' and 'setVariableBounds', and--- 'IPMonad' additionally provides 'setVariableDomain'. While--- sufficient to create your programs, you are encouraged to use the--- more natural functions below.+    -- * Naming model attributes+    withVariableName,+    withConstraintName,+    withObjectiveName,+  )+where --- $expressions------ The module 'Math.Programming.LinearExpression' provides operators--- to build up 'LinearExpression' objects using declared variables.+import Math.Programming.Dsl+import Math.Programming.LinExpr+import Math.Programming.Types --- $addition------ We can summarize the addition operators with the table+-- $introduction ----- +-----------------+--------+--------+------------------+--- |                 |Constant|Variable|    Expression    |--- +-----------------+--------+--------+------------------+--- |Constant         | '+'    | '#+@'  | '#+.'            |--- +-----------------+--------+--------+------------------+--- |Variable         | '@+#'  | '@+@'  | '@+.'            |--- +-----------------+--------+--------+------------------+--- |Expression       | '.+#'  | '.+@'  | '.+.'            |--- +-----------------+--------+--------+------------------++-- This library provides a monadic interface for building and solving+-- linear and integer programs. --- $subtraction------ We can summarize the subtraction operators with the table+-- $models ----- +-----------------+--------+--------+------------------+--- |                 |Constant|Variable|    Expression    |--- +-----------------+--------+--------+------------------+--- |Constant         | '-'    | '#-@'  | '#-.'            |--- +-----------------+--------+--------+------------------+--- |Variable         | '@-#'  | '@-@'  | '@-.'            |--- +-----------------+--------+--------+------------------+--- |Expression       | '.-#'  | '.-@'  | '.-.'            |--- +-----------------+--------+--------+------------------++-- We provide a monadic DSL for specifying math programs. This DSL+-- builds up programs statefully, rather than building some pure,+-- abstract representation of a math program. --- $multiplication------ We can summarize the multiplication operators with the table------ +-----------------+--------+--------+------------------+--- |                 |Constant|Variable|    Expression    |--- +-----------------+--------+--------+------------------+--- |Constant         | '*'    | '#*@'  | '#*.'            |--- +-----------------+--------+--------+------------------+--- |Variable         | '@*#'  |        |                  |--- +-----------------+--------+--------+------------------+--- |Expression       | '.*#'  |        |                  |--- +-----------------+--------+--------+------------------+------ As there are few possibilities for valid multiplication, it can be--- convenient to define e.g. @.*@ or some other short operator as an--- alias for '#*@'.+-- $modifiers+-- Regardless of the helper functions used above to create a+-- variable, you can modify its behavior using the following+-- modifiers. --- $division------ We can summarize the multiplication operators with the table------ +-----------------+--------+--------+------------------+--- |                 |Constant|Variable|    Expression    |--- +-----------------+--------+--------+------------------+--- |Constant         | '/'    |        |                  |--- +-----------------+--------+--------+------------------+--- |Variable         | '@/#'  |        |                  |--- +-----------------+--------+--------+------------------+--- |Expression       | './#'  |        |                  |--- +-----------------+--------+--------+------------------++-- $expressions ----- As there are few possibilities for valid division, it--- can be convenient to define e.g. @./@ or some other short operator--- as an alias for '@/#'.+-- A @'LinExpr' a b@ is a linear expression over variables of type @b@+-- with coefficients of type @a@ (typically 'Double'.) We provide a+-- number of operators to build up linear expressions naturally. The+-- mnemonic is that @.@ characters point to expressions.  -- $constraints ----- The 'LPMonad' provides the 'addConstraint' function. However, you--- will typically use the operators below to directly apply--- constraints to the model. We follow the same conventions as with--- our arithmetic operators.---- $lt------ We can summarize the various inquality operators in the following table.------ +-----------------+--------+--------+------------------+--- |                 |Constant|Variable|    Expression    |--- +-----------------+--------+--------+------------------+--- |Constant         |        | '#<=@' | '#<=.'           |--- +-----------------+--------+--------+------------------+--- |Variable         | '@<=#' | '@<=@' | '@<=.'           |--- +-----------------+--------+--------+------------------+--- |Expression       | '.<=#' | '.<=@' | '.<=.'           |--- +-----------------+--------+--------+------------------+---- $gt------ We can summarize the various inquality operators in the following table.+-- An @'Inequality' a@ is an inequality over the type @a@, which in+-- turn is typically an @'Expr' v@ for some variable type @v@. Despite+-- the name, 'Inequality' can also represent equality constraints+-- directly. ----- +-----------------+--------+--------+------------------+--- |                 |Constant|Variable|    Expression    |--- +-----------------+--------+--------+------------------+--- |Constant         |        | '#>=@' | '#>=.'           |--- +-----------------+--------+--------+------------------+--- |Variable         | '@>=#' | '@>=@' | '@>=.'           |--- +-----------------+--------+--------+------------------+--- |Expression       | '.>=#' | '.>=@' | '.>=.'           |--- +-----------------+--------+--------+------------------++-- As an alternative to constructing an inequality and passing it to+-- 'addConstraint', we can use the convenience operators below. Since+-- linear programming constraints often involve constant bounds, we+-- offer operators specialized for both expressions and constants. The+-- mnemonic is that @.@ characters point to expressions --- $eq------ We can summarize the various inquality operators in the following table.+-- $mathprograms ----- +-----------------+--------+--------+------------------+--- |                 |Constant|Variable|    Expression    |--- +-----------------+--------+--------+------------------+--- |Constant         |        | '#==@' | '#==.'           |--- +-----------------+--------+--------+------------------+--- |Variable         | '@==#' | '@==@' | '@==.'           |--- +-----------------+--------+--------+------------------+--- |Expression       | '.==#' | '.==@' | '.==.'           |--- +-----------------+--------+--------+------------------++-- The 'MonadLP' and 'MonadIP' classes provide low-level APIs for+-- defining linear and integer programs, respectively, although the+-- high-level DSL will typically be easier to work with.

@@ -1,42 +1,47 @@-module Math.Programming.Dsl where+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} -import           Data.Bifunctor-import           Data.List              (sortOn)+module Math.Programming.Dsl where -import           Math.Programming.Types+import Data.Functor+import qualified Data.Text as T+import Math.Programming.LinExpr+import Math.Programming.Types+import Text.Printf  -- | Create an objective to be minimized.-minimize :: LPMonad m => Expr m -> m (Objective m)+minimize :: MonadLP v c o m => Expr v -> m o minimize objectiveExpr = do   objective <- addObjective objectiveExpr   setObjectiveSense objective Minimization   pure objective  -- | Create an objective to be maximized.-maximize :: LPMonad m => Expr m -> m (Objective m)+maximize :: MonadLP v c o m => Expr v -> m o maximize objectiveExpr = do   objective <- addObjective objectiveExpr   setObjectiveSense objective Maximization   pure objective  -- | Get the value of a linear expression in the current solution.-evalExpr :: LPMonad m => Expr m -> m (Numeric m)-evalExpr expr = traverse getVariableValue expr >>= return . eval+evalExpr :: MonadLP v c o m => Expr v -> m Double+evalExpr expr = traverse getVariableValue expr <&> eval  -- | Create a new free variable.-free :: LPMonad m => m (Variable m)+free :: MonadLP v c o m => m v free = addVariable `within` Free  -- | Create a new non-negative variable.-nonNeg :: LPMonad m => m (Variable m)+nonNeg :: MonadLP v c o m => m v nonNeg = addVariable `within` NonNegativeReals  -- | Create a new non-positive variable.-nonPos :: LPMonad m => m (Variable m)+nonPos :: MonadLP v c o m => m v nonPos = addVariable `within` NonPositiveReals  -- | Create a new variable bounded between two values.-bounded :: LPMonad m => Numeric m -> Numeric m -> m (Variable m)+bounded :: MonadLP v c o m => Double -> Double -> m v bounded lo hi = within addVariable (Interval lo hi)  -- | Constrain a variable to take on certain values.@@ -44,28 +49,31 @@ -- This function is designed to be used as an infix operator, e.g. -- -- @--- 'addVariable' \``within`\` 'NonNegativeReals'+-- 'integer' \``within`\` 'Interval 3 7' -- @-within :: LPMonad m => m (Variable m) -> Bounds (Numeric m) -> m (Variable m)+--+-- creates an integer variable that can take on values 3, 4, 5, 6, or+-- 7.+within :: MonadLP v c o m => m v -> Bounds -> m v within makeVar bounds = do   variable <- makeVar   setVariableBounds variable bounds   pure variable  -- | Create an integer-valued variable.-integer :: IPMonad m => m (Variable m)-integer = addVariable `asKind` Integer+integer :: MonadIP v c o m => m v+integer = addVariable `asKind` Integer `within` Free  -- | Create a binary variable.-binary :: IPMonad m => m (Variable m)+binary :: MonadIP v c o m => m v binary = addVariable `asKind` Binary  -- | Create an integer-value variable that takes on non-negative values.-nonNegInteger :: IPMonad m => m (Variable m)+nonNegInteger :: MonadIP v c o m => m v nonNegInteger = addVariable `asKind` Integer `within` NonNegativeReals  -- | Create an integer-value variable that takes on non-positive values.-nonPosInteger :: IPMonad m => m (Variable m)+nonPosInteger :: MonadIP v c o m => m v nonPosInteger = addVariable `asKind` Integer `within` NonPositiveReals  -- | Set the type of a variable.@@ -73,202 +81,91 @@ -- This function is designed to be used as an infix operator, e.g. -- -- @--- 'addVariable' \``asKind`\` 'Binary'+-- 'free' \``asKind`\` 'Binary' -- @-asKind :: IPMonad m => m (Variable m) -> Domain -> m (Variable m)-asKind make domain = do+asKind :: MonadIP v c o m => m v -> Domain -> m v+asKind make dom = do   variable <- make-  setVariableDomain variable domain+  setVariableDomain variable dom   pure variable --- | Name a variable, constraint, or objective.------ This function is designed to be used as an infix operator, e.g.------ @--- 'free' \``named`\` "X_1"--- @-named :: (Monad m, Nameable m a) => m a -> String -> m a-named make name = do-  x <- make-  setName x name-  pure x+-- | A less-than or equal-to constraint+(.<=.) :: MonadLP v c o m => Expr v -> Expr v -> m c+(.<=.) x y = addConstraint $ Inequality LT x y --- | Retrieve the name of a variable, constraint, or objective.-nameOf :: (Monad m, Nameable m a) => a -> m String-nameOf = getName+-- | A less-than or equal-to constraint with a numeric left-hand side+(<=.) :: MonadLP v c o m => Double -> Expr v -> m c+(<=.) x y = con x .<=. y -(#+@) :: Num a => a                    -> b                    -> LinearExpression a b-(#+.) :: Num a => a                    -> LinearExpression a b -> LinearExpression a b-(@+#) :: Num a => b                    -> a                    -> LinearExpression a b-(@+@) :: Num a => b                    -> b                    -> LinearExpression a b-(@+.) :: Num a => b                    -> LinearExpression a b -> LinearExpression a b-(.+#) :: Num a => LinearExpression a b -> a                    -> LinearExpression a b-(.+@) :: Num a => LinearExpression a b -> b                    -> LinearExpression a b-(.+.) :: Num a => LinearExpression a b -> LinearExpression a b -> LinearExpression a b-(#-@) :: Num a => a                    -> b                    -> LinearExpression a b-(#-.) :: Num a => a                    -> LinearExpression a b -> LinearExpression a b-(@-#) :: Num a => b                    -> a                    -> LinearExpression a b-(@-@) :: Num a => b                    -> b                    -> LinearExpression a b-(@-.) :: Num a => b                    -> LinearExpression a b -> LinearExpression a b-(.-#) :: Num a => LinearExpression a b -> a                    -> LinearExpression a b-(.-@) :: Num a => LinearExpression a b -> b                    -> LinearExpression a b-(.-.) :: Num a => LinearExpression a b -> LinearExpression a b -> LinearExpression a b-(#*.) :: Num a => a                    -> LinearExpression a b -> LinearExpression a b-(.*#) :: Num a => LinearExpression a b -> a                    -> LinearExpression a b-(#*@) :: Num a => a                    -> b                    -> LinearExpression a b-(@*#) :: Num a => b                    -> a                    -> LinearExpression a b-(@/#) :: Fractional a => b -> a -> LinearExpression a b-(./#) :: Fractional a => LinearExpression a b -> a -> LinearExpression a b+-- | A less-than or equal-to constraint with a numeric right-hand side+(.<=) :: MonadLP v c o m => Expr v -> Double -> m c+(.<=) x y = x .<=. con y -x #+@ y = con x .+. var y-x #+. y = con x .+. y-x @+# y = var x .+. con y-x @+@ y = var x .+. var y-x @+. y = var x .+. y-x .+@ y = x     .+. var y-x .+# y = x     .+. con y-x .+. y = x     <>  y-x #-@ y = con x .-. var y-x #-. y = con x .-. y-x @-# y = var x .-. con y-x @-@ y = var x .-. var y-x @-. y = var x .-. y-x .-# y = x     .-. con y-x .-@ y = x     .-. var y-x .-. y = x     .+. (-1) #*. y-x #*@ y = var y .*# x-x #*. y = y     .*# x-x @*# y = var x .*# y-x .*# y = first (* y) x-x @/# y = var x ./# y-x ./# y = first (/ y) x+-- | A greater-than or equal-to constraint+(.>=.) :: MonadLP v c o m => Expr v -> Expr v -> m c+(.>=.) x y = addConstraint $ Inequality GT x y -infixl 6 #+@-infixl 6 #+.-infixl 6 @+#-infixl 6 @+@-infixl 6 @+.-infixl 6 .+#-infixl 6 .+@-infixl 6 .+.-infixl 6 #-@-infixl 6 #-.-infixl 6 @-#-infixl 6 @-@-infixl 6 @-.-infixl 6 .-#-infixl 6 .-@-infixl 6 .-.-infixl 7 #*@-infixl 7 #*.-infixl 7 @*#-infixl 7 .*#-infixl 7 @/#-infixl 7 ./#+-- | A greater-than or equal-to constraint with a numeric left-hand side+(>=.) :: MonadLP v c o m => Double -> Expr v -> m c+(>=.) x y = con x .>=. y --- | Combine equivalent terms by summing their coefficients.-simplify :: (Ord b, Num a) => LinearExpression a b -> LinearExpression a b-simplify (LinearExpression terms constant)-  = LinearExpression (reduce (sortOn snd terms)) constant-  where-    reduce []           = []-    reduce ((c, x): []) = [(c, x)]-    reduce ((c, x): (c', x'): xs)-      | x == x'   = (c + c', x) : reduce xs-      | otherwise = (c, x) : reduce ((c', x'): xs)+-- | A greater-than or equal-to constraint with a numeric right-hand side+(.>=) :: MonadLP v c o m => Expr v -> Double -> m c+(.>=) x y = x .>=. con y --- | Reduce an expression to its value.-eval :: Num a => LinearExpression a a -> a-eval (LinearExpression terms constant) = constant + sum (map (uncurry (*)) terms)+-- | An equality constraint+(.==.) :: MonadLP v c o m => Expr v -> Expr v -> m c+(.==.) x y = addConstraint $ Inequality EQ x y --- | Construct an expression representing a variable.-var :: Num a => b -> LinearExpression a b-var x = LinearExpression [(1, x)] 0+-- | An equality constraint with a numeric left-hand side+(==.) :: MonadLP v c o m => Double -> Expr v -> m c+(==.) x y = con x .==. y --- | Construct an expression representing a constant.-con :: Num a => a -> LinearExpression a b-con x = LinearExpression [] x+-- | An equality constraint with a numeric right-hand side+(.==) :: MonadLP v c o m => Expr v -> Double -> m c+(.==) x y = x .==. con y --- | Construct an expression by summing expressions.-exprSum :: Num a => [LinearExpression a b] -> LinearExpression a b-exprSum = mconcat+infix 4 <=. --- | Construct an expression by summing variables.-varSum :: Num a => [b] -> LinearExpression a b-varSum = mconcat . fmap var+infix 4 .<= -(#<=@) :: LPMonad m => Numeric m  -> Variable m -> m (Constraint m)-(#<=.) :: LPMonad m => Numeric m  -> Expr m     -> m (Constraint m)-(@<=#) :: LPMonad m => Variable m -> Numeric m  -> m (Constraint m)-(@<=@) :: LPMonad m => Variable m -> Variable m -> m (Constraint m)-(@<=.) :: LPMonad m => Variable m -> Expr m     -> m (Constraint m)-(.<=#) :: LPMonad m => Expr m     -> Numeric m  -> m (Constraint m)-(.<=@) :: LPMonad m => Expr m     -> Variable m -> m (Constraint m)-(.<=.) :: LPMonad m => Expr m     -> Expr m     -> m (Constraint m)-(#>=@) :: LPMonad m => Numeric m  -> Variable m -> m (Constraint m)-(#>=.) :: LPMonad m => Numeric m  -> Expr m     -> m (Constraint m)-(@>=#) :: LPMonad m => Variable m -> Numeric m  -> m (Constraint m)-(@>=@) :: LPMonad m => Variable m -> Variable m -> m (Constraint m)-(@>=.) :: LPMonad m => Variable m -> Expr m     -> m (Constraint m)-(.>=#) :: LPMonad m => Expr m     -> Numeric m  -> m (Constraint m)-(.>=@) :: LPMonad m => Expr m     -> Variable m -> m (Constraint m)-(.>=.) :: LPMonad m => Expr m     -> Expr m     -> m (Constraint m)-(#==@) :: LPMonad m => Numeric m  -> Variable m -> m (Constraint m)-(#==.) :: LPMonad m => Numeric m  -> Expr m     -> m (Constraint m)-(@==#) :: LPMonad m => Variable m -> Numeric m  -> m (Constraint m)-(@==@) :: LPMonad m => Variable m -> Variable m -> m (Constraint m)-(@==.) :: LPMonad m => Variable m -> Expr m     -> m (Constraint m)-(.==#) :: LPMonad m => Expr m     -> Numeric m  -> m (Constraint m)-(.==@) :: LPMonad m => Expr m     -> Variable m -> m (Constraint m)-(.==.) :: LPMonad m => Expr m     -> Expr m     -> m (Constraint m)+infix 4 .<=. -x #<=@ y = addConstraint $ Inequality LT (con x) (var y)-x #<=. y = addConstraint $ Inequality LT (con x) y-x @<=# y = addConstraint $ Inequality LT (var x) (con y)-x @<=@ y = addConstraint $ Inequality LT (var x) (var y)-x @<=. y = addConstraint $ Inequality LT (var x) y-x .<=# y = addConstraint $ Inequality LT x       (con y)-x .<=@ y = addConstraint $ Inequality LT x       (var y)-x .<=. y = addConstraint $ Inequality LT x       y-x #>=@ y = addConstraint $ Inequality GT (con x) (var y)-x #>=. y = addConstraint $ Inequality GT (con x) y-x @>=# y = addConstraint $ Inequality GT (var x) (con y)-x @>=@ y = addConstraint $ Inequality GT (var x) (var y)-x @>=. y = addConstraint $ Inequality GT (var x) y-x .>=# y = addConstraint $ Inequality GT x       (con y)-x .>=@ y = addConstraint $ Inequality GT x       (var y)-x .>=. y = addConstraint $ Inequality GT x       y-x #==@ y = addConstraint $ Inequality EQ (con x) (var y)-x #==. y = addConstraint $ Inequality EQ (con x) y-x @==# y = addConstraint $ Inequality EQ (var x) (con y)-x @==@ y = addConstraint $ Inequality EQ (var x) (var y)-x @==. y = addConstraint $ Inequality EQ (var x) y-x .==# y = addConstraint $ Inequality EQ x       (con y)-x .==@ y = addConstraint $ Inequality EQ x       (var y)-x .==. y = addConstraint $ Inequality EQ x       y+infix 4 >=. -infix 4 #<=@-infix 4 #<=.-infix 4 @<=#-infix 4 @<=@-infix 4 @<=.-infix 4 .<=#-infix 4 .<=@-infix 4 .<=.-infix 4 #>=@-infix 4 #>=.-infix 4 @>=#-infix 4 @>=@-infix 4 @>=.-infix 4 .>=#-infix 4 .>=@+infix 4 .>=+ infix 4 .>=.-infix 4 #==@-infix 4 #==.-infix 4 @==#-infix 4 @==@-infix 4 @==.-infix 4 .==#-infix 4 .==@++infix 4 ==.++infix 4 .==+ infix 4 .==.++formatExpr :: MonadLP v c o m => Expr v -> m T.Text+formatExpr = formatExpr' getVariableName++formatExpr' :: Monad m => (v -> m T.Text) -> Expr v -> m T.Text+formatExpr' nameOf (LinExpr terms coef) = do+  names <- mapM (traverse nameOf) terms+  let strTerms = fmap (T.pack . uncurry (printf "%f * %s")) names+  pure $ T.intercalate " + " (strTerms <> [T.pack (show coef)])++withVariableName :: MonadLP v c o m => m v -> T.Text -> m v+withVariableName mv name = do+  v <- mv+  setVariableName v name+  pure v++withConstraintName :: MonadLP v c o m => m c -> T.Text -> m c+withConstraintName mc name = do+  c <- mc+  setConstraintName c name+  pure c++withObjectiveName :: MonadLP v c o m => m o -> T.Text -> m o+withObjectiveName mo name = do+  o <- mo+  setObjectiveName o name+  pure o

@@ -0,0 +1,96 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE TupleSections #-}++-- | Linear expressions of variables.+module Math.Programming.LinExpr where++import Data.List (foldl', sortOn)++-- | A linear expression.+--+-- Linear expressions contain symbolic variables of type @b@ and+-- numeric coefficients of type @a@. Often @a@ will be 'Double', and+-- @b@ will be whatever variable type your linear program uses.+data LinExpr a b+  = LinExpr ![(a, b)] !a+  deriving (Eq, Read, Show, Functor, Foldable, Traversable)++instance Num a => Semigroup (LinExpr a b) where+  (<>) = (.+.)++instance Num a => Monoid (LinExpr a b) where+  mempty = con 0++-- | Construct a term in a linear expression by multiplying a constant+-- by a variable.+(*.) :: Num a => a -> b -> LinExpr a b+(*.) x y = LinExpr [(x, y)] 0++infixl 7 .*++-- | Construct a term in a linear expression by multiplying a variable+-- by a constant.+(.*) :: Num a => b -> a -> LinExpr a b+(.*) = flip (*.)++infixl 7 *.++-- | Construct a term in a linear expression by dividing a variable by+-- a constant.+(./) :: Fractional a => b -> a -> LinExpr a b+(./) x y = x .* (1 / y)++infixl 7 ./++-- | Multiplication of linear expressions by a constant.+scale :: Num a => a -> LinExpr a b -> LinExpr a b+scale coef (LinExpr terms constant) = LinExpr terms' constant'+  where+    terms' = [(c * coef, x) | (c, x) <- terms]+    constant' = constant * coef++-- | Addition of linear expressions.+(.+.) :: Num a => LinExpr a b -> LinExpr a b -> LinExpr a b+(.+.) (LinExpr terms constant) (LinExpr terms' constant') =+  LinExpr (terms <> terms') (constant + constant')++infixl 6 .+.++-- | The difference of linear expressions.+(.-.) :: Num a => LinExpr a b -> LinExpr a b -> LinExpr a b+(.-.) x y = x .+. scale (-1) y++infixl 6 .-.++-- | A linear expression with a single variable term.+var :: Num a => b -> LinExpr a b+var x = LinExpr [(1, x)] 0++-- | A linear expression with only a constant term.+con :: a -> LinExpr a b+con = LinExpr []++-- | The sum of variable terms with coefficients of unity.+vsum :: Num a => [b] -> LinExpr a b+vsum = flip LinExpr 0 . fmap (1,)++-- | The sum of linear expressions.+esum :: Num a => Foldable t => t (LinExpr a b) -> LinExpr a b+esum = foldl' (.+.) mempty++-- | Reduce an expression to its value.+eval :: Num a => LinExpr a a -> a+eval (LinExpr terms constant) = constant + sum' (map (uncurry (*)) terms)+  where+    sum' = foldl' (+) 0++-- | Simplify an expression by grouping like terms.+simplify :: (Num a, Ord b) => LinExpr a b -> LinExpr a b+simplify (LinExpr terms constant) =+  LinExpr (foldr f [] (sortOn snd terms)) constant+  where+    f (c, x) [] = [(c, x)]+    f (c, x) ((c', x') : xs) =+      if x == x'+        then (c + c', x) : xs+        else (c, x) : (c', x') : xs

@@ -1,178 +1,287 @@-{-# LANGUAGE FlexibleContexts       #-}-{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE TypeFamilies           #-}-module Math.Programming.Types where+{-# LANGUAGE UndecidableInstances #-} -import           Data.Bifunctor-import           Data.Traversable (fmapDefault, foldMapDefault)+-- | Data and class definitions for the core math programming+-- interface.+module Math.Programming.Types where --- | A convient shorthand for the type of linear expressions used in a--- given model.-type Expr m = LinearExpression (Numeric m) (Variable m)+import Control.Monad.Trans.Class+import Control.Monad.Trans.RWS+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State+import Control.Monad.Trans.Writer+import qualified Data.Text as T+import Math.Programming.LinExpr --- | A monad for formulating and solving linear programs.+-- | A linear program. ----- We manipulate linear programs and their settings using the--- 'Mutable' typeclass.-class (Monad m, Show (Numeric m), RealFrac (Numeric m)) => LPMonad m where-  -- | The numeric type used in the model.-  type Numeric m :: *--  -- | The type of variables in the model. 'LPMonad' treats these as-  -- opaque values, but instances may expose more details.-  data Variable m :: *--  -- | The type of constraints in the model. 'LPMonad' treats these-  -- as opaque values, but instances may expose more details.-  data Constraint m :: *--  -- | The type of objectives in the model. 'LPMonad' treats these-  -- as opaque values, but instances may expose more details.-  data Objective m :: *--  -- | Create a new decision variable in the model.+-- This is a monadic context for formulating and solving linear+-- programs. The types @v@, @c@, and @o@ refer to the types of+-- variables, constraints, and objectives, respectively, used by a+-- particular solver backend.+class Monad m => MonadLP v c o m | m -> v c o where+  -- | Add a new (free) variable to the model.   ---  -- This variable will be initialized to be a non-negative continuous-  -- variable.-  addVariable :: m (Variable m)+  -- See 'Math.Programming.Dsl.free', 'Math.Programming.Dsl.bounded',+  -- 'Math.Programming.Dsl.nonNeg', and 'Math.Programming.Dsl.nonPos'+  -- as higher-level alternatives.+  addVariable :: m v -  -- | Remove a decision variable from the model.-  ---  -- The variable cannot be used after being deleted.-  removeVariable :: Variable m -> m ()+  -- | Remove a variable from the model.+  deleteVariable :: v -> m () -  -- | Get the name of the variable.-  getVariableName :: Variable m -> m String+  -- | Get the name of a variable.+  getVariableName :: v -> m T.Text -  -- | Set the name of the variable.-  setVariableName :: Variable m -> String -> m ()+  -- | Set a name for a variable.+  setVariableName :: v -> T.Text -> m () -  -- | Get the allowed values of a variable.-  getVariableBounds :: Variable m -> m (Bounds (Numeric m))+  -- | Retrieve the current bounds associated with a variable.+  getVariableBounds :: v -> m Bounds -  -- | Constrain a variable to take on certain values.-  setVariableBounds :: Variable m -> Bounds (Numeric m) -> m ()+  -- | Apply bounds to a variable.+  --+  -- See 'Math.Programming.Dsl.within' as a higher-level alternative.+  setVariableBounds :: v -> Bounds -> m ()    -- | Get the value of a variable in the current solution.-  getVariableValue :: Variable m -> m (Numeric m)+  --+  -- This value could be arbitrary if no solve has been completed, or+  -- a solve produced an infeasible or unbounded solution.+  getVariableValue :: v -> m Double -  -- | Add a constraint to the model represented by an inequality.-  addConstraint :: Inequality (LinearExpression (Numeric m) (Variable m)) -> m (Constraint m)+  -- | Add a constraint representing the given inequality to the model.+  --+  -- See the 'Math.Programming.Dsl..==.', 'Math.Programming.Dsl..==#',+  -- 'Math.Programming.Dsl.==.', 'Math.Programming.Dsl..>=.',+  -- 'Math.Programming.Dsl..>=', 'Math.Programming.Dsl.>=.',+  -- 'Math.Programming.Dsl..<=.', 'Math.Programming.Dsl..<=', and+  -- 'Math.Programming.Dsl.<=.' functions as higher-level+  -- alternatives.+  addConstraint :: Inequality (Expr v) -> m c    -- | Remove a constraint from the model.-  ---  -- The constraint cannot used after being deleted.-  removeConstraint :: Constraint m -> m ()+  deleteConstraint :: c -> m () -  -- | Get the name of the constraint.-  getConstraintName :: Constraint m -> m String+  -- | Get the name of a constraint.+  getConstraintName :: c -> m T.Text -  -- | Set the name of the constraint.-  setConstraintName :: Constraint m -> String -> m ()+  -- | Set a name for a constraint.+  setConstraintName :: c -> T.Text -> m () -  -- | Get the value of the dual variable associated with the-  -- constraint in the current solution.+  -- | Get the dual value associated with a constraint.+  getConstraintValue :: c -> m Double++  -- | Add an objective to the problem.   ---  -- This value has no meaning if the current solution is not an LP-  -- solution.-  getDualValue :: Constraint m -> m (Numeric m)+  -- Depending on the solver backend, this might replace an existing objective.+  addObjective :: Expr v -> m o -  -- | Add a constraint to the model represented by an inequality.-  addObjective :: LinearExpression (Numeric m) (Variable m) -> m (Objective m)+  -- | Remove an objective from the model.+  deleteObjective :: o -> m () -  -- | Get the name of the objective.-  getObjectiveName :: Objective m -> m String+  -- | Get the name of a objective.+  getObjectiveName :: o -> m T.Text -  -- | Set the name of the objective.-  setObjectiveName :: Objective m -> String -> m ()+  -- | Set a name for a objective.+  setObjectiveName :: o -> T.Text -> m () -  -- | Whether the objective is to be minimized or maximized.-  getObjectiveSense :: Objective m -> m Sense+  -- | Get the sense of an objective.+  getObjectiveSense :: o -> m Sense -  -- | Set whether the objective is to be minimized or maximized.-  setObjectiveSense :: Objective m -> Sense -> m ()+  -- | Set the sense of an objective.+  setObjectiveSense :: o -> Sense -> m () -  -- | Get the value of the objective in the current solution.-  getObjectiveValue :: Objective m -> m (Numeric m)+  -- | Get the value of an objective.+  getObjectiveValue :: o -> m Double -  -- | Get the number of seconds the solver is allowed to run before-  -- halting.+  -- | Get the timeout associated with a problem.   getTimeout :: m Double -  -- | Set the number of seconds the solver is allowed to run before-  -- halting.+  -- | Set the timeout associated with a problem.   setTimeout :: Double -> m () -  -- | Optimize the continuous relaxation of the model.+  -- | Compute an LP-optimal solution.   optimizeLP :: m SolutionStatus +-- | Function composition involving a 2-argument function.+compose2 :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)+compose2 = fmap fmap fmap++-- | Monadic lifting  involving a 2-argument function.+lift2 :: (MonadTrans t, Monad m) => (a -> b -> m c) -> (a -> b -> t m c)+lift2 = compose2 lift++instance (MonadLP v c o m) => MonadLP v c o (ReaderT r m) where+  addVariable = lift addVariable+  deleteVariable = lift . deleteVariable+  getVariableName = lift . getVariableName+  setVariableName = lift2 setVariableName+  getVariableValue = lift . getVariableValue+  getVariableBounds = lift . getVariableBounds+  setVariableBounds = lift2 setVariableBounds+  addConstraint = lift . addConstraint+  deleteConstraint = lift . deleteConstraint+  getConstraintName = lift . getConstraintName+  setConstraintName = lift2 setConstraintName+  getConstraintValue = lift . getConstraintValue+  addObjective = lift . addObjective+  deleteObjective = lift . deleteObjective+  getObjectiveName = lift . getObjectiveName+  setObjectiveName = lift2 setObjectiveName+  getObjectiveValue = lift . getObjectiveValue+  getObjectiveSense = lift . getObjectiveSense+  setObjectiveSense = lift2 setObjectiveSense+  getTimeout = lift getTimeout+  setTimeout = lift . setTimeout+  optimizeLP = lift optimizeLP++instance (MonadLP v c o m, Monoid w) => MonadLP v c o (WriterT w m) where+  addVariable = lift addVariable+  deleteVariable = lift . deleteVariable+  getVariableName = lift . getVariableName+  setVariableName = lift2 setVariableName+  getVariableValue = lift . getVariableValue+  getVariableBounds = lift . getVariableBounds+  setVariableBounds = lift2 setVariableBounds+  addConstraint = lift . addConstraint+  deleteConstraint = lift . deleteConstraint+  getConstraintName = lift . getConstraintName+  setConstraintName = lift2 setConstraintName+  getConstraintValue = lift . getConstraintValue+  addObjective = lift . addObjective+  deleteObjective = lift . deleteObjective+  getObjectiveName = lift . getObjectiveName+  setObjectiveName = lift2 setObjectiveName+  getObjectiveValue = lift . getObjectiveValue+  getObjectiveSense = lift . getObjectiveSense+  setObjectiveSense = lift2 setObjectiveSense+  getTimeout = lift getTimeout+  setTimeout = lift . setTimeout+  optimizeLP = lift optimizeLP++instance (MonadLP v c o m, Monoid w) => MonadLP v c o (RWST r w s m) where+  addVariable = lift addVariable+  deleteVariable = lift . deleteVariable+  getVariableName = lift . getVariableName+  setVariableName = lift2 setVariableName+  getVariableValue = lift . getVariableValue+  getVariableBounds = lift . getVariableBounds+  setVariableBounds = lift2 setVariableBounds+  addConstraint = lift . addConstraint+  deleteConstraint = lift . deleteConstraint+  getConstraintName = lift . getConstraintName+  setConstraintName = lift2 setConstraintName+  getConstraintValue = lift . getConstraintValue+  addObjective = lift . addObjective+  deleteObjective = lift . deleteObjective+  getObjectiveName = lift . getObjectiveName+  setObjectiveName = lift2 setObjectiveName+  getObjectiveValue = lift . getObjectiveValue+  getObjectiveSense = lift . getObjectiveSense+  setObjectiveSense = lift2 setObjectiveSense+  getTimeout = lift getTimeout+  setTimeout = lift . setTimeout+  optimizeLP = lift optimizeLP++instance MonadLP v c o m => MonadLP v c o (StateT s m) where+  addVariable = lift addVariable+  deleteVariable = lift . deleteVariable+  getVariableValue = lift . getVariableValue+  getVariableName = lift . getVariableName+  setVariableName = lift2 setVariableName+  getVariableBounds = lift . getVariableBounds+  setVariableBounds = lift2 setVariableBounds+  addConstraint = lift . addConstraint+  deleteConstraint = lift . deleteConstraint+  getConstraintName = lift . getConstraintName+  setConstraintName = lift2 setConstraintName+  getConstraintValue = lift . getConstraintValue+  addObjective = lift . addObjective+  deleteObjective = lift . deleteObjective+  getObjectiveName = lift . getObjectiveName+  setObjectiveName = lift2 setObjectiveName+  getObjectiveValue = lift . getObjectiveValue+  getObjectiveSense = lift . getObjectiveSense+  setObjectiveSense = lift2 setObjectiveSense+  getTimeout = lift getTimeout+  setTimeout = lift . setTimeout+  optimizeLP = lift optimizeLP+ -- | A (mixed) integer program. ----- In addition to the methods of the 'LPMonad' class, this monad+-- In addition to the methods of the 'MonadLP' class, this monad -- supports constraining variables to be either continuous or -- discrete.-class ( LPMonad m-      ) => IPMonad m where-  -- | Optimize the mixed-integer program.-  optimizeIP :: m SolutionStatus+class MonadLP v c o m => MonadIP v c o m | m -> v c o where+  getVariableDomain :: v -> m Domain+  setVariableDomain :: v -> Domain -> m () -  -- | Get the domain of a variable.-  getVariableDomain :: Variable m -> m Domain+  getRelativeMIPGap :: m Double+  setRelativeMIPGap :: Double -> m () -  -- | Set the domain of a variable.-  setVariableDomain :: Variable m -> Domain -> m ()+  optimizeIP :: m SolutionStatus -  -- | Get the allowed relative gap between LP and IP solutions.-  getRelativeMIPGap :: m Double+instance MonadIP v c o m => MonadIP v c o (ReaderT r m) where+  getVariableDomain = lift . getVariableDomain+  setVariableDomain = lift2 setVariableDomain+  getRelativeMIPGap = lift getRelativeMIPGap+  setRelativeMIPGap = lift . setRelativeMIPGap+  optimizeIP = lift optimizeIP -  -- | Set the allowed relative gap between LP and IP solutions.-  setRelativeMIPGap :: Double -> m ()+instance MonadIP v c o m => MonadIP v c o (StateT s m) where+  getVariableDomain = lift . getVariableDomain+  setVariableDomain = lift2 setVariableDomain+  getRelativeMIPGap = lift getRelativeMIPGap+  setRelativeMIPGap = lift . setRelativeMIPGap+  optimizeIP = lift optimizeIP  -- | Whether a math program is minimizing or maximizing its objective. data Sense = Minimization | Maximization   deriving-    ( Eq-    , Ord-    , Read-    , Show+    ( Eq,+      Ord,+      Read,+      Show     )  -- | The outcome of an optimization. data SolutionStatus-  = Optimal-  -- ^ An optimal solution has been found.-  | Feasible-  -- ^ A feasible solution has been found. The result may or may not-  -- be optimal.-  | Infeasible-  -- ^ The model has been proven to be infeasible.-  | Unbounded-  -- ^ The model has been proven to be unbounded.-  | Error-  -- ^ An error was encountered during the solve. Instance-specific-  -- methods should be used to determine what occurred.+  = -- | An optimal solution has been found.+    Optimal+  | -- | A feasible solution has been found. The result may or may not+    -- be optimal.+    Feasible+  | -- | The model has been proven to be infeasible.+    Infeasible+  | -- | The model has been proven to be unbounded.+    Unbounded+  | -- | An error was encountered during the solve. Instance-specific+    -- methods should be used to determine what occurred.+    Error   deriving-    ( Eq-    , Ord-    , Read-    , Show+    ( Eq,+      Ord,+      Read,+      Show     )  -- | An interval of the real numbers.-data Bounds b-  = NonNegativeReals-  -- ^ The non-negative reals.-  | NonPositiveReals-  -- ^ The non-positive reals.-  | Interval b b-  -- ^ Any closed interval of the reals.-  | Free-  -- ^ Any real number.+data Bounds+  = -- | The non-negative reals.+    NonNegativeReals+  | -- | The non-positive reals.+    NonPositiveReals+  | -- | Any closed interval of the reals.+    Interval Double Double+  | -- | Any real number.+    Free   deriving-    ( Read-    , Show+    ( Read,+      Show     )  -- | The type of values that a variable can take on.@@ -182,89 +291,28 @@ -- of the same name. The ambiguity is unfortunate, but other natural -- nomenclature such as @Integral@ are similarly conflicted. data Domain-  = Continuous-  -- ^ The variable lies in the real numbers-  | Integer-  -- ^ The variable lies in the integers-  | Binary-  -- ^ The variable lies in the set @{0, 1}@.-  deriving-    ( Read-    , Show-    )--class Nameable m a where-  getName :: a -> m String-  setName :: a -> String -> m ()--instance LPMonad m => Nameable m (Variable m) where-  getName = getVariableName-  setName = setVariableName--instance LPMonad m => Nameable m (Constraint m) where-  getName = getConstraintName-  setName = setConstraintName--instance LPMonad m => Nameable m (Objective m) where-  getName = getObjectiveName-  setName = setObjectiveName---- | A linear expression containing symbolic variables of type @b@ and--- numeric coefficients of type @a@.------ Using 'String's to denote variables and 'Double's as our numeric--- type, we could express /3 x + 2 y + 1/ as------ @---   LinearExpression [(3, "x"), (2, "y")] 1--- @-data LinearExpression a b-  = LinearExpression [(a, b)] a+  = -- | The variable lies in the real numbers+    Continuous+  | -- | The variable lies in the integers+    Integer+  | -- | The variable lies in the set @{0, 1}@.+    Binary   deriving-    ( Read-    , Show+    ( Read,+      Show     ) --- | Implements addition of 'LinearExpression a b' terms-instance Num a => Semigroup (LinearExpression a b) where-  (LinearExpression termsLhs constantLhs) <> (LinearExpression termsRhs constantRhs)-    = LinearExpression (termsLhs <> termsRhs) (constantLhs + constantRhs)---- | Using '0' as the identity element-instance Num a => Monoid (LinearExpression a b) where-  mempty = LinearExpression [] 0--instance Functor (LinearExpression a) where-  fmap = fmapDefault--instance Bifunctor LinearExpression where-  first f (LinearExpression terms constant)-    = LinearExpression (fmap (first f) terms) (f constant)-  second f (LinearExpression terms constant)-    = LinearExpression (fmap (fmap f) terms) constant--instance Foldable (LinearExpression a) where-  foldMap = foldMapDefault---- | Useful for substituting values in a monadic/applicative context-instance Traversable (LinearExpression a) where-  traverse f (LinearExpression terms constant)-    = LinearExpression <$> traverse (traverse f) terms <*> pure constant- -- | Non-strict inequalities. data Inequality a   = Inequality Ordering a a   deriving-    ( Read-    , Show+    ( Read,+      Show,+      Functor,+      Foldable,+      Traversable     ) -instance Functor Inequality where-  fmap = fmapDefault--instance Foldable Inequality where-  foldMap = foldMapDefault--instance Traversable Inequality where-  traverse f (Inequality sense lhs rhs)-    = Inequality sense <$> f lhs <*> f rhs+-- | A convient shorthand for the type of linear expressions used in+-- models.+type Expr = LinExpr Double

@@ -1,10 +0,0 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --ignores="*~" #-}-{-|-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,21 @@+{-# LANGUAGE OverloadedStrings #-}++module Math.Programming.DslSpec where++import Control.Monad.Identity+import qualified Data.Text as T+import Math.Programming+import Math.Programming.Dsl+import Test.Hspec++spec :: Spec+spec = do+  describe "formatExpr" $ do+    it "formats expressions correctly" $ do+      let ex :: Expr T.Text+          ex = 2 *. "x" .+. 3 *. "y" .+. con 1+      formatExpr' pure ex `shouldBe` Identity "2.0 * x + 3.0 * y + 1.0"++      let ex2 :: Expr T.Text+          ex2 = con 0+      formatExpr' pure ex2 `shouldBe` Identity "0.0"

@@ -0,0 +1,87 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Programming.LinExprSpec where++import Control.Monad+import Data.Ratio+import Math.Programming+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck++spec :: Spec+spec = do+  describe "algebraic properties" $ do+    prop "satisfies addititive commutivity" commutativityProp+    prop "satisfies addititive associativity" additiveAssociativityProp+    prop "satisfies coefficient commutativity" coefficientCommutativityProp+  describe "simplification" $ do+    simplifyRegressions+    prop "simplification preserves value" simplifyProp++type ExactExpr = LinExpr (Ratio Integer) (Ratio Integer)++instance Arbitrary ExactExpr where+  arbitrary = LinExpr <$> arbitrary <*> arbitrary++-- | A pair of linear expressions, differing only by the ordering of+-- the summands.+newtype ShuffledAndUnshuffled+  = ShuffledAndUnshuffled (ExactExpr, ExactExpr)+  deriving+    ( Show+    )++instance Arbitrary ShuffledAndUnshuffled where+  arbitrary = do+    unshuffled@(LinExpr terms constant) <- arbitrary+    shuffledTerms <- shuffle terms+    let shuffled = LinExpr shuffledTerms constant+    return $ ShuffledAndUnshuffled (unshuffled, shuffled)++-- | Addition should be commutative.+commutativityProp :: ShuffledAndUnshuffled -> Bool+commutativityProp (ShuffledAndUnshuffled (shuffled, unshuffled)) =+  eval shuffled == eval unshuffled++-- | A pair of linear expressions, differing only by the ordering of+-- the coefficients of the summands.+newtype ShuffledCoefficients+  = ShuffledCoefficients (ExactExpr, ExactExpr)+  deriving+    ( Show+    )++instance Arbitrary ShuffledCoefficients where+  arbitrary = do+    unshuffled@(LinExpr terms constant) <- arbitrary+    terms' <- forM terms $ \(x, y) -> do+      flipped <- arbitrary+      return $+        if flipped+          then (y, x)+          else (x, y)+    let shuffled = LinExpr terms' constant+    return $ ShuffledCoefficients (shuffled, unshuffled)++coefficientCommutativityProp :: ShuffledCoefficients -> Bool+coefficientCommutativityProp (ShuffledCoefficients (shuffled, unshuffled)) =+  eval shuffled == eval unshuffled++additiveAssociativityProp :: ExactExpr -> ExactExpr -> ExactExpr -> Bool+additiveAssociativityProp x y z =+  eval ((x .+. y) .+. z) == eval (x .+. (y .+. z))++simplifyProp :: ExactExpr -> Bool+simplifyProp x = eval x == eval (simplify x)++simplifyRegressions :: Spec+simplifyRegressions = do+  it "simplifies x + x - x" $+    let terms :: [(Int, Int)]+        coef :: Int+        (LinExpr terms coef) = simplify $ LinExpr [(1, 0), (1, 0), (-1, 0)] 0+     in do+          coef `shouldBe` 0+          terms `shouldBe` [(1, 0)]

@@ -1,74 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances #-}-module Math.Programming.TestLinearExpression where--import           Control.Monad-import           Data.Ratio--import           Test.Tasty-import           Test.Tasty.QuickCheck--import           Math.Programming--test_tree :: TestTree-test_tree = testGroup "LinearExpression tests"-  [ testProperty "Additive commutativity" commutativityProp-  , testProperty "Additive associativity" additiveAssociativityProp-  , testProperty "Coefficient commutativity" coefficientCommutativityProp-  , testProperty "Simplification" simplifyProp-  ]--type ExactExpr = LinearExpression (Ratio Integer) (Ratio Integer)--instance Arbitrary ExactExpr where-  arbitrary = LinearExpression <$> arbitrary <*> arbitrary---- | A pair of linear expressions, differing only by the ordering of--- the summands.-newtype ShuffledAndUnshuffled-  = ShuffledAndUnshuffled (ExactExpr, ExactExpr)-  deriving-    ( Show-    )--instance Arbitrary ShuffledAndUnshuffled where-  arbitrary = do-    unshuffled@(LinearExpression terms constant) <- arbitrary-    shuffledTerms <- shuffle terms-    let shuffled = LinearExpression shuffledTerms constant-    return $ ShuffledAndUnshuffled (unshuffled, shuffled)---- | Addition should be commutative.-commutativityProp :: ShuffledAndUnshuffled -> Bool-commutativityProp (ShuffledAndUnshuffled (shuffled, unshuffled))-  = eval shuffled == eval unshuffled---- | A pair of linear expressions, differing only by the ordering of--- the coefficients of the summands.-newtype ShuffledCoefficients-  = ShuffledCoefficients (ExactExpr, ExactExpr)-  deriving-    ( Show-    )--instance Arbitrary ShuffledCoefficients where-  arbitrary = do-    unshuffled@(LinearExpression terms constant) <- arbitrary-    terms' <- forM terms $ \(x, y) -> do-      flipped <- arbitrary-      return $ if flipped-               then (y, x)-               else (x, y)-    let shuffled = LinearExpression terms' constant-    return $ ShuffledCoefficients (shuffled, unshuffled)--coefficientCommutativityProp :: ShuffledCoefficients -> Bool-coefficientCommutativityProp (ShuffledCoefficients (shuffled, unshuffled))-  = eval shuffled == eval unshuffled--additiveAssociativityProp :: ExactExpr -> ExactExpr -> ExactExpr -> Bool-additiveAssociativityProp x y z-  = eval ((x .+. y) .+. z) == eval (x .+. (y .+. z))--simplifyProp :: ExactExpr -> Bool-simplifyProp x = eval x == eval (simplify x)

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