coinor-clp 0.0 → 0.0.0.1

raw patch · 5 files changed

+343/−77 lines, 5 filesdep ~deepseqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: deepseq

API changes (from Hackage documentation)

Files

• coinor-clp.cabal +3/−3
• src/Numeric/COINOR/CLP.hs +101/−9
• src/Numeric/COINOR/CLP/Monad.hs +51/−6
• test/Test/Numeric/COINOR/CLP.hs +134/−42
• test/Test/Numeric/COINOR/CLP/Monad.hs +54/−17

@@ -1,6 +1,6 @@ Cabal-Version:    2.2 Name:             coinor-clp-Version:          0.0+Version:          0.0.0.1 License:          BSD-3-Clause License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -42,7 +42,7 @@   Manual:      True  Source-Repository this-  Tag:         0.0+  Tag:         0.0.0.1   Type:        darcs   Location:    https://hub.darcs.net/thielema/coinor-clp/ @@ -55,7 +55,7 @@     linear-programming >=0.0 && <0.1,     comfort-array >=0.4 && <0.6,     QuickCheck >=2 && <3,-    deepseq >=1.3 && <1.5,+    deepseq >=1.3 && <1.6,     transformers >=0.3 && <0.7,     non-empty >=0.3.2 && <0.4,     utility-ht >=0.0.16 && <0.1,

@@ -165,20 +165,112 @@   {- |->>> 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)+>>> :{+   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)+:} Right (28.0,(5.0,0.0,4.0))->>> 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)+>>> :{+   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)+:} Right (116.0,(22.0,12.0,32.0))->>> 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)+>>> :{+   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)+:} Right (116.0,(22.0,12.0,32.0)) -prop> 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-prop> 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+prop> :{+   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+            Left _ -> QC.property False+            Right (absol,(posResult,negResult)) ->+               QC.property (absol>=0)+               .&&.+               (posResult === 0 .||. negResult === 0)+:}+prop> :{+   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+            Left _ -> QC.property False+            Right (absol,(posResult,negResult)) ->+               QC.counterexample (show(absol,(posResult,negResult))) $+               QC.property (approxReal 0.001 absol (abs target))+               .&&.+               (posResult === 0 .||. negResult === 0)+:} -prop> 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-prop> 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-prop> 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-prop> 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+prop> :{+   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 _ -> False+      Right _ -> True+:}+prop> :{+   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 (_,sol) -> TestLP.checkFeasibility 0.1 bounds constrs sol+:}+prop> :{+   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 (_,sol) ->+         QC.forAll (QC.choose (0,1)) $ \lambda ->+         TestLP.checkFeasibility 0.1 bounds constrs $+         TestLP.affineCombination lambda sol (Array.map fromIntegral origin)+:}+prop> :{+   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+:} -} simplex ::    (Coefficient a, Shape.Indexed sh, Shape.Index sh ~ ix) =>

