Test Bounds

+ Fix bug with mergeBounds

Author: rasheedja

src/Linear/Simplex/Types.hs

@@ -371,7 +371,23 @@ deriveBounds = foldr updateBounds M.empty
     updateBounds _ = id
 
     mergeBounds :: Bounds -> Bounds -> Bounds
-    mergeBounds (Bounds l1 u1) (Bounds l2 u2) = Bounds (liftA2 max l1 l2) (liftA2 min u1 u2)
+    mergeBounds (Bounds l1 u1) (Bounds l2 u2) = Bounds (mergeLower l1 l2) (mergeUpper u1 u2)
+      where
+        mergeLower Nothing b = b
+        mergeLower a Nothing = a
+        mergeLower (Just a) (Just b) = Just (max a b)
+
+        mergeUpper Nothing b = b
+        mergeUpper a Nothing = a
+        mergeUpper (Just a) (Just b) = Just (min a b)
+
+validateBounds :: VarBounds -> Bool
+validateBounds boundsMap = all soundBounds $ M.toList boundsMap
+  where
+    soundBounds (_, Bounds lowerBound upperBound) =
+      case (lowerBound, upperBound) of
+        (Just l, Just u) -> l <= u
+        (_, _) -> True
 
 -- Eliminate inequalities which are outside the bounds
 -- precondition: no zero coefficients

test/Linear/Simplex/TypesSpec.hs

@@ -538,4 +538,157 @@ spec = do
                 <> "\nsimplifiedSimpleSystemEval: "
                 <> show simplifiedSimpleSystemEval
             ) $
-            simpleSystemEval == simplifiedSimpleSystemEval
+            simpleSystemEval == simplifiedSimpleSystemEval
+  describe "Bounds" $ do
+    it "validateBounds finds that deriving bounds for a system where -1 <= x <= 1 has valid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= (-1)
+            , Expr (VarTerm 0) :<= 1
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just (-1)) (Just 1))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` True
+    it "validateBounds finds that deriving bounds for a system where 0 <= x <= 1 has valid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 0
+            , Expr (VarTerm 0) :<= 1
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just 0) (Just 1))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` True
+    it "validateBounds finds that deriving bounds for a system where 1 <= x <= 1 has valid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 1
+            , Expr (VarTerm 0) :<= 1
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just 1) (Just 1))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` True
+    it "validateBounds finds that deriving bounds for a system where 1 <= x <= 0 has invalid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 1
+            , Expr (VarTerm 0) :<= 0
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just 1) (Just 0))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` False
+    it "validateBounds finds that deriving bounds for a system where 0 <= x <= 1 and 1 <= y <= 3 has valid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 0
+            , Expr (VarTerm 0) :<= 1
+            , Expr (VarTerm 1) :>= 1
+            , Expr (VarTerm 1) :<= 3
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just 0) (Just 1)), (1, Bounds (Just 1) (Just 3))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` True
+    it "validateBounds finds that deriving bounds for a system where 1 <= x <= 0 and 3 <= y <= 1 has invalid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 1
+            , Expr (VarTerm 0) :<= 0
+            , Expr (VarTerm 1) :>= 3
+            , Expr (VarTerm 1) :<= 1
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just 1) (Just 0)), (1, Bounds (Just 3) (Just 1))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` False
+    it "validateBounds finds that deriving bounds for a system where 1 <= x <= 0 and 1 <= y <= 3 has invalid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 1
+            , Expr (VarTerm 0) :<= 0
+            , Expr (VarTerm 1) :>= 1
+            , Expr (VarTerm 1) :<= 3
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just 1) (Just 0)), (1, Bounds (Just 1) (Just 3))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` False
+    it "validateBounds finds that deriving bounds for a system where 0 <= x <= 1 and 3 <= y <= 1 has invalid bounds" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 0
+            , Expr (VarTerm 0) :<= 1
+            , Expr (VarTerm 1) :>= 3
+            , Expr (VarTerm 1) :<= 1
+            ]
+          derivedBounds = deriveBounds simpleSystem
+          expectedBounds = Map.fromList [(0, Bounds (Just 0) (Just 1)), (1, Bounds (Just 3) (Just 1))]
+      derivedBounds `shouldBe` expectedBounds
+      validateBounds derivedBounds `shouldBe` False
+    it "removeUselessSystemBounds removes x <= 3 when bounds say x <= 2" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :<= 2
+            , Expr (VarTerm 0) :<= 3
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 0) (Just 2))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :<= 2]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+    it "removeUselessSystemBounds does not remove x <= 2 when bounds say x <= 2" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :<= 2
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 0) (Just 2))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :<= 2]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+    it "removeUselessSystemBounds removes x >= 3 when bounds say x >= 4" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 4
+            , Expr (VarTerm 0) :>= 3
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 4) (Just 5))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :>= 4]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+    it "removeUselessSystemBounds does not remove x >= 4 when bounds say x >= 4" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 4
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 4) (Just 5))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :>= 4]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+    it "removeUselessSystemBounds does not remove 0 <= x <= 2 when bounds say 0 <= x <= 2" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 0
+            , Expr (VarTerm 0) :<= 2
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 0) (Just 2))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :>= 0, Expr (VarTerm 0) :<= 2]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+    it "removeUselessSystemBounds removes upper bound of 0 <= x <= 2 when bounds say 0 <= x <= 1" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 0
+            , Expr (VarTerm 0) :<= 2
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 0) (Just 1))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :>= 0]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+    it "removeUselessSystemBounds removes lower bound of 0 <= x <= 2 when bounds say 1 <= x <= 2" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :>= 0
+            , Expr (VarTerm 0) :<= 2
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 1) (Just 2))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :<= 2]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+    it "removeUselssSystemBounds only removes constraints of the form x <= c" $ do
+      let simpleSystem =
+            [ Expr (VarTerm 0) :<= 2
+            , Expr (VarTerm 0) :<= 3
+            , Expr (CoeffTerm 2 0) :<= 6
+            ]
+          bounds = Map.fromList [(0, Bounds (Just 0) (Just 2))]
+          simplifiedSimpleSystem = removeUselessSystemBounds simpleSystem bounds
+          expectedSimpleSystem = [Expr (VarTerm 0) :<= 2, Expr (CoeffTerm 2 0) :<= 6]
+      simplifiedSimpleSystem `shouldBe` expectedSimpleSystem
+