packages feed

math-programming (empty) → 0.3.0

raw patch · 10 files changed

+1010/−0 lines, 10 filesdep +basedep +containersdep +math-programmingsetup-changed

Dependencies added: base, containers, math-programming, mtl, tasty, tasty-discover, tasty-hunit, tasty-quickcheck, text

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for math-programming++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Patrick Steele (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Patrick Steele nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,11 @@+# 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).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ math-programming.cabal view
@@ -0,0 +1,60 @@+cabal-version:      1.12+name:               math-programming+version:            0.3.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++source-repository head+    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+    ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall+    build-depends:+        base >=4.7 && <5,+        containers >=0.6.0.1 && <0.7,+        math-programming,+        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
+ src/Math/Programming.hs view
@@ -0,0 +1,273 @@+{-| 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>.+-}+module Math.Programming+  ( -- * Math programs+    -- $mathprograms++    -- ** Linear programs+    LPMonad (..)+  , Expr+  , Bounds (..)+  , SolutionStatus (..)+  , Sense (..)++    -- ** Integer programs+  , IPMonad (..)+  , Domain (..)++    -- * 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+  , (.-.)+  , (@-@)+  , (.-@)+  , (@-.)+  , (@-#)+  , (#-@)+  , (#-.)+  , (.-#)++    -- *** Multiplication+    -- $multiplication+  , (#*@)+  , (@*#)+  , (#*.)+  , (.*#)++    -- *** Division+    -- $division+  , (@/#)+  , (./#)++    -- ** Constraints+    -- $constraints+  , Inequality (..)++    -- *** Less-than constraints+    -- $lt+  , (#<=@)+  , (#<=.)+  , (@<=#)+  , (@<=@)+  , (@<=.)+  , (.<=#)+  , (.<=@)+  , (.<=.)++    -- *** Greater-than constraints+    -- $gt+  , (#>=@)+  , (#>=.)+  , (@>=#)+  , (@>=@)+  , (@>=.)+  , (.>=#)+  , (.>=@)+  , (.>=.)++  -- *** Equality constraints+  -- $eq+  , (#==@)+  , (#==.)+  , (@==#)+  , (@==@)+  , (@==.)+  , (.==#)+  , (.==@)+  , (.==.)++    -- ** Specifying objectives+  , minimize+  , maximize++    -- ** Utilities+  , evalExpr+  , named+  , nameOf+  ) where++import           Math.Programming.Dsl+import           Math.Programming.Types++-- $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.++-- $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.++-- $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.++-- $expressions+--+-- The module 'Math.Programming.LinearExpression' provides operators+-- to build up 'LinearExpression' objects using declared variables.++-- $addition+--+-- We can summarize the addition operators with the table+--+-- +-----------------+--------+--------+------------------++-- |                 |Constant|Variable|    Expression    |+-- +-----------------+--------+--------+------------------++-- |Constant         | '+'    | '#+@'  | '#+.'            |+-- +-----------------+--------+--------+------------------++-- |Variable         | '@+#'  | '@+@'  | '@+.'            |+-- +-----------------+--------+--------+------------------++-- |Expression       | '.+#'  | '.+@'  | '.+.'            |+-- +-----------------+--------+--------+------------------+++-- $subtraction+--+-- We can summarize the subtraction operators with the table+--+-- +-----------------+--------+--------+------------------++-- |                 |Constant|Variable|    Expression    |+-- +-----------------+--------+--------+------------------++-- |Constant         | '-'    | '#-@'  | '#-.'            |+-- +-----------------+--------+--------+------------------++-- |Variable         | '@-#'  | '@-@'  | '@-.'            |+-- +-----------------+--------+--------+------------------++-- |Expression       | '.-#'  | '.-@'  | '.-.'            |+-- +-----------------+--------+--------+------------------+++-- $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 '#*@'.++-- $division+--+-- We can summarize the multiplication operators with the table+--+-- +-----------------+--------+--------+------------------++-- |                 |Constant|Variable|    Expression    |+-- +-----------------+--------+--------+------------------++-- |Constant         | '/'    |        |                  |+-- +-----------------+--------+--------+------------------++-- |Variable         | '@/#'  |        |                  |+-- +-----------------+--------+--------+------------------++-- |Expression       | './#'  |        |                  |+-- +-----------------+--------+--------+------------------++--+-- 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 '@/#'.++-- $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.+--+-- +-----------------+--------+--------+------------------++-- |                 |Constant|Variable|    Expression    |+-- +-----------------+--------+--------+------------------++-- |Constant         |        | '#>=@' | '#>=.'           |+-- +-----------------+--------+--------+------------------++-- |Variable         | '@>=#' | '@>=@' | '@>=.'           |+-- +-----------------+--------+--------+------------------++-- |Expression       | '.>=#' | '.>=@' | '.>=.'           |+-- +-----------------+--------+--------+------------------+++-- $eq+--+-- We can summarize the various inquality operators in the following table.+--+-- +-----------------+--------+--------+------------------++-- |                 |Constant|Variable|    Expression    |+-- +-----------------+--------+--------+------------------++-- |Constant         |        | '#==@' | '#==.'           |+-- +-----------------+--------+--------+------------------++-- |Variable         | '@==#' | '@==@' | '@==.'           |+-- +-----------------+--------+--------+------------------++-- |Expression       | '.==#' | '.==@' | '.==.'           |+-- +-----------------+--------+--------+------------------+
+ src/Math/Programming/Dsl.hs view
@@ -0,0 +1,274 @@+module Math.Programming.Dsl where++import           Data.Bifunctor+import           Data.List              (sortOn)++import           Math.Programming.Types++-- | Create an objective to be minimized.+minimize :: LPMonad m => Expr m -> m (Objective m)+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 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++-- | Create a new free variable.+free :: LPMonad m => m (Variable m)+free = addVariable `within` Free++-- | Create a new non-negative variable.+nonNeg :: LPMonad m => m (Variable m)+nonNeg = addVariable `within` NonNegativeReals++-- | Create a new non-positive variable.+nonPos :: LPMonad m => m (Variable m)+nonPos = addVariable `within` NonPositiveReals++-- | Create a new variable bounded between two values.+bounded :: LPMonad m => Numeric m -> Numeric m -> m (Variable m)+bounded lo hi = within addVariable (Interval lo hi)++-- | Constrain a variable to take on certain values.+--+-- This function is designed to be used as an infix operator, e.g.+--+-- @+-- 'addVariable' \``within`\` 'NonNegativeReals'+-- @+within :: LPMonad m => m (Variable m) -> Bounds (Numeric m) -> m (Variable m)+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++-- | Create a binary variable.+binary :: IPMonad m => m (Variable m)+binary = addVariable `asKind` Binary++-- | Create an integer-value variable that takes on non-negative values.+nonNegInteger :: IPMonad m => m (Variable m)+nonNegInteger = addVariable `asKind` Integer `within` NonNegativeReals++-- | Create an integer-value variable that takes on non-positive values.+nonPosInteger :: IPMonad m => m (Variable m)+nonPosInteger = addVariable `asKind` Integer `within` NonPositiveReals++-- | Set the type of a variable.+--+-- This function is designed to be used as an infix operator, e.g.+--+-- @+-- 'addVariable' \``asKind`\` 'Binary'+-- @+asKind :: IPMonad m => m (Variable m) -> Domain -> m (Variable m)+asKind make domain = do+  variable <- make+  setVariableDomain variable domain+  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++-- | Retrieve the name of a variable, constraint, or objective.+nameOf :: (Monad m, Nameable m a) => a -> m String+nameOf = getName++(#+@) :: 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++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++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 ./#++-- | 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)++-- | Reduce an expression to its value.+eval :: Num a => LinearExpression a a -> a+eval (LinearExpression terms constant) = constant + sum (map (uncurry (*)) terms)++-- | Construct an expression representing a variable.+var :: Num a => b -> LinearExpression a b+var x = LinearExpression [(1, x)] 0++-- | Construct an expression representing a constant.+con :: Num a => a -> LinearExpression a b+con x = LinearExpression [] x++-- | Construct an expression by summing expressions.+exprSum :: Num a => [LinearExpression a b] -> LinearExpression a b+exprSum = mconcat++-- | Construct an expression by summing variables.+varSum :: Num a => [b] -> LinearExpression a b+varSum = mconcat . fmap var++(#<=@) :: 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)++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 .==.
+ src/Math/Programming/Types.hs view
@@ -0,0 +1,273 @@+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE TypeFamilies           #-}+module Math.Programming.Types where++import           Data.Bifunctor+import           Data.Traversable (fmapDefault, foldMapDefault)++-- | A convient shorthand for the type of linear expressions used in a+-- given model.+type Expr m = LinearExpression (Numeric m) (Variable m)++-- | A monad for formulating and solving linear programs.+--+-- We manipulate linear programs and their settings using the+-- 'Mutable' typeclass.+class (Monad m, Num (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 variable will be initialized to be a non-negative continuous+  -- variable.+  addVariable :: m (Variable m)++  -- | Remove a decision variable from the model.+  --+  -- The variable cannot be used after being deleted.+  removeVariable :: Variable m -> m ()++  -- | Get the name of the variable.+  getVariableName :: Variable m -> m String++  -- | Set the name of the variable.+  setVariableName :: Variable m -> String -> m ()++  -- | Get the allowed values of a variable.+  getVariableBounds :: Variable m -> m (Bounds (Numeric m))++  -- | Constrain a variable to take on certain values.+  setVariableBounds :: Variable m -> Bounds (Numeric m) -> m ()++  -- | Get the value of a variable in the current solution.+  getVariableValue :: Variable m -> m (Numeric m)++  -- | Add a constraint to the model represented by an inequality.+  addConstraint :: Inequality (LinearExpression (Numeric m) (Variable m)) -> m (Constraint m)++  -- | Remove a constraint from the model.+  --+  -- The constraint cannot used after being deleted.+  removeConstraint :: Constraint m -> m ()++  -- | Get the name of the constraint.+  getConstraintName :: Constraint m -> m String++  -- | Set the name of the constraint.+  setConstraintName :: Constraint m -> String -> m ()++  -- | Get the value of the dual variable associated with the+  -- constraint in the current solution.+  --+  -- This value has no meaning if the current solution is not an LP+  -- solution.+  getDualValue :: Constraint m -> m (Numeric m)++  -- | Add a constraint to the model represented by an inequality.+  addObjective :: LinearExpression (Numeric m) (Variable m) -> m (Objective m)++  -- | Get the name of the objective.+  getObjectiveName :: Objective m -> m String++  -- | Set the name of the objective.+  setObjectiveName :: Objective m -> String -> m ()++  -- | Whether the objective is to be minimized or maximized.+  getObjectiveSense :: Objective m -> m Sense++  -- | Set whether the objective is to be minimized or maximized.+  setObjectiveSense :: Objective m -> Sense -> m ()++  -- | Get the value of the objective in the current solution.+  getObjectiveValue :: Objective m -> m (Numeric m)++  -- | Get the number of seconds the solver is allowed to run before+  -- halting.+  getTimeout :: m Double++  -- | Set the number of seconds the solver is allowed to run before+  -- halting.+  setTimeout :: Double -> m ()++  -- | Optimize the continuous relaxation of the model.+  optimizeLP :: m SolutionStatus++  -- | Write out the formulation.+  writeFormulation :: FilePath -> m ()++-- | A (mixed) integer program.+--+-- In addition to the methods of the 'LPMonad' 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++  -- | Get the domain of a variable.+  getVariableDomain :: Variable m -> m Domain++  -- | Set the domain of a variable.+  setVariableDomain :: Variable m -> Domain -> m ()++  -- | Get the allowed relative gap between LP and IP solutions.+  getRelativeMIPGap :: m Double++  -- | Set the allowed relative gap between LP and IP solutions.+  setRelativeMIPGap :: Double -> m ()++-- | Whether a math program is minimizing or maximizing its objective.+data Sense = Minimization | Maximization+  deriving+    ( 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.+  deriving+    ( 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.+  deriving+    ( Read+    , Show+    )++-- | The type of values that a variable can take on.+--+-- Note that the @Integer@ constructor does not interfere with the+-- @Integer@ type, as the @Integer@ type does not define a constuctor+-- 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+  deriving+    ( 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+    )++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
+ test/Driver.hs view
@@ -0,0 +1,10 @@+{-# 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
+ test/Math/Programming/TestLinearExpression.hs view
@@ -0,0 +1,74 @@+{-# 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)