diff options
| author | Justin Bedo <cu@cua0.org> | 2014-11-01 10:18:31 +1100 |
|---|---|---|
| committer | Justin Bedo <cu@cua0.org> | 2014-11-01 10:18:31 +1100 |
| commit | aeafc1692afa5952f3d06195916bb38463c1674c (patch) | |
| tree | 8d0c0a3ddad35f4f5b85f4e53709e0cb8ba15385 /Math/LinProg/LPSolve | |
| parent | 946d8bcd81c1ea580032cd9f8140aad223b3156f (diff) | |
Benchmarking & optimisations
Diffstat (limited to 'Math/LinProg/LPSolve')
| -rw-r--r-- | Math/LinProg/LPSolve/FFI.hs | 13 | ||||
| -rw-r--r-- | Math/LinProg/LPSolve/bindings.c | 12 |
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; +} |