diff --git a/ChangeLog.md b/ChangeLog.md index f3ef37b..09fc855 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,8 @@ ## Unreleased changes +- Prevent degenerate simplex pivot cycles by using Bland's least-index entering and leaving rules in both phases. Tied optimal solutions may select different variable values while preserving the objective optimum. +- Remove zero-valued artificial basic variables before phase two, preserving the original constraints when a degenerate phase-one optimum leaves artificials in the basis. - Support zero objectives after the artificial-variable phase and replace custom coefficient-map merging with standard Data.Map operations. ([#18](https://github.com/rasheedja/simplex-method/pull/18)) - Correct fractional coefficients in pretty-printed expressions and remove trailing plus separators. ([#19](https://github.com/rasheedja/simplex-method/pull/19)) - Share shift and split coefficient-map transformations between objectives and constraints, and simplify access to their fields. ([#23](https://github.com/rasheedja/simplex-method/pull/23)) diff --git a/src/Linear/Simplex/Solver/TwoPhase.hs b/src/Linear/Simplex/Solver/TwoPhase.hs index b49763a..7b3e2bb 100644 --- a/src/Linear/Simplex/Solver/TwoPhase.hs +++ b/src/Linear/Simplex/Solver/TwoPhase.hs @@ -130,7 +130,7 @@ findFeasibleSolution unsimplifiedSystem = do <> showT eliminateArtificialVarsFromPhase1Tableau pure . Just $ FeasibleSystem - { dict = eliminateArtificialVarsFromPhase1Tableau + { dict = removeArtificialBasics phase1Dict , slackVars = slackVars , artificialVars = artificialVars , objectiveVar = objectiveVar @@ -150,7 +150,7 @@ findFeasibleSolution unsimplifiedSystem = do <> showT eliminateArtificialVarsFromPhase1Tableau pure . Just $ FeasibleSystem - { dict = eliminateArtificialVarsFromPhase1Tableau + { dict = removeArtificialBasics phase1Dict , slackVars = slackVars , artificialVars = artificialVars , objectiveVar = objectiveVar @@ -174,6 +174,26 @@ findFeasibleSolution unsimplifiedSystem = do <> showT systemWithBasicVarsAsDictionary pure Nothing where + -- Called only after the phase-one optimum has been verified to be zero. + -- A remaining artificial basic must stay zero in the original problem. + -- Pivot it out on any nonzero non-artificial coefficient, of either sign: + -- its zero constant makes the pivot degenerate and preserves feasibility. + -- A row with no such coefficient is redundant once artificials are zero. + removeArtificialBasics :: Dict -> Dict + removeArtificialBasics dictionary = + M.map (\row -> row & #varMapSum %~ (`M.withoutKeys` artificialVarSet)) $ + foldl removeBasic dictionary artificialVars + where + removeBasic dict artificialVar = + case M.lookup artificialVar dict of + Nothing -> dict + Just row + | row.constant /= 0 -> error "removeArtificialBasics: artificial basic variable is nonzero" + | otherwise -> + case M.lookupMin (M.filter (/= 0) (M.withoutKeys row.varMapSum artificialVarSet)) of + Nothing -> M.delete artificialVar dict + Just (enteringVar, _) -> pivot artificialVar enteringVar dict + system = simplifySystem unsimplifiedSystem maxVar = @@ -661,12 +681,16 @@ unapplyTransformToVarMap transform valMap = origVal = posVal - negVal in M.insert origVar origVal (M.delete posVar (M.delete negVar valMap)) --- | Perform the simplex pivot algorithm on a system with basic vars, assume that the first row is the 'ObjectiveFunction'. +-- | Pivot a feasible dictionary using Bland's anti-cycling rule in both phases. +-- Choose the least-index improving non-basic variable, then the least-index +-- basic variable among minimum-ratio ties. The fixed 'Var' ordering and exact +-- rational arithmetic ensure degenerate pivots cannot cycle. The objective row +-- is not a nonnegative basic variable and must not constrain the ratio test. simplexPivot :: (MonadIO m, MonadLogger m) => PivotObjective -> Dict -> m (Maybe Dict) simplexPivot objective@(PivotObjective {variable = objectiveVar, function = objectiveFunc, constant = objectiveConstant}) dictionary = do logMsg LevelInfo $ "simplexPivot: Pivoting with objective " <> showT objective <> " over system (in Dict form) " <> showT dictionary - case mostPositive objectiveFunc of + case M.lookupMin (M.filter (> 0) objectiveFunc) of Nothing -> do logMsg LevelInfo $ "simplexPivot: Pivoting complete as no positive variables found in objective " @@ -674,10 +698,11 @@ simplexPivot objective@(PivotObjective {variable = objectiveVar, function = obje <> " over system (in Dict form) " <> showT dictionary pure $ Just (insertPivotObjectiveToDict objective dictionary) - Just pivotNonBasicVar -> do + Just (pivotNonBasicVar, _) -> do logMsg LevelInfo $ - "simplexPivot: Non-basic pivoting variable in objective, determined by largest coefficient = " <> showT pivotNonBasicVar - let mPivotBasicVar = ratioTest dictionary pivotNonBasicVar Nothing Nothing + "simplexPivot: Non-basic pivoting variable in objective, determined by Bland's least-index rule = " + <> showT pivotNonBasicVar + let mPivotBasicVar = ratioTest dictionary pivotNonBasicVar case mPivotBasicVar of Nothing -> do logMsg LevelInfo $ @@ -711,103 +736,81 @@ simplexPivot objective@(PivotObjective {variable = objectiveVar, function = obje pivotedObj pivotedDict where - ratioTest :: Dict -> Var -> Maybe Var -> Maybe Rational -> Maybe Var - ratioTest dict = aux (M.toList dict) + ratioTest :: Dict -> Var -> Maybe Var + ratioTest dict enteringVar = + case ratios of + [] -> Nothing + -- Pair ordering first minimizes the step, then the leaving variable. + _ -> Just (snd (minimum ratios)) where - aux :: [(Var, DictValue)] -> Var -> Maybe Var -> Maybe Rational -> Maybe Var - aux [] _ mCurrentMinBasicVar _ = mCurrentMinBasicVar - aux (x@(basicVar, dictEquation) : xs) mostNegativeVar mCurrentMinBasicVar mCurrentMin = - case M.lookup mostNegativeVar dictEquation.varMapSum of - Nothing -> aux xs mostNegativeVar mCurrentMinBasicVar mCurrentMin - Just currentCoeff -> - let dictEquationConstant = dictEquation.constant - in if currentCoeff >= 0 || dictEquationConstant < 0 - then aux xs mostNegativeVar mCurrentMinBasicVar mCurrentMin - else case mCurrentMin of - Nothing -> aux xs mostNegativeVar (Just basicVar) (Just (dictEquationConstant / currentCoeff)) - Just currentMin -> - if (dictEquationConstant / currentCoeff) >= currentMin - then aux xs mostNegativeVar (Just basicVar) (Just (dictEquationConstant / currentCoeff)) - else aux xs mostNegativeVar mCurrentMinBasicVar mCurrentMin - - mostPositive :: VarLitMapSum -> Maybe Var - mostPositive varLitMap = - case findLargestCoeff (M.toList varLitMap) Nothing of - Just (largestVarName, largestVarCoeff) -> - if largestVarCoeff <= 0 - then Nothing - else Just largestVarName - Nothing -> Nothing + ratios = + [ (row.constant / negate coeff, basicVar) + | (basicVar, row) <- M.toList dict + , basicVar /= objectiveVar + , Just coeff <- [M.lookup enteringVar row.varMapSum] + , coeff < 0 + , row.constant >= 0 + ] + +-- Pivot a dictionary using the two given variables. +-- The first variable is the leaving basic variable. +-- The second variable is the entering non-basic variable. +-- Expects the entering variable to be present in the row containing the leaving variable. +-- Expects each row to have a unique basic variable. +-- Expects each basic variable to not appear on the RHS of any equation. +pivot :: Var -> Var -> Dict -> Dict +pivot leavingVariable enteringVariable dict = + case M.lookup enteringVariable (dictEntertingRow.varMapSum) of + Just enteringVariableCoeff -> + updatedRows where - findLargestCoeff :: [(Var, SimplexNum)] -> Maybe (Var, SimplexNum) -> Maybe (Var, SimplexNum) - findLargestCoeff [] mCurrentMax = mCurrentMax - findLargestCoeff (v@(vName, vCoeff) : vs) mCurrentMax = - case mCurrentMax of - Nothing -> findLargestCoeff vs (Just v) - Just (_, currentMaxCoeff) -> - if currentMaxCoeff >= vCoeff - then findLargestCoeff vs mCurrentMax - else findLargestCoeff vs (Just v) - - -- Pivot a dictionary using the two given variables. - -- The first variable is the leaving (non-basic) variable. - -- The second variable is the entering (basic) variable. - -- Expects the entering variable to be present in the row containing the leaving variable. - -- Expects each row to have a unique basic variable. - -- Expects each basic variable to not appear on the RHS of any equation. - pivot :: Var -> Var -> Dict -> Dict - pivot leavingVariable enteringVariable dict = - case M.lookup enteringVariable (dictEntertingRow.varMapSum) of - Just enteringVariableCoeff -> - updatedRows + -- Move entering variable to basis, update other variables in row appropriately + pivotEnteringRow :: DictValue + pivotEnteringRow = + dictEntertingRow + & #varMapSum + %~ ( \basicEquation -> + -- uncurry + M.insert + leavingVariable + (-1) + (filterOutEnteringVarTerm basicEquation) + & traverse + %~ divideByNegatedEnteringVariableCoeff + ) + & #constant + %~ divideByNegatedEnteringVariableCoeff where - -- Move entering variable to basis, update other variables in row appropriately - pivotEnteringRow :: DictValue - pivotEnteringRow = - dictEntertingRow - & #varMapSum - %~ ( \basicEquation -> - -- uncurry - M.insert - leavingVariable - (-1) - (filterOutEnteringVarTerm basicEquation) - & traverse - %~ divideByNegatedEnteringVariableCoeff - ) - & #constant - %~ divideByNegatedEnteringVariableCoeff - where - divideByNegatedEnteringVariableCoeff = (/ negate enteringVariableCoeff) - - -- Substitute pivot equation into other rows - updatedRows :: Dict - updatedRows = - M.fromList $ map (uncurry updateRow) $ M.toList dict - where - updateRow :: Var -> DictValue -> (Var, DictValue) - updateRow entryVar entryVal = - if leavingVariable == entryVar - then (enteringVariable, pivotEnteringRow) - else case M.lookup enteringVariable (entryVal.varMapSum) of - Just subsCoeff -> - ( entryVar - , entryVal - & #varMapSum - .~ combineVarLitMapSums - (pivotEnteringRow.varMapSum <&> (subsCoeff *)) - (filterOutEnteringVarTerm (entryVal.varMapSum)) - & #constant - .~ ((subsCoeff * (pivotEnteringRow.constant)) + entryVal.constant) - ) - Nothing -> (entryVar, entryVal) - Nothing -> error "pivot: non basic variable not found in basic row" - where - -- \| The entering row, i.e., the row in the dict which is the value of - -- leavingVariable. - dictEntertingRow = - fromMaybe - (error "pivot: Basic variable not found in Dict") - $ M.lookup leavingVariable dict - - filterOutEnteringVarTerm = M.delete enteringVariable + divideByNegatedEnteringVariableCoeff = (/ negate enteringVariableCoeff) + + -- Substitute pivot equation into other rows + updatedRows :: Dict + updatedRows = + M.fromList $ map (uncurry updateRow) $ M.toList dict + where + updateRow :: Var -> DictValue -> (Var, DictValue) + updateRow entryVar entryVal = + if leavingVariable == entryVar + then (enteringVariable, pivotEnteringRow) + else case M.lookup enteringVariable (entryVal.varMapSum) of + Just subsCoeff -> + ( entryVar + , entryVal + & #varMapSum + .~ combineVarLitMapSums + (pivotEnteringRow.varMapSum <&> (subsCoeff *)) + (filterOutEnteringVarTerm (entryVal.varMapSum)) + & #constant + .~ ((subsCoeff * (pivotEnteringRow.constant)) + entryVal.constant) + ) + Nothing -> (entryVar, entryVal) + Nothing -> error "pivot: non basic variable not found in basic row" + where + -- \| The entering row, i.e., the row in the dict which is the value of + -- leavingVariable. + dictEntertingRow = + fromMaybe + (error "pivot: Basic variable not found in Dict") + $ M.lookup leavingVariable dict + + filterOutEnteringVarTerm = M.delete enteringVariable diff --git a/test/Linear/Simplex/Solver/TwoPhaseSpec.hs b/test/Linear/Simplex/Solver/TwoPhaseSpec.hs index 8e96a43..6837350 100644 --- a/test/Linear/Simplex/Solver/TwoPhaseSpec.hs +++ b/test/Linear/Simplex/Solver/TwoPhaseSpec.hs @@ -5,11 +5,23 @@ module Linear.Simplex.Solver.TwoPhaseSpec where import Prelude hiding (EQ) -import Control.Monad.Logger (LogLevel (LevelInfo), filterLogger, runNoLoggingT, runStdoutLoggingT) +import Control.Exception (evaluate) +import Control.Monad.Logger + ( LogLevel (LevelInfo) + , filterLogger + , fromLogStr + , runLoggingT + , runNoLoggingT + , runStdoutLoggingT + ) +import Data.IORef (modifyIORef', newIORef, readIORef) import qualified Data.Map as M import Data.Maybe (isJust) import Data.Ratio ((%)) import qualified Data.Set as Set +import qualified Data.Text as Text +import Data.Text.Encoding (decodeUtf8) +import System.Timeout (timeout) import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe, shouldSatisfy) import Test.QuickCheck (NonEmptyList (..), Positive (..), property, (==>)) @@ -24,8 +36,10 @@ import Linear.Simplex.Solver.TwoPhase , applyTransforms , collectAllVars , computeObjective + , findFeasibleSolution , generateTransform , getTransform + , optimizeFeasibleSystem , postprocess , preprocess , shiftVarInMap @@ -35,7 +49,9 @@ import Linear.Simplex.Solver.TwoPhase , unapplyTransformsToVarMap ) import Linear.Simplex.Types - ( ObjectiveFunction (..) + ( DictValue (..) + , FeasibleSystem (..) + , ObjectiveFunction (..) , ObjectiveResult (..) , OptimisationOutcome (..) , PolyConstraint (..) @@ -51,6 +67,174 @@ import Linear.Simplex.Types spec :: Spec spec = do + describe "Bland's anti-cycling rule" $ do + let -- a, b, c, d, z, in that order. The old pivot policy repeats a + -- six-pivot cycle on this bounded, feasible variant of Beale's LP. + constraints = + [ LEQ (M.singleton 2 1) 1 + , LEQ (M.fromList [(1, -3 % 2), (2, 1 % 2), (3, 1), (4, -1 % 2)]) 0 + , LEQ (M.fromList [(1, -11 % 2), (2, 1 % 2), (3, 9), (4, -5 % 2)]) 0 + , LEQ (M.fromList [(1, 57), (2, -10), (3, 24), (4, 9), (5, 1)]) 0 + ] + domainMap = VarDomainMap $ M.fromList [(v, boundedRange 0 10) | v <- [1 .. 5]] + assertFeasible varMap = do + mapM_ (\v -> M.findWithDefault 0 v varMap `shouldSatisfy` (\x -> 0 <= x && x <= 10)) [1 .. 5] + mapM_ (\constraint -> computeObjective (Max constraint.lhs) varMap `shouldSatisfy` (<= constraint.rhs)) constraints + -- Force the whole result inside the timeout: timing only construction + -- of a lazy result would not guard against a nonterminating solver. + withinTimeout action = timeout 5000000 $ do + result <- action + _ <- evaluate (length (show result)) + pure result + + it "terminates on a bounded cycling LP and preserves each objective optimum" $ do + let objectives = [Max (M.singleton 5 1), Min (M.singleton 5 (-1)), Min (M.singleton 5 1)] + actual <- withinTimeout $ runNoLoggingT $ twoPhaseSimplex domainMap objectives constraints + case actual of + Nothing -> expectationFailure "Solver timed out after five seconds on the bounded cycling LP" + Just (SimplexResult (Just _) results) -> do + map (.objectiveFunction) results `shouldBe` objectives + -- The second constraint implies d >= b - 3a + 2c, hence + -- z <= b - 30a - 42c <= 1. (a,b,c,d,z)=(0,1,0,1,1) + -- attains that bound; the origin attains min z = 0. + mapM_ + ( \(ObjectiveResult obj outcome, expected) -> case outcome of + Optimal varMap -> do + assertFeasible varMap + computeObjective obj varMap `shouldBe` expected + Unbounded -> expectationFailure "A bounded cycling LP was reported unbounded" + ) + (zip results [1, -1, 0]) + Just result -> expectationFailure $ "Expected a feasible cycling LP, got " ++ show result + + it "also terminates when the public phase-one and phase-two APIs are called separately" $ do + let bounds = [LEQ (M.singleton v 1) 10 | v <- [1 .. 5]] + obj = Max (M.singleton 5 1) + actual <- withinTimeout $ runNoLoggingT $ do + feasible <- findFeasibleSolution (constraints ++ bounds) + traverse (optimizeFeasibleSystem obj) feasible + case actual of + Just (Just (Optimal varMap)) -> do + assertFeasible varMap + computeObjective obj varMap `shouldBe` 1 + Nothing -> expectationFailure "Separate solver phases timed out after five seconds on the cycling LP" + Just result -> expectationFailure $ "Expected an optimum from the separate solver phases, got " ++ show result + + it "chooses the least entering index and least tied leaving index during phase one" $ do + -- The artificial objective has coefficients 3 for x1 and 6 for x2. + -- Both artificial rows (x3 and x4) have ratio zero. Bland chooses + -- x1 to enter and x3 to leave. Cleanup then removes redundant x4. + -- Observe the pivot choices before cleanup removes that basis evidence. + pivotChoices <- newIORef [] + actual <- + withinTimeout $ + runLoggingT + ( findFeasibleSolution + [ EQ (M.fromList [(1, 1), (2, 2)]) 0 + , EQ (M.fromList [(1, 2), (2, 4)]) 0 + ] + ) + ( \_ _ _ message -> do + let text = decodeUtf8 (fromLogStr message) + if "pivoting variable" `Text.isInfixOf` text + then modifyIORef' pivotChoices (++ [Text.takeWhileEnd (/= ' ') text]) + else pure () + ) + readIORef pivotChoices >>= (`shouldBe` ["1", "3"]) + case actual of + Just (Just feasible) -> do + M.keys (M.delete feasible.objectiveVar feasible.dict) `shouldBe` [1] + feasible.artificialVars `shouldBe` [3, 4] + Nothing -> expectationFailure "Degenerate phase one timed out after five seconds" + Just Nothing -> expectationFailure "The origin satisfies both degenerate equalities" + + it "excludes a retained objective row from the leaving-variable ratio test" $ do + -- x2 = 1 - x1 is the constraint; the retained objective x3 = -x1 + -- imposes no nonnegativity restriction on x1 when maximizing x1. + let feasible = + FeasibleSystem + { dict = M.fromList [(2, DictValue (M.singleton 1 (-1)) 1), (3, DictValue (M.singleton 1 (-1)) 0)] + , slackVars = [2] + , artificialVars = [] + , objectiveVar = 3 + } + obj = Max (M.singleton 1 1) + actual <- withinTimeout $ runNoLoggingT $ optimizeFeasibleSystem obj feasible + case actual of + Just (Optimal varMap) -> computeObjective obj varMap `shouldBe` 1 + Nothing -> expectationFailure "Optimization with a retained objective row timed out" + Just Unbounded -> expectationFailure "The actual constraint bounds x1 by one" + + it "keeps zero artificial basic variables fixed when optimizing the original system" $ do + let domains = VarDomainMap $ M.fromList [(v, boundedRange 1 2) | v <- [1, 2]] + objectives = concat [[Min (M.singleton v 1), Max (M.singleton v 1)] | v <- [1, 2]] + cornerConstraints = + [ LEQ (M.fromList [(1, 1), (2, 1)]) 2 + , LEQ (M.fromList [(1, 2), (2, 2)]) 5 + ] + actual <- withinTimeout $ runNoLoggingT $ twoPhaseSimplex domains objectives cornerConstraints + case actual of + Just (SimplexResult (Just feasible) results) -> do + -- x1,x2 >= 1 and x1+x2 <= 2 force the unique point (1,1). + -- A residual artificial basic must not relax either lower bound. + map (.objectiveFunction) results `shouldBe` objectives + mapM_ + ( \(ObjectiveResult obj outcome) -> case outcome of + Optimal varMap -> do + [M.findWithDefault 0 v varMap | v <- [1, 2]] `shouldBe` [1, 1] + computeObjective obj varMap `shouldBe` 1 + Unbounded -> expectationFailure "The unique feasible point cannot yield an unbounded objective" + ) + results + M.keys feasible.dict `shouldSatisfy` all (`notElem` feasible.artificialVars) + mapM_ (\row -> M.keys row.varMapSum `shouldSatisfy` all (`notElem` feasible.artificialVars)) (M.elems feasible.dict) + Nothing -> expectationFailure "The unique feasible point LP timed out" + Just result -> expectationFailure $ "Expected the unique feasible point (1,1), got " ++ show result + + it "drops only redundant zero rows when removing artificial basic variables" $ do + let domains = VarDomainMap $ M.fromList [(v, nonNegative) | v <- [1, 2]] + objectives = concat [[Min (M.singleton v 1), Max (M.singleton v 1)] | v <- [1, 2]] + redundantEqualities = + [ EQ (M.fromList [(1, 1), (2, 1)]) 1 + , EQ (M.fromList [(1, 2), (2, 2)]) 2 + , EQ (M.fromList [(1, 3), (2, 3)]) 3 + ] + actual <- withinTimeout $ runNoLoggingT $ twoPhaseSimplex domains objectives redundantEqualities + case actual of + Just (SimplexResult (Just feasible) results) -> do + M.size (M.delete feasible.objectiveVar feasible.dict) `shouldBe` 1 + map (.objectiveFunction) results `shouldBe` objectives + mapM_ + ( \(ObjectiveResult obj outcome, expected) -> case outcome of + Optimal varMap -> do + let values = [M.findWithDefault 0 v varMap | v <- [1, 2]] + values `shouldSatisfy` all (>= 0) + sum values `shouldBe` 1 + computeObjective obj varMap `shouldBe` expected + Unbounded -> expectationFailure "The retained equality bounds both variables" + ) + (zip results [0, 1, 0, 1]) + Nothing -> expectationFailure "The redundant equalities timed out" + Just result -> expectationFailure $ "Expected feasible redundant equalities, got " ++ show result + + it "can remove an artificial basic by pivoting on a negative coefficient" $ do + -- Phase one first pivots x1 into the x3 row, leaving x4 = -x2 + x3 + -- and x5 = 2*x2 + x3. The phase-one objective is already optimal. + -- Cleanup encounters x4 first and must accept its negative x2 coefficient. + actual <- withinTimeout $ runNoLoggingT $ do + feasible <- + findFeasibleSolution + [ EQ (M.fromList [(1, 1), (2, 2)]) 0 + , EQ (M.fromList [(1, 1), (2, 3)]) 0 + , EQ (M.singleton 1 1) 0 + ] + traverse (optimizeFeasibleSystem (Max (M.singleton 2 1))) feasible + case actual of + Just (Just (Optimal varMap)) -> + [M.findWithDefault 0 v varMap | v <- [1, 2]] `shouldBe` [0, 0] + Nothing -> expectationFailure "Cleanup with a negative pivot coefficient timed out" + Just result -> expectationFailure $ "Expected the origin as the unique feasible point, got " ++ show result + describe "twoPhaseSimplex" $ do -- From page 50 of 'Linear and Integer Programming Made Easy' describe "From 'Linear and Integer Programming Made Easy' (page 50)" $ do @@ -809,7 +993,8 @@ spec = do twoPhaseSimplex domainMap [obj] constraints case actualResult of SimplexResult (Just _) [ObjectiveResult _ (Optimal varMap)] -> do - varMap `shouldBe` M.fromList [(1, 5 % 2), (2, 5 % 3), (3, 0)] + -- A zero variable may be non-basic and omitted from the result. + M.union varMap (M.singleton 3 0) `shouldBe` M.fromList [(1, 5 % 2), (2, 5 % 3), (3, 0)] computeObjective obj varMap `shouldBe` (5 % 2) SimplexResult Nothing _ -> expectationFailure "Expected optimal but got infeasible" _ -> expectationFailure "Unexpected result" @@ -839,7 +1024,7 @@ spec = do twoPhaseSimplex domainMap [obj] constraints case actualResult of SimplexResult (Just _) [ObjectiveResult _ (Optimal varMap)] -> do - varMap `shouldBe` M.fromList [(2, 5 % 2), (1, 5 % 2), (3, 0)] + M.union varMap (M.singleton 3 0) `shouldBe` M.fromList [(2, 5 % 2), (1, 5 % 2), (3, 0)] computeObjective obj varMap `shouldBe` (5 % 2) SimplexResult Nothing _ -> expectationFailure "Expected optimal but got infeasible" _ -> expectationFailure "Unexpected result" @@ -950,7 +1135,7 @@ spec = do twoPhaseSimplex domainMap [obj] constraints case actualResult of SimplexResult (Just _) [ObjectiveResult _ (Optimal varMap)] -> do - varMap `shouldBe` M.fromList [(2, 5 % 9), (1, 7 % 2), (3, 0)] + M.union varMap (M.singleton 3 0) `shouldBe` M.fromList [(2, 5 % 9), (1, 7 % 2), (3, 0)] computeObjective obj varMap `shouldBe` (7 % 2) SimplexResult Nothing _ -> expectationFailure "Expected optimal but got infeasible" _ -> expectationFailure "Unexpected result"