From d68fb49cad1a5bba7e52c7ff464d15c867052d0f Mon Sep 17 00:00:00 2001
From: Justin Bedo <cu@cua0.org>
Date: Tue, 28 Oct 2014 10:19:49 +1100
Subject: Add support for binary/integer contraints; Change to hash maps to
 speed up variable LUT for large number of variables.

---
 Math/LinProg/LP.hs | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

(limited to 'Math/LinProg/LP.hs')

diff --git a/Math/LinProg/LP.hs b/Math/LinProg/LP.hs
index 18d2068..d1a1cf1 100644
--- a/Math/LinProg/LP.hs
+++ b/Math/LinProg/LP.hs
@@ -20,6 +20,8 @@ module Math.LinProg.LP (
   ,objective
   ,equals
   ,leqs
+  ,ints
+  ,bins
 ) where
 
 import Data.List
@@ -35,6 +37,8 @@ data CompilerS t v = CompilerS {
   _objective :: LinExpr t v
   ,_equals :: [Equation t v]
   ,_leqs :: [Equation t v]
+  ,_bins :: [v]
+  ,_ints :: [v]
 } deriving (Eq)
 
 $(makeLenses ''CompilerS)
@@ -45,12 +49,16 @@ compile ast = compile' ast initCompilerS where
   compile' (Free (Objective a c)) state = compile' c $ state & objective +~ a
   compile' (Free (EqConstraint a b c)) state = compile' c $ state & equals %~ (split (a-b):)
   compile' (Free (LeqConstraint a b c)) state = compile' c $ state & leqs %~ (split (a-b):)
+  compile' (Free (Integer a b)) state = compile' b $ state & ints %~ (a:)
+  compile' (Free (Binary a b)) state = compile' b $ state & bins %~ (a:)
   compile' _ state = state
 
   initCompilerS = CompilerS
     0
     []
     []
+    []
+    []
 
 -- | Shows a compiled state as LP format.  Requires variable ids are strings.
 instance (Show t, Num t, Ord t) => Show (CompilerS t String) where
@@ -62,6 +70,10 @@ instance (Show t, Num t, Ord t) => Show (CompilerS t String) where
       ,if hasUnbounded then Just (intercalate "\n" $ map (\(a, b) -> showEq a ++ " <= " ++ show (negate b)) unbounded) else Nothing
       ,if hasBounded then Just "Bounds" else Nothing
       ,if hasBounded then Just (intercalate "\n" $ map (\(l, v, u) -> show l ++ " <= " ++ v ++ " <= " ++ show u) bounded) else Nothing
+      ,if hasInts then Just "General" else Nothing
+      ,if hasInts then Just (unwords $ s ^. ints) else Nothing
+      ,if hasBins then Just "Binary" else Nothing
+      ,if hasBins then Just (unwords $ s ^. bins) else Nothing
     ]
     where
       showEq = unwords . map (\(a, b) -> render b ++ " " ++ a) . varTerms
@@ -71,6 +83,8 @@ instance (Show t, Num t, Ord t) => Show (CompilerS t String) where
       hasUnbounded = not (null unbounded)
       hasEqs = not (null (s^.equals))
       hasST = hasUnbounded || hasEqs
+      hasInts = not . null $ s ^. ints
+      hasBins = not . null $ s ^. bins
 
       render x = (if x >= 0 then "+" else "") ++ show x
 
-- 
cgit v1.2.3