packages feed

comfort-glpk-0.0.1: test/Test/Numeric/GLPK.hs

-- Do not edit! Automatically created with doctest-extract from src/Numeric/GLPK.hs
{-# LINE 82 "src/Numeric/GLPK.hs" #-}

module Test.Numeric.GLPK where

import Test.DocTest.Base
import qualified Test.DocTest.Driver as DocTest

{-# LINE 83 "src/Numeric/GLPK.hs" #-}
import     qualified Test.Numeric.GLPK.Generator as TestLP
import     qualified Numeric.GLPK as LP
import     Numeric.GLPK ((.*), (<=.), (==.))

import     qualified Data.Array.Comfort.Storable as Array
import     qualified Data.Array.Comfort.Shape as Shape

import     Data.Tuple.HT (mapPair, 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

round3     :: Double -> Double
round3     x = fromInteger (round (1000*x)) / 1000

test :: DocTest.T ()
test = do
 DocTest.printPrefix "Numeric.GLPK:141: "
{-# LINE 141 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 141 "src/Numeric/GLPK.hs" #-}
     (\target -> case Shape.indexTupleFromShape pairShape of (pos,neg) -> case mapSnd (mapSnd Array.toTuple) <$> LP.simplex [] [[1.*pos, (-1).*neg] ==. target] (LP.Minimize, Array.fromTuple (1,1) :: Array.Array PairShape Double) of (Right (LP.Optimal,(absol,(posResult,negResult)))) -> QC.property (TestLP.approxReal 0.001 absol (abs target)) .&&. (posResult === 0 .||. negResult === 0); _ -> QC.property False)
 DocTest.printPrefix "Numeric.GLPK:142: "
{-# LINE 142 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 142 "src/Numeric/GLPK.hs" #-}
     (\(QC.Positive posWeight) (QC.Positive negWeight) target -> case Shape.indexTupleFromShape pairShape of (pos,neg) -> case mapSnd (mapSnd Array.toTuple) <$> LP.simplex [] [[1.*pos, (-1).*neg] ==. target] (LP.Minimize, Array.fromTuple (posWeight,negWeight) :: Array.Array PairShape Double) of (Right (LP.Optimal,(absol,(posResult,negResult)))) -> QC.property (absol>=0) .&&. (posResult === 0 .||. negResult === 0); _ -> QC.property False)
 DocTest.printPrefix "Numeric.GLPK:143: "
{-# LINE 143 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 143 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAll (TestLP.genProblem origin) $ \(bounds, constrs) -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case LP.simplex bounds constrs (dir,obj) of Right (LP.Optimal, _) -> True; _ -> False)
 DocTest.printPrefix "Numeric.GLPK:138: "
{-# LINE 138 "src/Numeric/GLPK.hs" #-}
 DocTest.example
{-# LINE 138 "src/Numeric/GLPK.hs" #-}
   (case Shape.indexTupleFromShape tripletShape of (x1,x2,x3) -> mapSnd (mapSnd Array.toTuple) <$> LP.simplex [] [[2.*x1, 1.*x2] <=. 10, [1.*x2, 5.*x3] <=. 20] (LP.Maximize, Array.fromTuple (4,-3,2) :: Array.Array TripletShape Double))
  [ExpectedLine [LineChunk "Right (Optimal,(28.0,(5.0,0.0,4.0)))"]]
 DocTest.printPrefix "Numeric.GLPK:180: "
{-# LINE 180 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 180 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAllShrink (TestLP.genProblem origin) TestLP.shrinkProblem $ \(bounds, constrs) -> QC.forAllShrink (TestLP.genObjectives origin) TestLP.shrinkObjectives $ \objs -> case LP.simplexMulti bounds constrs (Array.shape origin) objs of (_, Right (LP.Optimal, _)) -> QC.property True; result -> QC.counterexample (show result) False)
 DocTest.printPrefix "Numeric.GLPK:219: "
{-# LINE 219 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 219 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAllShrink (TestLP.genProblem origin) TestLP.shrinkProblem $ \(bounds, constrs) -> QC.forAllShrink (TestLP.genObjectives origin) TestLP.shrinkObjectives $ \objs -> case uncurry (LP.simplexSuccessive bounds constrs) $ TestLP.successiveObjectives origin 0.01 objs of result -> QC.counterexample (show result) $ case result of Right results -> all (\r -> case r of (LP.Optimal, _) -> True; _ -> False) results; _ -> False)
 DocTest.printPrefix "Numeric.GLPK:220: "
{-# LINE 220 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 220 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAllShrink (TestLP.genProblem origin) TestLP.shrinkProblem $ \(bounds, constrs) -> QC.forAllShrink (TestLP.genObjectives origin) TestLP.shrinkObjectives $ \objs -> case uncurry (LP.exactSuccessive bounds constrs) $ TestLP.successiveObjectives origin 0.01 objs of result -> QC.counterexample (show result) $ case result of Right results -> all (\r -> case r of (LP.Optimal, _) -> True; _ -> False) results; _ -> False)
 DocTest.printPrefix "Numeric.GLPK:240: "
{-# LINE 240 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 240 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAll (TestLP.genProblem origin) $ \(bounds, constrs) -> QC.forAll (TestLP.genObjectives origin) $ (. TestLP.successiveObjectives origin 0.01) $ \(obj,objs) -> case (LP.simplexSuccessive bounds constrs obj objs, LP.solveSuccessive (LP.simplex bounds) constrs obj objs) of (resultA,resultB) -> TestLP.approxSuccession 0.01 resultA resultB)
 DocTest.printPrefix "Numeric.GLPK:241: "
{-# LINE 241 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 241 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAll (TestLP.genProblem origin) $ \(bounds, constrs) -> QC.forAll (TestLP.genObjectives origin) $ (. TestLP.successiveObjectives origin 0.01) $ \(obj,objs) -> case (LP.exactSuccessive bounds constrs obj objs, LP.solveSuccessive (LP.exact bounds) constrs obj objs) of (resultA,resultB) -> TestLP.approxSuccession 0.01 resultA resultB)
 DocTest.printPrefix "Numeric.GLPK:274: "
{-# LINE 274 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 274 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAll (TestLP.genProblem origin) $ \(bounds, constrs) -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case (LP.simplex bounds constrs (dir,obj), LP.exact bounds constrs (dir,obj)) of (Right (LP.Optimal, (optSimplex,_)), Right (LP.Optimal, (optExact,_))) -> TestLP.approx "optimum" 0.001 optSimplex optExact; _ -> QC.property False)
 DocTest.printPrefix "Numeric.GLPK:271: "
{-# LINE 271 "src/Numeric/GLPK.hs" #-}
 DocTest.example
{-# LINE 271 "src/Numeric/GLPK.hs" #-}
   (case Shape.indexTupleFromShape tripletShape of (x1,x2,x3) -> mapSnd (mapSnd Array.toTuple) <$> LP.exact [] [[2.*x1, 1.*x2] <=. 10, [1.*x2, 5.*x3] <=. 20] (LP.Maximize, Array.fromTuple (4,-3,2) :: Array.Array TripletShape Double))
  [ExpectedLine [LineChunk "Right (Optimal,(28.0,(5.0,0.0,4.0)))"]]
 DocTest.printPrefix "Numeric.GLPK:346: "
{-# LINE 346 "src/Numeric/GLPK.hs" #-}
 DocTest.property
{-# LINE 346 "src/Numeric/GLPK.hs" #-}
     (QC.forAllShrink TestLP.genOrigin TestLP.shrinkOrigin $ \origin -> QC.forAll (TestLP.genProblem origin) $ \(bounds, constrs) -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case (LP.simplex bounds constrs (dir,obj), LP.interior bounds constrs (dir,obj)) of (Right (LP.Optimal, (optSimplex,_)), Right (LP.Optimal, (optExact,_))) -> TestLP.approx "optimum" 0.001 optSimplex optExact; _ -> QC.property False)
 DocTest.printPrefix "Numeric.GLPK:343: "
{-# LINE 343 "src/Numeric/GLPK.hs" #-}
 DocTest.example
{-# LINE 343 "src/Numeric/GLPK.hs" #-}
   (case Shape.indexTupleFromShape tripletShape of (x1,x2,x3) -> mapSnd (mapPair (round3, Array.toTuple . Array.map round3)) <$> LP.interior [] [[2.*x1, 1.*x2] <=. 10, [1.*x2, 5.*x3] <=. 20] (LP.Maximize, Array.fromTuple (4,-3,2) :: Array.Array TripletShape Double))
  [ExpectedLine [LineChunk "Right (Optimal,(28.0,(5.0,0.0,4.0)))"]]