limp-cbc-0.3.2.2: test/Main.hs

{-# 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
-}