@@ -23,7 +23,7 @@           storeConstraints, setOptimizationDirection, examineStatus)  import Numeric.LinearProgramming.Common-         (Bounds, Constraints, Direction(..), Objective)+         (Bounds, Constraints, Direction(..), Objective, Term(Term))  import qualified Data.Array.Comfort.Storable as Array import qualified Data.Array.Comfort.Shape as Shape@@ -175,14 +175,51 @@ Add new constraints to an existing problem and simplex with a new direction and objective. ->>> case Shape.indexTupleFromShape tripletShape of (x,y,z) -> mapSnd Array.toTuple <$> LP.run tripletShape [] (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))+>>> :{+   case Shape.indexTupleFromShape tripletShape of+      (x,y,z) ->+         mapSnd Array.toTuple <$>+         LP.run tripletShape []+            (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))+:} Right (28.0,(5.0,0.0,4.0)) -prop> forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case (CLP.simplex method bounds constrs (dir,obj), LP.run (Array.shape origin) bounds $ LP.simplex method constrs (dir,obj)) of (Right (optA,_), Right (optB,_)) -> TestLP.approxReal 0.1 optA optB; _ -> False+prop> :{+   forAllMethod $ \method ->+   TestLP.forAllOrigin $ \origin ->+   TestLP.forAllProblem origin $ \bounds constrs ->+   QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->+   case (CLP.simplex method bounds constrs (dir,obj),+         LP.run (Array.shape origin) bounds $+            LP.simplex method constrs (dir,obj)) of+      (Right (optA,_), Right (optB,_)) ->+         TestLP.approxReal 0.1 optA optB; _ -> False+:} -prop> forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> TestLP.forAllObjectives origin $ \objs_ -> case TestLP.successiveObjectives origin 0.01 objs_ of (dirObj, objs) -> either (\msg -> QC.counterexample (show msg) False) (const $ QC.property True) $ runSuccessive method (Array.shape origin) bounds (constrs,dirObj) objs+prop> :{+   forAllMethod $ \method ->+   TestLP.forAllOrigin $ \origin ->+   TestLP.forAllProblem origin $ \bounds constrs ->+   TestLP.forAllObjectives origin $ \objs_ ->+   case TestLP.successiveObjectives origin 0.01 objs_ of+      (dirObj, objs) ->+         either (\msg -> QC.counterexample (show msg) False) (const $ QC.property True) $+         runSuccessive method (Array.shape origin) bounds (constrs,dirObj) objs+:} -prop> forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> TestLP.forAllObjectives origin $ \objs_ -> case TestLP.successiveObjectives origin 0.01 objs_ of (dirObj, objs) -> approxSuccession 0.01 (solveSuccessiveWarm method (Array.shape origin) bounds (constrs,dirObj) objs) (solveSuccessiveGen method (Array.shape origin) bounds (constrs,dirObj) objs)+prop> :{+   forAllMethod $ \method ->+   TestLP.forAllOrigin $ \origin ->+   TestLP.forAllProblem origin $ \bounds constrs ->+   TestLP.forAllObjectives origin $ \objs_ ->+   case TestLP.successiveObjectives origin 0.01 objs_ of+      (dirObj, objs) ->+         approxSuccession 0.01+            (solveSuccessiveWarm method (Array.shape origin) bounds (constrs,dirObj) objs)+            (solveSuccessiveGen method (Array.shape origin) bounds (constrs,dirObj) objs)+:} -} simplex ::    (Eq sh, Shape.Indexed sh, Shape.Index sh ~ ix) =>@@ -194,7 +231,15 @@       error "COINOR.CLP.Monad.solve: objective shape mismatch"     liftIO $ runContT $ do-      (_, coefficientsPtr, indexPtr, startPtr) <- storeConstraints shape constrs+      {- ToDo: Remove this in the future.+      This is a work-around for a bug in Clp_addRows+      https://hydra.nixos.org/build/239790474/nixlog/2+      https://list.coin-or.org/pipermail/clp/2023-November/001805.html+      -}+      let constrsFiltered =+            map (fmap (filter (\(Term c _x) -> c/=0)))constrs+      (_, coefficientsPtr, indexPtr, startPtr) <-+         storeConstraints shape constrsFiltered       (rowlbPtr,rowubPtr) <- storeBounds $ prepareRowBoundsArrays constrs       objPtr <- withBuffer $ Array.map realToFrac obj       liftIO $ do

@@ -50,51 +50,143 @@  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+ 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))+      +   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))+ DocTest.printPrefix "Numeric.COINOR.CLP:177: "+{-# LINE 177 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.example(+{-# LINE 177 "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))+ DocTest.printPrefix "Numeric.COINOR.CLP:186: "+{-# LINE 186 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.example(+{-# LINE 186 "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))"]]+ DocTest.printPrefix "Numeric.COINOR.CLP:197: "+{-# LINE 197 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.property(+{-# LINE 197 "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+            Left _ -> QC.property False+            Right (absol,(posResult,negResult)) ->+               QC.property (absol>=0)+               .&&.+               (posResult === 0 .||. negResult === 0)+  )+ DocTest.printPrefix "Numeric.COINOR.CLP:212: "+{-# LINE 212 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.property(+{-# LINE 212 "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+            Left _ -> QC.property False+            Right (absol,(posResult,negResult)) ->+               QC.counterexample (show(absol,(posResult,negResult))) $+               QC.property (approxReal 0.001 absol (abs target))+               .&&.+               (posResult === 0 .||. negResult === 0)+  )+ DocTest.printPrefix "Numeric.COINOR.CLP:229: "+{-# LINE 229 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.property(+{-# LINE 229 "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 _ -> False+      Right _ -> True+  )+ DocTest.printPrefix "Numeric.COINOR.CLP:238: "+{-# LINE 238 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.property(+{-# LINE 238 "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 (_,sol) -> TestLP.checkFeasibility 0.1 bounds constrs sol+  )+ DocTest.printPrefix "Numeric.COINOR.CLP:247: "+{-# LINE 247 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.property(+{-# LINE 247 "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 (_,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.COINOR.CLP:259: "+{-# LINE 259 "src/Numeric/COINOR/CLP.hs" #-}+ DocTest.property(+{-# LINE 259 "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+  )

@@ -114,24 +114,61 @@  test :: DocTest.T () test = do- DocTest.printPrefix "Numeric.COINOR.CLP.Monad:181: "-{-# LINE 181 "src/Numeric/COINOR/CLP/Monad.hs" #-}- DocTest.property-{-# LINE 181 "src/Numeric/COINOR/CLP/Monad.hs" #-}-     (forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> QC.forAll (TestLP.genObjective origin) $ \(dir,obj) -> case (CLP.simplex method bounds constrs (dir,obj), LP.run (Array.shape origin) bounds $ LP.simplex method constrs (dir,obj)) of (Right (optA,_), Right (optB,_)) -> TestLP.approxReal 0.1 optA optB; _ -> False)- DocTest.printPrefix "Numeric.COINOR.CLP.Monad:183: "-{-# LINE 183 "src/Numeric/COINOR/CLP/Monad.hs" #-}- DocTest.property-{-# LINE 183 "src/Numeric/COINOR/CLP/Monad.hs" #-}-     (forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> TestLP.forAllObjectives origin $ \objs_ -> case TestLP.successiveObjectives origin 0.01 objs_ of (dirObj, objs) -> either (\msg -> QC.counterexample (show msg) False) (const $ QC.property True) $ runSuccessive method (Array.shape origin) bounds (constrs,dirObj) objs)- DocTest.printPrefix "Numeric.COINOR.CLP.Monad:185: "-{-# LINE 185 "src/Numeric/COINOR/CLP/Monad.hs" #-}- DocTest.property-{-# LINE 185 "src/Numeric/COINOR/CLP/Monad.hs" #-}-     (forAllMethod $ \method -> TestLP.forAllOrigin $ \origin -> TestLP.forAllProblem origin $ \bounds constrs -> TestLP.forAllObjectives origin $ \objs_ -> case TestLP.successiveObjectives origin 0.01 objs_ of (dirObj, objs) -> approxSuccession 0.01 (solveSuccessiveWarm method (Array.shape origin) bounds (constrs,dirObj) objs) (solveSuccessiveGen method (Array.shape origin) bounds (constrs,dirObj) objs))  DocTest.printPrefix "Numeric.COINOR.CLP.Monad:178: " {-# LINE 178 "src/Numeric/COINOR/CLP/Monad.hs" #-}- DocTest.example+ DocTest.example( {-# LINE 178 "src/Numeric/COINOR/CLP/Monad.hs" #-}-   (case Shape.indexTupleFromShape tripletShape of (x,y,z) -> mapSnd Array.toTuple <$> LP.run tripletShape [] (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)))+      +   case Shape.indexTupleFromShape tripletShape of+      (x,y,z) ->+         mapSnd Array.toTuple <$>+         LP.run tripletShape []+            (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.Monad:189: "+{-# LINE 189 "src/Numeric/COINOR/CLP/Monad.hs" #-}+ DocTest.property(+{-# LINE 189 "src/Numeric/COINOR/CLP/Monad.hs" #-}+        +   forAllMethod $ \method ->+   TestLP.forAllOrigin $ \origin ->+   TestLP.forAllProblem origin $ \bounds constrs ->+   QC.forAll (TestLP.genObjective origin) $ \(dir,obj) ->+   case (CLP.simplex method bounds constrs (dir,obj),+         LP.run (Array.shape origin) bounds $+            LP.simplex method constrs (dir,obj)) of+      (Right (optA,_), Right (optB,_)) ->+         TestLP.approxReal 0.1 optA optB; _ -> False+  )+ DocTest.printPrefix "Numeric.COINOR.CLP.Monad:201: "+{-# LINE 201 "src/Numeric/COINOR/CLP/Monad.hs" #-}+ DocTest.property(+{-# LINE 201 "src/Numeric/COINOR/CLP/Monad.hs" #-}+        +   forAllMethod $ \method ->+   TestLP.forAllOrigin $ \origin ->+   TestLP.forAllProblem origin $ \bounds constrs ->+   TestLP.forAllObjectives origin $ \objs_ ->+   case TestLP.successiveObjectives origin 0.01 objs_ of+      (dirObj, objs) ->+         either (\msg -> QC.counterexample (show msg) False) (const $ QC.property True) $+         runSuccessive method (Array.shape origin) bounds (constrs,dirObj) objs+  )+ DocTest.printPrefix "Numeric.COINOR.CLP.Monad:212: "+{-# LINE 212 "src/Numeric/COINOR/CLP/Monad.hs" #-}+ DocTest.property(+{-# LINE 212 "src/Numeric/COINOR/CLP/Monad.hs" #-}+        +   forAllMethod $ \method ->+   TestLP.forAllOrigin $ \origin ->+   TestLP.forAllProblem origin $ \bounds constrs ->+   TestLP.forAllObjectives origin $ \objs_ ->+   case TestLP.successiveObjectives origin 0.01 objs_ of+      (dirObj, objs) ->+         approxSuccession 0.01+            (solveSuccessiveWarm method (Array.shape origin) bounds (constrs,dirObj) objs)+            (solveSuccessiveGen method (Array.shape origin) bounds (constrs,dirObj) objs)+  )