limp-cbc 0.3.2.1 → 0.3.2.2
raw patch · 10 files changed
+124/−268 lines, 10 filesdep +QuickCheckdep +tastydep +tasty-quickcheckdep ~basedep ~limpdep ~vector
Dependencies added: QuickCheck, tasty, tasty-quickcheck
Dependency ranges changed: base, limp, vector
Files
- cbits/Cbc.cpp +2/−2
- examples/Base.hs +0/−36
- examples/Clustering.hs +0/−114
- examples/Infeasible.hs +0/−21
- examples/Simple.hs +0/−59
- examples/Stupid.hs +0/−19
- limp-cbc.cabal +15/−12
- src/Numeric/Limp/Solvers/Cbc/Error.hs +1/−1
- src/Numeric/Limp/Solvers/Cbc/Internal/Foreign.chs +5/−4
- test/Main.hs +101/−0
cbits/Cbc.cpp view
@@ -1,5 +1,5 @@-#include <coin/CbcModel.hpp>-#include <coin/OsiClpSolverInterface.hpp>+#include <CbcModel.hpp>+#include <OsiClpSolverInterface.hpp> #define FROM_CPP #include "Cbc.h"
− examples/Base.hs
@@ -1,36 +0,0 @@-module Base where--import Numeric.Limp.Rep-import Numeric.Limp.Program-import Numeric.Limp.Solvers.Cbc--data V0--deriving instance Ord V0-deriving instance Eq V0-deriving instance Show V0--data V2 = A | B- deriving (Ord, Eq, Show)---solve_problem :: (Show z, Show r, Ord z, Ord r) => (Direction -> Program z r IntDouble) -> IO ()-solve_problem problem- = do let a1 = solve $ problem Minimise- putStrLn "*** Minimise *** "- show_result a1-- let a2 = solve $ problem Maximise- putStrLn "*** Maximise *** "- show_result a2--show_result :: (Show z, Show r, Ord z, Ord r) => Either Error (Assignment z r IntDouble) -> IO ()-show_result as- = case as of- Left e- -> do putStrLn "Error:"- print e- Right a- -> do putStrLn "Success:"- print a-
− examples/Clustering.hs
@@ -1,114 +0,0 @@--- Example program based on one generated by our fusion/clustering algorithm------ sum1 = fold (+) 0 xs--- nor1 = map (/ sum1) xs--- ys = filter (> 0) xs--- sum2 = fold (+) 0 ys--- nor2 = map (/ sum2) xs-----module Clustering (clustering) where--import Base-import Numeric.Limp.Rep-import Numeric.Limp.Program--import qualified Numeric.Limp.Canon as C-import qualified Numeric.Limp.Canon.Pretty as C---- | One for each combinator-data Node- = Sum1 | Nor1 | Ys | Sum2 | Nor2- deriving (Ord, Eq, Show)---- | The integer variables:--- forall a b. 0 <= F a b <= 1 :: Z--- F a b == 0 iff a and b are fused-data VZ- = F Node Node- deriving (Ord, Eq, Show)---- | The real variables:--- forall a b. F a b == 0 ==> O a == O b--- O a > O b if edge from a to b-data VR- = O Node- deriving (Ord, Eq, Show)---problem1 :: Direction -> Program VZ VR IntDouble-problem1 dir- = program dir- objective- constraints- bounds----Minimise 5f(sum1, ys) + 1f(sum1, sum2)--- + 5f(sum1, nor2) + 5f(ys, sum2)--- + 5f(ys, nor1) + 5f(sum2, nor1)--- + 5f(nor1, nor2)-objective- = f100 Sum1 Ys .+. f1 Sum1 Sum2- .+. f100 Sum1 Nor2 .+. f100 Ys Sum2- .+. f100 Ys Nor1 .+. f1 Sum2 Nor1- .+. f100 Nor1 Nor2----Subject to --- f(sum1, ys) ≤ f(sum1, sum2)--- f(sum2, ys) ≤ f(sum1, sum2)--- -5f(sum1, ys) ≤ o(ys) - o(sum1) ≤ 5f(sum1, ys)--- -5f(sum1, sum2) ≤ o(sum2) - o(sum1) ≤ 5f(sum1, sum2)--- 1f(ys, sum2) ≤ o(sum2) - o(ys) ≤ 5f(ys, sum2)--- -5f(nor1, nor2) ≤ o(nor2) - o(nor1) ≤ 5f(nor1, nor2)--- o(sum1) < o(nor1)--- o(sum2) < o(nor2)----constraints- = filt Sum1 Sum2 Ys- :&& filt Sum2 Nor1 Ys- :&& odiff (-5) Sum1 Ys 5- :&& odiff (-5) Sum1 Sum2 5- :&& odiff 1 Ys Sum2 5- :&& odiff (-5) Ys Nor1 5- :&& odiff (-5) Nor1 Nor2 5- :&& odiff (-5) Sum1 Nor2 5- :&& odiff (-5) Sum2 Nor1 5- :&& o Sum1 `lt` o Nor1- :&& o Sum2 `lt` o Nor2- where-- o = r1 . O-- lt a b = a .+. c1 :<= b-- filt a b c- = f1 a c :<= f1 a b- :&& f1 b c :<= f1 a b-- odiff p a b q- = Between (p *. f1 a b) (o b .-. o a) (q *. f1 a b)--bounds- = [ binary $ F Sum1 Sum2- , binary $ F Sum1 Ys- , binary $ F Sum1 Nor2- , binary $ F Ys Sum2- , binary $ F Nor1 Ys- , binary $ F Nor1 Sum2- , binary $ F Nor1 Nor2- ]--f100 :: Node -> Node -> Linear VZ VR IntDouble KZ-f100 a b- = 100 *. f1 a b--f1 :: Node -> Node -> Linear VZ VR IntDouble KZ-f1 a b- = z1 $ F (min a b) (max a b)---clustering :: IO ()-clustering- = do solve_problem problem1- putStr (show $ C.program $ problem1 Minimise)-
− examples/Infeasible.hs
@@ -1,21 +0,0 @@-module Infeasible (infeasible) where--import Base-import Numeric.Limp.Rep-import Numeric.Limp.Program---- Minimise 1--- Subject to a >= b + 1--- b >= a + 1-problem1 :: Direction -> Program V0 V2 IntDouble-problem1 dir- = program dir- c1- ( r1 A :>= r1 B .+. c1- :&& r1 B :>= r1 A .+. c1)- []--infeasible :: IO ()-infeasible- = do solve_problem problem1-
− examples/Simple.hs
@@ -1,59 +0,0 @@-module Simple (simple) where--import Base-import Numeric.Limp.Rep-import Numeric.Limp.Program---- Minimise a + b--- Subject to a + 2b >= 3--- Where 0 <= a <= 10 :: Z--- 0 <= b <= 10 :: R-problem1 :: Direction -> Program String String IntDouble-problem1 dir- = program dir- (z1 "a" .+. r1 "b" )- (z1 "a" .+. r "b" 2 :>= con 3)- [ lowerUpperZ 0 "a" 10- , lowerUpperR 0 "b" 10 ]---- As above, but swap coefficients on >= 3 constraint.------ Minimise a + b--- Subject to 2a + b >= 3--- Where 0 <= a <= 10 :: Z--- 0 <= b <= 10 :: R-problem2 :: Direction -> Program String String IntDouble-problem2 dir- = program dir- (z1 "a" .+. r1 "b" )- (z "a" 2 .+. r1 "b" :>= con 3)- [ lowerUpperZ 0 "a" 10- , lowerUpperR 0 "b" 10 ]----- Leave out the bounds on variables------ Minimise a + b--- Subject to a >= b--- b >= a--- a >= 3--- b <= 10--- Where a :: Z--- b :: R-problem3 :: Direction -> Program String String IntDouble-problem3 dir- = program dir- (z1 "a" .+. r1 "b")- ( z1 "a" :>= r1 "b"- :&& r1 "b" :>= z1 "a"- :&& z1 "a" :>= con 3- :&& r1 "b" :<= con 10)- [ ]---simple :: IO ()-simple- = do solve_problem problem1- solve_problem problem2- solve_problem problem3-
− examples/Stupid.hs
@@ -1,19 +0,0 @@--- Stupid examples that might just fail-module Stupid (stupid) where--import Base-import Numeric.Limp.Rep-import Numeric.Limp.Program--problem1 :: Direction -> Program String String IntDouble-problem1 dir- = program dir- c1- CTrue- []--stupid :: IO ()-stupid- = do solve_problem problem1--
limp-cbc.cabal view
@@ -1,5 +1,5 @@ name: limp-cbc-version: 0.3.2.1+version: 0.3.2.2 synopsis: bindings for integer linear programming solver Coin/CBC description: very simple binding to external solver, CBC. CBC is somewhat faster than GLPK, and also has a more permissive licence.@@ -279,10 +279,10 @@ Numeric.Limp.Solvers.Cbc.Internal.Foreign Numeric.Limp.Solvers.Cbc.Internal.Wrapper build-depends:- base < 5,+ base >= 4.9 && < 5, containers == 0.5.*,- vector == 0.10.*,- limp == 0.3.2.*+ vector >= 0.10 && < 0.13,+ limp == 0.3.2.2 ghc-options: -Wall -fno-warn-orphans default-language: Haskell2010@@ -291,7 +291,8 @@ build-tools: c2hs if !flag(embedded)- extra-libraries: Cbc Clp CbcSolver Cgl Osi OsiCbc OsiClp OsiCommonTests CoinUtils CoinMP stdc+++ extra-libraries: stdc+++ pkgconfig-depends: cbc include-dirs: cbits includes: Cbc.h c-sources: cbits/Cbc.cpp@@ -506,17 +507,19 @@ cbits/coin/OsiSolverBranch.cpp cbits/coin/OsiSolverInterface.cpp -test-suite test+test-suite examples type: exitcode-stdio-1.0 hs-source-dirs: examples main-is: Test.hs- other-modules:- Base- Clustering- Infeasible- Simple- Stupid build-depends: base, limp, limp-cbc+ default-language: Haskell2010+ default-extensions: TemplateHaskell TypeFamilies FlexibleContexts GeneralizedNewtypeDeriving DataKinds GADTs RankNTypes StandaloneDeriving++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base, limp, limp-cbc, tasty, tasty-quickcheck, QuickCheck default-language: Haskell2010 default-extensions: TemplateHaskell TypeFamilies FlexibleContexts GeneralizedNewtypeDeriving DataKinds GADTs RankNTypes StandaloneDeriving
src/Numeric/Limp/Solvers/Cbc/Error.hs view
@@ -2,5 +2,5 @@ data Error = Infeasible- deriving Show+ deriving (Show, Eq, Ord)
src/Numeric/Limp/Solvers/Cbc/Internal/Foreign.chs view
@@ -4,8 +4,6 @@ import Foreign import Foreign.C -import Control.Applicative- import qualified Data.Vector.Storable as V import Data.Vector.Storable (Vector) @@ -73,11 +71,14 @@ getSolution :: CbcModel -> IO (Vector Double)-getSolution m+getSolution m@(CbcModel fp) = do ncols <- fromIntegral <$> withCbcModel m {#call getNumCols#} vd <- unsafeCoerce <$> withCbcModel m {#call getBestSolution#}+ arr <- V.generateM ncols (peekElemOff vd) - V.generateM ncols (peekElemOff vd)+ -- The model owns the array, so ensure we keep it around until after we've read the whole array+ touchForeignPtr fp+ return arr {#fun setObjSense as ^
+ test/Main.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, TupleSections #-}+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.QuickCheck.Property+import Data.IORef+import Data.Void+import Data.Either+import Numeric.Limp.Solvers.Cbc (solve, Error(..))+import Numeric.Limp.Program+import Numeric.Limp.Rep.IntDouble+import Numeric.Limp.Solvers.Cbc.MatrixRepr (matrixReprOfProgram)++import qualified Numeric.Limp.Canon as Canon+import qualified Numeric.Limp.Canon.Pretty as Canon++main :: IO ()+main = defaultMain limpTest++instance Arbitrary (Program Int Void IntDouble) where+ arbitrary = do+ let+ vars :: [Int]+ vars = [1 .. 10]+ bounds = map binary vars+ obj = LZ ((,1) <$> vars) 0+ constraints <- fmap mconcat . vectorOf 5 $ do+ vars1 <- sublistOf vars+ return $ LZ ((,1) <$> vars1) 0 :== c1+ return $ minimise obj constraints bounds++limpTest :: TestTree+limpTest = testProperty "limp" $ \(prog1 :: Program Int Void IntDouble) ->+ ioProperty $ do+ -- prevent CSE+ v <- newIORef prog1+ prog2 <- readIORef v+ let sol1 = solve prog1+ sol2 = solve prog2+ score1 = eval <$> sol1 <*> pure (_objective prog1)+ score2 = eval <$> sol2 <*> pure (_objective prog2)+ valid1 = checkProgram <$> sol1 <*> pure prog1+ valid2 = checkProgram <$> sol2 <*> pure prog2+ return $+ classify (isRight sol1) "feasible" $+ if score1 == score2+ then property True+ else property $+ MkResult (Just False) True+ ("\n" ++ show (score1,valid1,sol1) +++ "\n" ++ show (score2,valid2,sol2) +++ "\n\n" ++ ppr prog1)+ Nothing False Nothing mempty mempty mempty [show prog1]++ppr :: Program Int Void IntDouble -> String+ppr p0 = + let p = Canon.program p0+ m = matrixReprOfProgram p+ lp = Canon.ppr (("Z"++) . show) (("R"++) . show) p+ in lp ++ "\n\n" ++ show m++{-+ (Right -9.223372036854776e18,Right (Assignment (fromList [(1,-9223372036854775808),(2,0),(3,0),(4,1),(5,1),(6,0),(7,0),(8,1),(9,0),(10,0)]) (fromList [])))+ (Right 3.0,Right (Assignment (fromList [(1,0),(2,0),(3,0),(4,1),(5,1),(6,0),(7,0),(8,1),(9,0),(10,0)]) (fromList [])))+ Minimize+ 1.0 Z1 + 1.0 Z2 + 1.0 Z3 + 1.0 Z4 + 1.0 Z5 + 1.0 Z6 + 1.0 Z7 + 1.0 Z8 + 1.0 Z9 + 1.0 Z10+ Subject to+ -1.0 Z1 - 1.0 Z2 - 1.0 Z6 - 1.0 Z8 - 1.0 Z10 >= -1.0+ -1.0 Z1 - 1.0 Z2 - 1.0 Z6 - 1.0 Z8 - 1.0 Z10 <= -1.0+ -1.0 Z1 - 1.0 Z2 - 1.0 Z5 - 1.0 Z7 - 1.0 Z9 >= -1.0+ -1.0 Z1 - 1.0 Z2 - 1.0 Z5 - 1.0 Z7 - 1.0 Z9 <= -1.0+ -1.0 Z5 >= -1.0+ -1.0 Z5 <= -1.0+ -1.0 Z1 - 1.0 Z4 - 1.0 Z7 - 1.0 Z9 >= -1.0+ -1.0 Z1 - 1.0 Z4 - 1.0 Z7 - 1.0 Z9 <= -1.0+ -1.0 Z7 - 1.0 Z8 >= -1.0+ -1.0 Z7 - 1.0 Z8 <= -1.0++ Bounds+ 0.0 <= Z1 <= 1.0+ 0.0 <= Z2 <= 1.0+ 0.0 <= Z3 <= 1.0+ 0.0 <= Z4 <= 1.0+ 0.0 <= Z5 <= 1.0+ 0.0 <= Z6 <= 1.0+ 0.0 <= Z7 <= 1.0+ 0.0 <= Z8 <= 1.0+ 0.0 <= Z9 <= 1.0+ 0.0 <= Z10 <= 1.0++ Generals+ Z1+ Z2+ Z3+ Z4+ Z5+ Z6+ Z7+ Z8+ Z9+ Z10+-}