-- Do not edit! Automatically created with doctest-extract from src/Numeric/COINOR/CLP.hs {-# LINE 45 "src/Numeric/COINOR/CLP.hs" #-} module Test.Numeric.COINOR.CLP where import Test.DocTest.Base import qualified Test.DocTest.Driver as DocTest {-# LINE 46 "src/Numeric/COINOR/CLP.hs" #-} import qualified Numeric.COINOR.CLP as LP import qualified Numeric.LinearProgramming.Test as TestLP import Numeric.COINOR.CLP (PlusMinusOne(..), (.*), (==.), (<=.), (>=<.)) import qualified Data.Array.Comfort.Storable as Array import qualified Data.Array.Comfort.Shape as Shape import Data.Tuple.HT (mapSnd) import qualified Test.QuickCheck as QC import Test.QuickCheck ((===), (.&&.), (.||.)) type X = Shape.Element type PairShape = Shape.NestedTuple Shape.TupleIndex (X,X) type TripletShape = Shape.NestedTuple Shape.TupleIndex (X,X,X) pairShape :: PairShape pairShape = Shape.static tripletShape :: TripletShape tripletShape = Shape.static approxReal :: (Ord a, Num a) => a -> a -> a -> Bool approxReal tol x y = abs (x-y) <= tol genMethod :: QC.Gen (String, LP.Method) genMethod = QC.elements $ ("dual", LP.dual) : ("primal", LP.primal) : ("initialSolve", LP.initialSolve) : ("initialDualSolve", LP.initialDualSolve) : ("initialPrimalSolve", LP.initialPrimalSolve) : ("initialBarrierSolve", LP.initialBarrierSolve) : -- let tests fail -- ("initialBarrierNoCrossSolve", LP.initialBarrierNoCrossSolve) : [] forAllMethod :: (QC.Testable prop) => (LP.Method -> prop) -> QC.Property forAllMethod prop = QC.forAllShow genMethod fst (prop . snd) test :: DocTest.T () test = do DocTest.printPrefix "Numeric.COINOR.CLP:175: " {-# LINE 175 "src/Numeric/COINOR/CLP.hs" #-} DocTest.property {-# LINE 175 "src/Numeric/COINOR/CLP.hs" #-} (forAllMethod $ \method (QC.Positive posWeight) (QC.Positive negWeight) target -> case Shape.indexTupleFromShape pairShape of (pos,neg) -> case mapSnd Array.toTuple <$> LP.simplex method [] [[1.*pos, (-1::Double).*neg] ==. target] (LP.Minimize, Array.fromTuple (posWeight,negWeight) :: Array.Array PairShape Double) of (Right (absol,(posResult,negResult))) -> QC.property (absol>=0) .&&. (posResult === 0 .||. negResult === 0); _ -> QC.property False) DocTest.printPrefix "Numeric.COINOR.CLP:176: " {-# LINE 176 "src/Numeric/COINOR/CLP.hs" #-} DocTest.property {-# LINE 176 "src/Numeric/COINOR/CLP.hs" #-} (forAllMethod $ \method target -> case Shape.indexTupleFromShape pairShape of (pos,neg) -> case mapSnd Array.toTuple <$> LP.simplex method [] [[1.*pos, (-1::Double).*neg] ==. target] (LP.Minimize, Array.fromTuple (1,1) :: Array.Array PairShape Double) of (Right (absol,(posResult,negResult))) -> QC.counterexample (show(absol,(posResult,negResult))) $ QC.property (approxReal 0.001 absol (abs target)) .&&. (posResult === 0 .||. negResult === 0); _ -> QC.property False) DocTest.printPrefix "Numeric.COINOR.CLP:178: " {-# LINE 178 "src/Numeric/COINOR/CLP.hs" #-} DocTest.property {-# LINE 178 "src/Numeric/COINOR/CLP.hs" #-} (forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case LP.simplex method bounds constrs (dir,obj) of Right _ -> True; _ -> False) DocTest.printPrefix "Numeric.COINOR.CLP:179: " {-# LINE 179 "src/Numeric/COINOR/CLP.hs" #-} DocTest.property {-# LINE 179 "src/Numeric/COINOR/CLP.hs" #-} (forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case LP.simplex method bounds constrs (dir,obj) of Right (_,sol) -> TestLP.checkFeasibility 0.1 bounds constrs sol; _ -> QC.property False) DocTest.printPrefix "Numeric.COINOR.CLP:180: " {-# LINE 180 "src/Numeric/COINOR/CLP.hs" #-} DocTest.property {-# LINE 180 "src/Numeric/COINOR/CLP.hs" #-} (forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case LP.simplex method bounds constrs (dir,obj) of Right (_,sol) -> QC.forAll (QC.choose (0,1)) $ \lambda -> TestLP.checkFeasibility 0.1 bounds constrs $ TestLP.affineCombination lambda sol (Array.map fromIntegral origin); _ -> QC.property False) DocTest.printPrefix "Numeric.COINOR.CLP:181: " {-# LINE 181 "src/Numeric/COINOR/CLP.hs" #-} DocTest.property {-# LINE 181 "src/Numeric/COINOR/CLP.hs" #-} (forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case LP.simplex method bounds constrs (dir,obj) of Left _ -> QC.property False; Right (opt,sol) -> QC.forAll (QC.choose (0,1)) $ \lambda -> let val = TestLP.scalarProduct obj $ TestLP.affineCombination lambda sol (Array.map fromIntegral origin) in case dir of LP.Minimize -> opt-0.01 <= val; LP.Maximize -> opt+0.01 >= val) DocTest.printPrefix "Numeric.COINOR.CLP:168: " {-# LINE 168 "src/Numeric/COINOR/CLP.hs" #-} DocTest.example {-# LINE 168 "src/Numeric/COINOR/CLP.hs" #-} (case Shape.indexTupleFromShape tripletShape of (x,y,z) -> mapSnd Array.toTuple <$> LP.simplex LP.dual [] [[2.*x, 1.*y] <=. 10, [1.*y, (5::Double).*z] <=. 20] (LP.Maximize, Array.fromTuple (4,-3,2) :: Array.Array TripletShape Double)) [ExpectedLine [LineChunk "Right (28.0,(5.0,0.0,4.0))"]] DocTest.printPrefix "Numeric.COINOR.CLP:170: " {-# LINE 170 "src/Numeric/COINOR/CLP.hs" #-} DocTest.example {-# LINE 170 "src/Numeric/COINOR/CLP.hs" #-} (case Shape.indexTupleFromShape tripletShape of (x,y,z) -> mapSnd Array.toTuple <$> LP.simplex LP.primal [y >=<. (-12,12)] [[1.*x, (-1).*y] <=. 10, [(-1).*y, (1::Double).*z] <=. 20] (LP.Maximize, Array.fromTuple (4,-3,2) :: Array.Array TripletShape Double)) [ExpectedLine [LineChunk "Right (116.0,(22.0,12.0,32.0))"]] DocTest.printPrefix "Numeric.COINOR.CLP:172: " {-# LINE 172 "src/Numeric/COINOR/CLP.hs" #-} DocTest.example {-# LINE 172 "src/Numeric/COINOR/CLP.hs" #-} (case Shape.indexTupleFromShape tripletShape of (x,y,z) -> mapSnd Array.toTuple <$> LP.simplex LP.primal [y >=<. (-12,12)] [[PlusOne .* x, MinusOne .* y] <=. 10, [MinusOne .* y, PlusOne .* z] <=. 20] (LP.Maximize, Array.fromTuple (4,-3,2) :: Array.Array TripletShape Double)) [ExpectedLine [LineChunk "Right (116.0,(22.0,12.0,32.0))"]]