glpk-hs 0.3.5 → 0.5

raw patch · 14 files changed

+85/−399 lines, 14 filesdep +gaspPVP ok

version bump matches the API change (PVP)

Dependencies added: gasp

API changes (from Hackage documentation)

Files

• Control/Monad/LPMonad/Internal.hs +15/−12
• Data/Algebra.hs +0/−35
• Data/Algebra/Field.hs +0/−24
• Data/Algebra/Group.hs +0/−102
• Data/Algebra/Module.hs +0/−109
• Data/Algebra/Ring.hs +0/−61
• Data/LinearProgram/Common.hs +2/−2
• Data/LinearProgram/GLPK/IO/Internal.hs +3/−3
• Data/LinearProgram/GLPK/Internal.hs +3/−3
• Data/LinearProgram/LinExpr.hs +16/−13
• Data/LinearProgram/Spec.hs +19/−15
• Data/LinearProgram/Types.hs +5/−1
• examples/example1.hs +19/−11
• glpk-hs.cabal +3/−8

@@ -44,6 +44,7 @@ --         newVariables'         ) where +import Prelude hiding ((-),(+)) import Control.Monad.State.Strict import Control.Monad.Identity @@ -51,7 +52,7 @@  import Data.LinearProgram.Common --- | A simple monad for constructing linear programs.  This library is intended to be able to link to +-- | A simple monad for constructing linear programs.  This library is intended to be able to link to -- a variety of different linear programming implementations. type LPM v c = LPT v c Identity @@ -92,13 +93,13 @@ {-# SPECIALIZE geq :: (Ord v, Group c) => LinFunc v c -> LinFunc v c -> LPM v c (),         (Ord v, Group c, Monad m) => LinFunc v c -> LinFunc v c -> LPT v c m () #-} -- | Specifies the relationship between two functions in the variables.  So, for example,--- +-- -- > equal (f ^+^ g) h--- +-- -- constrains the value of @h@ to be equal to the value of @f@ plus the value of @g@. equal, leq, geq :: (Ord v, Group c, MonadState (LP v c) m) => LinFunc v c -> LinFunc v c -> m ()-equal f g = equalTo (f ^-^ g) zero-leq f g = leqTo (f ^-^ g) zero+equal f g = equalTo (f - g) zero+leq f g = leqTo (f - g) zero geq = flip leq  {-# SPECIALIZE equal' :: (Ord v, Group c) => String -> LinFunc v c -> LinFunc v c -> LPM v c (),@@ -109,8 +110,8 @@         (Ord v, Group c, Monad m) => String -> LinFunc v c -> LinFunc v c -> LPT v c m () #-} -- | Specifies the relationship between two functions in the variables, with a label on the constraint. equal', leq', geq' :: (Ord v, Group c, MonadState (LP v c) m) => String -> LinFunc v c -> LinFunc v c -> m ()-equal' lab f g = equalTo' lab (f ^-^ g) zero-leq' lab f g = leqTo' lab (f ^-^ g) zero+equal' lab f g = equalTo' lab (f - g) zero+leq' lab f g = leqTo' lab (f - g) zero geq' = flip . leq'  {-# SPECIALIZE equalTo :: LinFunc v c -> c -> LPM v c (), Monad m => LinFunc v c -> c -> LPT v c m () #-}@@ -150,7 +151,7 @@ --                                 Nothing        -> return $ take k [toEnum 0..] --                                 Just ((start, _), _) --                                         -> return $ take k $ tail [start..]---                                         +-- -- {-# SPECIALIZE newVariables' :: (Ord v, Enum v) => LPM v c [v], --         (Ord v, Enum v, Monad m) => LPT v c m [v] #-} -- -- | Returns an infinite list of unused variables.  If the program is currently empty,@@ -218,13 +219,15 @@ -- | Adds this function to the objective function. addObjective :: (Ord v, Group c, MonadState (LP v c) m) => LinFunc v c -> m () addObjective obj = modify addObj where-        addObj lp@LP{..} = lp {objective = obj ^+^ objective}+        addObj lp@LP{..} = lp {objective = obj + objective} -{-# SPECIALIZE addWeightedObjective :: (Ord v, Module r c) => r -> LinFunc v c -> LPM v c (),-        (Ord v, Module r c, Monad m) => r -> LinFunc v c -> LPT v c m () #-}+{-# SPECIALIZE addWeightedObjective ::+        (Ord v, Ring c) => c -> LinFunc v c -> LPM v c (),+        (Ord v, Ring c, Monad m) => c -> LinFunc v c -> LPT v c m () #-} -- | Adds this function to the objective function, with the specified weight.  Equivalent to -- @'addObjective' (wt '*^' obj)@.-addWeightedObjective :: (Ord v, Module r c, MonadState (LP v c) m) => r -> LinFunc v c -> m ()+addWeightedObjective :: (Ord v, Ring c, MonadState (LP v c) m) =>+                        c -> LinFunc v c -> m () addWeightedObjective wt obj = addObjective (wt *^ obj)  {-# SPECIALIZE setVarBounds :: (Ord v, Ord c) => v -> Bounds c -> LPM v c (),

