aboutsummaryrefslogtreecommitdiff
path: root/Math/LinProg/LPSolve
diff options
context:
space:
mode:
Diffstat (limited to 'Math/LinProg/LPSolve')
-rw-r--r--Math/LinProg/LPSolve/FFI.hs13
-rw-r--r--Math/LinProg/LPSolve/bindings.c12
2 files changed, 24 insertions, 1 deletions
diff --git a/Math/LinProg/LPSolve/FFI.hs b/Math/LinProg/LPSolve/FFI.hs
index 64919b9..edf0a43 100644
--- a/Math/LinProg/LPSolve/FFI.hs
+++ b/Math/LinProg/LPSolve/FFI.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ForeignFunctionInterface, ViewPatterns #-}
module Math.LinProg.LPSolve.FFI (
ResultCode(..)
,ConstraintType(..)
@@ -9,6 +9,7 @@ module Math.LinProg.LPSolve.FFI (
,setBin
,makeLP
,freeLP
+ ,setRow
,setMat
,setRHS
,solve
@@ -58,6 +59,7 @@ 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 ()
+foreign import ccall "hs_set_row" c_hs_set_row :: LPRec -> CInt -> CInt -> Ptr CInt -> Ptr CDouble -> IO CChar
debugDump :: LPRec -> FilePath -> IO ()
debugDump lp path = withCString path $ \str -> c_print_debugdump lp str
@@ -82,6 +84,15 @@ freeLP m = with m $ \m' -> c_free_lp m'
setMat :: LPRec -> Int -> Int -> Double -> IO Word8
setMat a b c d = fromIntegral <$> c_set_mat a (fromIntegral b) (fromIntegral c) (realToFrac d)
+setRow :: LPRec -> Int -> [(Int, Double)] -> IO Word8
+setRow m row (unzip -> (cols, ws)) = fmap fromIntegral $ withArray (map fromIntegral cols) $ \c ->
+ withArray (map realToFrac ws) $ \w ->
+ c_hs_set_row m
+ (fromIntegral row)
+ (fromIntegral (length cols))
+ c
+ w
+
setRHS :: LPRec -> Int -> Double -> IO Word8
setRHS a b c = fromIntegral <$> c_set_rh a (fromIntegral b) (realToFrac c)
diff --git a/Math/LinProg/LPSolve/bindings.c b/Math/LinProg/LPSolve/bindings.c
new file mode 100644
index 0000000..fbaf09f
--- /dev/null
+++ b/Math/LinProg/LPSolve/bindings.c
@@ -0,0 +1,12 @@
+#include <lp_lib.h>
+
+char
+hs_set_row(void *model, int row, int n, int *cols, double *ws)
+{
+ int i;
+
+ for(i = 0; i < n; i++)
+ set_mat(model, row, cols[i], ws[i]);
+
+ return 0;
+}