From 946d8bcd81c1ea580032cd9f8140aad223b3156f Mon Sep 17 00:00:00 2001
From: Justin Bedo <cu@cua0.org>
Date: Thu, 30 Oct 2014 07:03:03 +1100
Subject: Bugfix: alignment of variables in solution was incorrect

---
 Math/LinProg/LPSolve.hs     | 35 ++++++++++++++++++-----------------
 Math/LinProg/LPSolve/FFI.hs |  5 +++++
 2 files changed, 23 insertions(+), 17 deletions(-)

diff --git a/Math/LinProg/LPSolve.hs b/Math/LinProg/LPSolve.hs
index 5299d94..427c5d7 100644
--- a/Math/LinProg/LPSolve.hs
+++ b/Math/LinProg/LPSolve.hs
@@ -43,38 +43,38 @@ solveWithTimeout t (compile -> lp) = do
         setTimeout m t
 
         -- Eqs
-        forM_ (zip [1..] $ lp ^. equals) $ \(i, eq) ->
-          forM_ (varTerms (fst eq)) $ \(v, w) -> do
-            let c = negate $ snd eq
+        forM_ (zip [1..] $ lp ^. equals) $ \(i, eq) -> do
+          let c = negate $ snd eq
+          setConstrType m i EQ
+          setRHS m i c
+          forM_ (varTerms (fst eq)) $ \(v, w) ->
             setMat m i (varLUT M.! v) w
-            setConstrType m i EQ
-            setRHS m i c
-            return ()
+          return ()
 
         -- Leqs
-        forM_ (zip [1+nequals..] $ lp ^. leqs) $ \(i, eq) ->
-          forM_ (varTerms (fst eq)) $ \(v, w) -> do
-            let c = negate $ snd eq
+        forM_ (zip [1+nequals..] $ lp ^. leqs) $ \(i, eq) -> do
+          let c = negate $ snd eq
+          setConstrType m i LE
+          setRHS m i c
+          forM_ (varTerms (fst eq)) $ \(v, w) ->
             setMat m i (varLUT M.! v) w
-            setConstrType m i LE
-            setRHS m i c
-            return ()
+          return ()
 
         -- Ints
-        forM_ (lp ^. ints) $ \v -> do
+        forM_ (lp ^. ints) $ \v ->
           setInt m (varLUT M.! v)
 
         -- Bins
-        forM_ (lp ^. bins) $ \v -> do
+        forM_ (lp ^. bins) $ \v ->
           setBin m (varLUT M.! v)
 
         -- Objective
-        forM_ (varTerms (lp ^. objective)) $ \(v, w) -> do
+        forM_ (varTerms (lp ^. objective)) $ \(v, w) ->
           void $ setMat m 0 (varLUT M.! v) w
 
         res <- F.solve m
         sol <- snd <$> getSol nvars m
-        let vars = zip (M.keys varLUT) sol
+        let vars = zip varList sol
         return (Just res, vars)
   where
     nconstr = length allConstr
@@ -82,7 +82,8 @@ solveWithTimeout t (compile -> lp) = do
     nequals = length (lp ^. equals)
 
     allConstr = (lp ^. equals) ++ (lp ^. leqs)
-    varLUT = M.fromList $ zip (sort $ nub $ concatMap (vars . fst) allConstr ++ vars (lp ^. objective)) [1..]
+    varList = nub $ concatMap (vars . fst) allConstr ++ vars (lp ^. objective)
+    varLUT = M.fromList $ zip varList [1..]
 
     with m f = do
       r <- f m
diff --git a/Math/LinProg/LPSolve/FFI.hs b/Math/LinProg/LPSolve/FFI.hs
index ff0bc16..64919b9 100644
--- a/Math/LinProg/LPSolve/FFI.hs
+++ b/Math/LinProg/LPSolve/FFI.hs
@@ -13,6 +13,7 @@ module Math.LinProg.LPSolve.FFI (
   ,setRHS
   ,solve
   ,getSol
+  ,debugDump
 ) where
 
 import Foreign
@@ -56,6 +57,10 @@ foreign import ccall "set_constr_type" c_set_constr_type :: LPRec -> CInt -> CIn
 foreign import ccall "set_timeout" c_set_timeout :: LPRec -> CLong -> IO ()
 foreign import ccall "set_int" c_set_int :: LPRec -> CInt -> CChar -> IO CChar
 foreign import ccall "set_binary" c_set_binary :: LPRec -> CInt -> CChar -> IO CChar
+foreign import ccall "print_debugdump" c_print_debugdump :: LPRec -> CString -> IO ()
+
+debugDump :: LPRec -> FilePath -> IO ()
+debugDump lp path = withCString path $ \str -> c_print_debugdump lp str
 
 setTimeout :: LPRec -> Integer -> IO ()
 setTimeout lp x = c_set_timeout lp (fromIntegral x)
-- 
cgit v1.2.3