@@ -1,35 +0,0 @@--- | Common library for algebraic structures.  Has the advantage of automatically inferring lots of useful structure, especially--- in the writing of linear programs.  For example, here are several ways of writing @3 x - 4 y + z@:--- --- > gsum [3 *& x, (-4) *^ var y, var z]--- > linCombination [(3, x), (-4, y), (1, z)]--- > 3 *& x ^-^ 4 *& y ^+^ var z--- --- In addition, if we have two functions @f@ and @g@, we can construct linear combinations of those functions, using --- exactly the same syntax.  Moreover, we can multiply functions with 'Double' coefficients by 'Rational' values successfully.--- This module is intended to offer as much generality as possible without getting in your way.-module Data.Algebra (-	-- * Algebraic structures-	Group(..),-	Ring(..),-	Field(..),-	Module(..),-	VectorSpace(..),-	Poly,-	varPoly,-	GroupRing,-	LinFunc,-	-- * Algebraic functions-	gsum,-	combination,-	evalPoly,-	-- ** Specialized methods on linear functions-	var,-	varSum,-	(*&),-	linCombination) where--import Data.Algebra.Group-import Data.Algebra.Ring-import Data.Algebra.Field-import Data.Algebra.Module

@@ -1,24 +0,0 @@-{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses #-}--module Data.Algebra.Field where--import Data.Ratio--import Data.Algebra.Ring-import Data.Algebra.Module--class Ring f => Field f where-	inv :: f -> f-	(/#) :: f -> f -> f-	inv x = one /# x-	a /# b = a *# inv b--instance Field Double where-	inv = recip--instance Integral a => Field (Ratio a) where-	{-# SPECIALIZE instance Field Rational #-}-	inv = recip--class (Module f v, Field f) => VectorSpace f v-instance (Module f v, Field f) => VectorSpace f v

@@ -1,102 +0,0 @@-{-# LANGUAGE TypeSynonymInstances #-}-module Data.Algebra.Group where--import Control.Applicative-import qualified Data.Map as M-import qualified Data.IntMap as IM-import Data.Ratio--type Poly = []--infixr 4 ^+^-infixr 4 ^-^---- | The algebraic structure of a group.  Written additively.  Required functions: 'zero' and ('^-^' or ('^+^' and 'neg')).-class Group g where-	zero :: g-	(^+^) :: g -> g -> g-	(^-^) :: g -> g -> g-	neg :: g -> g-	-	a ^+^ b = a ^-^ neg b-	a ^-^ b = a ^+^ neg b-	neg a = zero ^-^ a--instance Group Bool where-	zero = False-	(^+^) = (/=)-	(^-^) = (/=)-	neg = id--instance Group Int where-	zero = 0-	(^+^) = (+)-	(^-^) = (-)-	neg = negate--instance Group Integer where-	zero = 0-	(^+^) = (+)-	(^-^) = (-)-	neg = negate--instance Group Double where-	zero = 0-	(^+^) = (+)-	(^-^) = (-)-	neg = negate--instance Integral a => Group (Ratio a) where-	{-# SPECIALIZE instance Group Rational #-}-	zero = 0-	(^+^) = (+)-	(^-^) = (-)-	neg = negate--instance Group g => Group (a -> g) where-	zero = const zero-	(^+^) = liftA2 (^+^)-	(^-^) = liftA2 (^-^)-	neg = fmap neg--instance (Ord k, Group g) => Group (M.Map k g) where-	zero = M.empty-	(^+^) = M.unionWith (^+^)-	neg = fmap neg--instance Group g => Group (IM.IntMap g) where-	zero = IM.empty-	(^+^) = IM.unionWith (^+^)-	neg = fmap neg--instance Group g => Group (Poly g) where-	zero = []-	[] ^+^ p = p-	p ^+^ [] = p-	(a:as) ^+^ (b:bs) = (a ^+^ b):(as ^+^ bs)--instance (Group g1, Group g2) => Group (g1, g2) where-	{-# SPECIALIZE instance Group g => Group (g, g) #-}-	zero = (zero, zero)-	(x1, y1) ^+^ (x2, y2) = (x1 ^+^ x2, y1 ^+^ y2)-	(x1, y1) ^-^ (x2, y2) = (x1 ^-^ x2, y1 ^-^ y2)-	neg (x, y) = (neg x, neg y)--instance (Group g1, Group g2, Group g3) => Group (g1, g2, g3) where-	{-# SPECIALIZE instance Group g => Group (g, g, g) #-}-	zero = (zero, zero, zero)-	(x1, y1, z1) ^+^ (x2, y2, z2) = (x1 ^+^ x2, y1 ^+^ y2, z1 ^+^ z2)-	(x1, y1, z1) ^-^ (x2, y2, z2) = (x1 ^-^ x2, y1 ^-^ y2, z1 ^-^ z2)-	neg (x, y, z) = (neg x, neg y, neg z)--instance (Group g1, Group g2, Group g3, Group g4) => Group (g1, g2, g3, g4) where-	{-# SPECIALIZE instance Group g => Group (g, g, g, g) #-}-	zero = (zero, zero, zero, zero)-	(x1, y1, z1, w1) ^+^ (x2, y2, z2, w2) = (x1 ^+^ x2, y1 ^+^ y2, z1 ^+^ z2, w1 ^+^ w2)-	(x1, y1, z1, w1) ^-^ (x2, y2, z2, w2) = (x1 ^-^ x2, y1 ^-^ y2, z1 ^-^ z2, w1 ^-^ w2)-	neg (x, y, z, w) = (neg x, neg y, neg z, neg w)--{-# INLINE gsum #-}--- | Does a summation over the elements of a group.-gsum :: Group g => [g] -> g-gsum = foldr (^+^) zero

@@ -1,109 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, IncoherentInstances, TypeSynonymInstances #-}--module Data.Algebra.Module where--import Data.Ratio-import qualified Data.Map as M-import qualified Data.IntMap as IM--import Data.Algebra.Group-import Data.Algebra.Ring---- | The algebraic structure of a module.  A vector space is a module with coefficients in a field.-class (Ring r, Group m) => Module r m where-	(*^) :: r -> m -> m--instance Module Int Int where-	(*^) = (*)--instance Module Integer Integer where-	(*^) = (*)--instance Module Int Integer where-	(*^) = (*) . fromIntegral--instance Integral a => Module Int (Ratio a) where-	{-# SPECIALIZE instance Module Int Rational #-}-	(*^) = (*) . fromIntegral--instance Integral a => Module Integer (Ratio a) where-	{-# SPECIALIZE instance Module Integer Rational #-}-	(*^) = (*) . fromIntegral--instance Integral a => Module (Ratio a) (Ratio a) where-	{-# SPECIALIZE instance Module Rational Rational #-}-	(*^) = (*)--instance Module Int Double where-	(*^) = (*) . fromIntegral--instance Module Integer Double where-	(*^) = (*) . fromIntegral--instance Integral a => Module (Ratio a) Double where-	{-# SPECIALIZE instance Module Rational Double #-}-	(*^) = (*) . realToFrac--instance Module Double Double where-	(*^) = (*)--instance (Ord g, Group g, Ring r) => Module (GroupRing r g) (GroupRing r g) where-	(*^) = (*#)--instance Module r m => Module r (a -> m) where-	(*^) = fmap . (*^)--instance (Ord k, Module r m) => Module r (M.Map k m) where-	(*^) = fmap . (*^)--instance Module r m => Module r (IM.IntMap m) where-	(*^) = fmap . (*^)--instance (Module r m1, Module r m2) => Module r (m1, m2) where-	{-# SPECIALIZE instance Module r m => Module r (m, m) #-}-	r *^ (a, b) = (r *^ a, r *^ b)--instance (Module r m1, Module r m2, Module r m3) => Module r (m1, m2, m3) where-	{-# SPECIALIZE instance Module r m => Module r (m, m, m) #-}-	r *^ (a, b, c) = (r *^ a, r *^ b, r *^ c)--instance (Module r m1, Module r m2, Module r m3, Module r m4) => Module r (m1, m2, m3, m4) where-	{-# SPECIALIZE instance Module r m => Module r (m, m, m, m) #-}-	r *^ (a, b, c, d) = (r *^ a, r *^ b, r *^ c, r *^ d)---- | @'LinFunc' v c@ is a linear combination of variables of type @v@ with coefficients--- from @c@.  Formally, this is the free @c@-module on @v@.  -type LinFunc = M.Map---- | Given a variable @v@, returns the function equivalent to @v@.-var :: (Ord v, Ring c) => v -> LinFunc v c-var v = M.singleton v one---- | @c '*&' v@ is equivalent to @c '*^' 'var' v@.-(*&) :: (Ord v, Ring c) => c -> v -> LinFunc v c-c *& v = M.singleton v c---- | Equivalent to @'vsum' . 'map' 'var'@.-varSum :: (Ord v, Ring c) => [v] -> LinFunc v c-varSum vs = M.fromList [(v, one) | v <- vs]---- | Given a collection of vectors and scaling coefficients, returns this--- linear combination.-combination :: Module r m => [(r, m)] -> m-combination xs = gsum [r *^ m | (r, m) <- xs]--{-# INLINE linCombination #-}--- | Given a set of basic variables and coefficients, returns the linear combination obtained--- by summing.-linCombination :: (Ord v, Num r) => [(r, v)] -> LinFunc v r-linCombination xs = M.fromListWith (+) [(v, r) | (r, v) <- xs]---- | Substitution into a polynomial.-evalPoly :: (Module r m, Ring m) => Poly r -> m -> m-evalPoly f x = foldr (\ c z -> (c *^ one) ^+^ (x *# z)) zero f--{-# RULES-	"zero/*^" forall m . zero *^ m = zero;-	"*^/zero" forall r . r *^ zero = zero;-	"one/*^" forall m . one *^ m = m;-	#-}

@@ -1,61 +0,0 @@-{-# LANGUAGE TypeSynonymInstances #-}-module Data.Algebra.Ring where--import Control.Applicative--import Data.Ratio-import qualified Data.Map as M--import Data.Algebra.Group--infixr 6 *#---- | A way of forming a ring from functions.  See <http://en.wikipedia.org/wiki/Group_ring>.-type GroupRing r g = M.Map g r---- | The algebraic structure of a unital ring.  Assumes that the additive operation forms an abelian group,--- that the multiplication operation forms a group, and that multiplication distributes.-class Group r => Ring r where-	one :: r-	(*#) :: r -> r -> r--instance Ring Bool where-	one = True-	(*#) = (&&)--instance Ring Int where-	one = 1-	(*#) = (*)--instance Ring Integer where-	one = 1-	(*#) = (*)--instance Ring Double where-	one = 1-	(*#) = (*)--instance Integral a => Ring (Ratio a) where-	{-# SPECIALIZE instance Ring Rational #-}-	one = 1-	(*#) = (*)---- | The polynomial ring.-instance Ring r => Ring (Poly r) where-	one = [one]-	(p:ps) *# (q:qs) = (p *# q):(ps *# (q:qs) ^+^ map (p *#) qs)-	_ *# _ = []---- | The function ring.-instance Ring r => Ring (a -> r) where-	one = const one-	(*#) = liftA2 (*#)---- | The group ring.-instance (Ord g, Group g, Ring r) => Ring (GroupRing r g) where-	one = M.singleton zero one-	m *# n = M.fromListWith (^+^) [(u ^+^ v, f *# g) | (u, f) <- M.assocs m, (v, g) <- M.assocs n]---- | Returns the polynomial @p(x) = x@.-varPoly :: Ring r => Poly r-varPoly = [zero, one]

@@ -2,11 +2,11 @@ -- linear programming libraries are made, this will be common to them all. module Data.LinearProgram.Common ( 	module Data.LinearProgram.Spec,-	module Data.Algebra,+	module Algebra.Classes, 	module Data.LinearProgram.Types) where  import Data.LinearProgram.Spec-import Data.Algebra+import Algebra.Classes import Data.LinearProgram.Types  import Data.Map

@@ -1,7 +1,7 @@ {-# LANGUAGE ForeignFunctionInterface #-}  module Data.LinearProgram.GLPK.IO.Internal (readGLPLP, writeGLPLP) where-+import Prelude hiding ((+)) import Control.Monad import Control.Monad.Trans (liftIO, lift) @@ -83,7 +83,7 @@ 		3	-> liftM UBound (ub i) 		4	-> liftM2 Bound (lb i) (ub i) 		_	-> liftM Equ (lb i)-		+ getObjCoef :: Int -> GLPK Double getObjCoef = getCDouble glpGetObjCoef @@ -118,7 +118,7 @@ 	sequence_ [do 		bds <- lift $ rowBounds i 		name <- lift $ getRowName i-		maybe constrain constrain' name +		maybe constrain constrain' name 			(linCombination [(v, names ! j) | (j, v) <- row]) bds 			| (i, row) <- rowContents] 	obj <- lift $ sequence [do

@@ -7,7 +7,7 @@ 	setObjCoef, setObjectiveDirection, setRowBounds, setRowName, solveSimplex) where-}  import Control.Monad-+import Prelude hiding ((+),(*)) import Foreign.Ptr import Foreign.C import Foreign.Marshal.Array@@ -36,7 +36,7 @@ foreign import ccall unsafe "c_glp_get_row_prim" glpGetRowPrim :: Ptr GlpProb -> CInt -> IO CDouble foreign import ccall unsafe "c_glp_get_col_prim" glpGetColPrim :: Ptr GlpProb -> CInt -> IO CDouble foreign import ccall unsafe "c_glp_set_col_kind" glpSetColKind :: Ptr GlpProb -> CInt -> CInt -> IO ()-foreign import ccall unsafe "c_glp_mip_solve" glpMipSolve :: +foreign import ccall unsafe "c_glp_mip_solve" glpMipSolve :: 	Ptr GlpProb -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CDouble -> CInt -> IO CInt foreign import ccall unsafe "c_glp_mip_obj_val" glpMIPObjVal :: Ptr GlpProb -> IO CDouble foreign import ccall unsafe "c_glp_mip_row_val" glpMIPRowVal :: Ptr GlpProb -> CInt -> IO CDouble@@ -78,7 +78,7 @@  {-# SPECIALIZE setMatRow :: Int -> [(Int, Double)] -> GLPK (), Int -> [(Int, Int)] -> GLPK () #-} setMatRow :: Real a => Int -> [(Int, a)] -> GLPK ()-setMatRow i row = GLP $ \ lp -> +setMatRow i row = GLP $ \ lp -> 	allocaArray (len+1) $ \ (ixs :: Ptr CInt) -> allocaArray (len+1) $ \ (coeffs :: Ptr CDouble) -> do 		pokeArray ixs (0:map (fromIntegral . fst) row) 		pokeArray coeffs (0:map (realToFrac . snd) row)

@@ -1,17 +1,16 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} module Data.LinearProgram.LinExpr (LinExpr(..), solve, substituteExpr, simplifyExpr, 	constTerm, coeffTerm, funcToExpr) where- import Control.Monad  import Data.LinearProgram.Types-import Data.Algebra+import Algebra.Classes import Data.Functor import Data.Foldable  import Data.Map -import Prelude hiding (lookup, filter, foldr)+import Prelude hiding (lookup, filter, foldr, Num(..), recip)  constTerm :: LinExpr v c -> c constTerm (LinExpr _ c) = c@@ -24,31 +23,35 @@  data LinExpr v c = LinExpr (LinFunc v c) c deriving (Eq, Read, Show) -instance (Ord v, Group c) => Group (LinExpr v c) where+instance (Ord v, Additive c) => Additive (LinExpr v c) where 	zero = LinExpr zero zero-	LinExpr a1 c1 ^+^ LinExpr a2 c2 = LinExpr (a1 ^+^ a2) (c1 ^+^ c2)-	LinExpr a1 c1 ^-^ LinExpr a2 c2 = LinExpr (a1 ^-^ a2) (c1 ^-^ c2)-	neg (LinExpr a c) = LinExpr (neg a) (neg c)+	LinExpr a1 c1 + LinExpr a2 c2 = LinExpr (a1 + a2) (c1 + c2) -instance (Ord v, Module r c) => Module r (LinExpr v c) where-	k *^ LinExpr a c = LinExpr (k *^ a) (k *^ c)+instance (Ord v, Group c) => Group (LinExpr v c) where+	LinExpr a1 c1 - LinExpr a2 c2 = LinExpr (a1 - a2) (c1 - c2)+	negate (LinExpr a c) = LinExpr (negate a) (negate c) +instance (Ord v,AbelianAdditive c) => AbelianAdditive (LinExpr v c)++instance (Ord v, Ring c) => Module c (LinExpr v c) where+	k *^ LinExpr a c = LinExpr (k *^ a) (k * c)+ substituteExpr :: (Ord v, Module c c) => v -> LinExpr v c -> LinExpr v c -> LinExpr v c substituteExpr v expV expr@(LinExpr a c) = case lookup v a of 	Nothing	-> expr-	Just k	-> LinExpr (delete v a) c ^+^ (k *^ expV)+	Just k	-> LinExpr (delete v a) c + (k *^ expV)  simplifyExpr :: (Ord v, Module c c) => LinExpr v c -> Map v (LinExpr v c) -> LinExpr v c simplifyExpr (LinExpr a c) sol =-	foldrWithKey (const (^+^)) (LinExpr (difference a sol) c) (intersectionWith (*^) a sol)+	foldrWithKey (const (+)) (LinExpr (difference a sol) c) (intersectionWith (*^) a sol)  solve :: (Ord v, Eq c, VectorSpace c c) => [(LinFunc v c, c)] -> Maybe (Map v (LinExpr v c))-solve equs = solve' [LinExpr a (neg c) | (a, c) <- equs]+solve equs = solve' [LinExpr a (negate c) | (a, c) <- equs]  solve' :: (Ord v, Eq c, VectorSpace c c) => [LinExpr v c] -> Maybe (Map v (LinExpr v c)) solve' (LinExpr a c:equs) = case minViewWithKey (filter (/= zero) a) of 	Nothing	-> guard (c == zero) >> solve' equs-	Just ((x, a0), a') -> let expX = neg (inv a0 *^ LinExpr a' c) in+	Just ((x, a0), a') -> let expX = negate (recip a0 *^ LinExpr a' c) in 		liftM (simplifyExpr expX >>= insert x) (solve' (substituteExpr x expX <$> equs)) solve' [] = return empty 

@@ -1,17 +1,18 @@ {-# LANGUAGE TupleSections, RecordWildCards, DeriveFunctor #-} module Data.LinearProgram.Spec (Constraint(..), VarTypes, ObjectiveFunc, VarBounds, LP(..),-        mapVars, mapVals, allVars) where+        mapVars, mapVals, allVars, linCombination) where +import Prelude hiding (negate, (+)) import Control.DeepSeq import Control.Monad- import Data.Char (isSpace) import Data.Map hiding (map, foldl)  import Text.ParserCombinators.ReadP -import Data.Algebra+import Algebra.Classes import Data.LinearProgram.Types+import qualified Data.Map as M  -- | Representation of a linear constraint on the variables, possibly labeled. -- The function may be bounded both above and below.@@ -30,6 +31,9 @@ data LP v c = LP {direction :: Direction, objective :: ObjectiveFunc v c, constraints :: [Constraint v c],                   varBounds :: VarBounds v c, varTypes :: VarTypes v} deriving (Read, Show, Functor) +linCombination :: (Ord v, Additive r) => [(r, v)] -> LinFunc v r+linCombination xs = M.fromListWith (+) [(v, r) | (r, v) <- xs]+ allVars :: Ord v => LP v c -> Map v () allVars LP{..} = foldl union ((() <$ objective) `union` (() <$ varBounds) `union` (() <$ varTypes))         [() <$ f | Constr _ f _ <- constraints]@@ -42,27 +46,27 @@         UBound x -> expr ++ " <= " ++ show x         Bound l u -> show l ++ " <= " ++ expr ++ " <= " ++ show u -showFunc :: (Show v, Num c, Ord c, Show c) => LinFunc v c -> String+showFunc :: (Show v, Ord c, Show c, Num c, Group c) => LinFunc v c -> String showFunc func = case assocs func of         []      -> "0"         ((v,c):vcs) ->-                show c ++ " " ++ map replaceSpace (show v) ++ +                show c ++ " " ++ map replaceSpace (show v) ++                         concatMap showTerm vcs         where   showTerm (v, c) = case compare c 0 of                         EQ      -> ""                         GT      -> " + " ++ show c ++ " " ++ show v                         LT      -> " - " ++ show (negate c) ++ " " ++ show v-                + replaceSpace :: Char -> Char replaceSpace c         | isSpace c     = '_'         | otherwise     = c -instance (Show v, Num c, Ord c, Show c) => Show (Constraint v c) where+instance (Show v, Ord c, Show c, Num c, Group c) => Show (Constraint v c) where         show (Constr lab func bds) = maybe "" (++ ": ") lab ++                 showBds (showFunc func) bds -instance (Read v, Ord v, Read c, Ord c, Num c) => Read (Constraint v c) where+instance (Read v, Ord v, Read c, Ord c, Num c, Group c) => Read (Constraint v c) where         readsPrec _= readP_to_S $ liftM toConstr (lab <++ nolab) where                 toConstr (l, f, bds) = Constr l (fromList f) bds                 lab = do        skipSpaces@@ -76,8 +80,8 @@                 readConst = readS_to_P reads                 readVar = readS_to_P reads -readCoef :: Num c => ReadP c -> ReadP c-readCoef readC = between skipSpaces skipSpaces $ +readCoef :: (Num c, Group c) => ReadP c -> ReadP c+readCoef readC = between skipSpaces skipSpaces $         (do     char '+'                 skipSpaces                 readC') <++@@ -121,7 +125,7 @@ -- | Applies the specified function to the variables in the linear program. -- If multiple variables in the original program are mapped to the same variable in the new program, -- in general, we set those variables to all be equal, as follows.--- +-- -- * In linear functions, including the objective function and the constraints, --      coefficients will be added together.  For instance, if @v1,v2@ are mapped to the same --      variable @v'@, then a linear function of the form @c1 *& v1 ^+^ c2 *& v2@ will be mapped to@@ -129,12 +133,12 @@ -- -- * In variable bounds, bounds will be combined.  An error will be thrown if the bounds --      are mutually contradictory.--- +-- -- * In variable kinds, the most restrictive kind will be retained. mapVars :: (Ord v', Ord c, Group c) => (v -> v') -> LP v c -> LP v' c-mapVars f LP{..} =  -        LP{objective = mapKeysWith (^+^) f objective, -                constraints = [Constr lab (mapKeysWith (^+^) f func) bd | Constr lab func bd <- constraints],+mapVars f LP{..} =+        LP{objective = mapKeysWith (+) f objective,+                constraints = [Constr lab (mapKeysWith (+) f func) bd | Constr lab func bd <- constraints],                 varBounds = mapKeysWith mappend f varBounds,                 varTypes = mapKeysWith mappend f varTypes, ..} 

@@ -1,9 +1,13 @@ {-# LANGUAGE DeriveFunctor, DeriveGeneric #-}-module Data.LinearProgram.Types (VarKind(..), Direction(..), Bounds(..)) where+module Data.LinearProgram.Types (LinFunc, VarKind(..), Direction(..), Bounds(..)) where  import Control.DeepSeq import Data.Monoid import GHC.Generics+import Data.Map++type LinFunc = Map+  data VarKind = ContVar | IntVar | BinVar deriving (Eq, Ord, Enum, Show, Read, Generic) 

@@ -1,21 +1,29 @@+import Prelude hiding (Num(..)) -import Data.LinearProgram.LPMonad+import Algebra.Classes+import Control.Monad.LPMonad+import Data.LinearProgram.Common import Data.LinearProgram import Data.LinearProgram.GLPK+import qualified Data.Map as M+import Data.LinearProgram.LinExpr  objFun :: LinFunc String Int objFun = linCombination [(10, "x1"), (6, "x2"), (4, "x3")] +n *& v = linCombination [(n,v)]+ lp :: LP String Int-lp = execLPM $ do	setDirection Max-			setObjective objFun-			leqTo (varSum ["x1", "x2", "x3"]) 100-			leqTo (10 *^ var "x1" ^+^ 4 *& "x2" ^+^ 5 *^ var "x3") 600-			leqTo (linCombination [(2, "x1"), (2, "x2"), (6, "x3")]) 300-			varGeq "x1" 0-			varBds "x2" 0 50-			varGeq "x3" 0-			setVarKind "x1" IntVar-			setVarKind "x2" ContVar+lp = execLPM $ do+  setDirection Max+  setObjective objFun+  leqTo (add $ map (1 *&) ["x1", "x2", "x3"]) 100+  leqTo (10 *& "x1" + 4 *& "x2" + 5 *& "x3") 600+  leqTo (linCombination [(2, "x1"), (2, "x2"), (6, "x3")]) 300+  varGeq "x1" 0+  varBds "x2" 0 50+  varGeq "x3" 0+  setVarKind "x1" IntVar+  setVarKind "x2" ContVar  main = print =<< glpSolveVars mipDefaults lp

@@ -1,5 +1,5 @@ Name:           glpk-hs-Version:        0.3.5+Version:        0.5 Author:         Louis Wasserman License:        BSD3 License-file:   LICENSE@@ -27,14 +27,13 @@   location: https://github.com/jyp/glpk-hs  library-  Build-Depends:    base >= 4 && < 5, array, containers, mtl, deepseq+  Build-Depends:    base >= 4 && < 5, array, containers, mtl, deepseq, gasp   Exposed-modules:  Data.LinearProgram,                     Data.LinearProgram.Common,                     Data.LinearProgram.LinExpr,                     Data.LinearProgram.GLPK,                     Data.LinearProgram.GLPK.Solver,                     Data.LinearProgram.GLPK.IO,-                    Data.Algebra,                     Control.Monad.LPMonad,                     Control.Monad.LPMonad.Supply,                     Control.Monad.LPMonad.Supply.Class@@ -44,10 +43,6 @@                     Data.LinearProgram.GLPK.IO.Internal,                     Control.Monad.LPMonad.Internal,                     Data.LinearProgram.Spec,-                    Data.LinearProgram.Types,-                    Data.Algebra.Group,-                    Data.Algebra.Ring,-                    Data.Algebra.Module,-                    Data.Algebra.Field+                    Data.LinearProgram.Types   c-sources:        glpk/glpk.c   extra-libraries:  glpk