diff options
author | Justin Bedo <cu@cua0.org> | 2014-10-23 13:47:53 +1100 |
---|---|---|
committer | Justin Bedo <cu@cua0.org> | 2014-10-23 13:49:09 +1100 |
commit | 2b2c0bfe78740fe4e228958054729e791e3733dd (patch) | |
tree | 1717077486406f76aec71acb2bc4eb6f802a2d9a | |
parent | 365afb5dca44d1ce19b30921aa9032e41d9c8e06 (diff) |
Added documentation.
-rw-r--r-- | Math/LinProg/LP.hs | 17 | ||||
-rw-r--r-- | Math/LinProg/LPSolve.hs | 13 | ||||
-rw-r--r-- | Math/LinProg/Types.hs | 58 | ||||
-rw-r--r-- | README.md | 38 |
4 files changed, 109 insertions, 17 deletions
diff --git a/Math/LinProg/LP.hs b/Math/LinProg/LP.hs index 5f9e168..1fc59e0 100644 --- a/Math/LinProg/LP.hs +++ b/Math/LinProg/LP.hs @@ -1,5 +1,18 @@ {-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables #-} +{-| +Module : Math.LinProg.LP +Description : Compiles LP monad and expressions to a intermediate form. +Copyright : (c) Justin Bedő, 2014 +License : BSD +Maintainer : cu@cua0.org +Stability : experimental +Linear programs that are specified using the monadic construction are compiled +to an intermediate data structure that's easier to work with. The compiled +state groups objective terms and splits (in)equality constraints into LHS and +RHS terms, with the LHS containing all variables and the RHS terms containing +fixed constants. +-} module Math.LinProg.LP ( compile ,Equation @@ -17,6 +30,7 @@ import Control.Monad.Free type Equation t v = (LinExpr t v, t) -- LHS and RHS +-- | Compiled state contatining the objective and (in)equality statements. data CompilerS t v = CompilerS { _objective :: LinExpr t v ,_equals :: [Equation t v] @@ -25,6 +39,7 @@ data CompilerS t v = CompilerS { $(makeLenses ''CompilerS) +-- | Compiles a linear programming monad to intermediate form which is easier to process compile :: (Num t, Show t, Ord t, Eq v) => LinProg t v () -> CompilerS t v compile ast = compile' ast initCompilerS where compile' (Free (Objective a c)) state = compile' c $ state & objective +~ a @@ -37,7 +52,7 @@ compile ast = compile' ast initCompilerS where [] [] --- Printing to LP format +-- | Shows a compiled state as LP format. Requires variable ids are strings. instance (Show t, Num t, Ord t) => Show (CompilerS t String) where show s = unlines $ catMaybes [ Just "Minimize" diff --git a/Math/LinProg/LPSolve.hs b/Math/LinProg/LPSolve.hs index 7b1f8ca..83a3f73 100644 --- a/Math/LinProg/LPSolve.hs +++ b/Math/LinProg/LPSolve.hs @@ -1,5 +1,17 @@ {-# LANGUAGE ViewPatterns #-} +{-| +Module : Math.LinProg.LPSolve +Description : Binding for solving LPs with lp_solve library. +Copyright : (c) Justin Bedő, 2014 +License : BSD +Maintainer : cu@cua0.org +Stability : experimental +This module allows finding the solution to an LP using the lp_solve library. +The LP is specified using the monad and expressions in Math.LinProg.Types. +Note that the objective is minimised by default, so negation is needed to +maximise instead. +-} module Math.LinProg.LPSolve ( solve ,ResultCode(..) @@ -16,6 +28,7 @@ import Math.LinProg.Types import qualified Data.Map as M import Prelude hiding (EQ) +-- | Solves an LP using lp_solve. solve :: (Eq v, Ord v) => LinProg Double v () -> IO (Either (Maybe ResultCode) [(v, Double)]) solve (compile -> lp) = do model <- makeLP nconstr nvars diff --git a/Math/LinProg/Types.hs b/Math/LinProg/Types.hs index 69da6bf..6fbad93 100644 --- a/Math/LinProg/Types.hs +++ b/Math/LinProg/Types.hs @@ -1,7 +1,20 @@ {-# LANGUAGE DeriveFunctor, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} - +{-| +Module : Math.LinProg.Types +Description : Base types for equations and optimisation monad +Copyright : (c) Justin Bedő, 2014 +License : BSD +Maintainer : cu@cua0.org +Stability : experimental + +This module defines the base types for representing equations and linear +programs. The linear program is created as a free monad, and equations as an +AST. Note that expressions are assumed to be linear expressions and hence +there is no explicit checking for higher order terms. +-} module Math.LinProg.Types ( LinExpr + ,LinExpr'(..) ,var ,vars ,varTerms @@ -13,14 +26,13 @@ module Math.LinProg.Types ( ,(<:) ,(=:) ,(>:) - ,eq - ,leq - ,geq ) where import Data.Functor.Foldable import Control.Monad.Free +-- | Base AST for expressions. Expressions have factors or type t and +-- variables referenced by ids of type v. data LinExpr' t v a = Lit t | Var v @@ -31,12 +43,12 @@ data LinExpr' t v a = type LinExpr t v = Fix (LinExpr' t v) +-- | Creates a new variable for reference in equations var = Fix . Var -instance Fractional t => Fractional (LinExpr t v) where - a / b = Fix (Mul a (1/b)) - fromRational a = Fix (Lit (fromRational a)) - +-- | For convient notation, expressions are declared as instances of num. +-- However, linear expressions cannot implement absolute value or sign +-- functions, hence these two remain undefined. instance Num t => Num (LinExpr t v) where a * b = Fix (Mul a b) a + b = Fix (Add a b) @@ -45,6 +57,12 @@ instance Num t => Num (LinExpr t v) where abs = undefined signum = undefined +-- | Linear expressions can also be instances of fractional. +instance Fractional t => Fractional (LinExpr t v) where + a / b = Fix (Mul a (1/b)) + fromRational a = Fix (Lit (fromRational a)) + +-- | Reduce a linear expression down to the constant factor. consts :: Num t => LinExpr t v -> t consts = cata consts' where consts' (Negate a) = negate a @@ -53,6 +71,7 @@ consts = cata consts' where consts' (Add a b) = a + b consts' (Mul a b) = a * b +-- | Gets the multiplier for a particular variable. getVar :: (Num t, Eq v) => v -> LinExpr t v -> t getVar id x = cata getVar' x - consts x where getVar' (Var x) | x == id = 1 @@ -62,6 +81,7 @@ getVar id x = cata getVar' x - consts x where getVar' (Mul a b) = a * b getVar' (Negate a) = negate a +-- | Gets all variables used in an equation. vars :: LinExpr t v -> [v] vars = cata vars' where vars' (Var x) = [x] @@ -70,6 +90,7 @@ vars = cata vars' where vars' (Negate a) = a vars' _ = [] +-- | Reduces an expression to the variable terms varTerms eq = go eq' where go [t] = t go (t:ts) = Fix (Add t (go ts)) @@ -79,6 +100,7 @@ varTerms eq = go eq' where vs = vars eq ws = map (`getVar` eq) vs +-- | Splits an expression into the variables and the constant term split :: (Num t, Eq v) => LinExpr t v -> (LinExpr t v, t) split eq = (varTerms eq, consts eq) @@ -89,8 +111,9 @@ prettyPrint = cata prettyPrint' where prettyPrint' (Add a b) = concat ["(", a, "+", b, ")"] prettyPrint' (Var x) = show x --- Monad for linear programs - +-- | Free monad for linear programs. The monad allows definition of the +-- objective function, equality constraints, and inequality constraints (≤ only +-- in the data type). data LinProg' t v a = Objective (LinExpr t v) a | EqConstraint (LinExpr t v) (LinExpr t v) a @@ -99,14 +122,17 @@ data LinProg' t v a = type LinProg t v = Free (LinProg' t v) +-- | Define a term in the objective function obj a = liftF (Objective a ()) -eq a b = liftF (EqConstraint a b ()) -leq a b = liftF (LeqConstraint a b ()) -geq b a = liftF (LeqConstraint a b ()) -a =: b = eq a b -a <: b = leq a b -a >: b = geq a b +-- | Define an equality constraint +a =: b = liftF (EqConstraint a b ()) + +-- | Define an inequality (less than equal) contraint +a <: b = liftF (LeqConstraint a b ()) +-- +-- | Define an inequality (greater than equal) contraint +b >: a = liftF (LeqConstraint a b ()) infix 4 =: infix 4 <: diff --git a/README.md b/README.md new file mode 100644 index 0000000..0d526e5 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +This library implements a simple eDSL for linear programming and a simple +wrapper around lp_solve (potentially other solvers can also be plugged in +easily). Here's how to solve the farmer example from the lp_solve +documentation: + +> Suppose a farmer has 75 acres on which to plant two crops: wheat and barley. +> To produce these crops, it costs the farmer (for seed, fertilizer, etc.) $120 +> per acre for the wheat and $210 per acre for the barley. The farmer has +> $15000 available for expenses. But after the harvest, the farmer must store +> the crops while awaiting favourable market conditions. The farmer has storage +> space for 4000 bushels. Each acre yields an average of 110 bushels of wheat +> or 30 bushels of barley. If the net profit per bushel of wheat (after all +> expenses have been subtracted) is $1.30 and for barley is $2.00, how should +> the farmer plant the 75 acres to maximize profit? + + import Control.Monad + import Math.LinProg.LPSolve + import Math.LinProg.Types + + data Crop = Wheat | Barley + deriving (Eq, Show, Ord) + + lp :: LinProg Double Crop () + lp = do + let vs@[w, b] = map var [Wheat, Barley] + obj $ negate $ 110 * 1.3 * w + 30 * 2 * b + 120 * w + 210 * b <: 15000 + 110 * w + 30 * b <: 4000 + w + b <: 75 + + main :: IO () + main = do + sol <- solve lp + print sol + +This outputs the solution: Right [(Wheat,21.875),(Barley,53.12499999999999)]. +Due to the monadic structure one can build up LPs using the usual monadic +controls such as mapM/forM etc, making it quite easy to specify constraints. |