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