highs-lp-0.0: test/Test/Numeric/HiGHS/LP.hs
-- Do not edit! Automatically created with doctest-extract from src/Numeric/HiGHS/LP.hs
{-# LINE 46 "src/Numeric/HiGHS/LP.hs" #-}
module Test.Numeric.HiGHS.LP where
import Test.DocTest.Base
import qualified Test.DocTest.Driver as DocTest
{-# LINE 47 "src/Numeric/HiGHS/LP.hs" #-}
import qualified Numeric.HiGHS.LP as LP
import qualified Numeric.LinearProgramming.Test as TestLP
import Numeric.HiGHS.LP ((.*), (==.), (<=.), (>=.), (>=<.))
import qualified Data.Array.Comfort.Storable as Array
import qualified Data.Array.Comfort.Shape as Shape
import Data.Tuple.HT (mapPair, mapSnd)
import Control.Applicative (liftA2)
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
forAllMethod ::
(QC.Testable prop) => (LP.Method -> prop) -> QC.Property
forAllMethod = QC.forAll (QC.elements [LP.simplex, LP.choose, LP.ipm])
test :: DocTest.T ()
test = do
DocTest.printPrefix "Numeric.HiGHS.LP:81: "
{-# LINE 81 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.example(
{-# LINE 81 "src/Numeric/HiGHS/LP.hs" #-}
case Shape.indexTupleFromShape tripletShape of
(x,y,z) ->
fmap (mapSnd Array.toTuple) $ snd $
LP.solve LP.simplex []
[[2.*x, 1.*y] <=. 10, [1.*y, (5::Double).*z] <=. 20]
(LP.Maximize, Array.fromTuple (4,-3,2)
:: Array.Array TripletShape Double)
)
[ExpectedLine [LineChunk "Just (28.0,(5.0,0.0,4.0))"]]
DocTest.printPrefix "Numeric.HiGHS.LP:92: "
{-# LINE 92 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.example(
{-# LINE 92 "src/Numeric/HiGHS/LP.hs" #-}
case Shape.indexTupleFromShape tripletShape of
(x,y,z) ->
fmap (mapSnd Array.toTuple) $ snd $
LP.solve LP.choose [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 "Just (116.0,(22.0,12.0,32.0))"]]
DocTest.printPrefix "Numeric.HiGHS.LP:103: "
{-# LINE 103 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.example(
{-# LINE 103 "src/Numeric/HiGHS/LP.hs" #-}
case Shape.indexTupleFromShape tripletShape of
(x,y,z) ->
mapSnd (fmap (mapSnd Array.toTuple)) $
LP.solve LP.choose [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 "(ModelStatusInfeasible,",WildCardChunk,LineChunk ")"]]
DocTest.printPrefix "Numeric.HiGHS.LP:114: "
{-# LINE 114 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.example(
{-# LINE 114 "src/Numeric/HiGHS/LP.hs" #-}
case Shape.indexTupleFromShape tripletShape of
(x,y,z) ->
mapSnd (fmap (mapSnd Array.toTuple)) $
LP.solve LP.choose [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 "(ModelStatusUnbounded,",WildCardChunk,LineChunk ")"]]
DocTest.printPrefix "Numeric.HiGHS.LP:125: "
{-# LINE 125 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 125 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method
(QC.Positive posWeight) (QC.Positive negWeight) target ->
case Shape.indexTupleFromShape pairShape of
(pos,neg) ->
case fmap (mapSnd Array.toTuple) $ snd $ LP.solve method []
[[1.*pos, (-1::Double).*neg] ==. target]
(LP.Minimize,
Array.fromTuple (posWeight,negWeight)
:: Array.Array PairShape Double) of
Nothing -> QC.property False
Just (absol,(posResult,negResult)) ->
QC.property (absol>=0)
.&&.
(posResult === 0 .||. negResult === 0)
)
DocTest.printPrefix "Numeric.HiGHS.LP:141: "
{-# LINE 141 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 141 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method target ->
case Shape.indexTupleFromShape pairShape of
(pos,neg) ->
case fmap (mapSnd Array.toTuple) $ snd $ LP.solve method []
[[1.*pos, (-1::Double).*neg] ==. target]
(LP.Minimize, Array.fromTuple (1,1)
:: Array.Array PairShape Double) of
Nothing -> QC.property False
Just (absol,(posResult,negResult)) ->
QC.counterexample (show(absol,(posResult,negResult))) $
QC.property (approxReal 0.001 absol (abs target))
.&&.
(posResult === 0 .||. negResult === 0)
)
DocTest.printPrefix "Numeric.HiGHS.LP:157: "
{-# LINE 157 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 157 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
case snd $ LP.solve method bounds constrs (dir,obj) of
Nothing -> False
Just _ -> True
)
DocTest.printPrefix "Numeric.HiGHS.LP:166: "
{-# LINE 166 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 166 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
case snd $ LP.solve method bounds constrs (dir,obj) of
Nothing -> QC.property False
Just (_,sol) -> TestLP.checkFeasibility 0.1 bounds constrs sol
)
DocTest.printPrefix "Numeric.HiGHS.LP:175: "
{-# LINE 175 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 175 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
case snd $ LP.solve method bounds constrs (dir,obj) of
Nothing -> QC.property False
Just (_,sol) ->
QC.forAll (QC.choose (0,1)) $ \lambda ->
TestLP.checkFeasibility 0.1 bounds constrs $
TestLP.affineCombination lambda sol (Array.map fromIntegral origin)
)
DocTest.printPrefix "Numeric.HiGHS.LP:187: "
{-# LINE 187 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 187 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
case snd $ LP.solve method bounds constrs (dir,obj) of
Nothing -> QC.property False
Just (opt,sol) ->
QC.forAll (QC.choose (0,1)) $ \lambda ->
let val = TestLP.scalarProduct obj $
TestLP.affineCombination lambda sol $
Array.map fromIntegral origin
in QC.counterexample (show (dir,opt,val)) $
case dir of
LP.Minimize -> opt-0.01 <= val
LP.Maximize -> opt+0.01 >= val
)
DocTest.printPrefix "Numeric.HiGHS.LP:204: "
{-# LINE 204 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 204 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllBoundedProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \dirObjA ->
QC.forAll (TestLP.genObjective origin) $ \dirObjB ->
let solA = snd $ LP.solve method bounds constrs dirObjA in
let solB = snd $ LP.solve method bounds constrs dirObjB in
QC.counterexample (show (fmap fst solA, fmap fst solB)) $
case (solA, solB) of
(Just _, Just _) -> True
(Nothing, Nothing) -> True
_ -> False
)
DocTest.printPrefix "Numeric.HiGHS.LP:218: "
{-# LINE 218 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 218 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \(_dir,obj) ->
case (snd $ LP.solve method bounds constrs (LP.Minimize,obj),
snd $ LP.solve method bounds constrs (LP.Maximize,obj)) of
(Just (optMin,_), Just (optMax,_)) ->
QC.counterexample (show (optMin, optMax)) $ optMin <= optMax + 0.01
_ -> QC.property False
)
DocTest.printPrefix "Numeric.HiGHS.LP:229: "
{-# LINE 229 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 229 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds allConstrs ->
QC.forAll (QC.sublistOf allConstrs) $ \someConstrs ->
QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
case (snd $ LP.solve method bounds allConstrs (dir,obj),
snd $ LP.solve method bounds someConstrs (dir,obj)) of
(Just (optAll,_), Just (optSome,_)) ->
QC.counterexample (show (optAll, optSome)) $
case dir of
LP.Minimize -> optAll >= optSome-0.01
LP.Maximize -> optAll <= optSome+0.01
_ -> QC.property False
)
DocTest.printPrefix "Numeric.HiGHS.LP:244: "
{-# LINE 244 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 244 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \methodA ->
forAllMethod $ \methodB ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \dirObj ->
case (snd $ LP.solve methodA bounds constrs dirObj,
snd $ LP.solve methodB bounds constrs dirObj) of
(Just (optA,_), Just (optB,_)) ->
QC.counterexample (show (optA, optB)) $
approxReal 0.01 optA optB
_ -> QC.property False
)
DocTest.printPrefix "Numeric.HiGHS.LP:265: "
{-# LINE 265 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.example(
{-# LINE 265 "src/Numeric/HiGHS/LP.hs" #-}
case Shape.indexTupleFromShape tripletShape of
(x,y,z) ->
fmap (mapSnd (mapPair (Array.toTuple, Array.toList))) $ snd $
LP.solveWith
(liftA2 (,) LP.getObjectiveValue LP.getBasisStatus)
LP.simplex []
[[2.*x, 1.*y] <=. 10, [1.*y, (5::Double).*z] <=. 20]
(LP.Maximize, Array.fromTuple (4,-3,2) :: Array.Array TripletShape Double)
)
[ExpectedLine [LineChunk "Just (28.0,((Highs.basisStatusBasic,Highs.basisStatusLower,Highs.basisStatusBasic),[Highs.basisStatusUpper,Highs.basisStatusUpper]))"]]
DocTest.printPrefix "Numeric.HiGHS.LP:277: "
{-# LINE 277 "src/Numeric/HiGHS/LP.hs" #-}
DocTest.property(
{-# LINE 277 "src/Numeric/HiGHS/LP.hs" #-}
forAllMethod $ \method ->
TestLP.forAllOrigin $ \origin ->
TestLP.forAllProblem origin $ \bounds constrs ->
QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->
case (snd $ LP.solve method bounds constrs (dir,obj),
snd $ LP.solveWith LP.getSolutionVectors
method bounds constrs (dir,obj)) of
(Just (_,sol0), Just ((sol1,_),_)) -> sol0 == sol1
_ -> False
)