aboutsummaryrefslogtreecommitdiff
path: root/Math/LinProg/LPSolve.hs
diff options
context:
space:
mode:
authorJustin Bedo <cu@cua0.org>2014-10-27 10:17:23 +1100
committerJustin Bedo <cu@cua0.org>2014-10-27 10:18:31 +1100
commit544eef53181f52423f513227e2bd98c20815b243 (patch)
tree5af4b35386c603b0fbbe5c7705a325d5f9b0d69b /Math/LinProg/LPSolve.hs
parente60c072870ee428720dce1f22890f1ce075325e4 (diff)
Improve computational complexity of varTerms by rewriting equations.
Diffstat (limited to 'Math/LinProg/LPSolve.hs')
-rw-r--r--Math/LinProg/LPSolve.hs36
1 files changed, 15 insertions, 21 deletions
diff --git a/Math/LinProg/LPSolve.hs b/Math/LinProg/LPSolve.hs
index 2031e0a..baa5d7e 100644
--- a/Math/LinProg/LPSolve.hs
+++ b/Math/LinProg/LPSolve.hs
@@ -26,10 +26,9 @@ import Math.LinProg.LPSolve.FFI hiding (solve)
import qualified Math.LinProg.LPSolve.FFI as F
import Math.LinProg.LP
import Math.LinProg.Types
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
import Prelude hiding (EQ)
--- | Solves an LP using lp_solve.
solve :: (Eq v, Ord v) => LinProg Double v () -> IO (Maybe ResultCode, [(v, Double)])
solve = solveWithTimeout 0
@@ -44,30 +43,25 @@ solveWithTimeout t (compile -> lp) = do
-- Eqs
forM_ (zip [1..] $ lp ^. equals) $ \(i, eq) ->
- forM_ (M.keys varLUT) $ \v -> do
- let w = getVar v $ fst eq
- c = negate $ snd eq
- when (w /= 0) $ do
- setMat m i (varLUT M.! v) w
- setConstrType m i EQ
- setRHS m i c
- return ()
+ forM_ (varTerms (fst eq)) $ \(v, w) -> do
+ let c = negate $ snd eq
+ setMat m i (varLUT M.! v) w
+ setConstrType m i EQ
+ setRHS m i c
+ return ()
-- Leqs
forM_ (zip [1+nequals..] $ lp ^. leqs) $ \(i, eq) ->
- forM_ (M.keys varLUT) $ \v -> do
- let w = getVar v $ fst eq
- c = negate $ snd eq
- when (w /= 0) $ do
- setMat m i (varLUT M.! v) w
- setConstrType m i LE
- setRHS m i c
- return ()
+ forM_ (varTerms (fst eq)) $ \(v, w) -> do
+ let c = negate $ snd eq
+ setMat m i (varLUT M.! v) w
+ setConstrType m i LE
+ setRHS m i c
+ return ()
-- Objective
- forM_ (M.keys varLUT) $ \v -> do
- let w = getVar v $ lp ^. objective
- when (w /= 0) $ void $ setMat m 0 (varLUT M.! v) w
+ forM_ (varTerms (lp ^. objective)) $ \(v, w) -> do
+ void $ setMat m 0 (varLUT M.! v) w
res <- F.solve m
sol <- snd <$> getSol nvars m