aboutsummaryrefslogtreecommitdiff
path: root/Math/LinProg/Compile.hs
diff options
context:
space:
mode:
authorJustin Bedo <cu@cua0.org>2014-10-07 10:55:00 +1100
committerJustin Bedo <cu@cua0.org>2014-10-07 10:58:27 +1100
commitfd68822fda2472f676d835d80d6b17668e52ee45 (patch)
tree77fceadc421e8b400e16741bf759bf52b2e1bffe /Math/LinProg/Compile.hs
parentf85bd4905301346d67224ccf5bfb00fb58a4deb9 (diff)
Added LPSolve as a solver
Diffstat (limited to 'Math/LinProg/Compile.hs')
-rw-r--r--Math/LinProg/Compile.hs40
1 files changed, 40 insertions, 0 deletions
diff --git a/Math/LinProg/Compile.hs b/Math/LinProg/Compile.hs
new file mode 100644
index 0000000..07398e7
--- /dev/null
+++ b/Math/LinProg/Compile.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE TemplateHaskell, FlexibleInstances, ScopedTypeVariables #-}
+
+module Math.LinProg.Compile (
+ compile
+ ,Equation
+ ,CompilerS(..)
+ ,objective
+ ,equals
+ ,leqs
+) where
+
+import Data.List
+import Math.LinProg.Types
+import Control.Lens
+import Control.Monad.State
+import Control.Monad.Free
+import Data.Maybe
+
+type Equation t v = (LinExpr t v, t) -- LHS and RHS
+
+data CompilerS t v = CompilerS {
+ _objective :: LinExpr t v
+ ,_equals :: [Equation t v]
+ ,_leqs :: [Equation t v]
+} deriving (Eq)
+
+$(makeLenses ''CompilerS)
+
+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
+ 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' _ state = state
+
+ initCompilerS = CompilerS
+ 0
+ []
+ []
+