linear-programming 0.0.0.1 → 0.0.1

raw patch · 2 files changed

+51/−9 lines, 2 filesdep ~random

Dependency ranges changed: random

Files

• linear-programming.cabal +2/−2
• src/Numeric/LinearProgramming/Test.hs +49/−7

@@ -1,6 +1,6 @@ Cabal-Version:    2.2 Name:             linear-programming-Version:          0.0.0.1+Version:          0.0.1 License:          BSD-3-Clause License-File:     LICENSE Author:           Henning Thielemann <haskell@henning-thielemann.de>@@ -16,7 +16,7 @@   Makefile  Source-Repository this-  Tag:         0.0.0.1+  Tag:         0.0.1   Type:        darcs   Location:    https://hub.darcs.net/thielema/linear-programming/ 

@@ -4,6 +4,7 @@    Element,    forAllOrigin,    forAllProblem,+   forAllBoundedProblem,    genObjective,    forAllObjectives,    successiveObjectives,@@ -56,11 +57,7 @@    Array sh a -> QC.Gen (LP.Bounds ix, Constraints ix) genProblem origin =    liftA2 (,)-      (for (Array.toAssociations origin) $ \(ix,x) ->-         LP.Inequality ix <$>-         liftA2 LP.Between-            (doubleFromElement . (x+) <$> QC.choose (-100,-50))-            (doubleFromElement . (x+) <$> QC.choose (50,100)))+      (genBounds origin)       (do          numConstraints <- QC.choose (1,20)          QC.vectorOf numConstraints $ do@@ -70,8 +67,7 @@                return (coeff, ix)             let offset = scalarProductTerms terms origin             let deviation = 25-            LP.Inequality-               (map (uncurry ((.*) . doubleFromElement)) terms)+            LP.Inequality (map (uncurry ((.*) . doubleFromElement)) terms)                <$>                QC.oneof (                   (do bound <- QC.choose (offset-deviation, offset+deviation)@@ -92,6 +88,45 @@ scalarProductTerms terms origin =    sum $ map (\(coeff, ix) -> coeff * origin!ix) terms +{- |+Generates bounded, but maybe infeasible problems.+-}+genBoundedProblem ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Element a) =>+   Array sh a -> QC.Gen (LP.Bounds ix, Constraints ix)+genBoundedProblem origin =+   liftA2 (,)+      (genBounds origin)+      (do+         numConstraints <- QC.choose (1,20)+         QC.vectorOf numConstraints $ do+            ixs <- QC.sublistOf $ Shape.indices $ Array.shape origin+            terms <- for ixs $ \ix -> do+               coeff <- QC.choose (-10, 10)+               return (coeff, ix)+            let doubleFromElem :: (Element a) => f a -> a -> Double+                doubleFromElem _ = doubleFromElement+            let choose = doubleFromElem origin <$> QC.choose (-100, 100)+            LP.Inequality (map (uncurry ((.*) . doubleFromElem origin)) terms)+               <$>+               QC.oneof (+                  (LP.LessEqual    <$> choose) :+                  (LP.GreaterEqual <$> choose) :+                  (liftA2+                     (\x y -> LP.Between (min x y) (max x y))+                     choose choose) :+                  []))++genBounds ::+   (Shape.Indexed sh, Element a) =>+   Array sh a -> QC.Gen [LP.Inequality (Shape.Index sh)]+genBounds origin =+   for (Array.toAssociations origin) $ \(ix,x) ->+      LP.Inequality ix <$>+      liftA2 LP.Between+         (doubleFromElement . (x+) <$> QC.choose (-100,-50))+         (doubleFromElement . (x+) <$> QC.choose (50,100))+ genVarShape :: QC.Gen (Shape.Range Char) genVarShape = Shape.Range 'a' <$> QC.choose ('a','j') @@ -158,6 +193,13 @@    Array sh a -> (LP.Bounds ix -> Constraints ix -> prop) -> QC.Property forAllProblem origin =    QC.forAllShrink (genProblem origin) shrinkProblem . uncurry++forAllBoundedProblem ::+   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) =>+   (QC.Testable prop, Element a) =>+   Array sh a -> (LP.Bounds ix -> Constraints ix -> prop) -> QC.Property+forAllBoundedProblem origin =+   QC.forAllShrink (genBoundedProblem origin) shrinkProblem . uncurry   genObjectives ::