From 7dc62e37ff5014aecd5d480aa439367ca67ef5c4 Mon Sep 17 00:00:00 2001 From: Junaid Rasheed Date: Fri, 2 Oct 2026 11:23:07 +0100 Subject: [PATCH 1/2] fix(simplex): support zero objectives after phase one --- src/Linear/Simplex/Util.hs | 33 ++-------------------- test/Linear/Simplex/Solver/TwoPhaseSpec.hs | 17 ++++++++++- test/Linear/Simplex/UtilSpec.hs | 7 ++--- 3 files changed, 22 insertions(+), 35 deletions(-) diff --git a/src/Linear/Simplex/Util.hs b/src/Linear/Simplex/Util.hs index 38b415c..64b6884 100644 --- a/src/Linear/Simplex/Util.hs +++ b/src/Linear/Simplex/Util.hs @@ -14,7 +14,6 @@ import Control.Monad.Logger (LogLevel (..), MonadLogger, logDebug, logError, log import Data.Generics.Labels () import Data.List (nub, (\\)) import qualified Data.Map as Map -import qualified Data.Map.Merge.Lazy as MapMerge import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Time (getCurrentTime) @@ -117,37 +116,11 @@ tableauInDictionaryForm = -- | Combines two 'VarLitMapSums together by summing values with matching keys combineVarLitMapSums :: VarLitMapSum -> VarLitMapSum -> VarLitMapSum -combineVarLitMapSums = - MapMerge.merge - (MapMerge.mapMaybeMissing keepVal) - (MapMerge.mapMaybeMissing keepVal) - (MapMerge.zipWithMaybeMatched sumVals) - where - keepVal = const pure - sumVals k v1 v2 = Just $ v1 + v2 +combineVarLitMapSums = Map.unionWith (+) +-- | Sum coefficient maps, treating an empty list as the zero expression. foldVarLitMap :: [VarLitMap] -> VarLitMap -foldVarLitMap [] = error "Empty list of VarLitMaps given to foldVarLitMap" -foldVarLitMap [x] = x -foldVarLitMap (vm1 : vm2 : vms) = - let combinedVars = nub $ Map.keys vm1 <> Map.keys vm2 - - combinedVarMap = - Map.fromList $ - map - ( \var -> - let mVm1VarVal = Map.lookup var vm1 - mVm2VarVal = Map.lookup var vm2 - in ( var - , case (mVm1VarVal, mVm2VarVal) of - (Just vm1VarVal, Just vm2VarVal) -> vm1VarVal + vm2VarVal - (Just vm1VarVal, Nothing) -> vm1VarVal - (Nothing, Just vm2VarVal) -> vm2VarVal - (Nothing, Nothing) -> error "Reached unreachable branch in foldVarLitMap" - ) - ) - combinedVars - in foldVarLitMap $ combinedVarMap : vms +foldVarLitMap = Map.unionsWith (+) insertPivotObjectiveToDict :: PivotObjective -> Dict -> Dict insertPivotObjectiveToDict objective = Map.insert objective.variable (DictValue {varMapSum = objective.function, constant = objective.constant}) diff --git a/test/Linear/Simplex/Solver/TwoPhaseSpec.hs b/test/Linear/Simplex/Solver/TwoPhaseSpec.hs index 9ca2246..65d6efd 100644 --- a/test/Linear/Simplex/Solver/TwoPhaseSpec.hs +++ b/test/Linear/Simplex/Solver/TwoPhaseSpec.hs @@ -5,7 +5,7 @@ module Linear.Simplex.Solver.TwoPhaseSpec where import Prelude hiding (EQ) -import Control.Monad.Logger (LogLevel (LevelInfo), filterLogger, runStdoutLoggingT) +import Control.Monad.Logger (LogLevel (LevelInfo), filterLogger, runNoLoggingT, runStdoutLoggingT) import qualified Data.Map as M import Data.Maybe (isJust) import Data.Ratio ((%)) @@ -1236,6 +1236,21 @@ spec = do SimplexResult Nothing _ -> expectationFailure "Expected optimal but got infeasible" _ -> expectationFailure "Unexpected result" + describe "zero objectives after phase one" $ do + mapM_ + ( \obj -> + it ("optimizes " ++ show obj ++ " after introducing artificial variables") $ do + let domains = VarDomainMap $ M.singleton 1 nonNegative + result <- runNoLoggingT $ twoPhaseSimplex domains [obj] [GEQ (M.singleton 1 1) 1] + result.feasibleSystem `shouldSatisfy` isJust + case result.objectiveResults of + [ObjectiveResult _ (Optimal values)] -> do + computeObjective obj values `shouldBe` 0 + M.findWithDefault 0 1 values `shouldSatisfy` (>= 1) + _ -> expectationFailure $ "Unexpected result: " ++ show result + ) + [Max M.empty, Min M.empty] + describe "twoPhaseSimplex with empty constraint system" $ do describe "Single variable with boundedRange" $ do it "Max x₁ with 0 ≤ x₁ ≤ 10: optimal at x₁=10" $ do diff --git a/test/Linear/Simplex/UtilSpec.hs b/test/Linear/Simplex/UtilSpec.hs index 6b74215..81385c4 100644 --- a/test/Linear/Simplex/UtilSpec.hs +++ b/test/Linear/Simplex/UtilSpec.hs @@ -4,9 +4,8 @@ module Linear.Simplex.UtilSpec where import Prelude hiding (EQ) -import Control.Exception (evaluate) import qualified Data.Map as M -import Test.Hspec (Spec, anyErrorCall, describe, expectationFailure, it, shouldBe, shouldThrow) +import Test.Hspec (Spec, describe, expectationFailure, it, shouldBe) import Test.QuickCheck (Positive (..), property) import Linear.Simplex.Types @@ -243,8 +242,8 @@ spec = do m3 = M.fromList [(2, 7), (3, 5)] foldVarLitMap [m1, m2, m3] `shouldBe` M.fromList [(1, 3), (2, 10), (3, 5)] - it "throws error on empty list" $ do - evaluate (foldVarLitMap []) `shouldThrow` anyErrorCall + it "returns the zero expression for an empty list" $ do + foldVarLitMap [] `shouldBe` M.empty describe "Properties" $ do it "folding a singleton list is identity" $ From a44718213f01918518539cdc242e72fb920a492d Mon Sep 17 00:00:00 2001 From: Junaid Rasheed Date: Fri, 2 Oct 2026 11:46:14 +0100 Subject: [PATCH 2/2] docs(changelog): document changes in PR #18 --- ChangeLog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/ChangeLog.md b/ChangeLog.md index d47e0a4..c064d1c 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,7 @@ ## Unreleased changes +- 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)) - `twoPhaseSimplex` now takes a `VarDomainMap` as its first argument - Specify each variable's domain using smart constructors: `nonNegative`, `unbounded`, `lowerBoundOnly`, `upperBoundOnly`, or `boundedRange` - Variables not in the `VarDomainMap` are assumed to be `unbounded`