packages feed

coinor-clp-0.0: test/Test/Numeric/COINOR/CLP.hs

-- 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))"]]