diff options
| -rw-r--r-- | Math/LinProg/LPSolve.hs | 35 | ||||
| -rw-r--r-- | 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) |