diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for simplex-haskell + +## Unreleased changes diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Junaid Rasheed (c) 2020-2022 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Junaid Rasheed nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,124 @@ +# simplex-method + +`simplex-method` is a Haskell library that implements the two-phase [simplex method](https://en.wikipedia.org/wiki/Simplex_algorithm) in exact rational arithmetic. + +## Quick Overview + +The `Linear.Simplex.Simplex` module contain both phases of the simplex method. + +### Phase One + +Phase one is implemented by `findFeasibleSolution`: + +```haskell +findFeasibleSolution :: [PolyConstraint] -> Maybe (DictionaryForm, [Integer], [Integer], Integer) +``` + +`findFeasibleSolution` takes a list of `PolyConstraint`s. +The `PolyConstraint` type, as well as other custom types required by this library, are defined in the `Linear.Simplex.Types` module. +`PolyConstraint` is defined as: + +```haskell +data PolyConstraint = + LEQ VarConstMap Rational | + GEQ VarConstMap Rational | + EQ VarConstMap Rational deriving (Show, Eq); +``` + +And `VarConstMap` is defined as: + +```haskell +type VarConstMap = [(Integer, Rational)] +``` + +A `VarConstMap` is treated as a list of `Integer` variables mapped to their `Rational` coefficients, with an implicit `+` between each element in the list. +For example: `[(1, 2), (2, (-3)), (1, 3)]` is equivalent to `(2x1 + (-3x2) + 3x1)`. + +And a `PolyConstraint` is an inequality/equality where the LHS is a `VarConstMap` and the RHS is a `Rational`. +For example: `LEQ [(1, 2), (2, (-3)), (1, 3)] 60` is equivalent to `(2x1 + (-3x2) + 3x1) <= 60`. + +Passing a `[PolyConstraint]` to `findFeasibleSolution` will return a feasible solution if it exists as well as a list of slack variables, artificial variables, and a variable that can be safely used to represent the objective for phase two. +`Nothing` is returned if the given `[PolyConstraint]` is infeasible. +The feasible system is returned as the type `DictionaryForm`: + +```haskell +type DictionaryForm = [(Integer, VarConstMap)] +``` + +`DictionaryForm` can be thought of as a list of equations, where the `Integer` represents a basic variable on the LHS that is equal to the RHS represented as a `VarConstMap`. In this `VarConstMap`, the `Integer` -1 is used internally to represent a `Rational` number. + +### Phase Two + +`optimizeFeasibleSystem` performs phase two of the simplex method, and has the type: + +```haskell +data ObjectiveFunction = Max VarConstMap | Min VarConstMap deriving (Show, Eq) + +optimizeFeasibleSystem :: ObjectiveFunction -> DictionaryForm -> [Integer] -> [Integer] -> Integer -> Maybe (Integer, [(Integer, Rational)]) +``` + +We first pass an `ObjectiveFunction`. +Then we give a feasible system in `DictionaryForm`, a list of slack variables, a list of artificial variables, and a variable to represent the objective. +`optimizeFeasibleSystem` Maximizes/Minimizes the linear equation represented as a `VarConstMap` in the given `ObjectiveFunction`. +The first item of the returned pair is the `Integer` variable representing the objective. +The second item is a list of `Integer` variables mapped to their optimized values. +If a variable is not in this list, the variable is equal to 0. + +### Two-Phase Simplex +`twoPhaseSimplex` performs both phases of the simplex method. +It has the type: +```haskell +twoPhaseSimplex :: ObjectiveFunction -> [PolyConstraint] -> Maybe (Integer, [(Integer, Rational)]) +``` +The return type is the same as that of `optimizeFeasibleSystem` + +### Extracting Results +The result of the objective function is present in the return type of both `twoPhaseSimplex` and `optimizeFeasibleSystem`, but this can be difficult to grok in systems with many variables, so the following function will extract the value of the objective function for you. + +```haskell +extractObjectiveValue :: Maybe (Integer, [(Integer, Rational)]) -> Maybe Rational +``` + +There are similar functions for `DictionaryForm` as well as other custom types in the module `Linear.Simplex.Util`. + +## Usage notes + +You must only use positive `Integer` variables in a `VarConstMap`. +This implementation assumes that the user only provides positive `Integer` variables; the `Integer` -1, for example, is sometimes used to represent a `Rational` number. + +## Example + +```haskell +exampleFunction :: (ObjectiveFunction, [PolyConstraint]) +exampleFunction = + ( + Max [(1, 3), (2, 5)], -- 3x1 + 5x2 + [ + LEQ [(1, 3), (2, 1)] 15, -- 3x1 + x2 <= 15 + LEQ [(1, 1), (2, 1)] 7, -- x1 + x2 <= 7 + LEQ [(2, 1)] 4, -- x2 <= 4 + LEQ [(1, -1), (2, 2)] 6 -- -x1 + 2x2 <= 6 + ] + ) + +twoPhaseSimplex (fst exampleFunction) (snd exampleFunction) +``` + +The result of the call above is: +```haskell +Just + (7, -- Integer representing objective function + [ + (7,29 % 1), -- Value for variable 7, so max(3x1 + 5x2) = 29. + (1,3 % 1), -- Value for variable 1, so x1 = 3 + (2,4 % 1) -- Value for variable 2, so x2 = 4 + ] + ) +``` + +There are many more examples in test/TestFunctions.hs. +You may use `prettyShowVarConstMap`, `prettyShowPolyConstraint`, and `prettyShowObjectiveFunction` to convert these tests into a more human-readable format. + +## Issues + +Please share any bugs you find [here](https://github.com/rasheedja/simplex-haskell/issues). diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/simplex-method.cabal b/simplex-method.cabal new file mode 100644 --- /dev/null +++ b/simplex-method.cabal @@ -0,0 +1,53 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack + +name: simplex-method +version: 0.1.0.0 +synopsis: Implementation of the two-phase simplex method in exact rational arithmetic +description: Please see the README on GitHub at +category: Math, Maths, Mathematics, Optimisation, Optimization, Linear Programming +homepage: https://github.com/rasheedja/simplex-method#readme +bug-reports: https://github.com/rasheedja/simplex-method/issues +author: Junaid Rasheed +maintainer: jrasheed178@gmail.com +copyright: BSD-3 +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/rasheedja/simplex-method + +library + exposed-modules: + Linear.Simplex.Prettify + Linear.Simplex.Simplex + Linear.Simplex.Types + Linear.Simplex.Util + other-modules: + Paths_simplex_method + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + default-language: Haskell2010 + +test-suite simplex-haskell-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + TestFunctions + Paths_simplex_method + hs-source-dirs: + test + build-depends: + base >=4.7 && <5 + , simplex-method + default-language: Haskell2010 diff --git a/src/Linear/Simplex/Prettify.hs b/src/Linear/Simplex/Prettify.hs new file mode 100644 --- /dev/null +++ b/src/Linear/Simplex/Prettify.hs @@ -0,0 +1,39 @@ +{-| +Module : Linear.Simplex.Prettify +Description : Prettifier for "Linear.Simplex.Types" types +Copyright : (c) Junaid Rasheed, 2020-2022 +License : BSD-3 +Maintainer : jrasheed178@gmail.com +Stability : experimental + +Converts "Linear.Simplex.Types" types into human-readable 'String's +-} +module Linear.Simplex.Prettify where + +import Linear.Simplex.Types as T +import Data.Ratio + +-- |Convert a 'VarConstMap' into a human-readable 'String' +prettyShowVarConstMap :: VarConstMap -> String +prettyShowVarConstMap [] = "" +prettyShowVarConstMap [(v, c)] = prettyShowRational c ++ " * x" ++ show v ++ "" + where + prettyShowRational r = + if r < 0 + then "(" ++ r' ++ ")" + else r' + where + r' = if denominator r == 1 then show (numerator r) else show (numerator r) ++ " / " ++ show (numerator r) + +prettyShowVarConstMap ((v, c) : vcs) = prettyShowVarConstMap [(v, c)] ++ " + " ++ prettyShowVarConstMap vcs + +-- |Convert a 'PolyConstraint' into a human-readable 'String' +prettyShowPolyConstraint :: PolyConstraint -> String +prettyShowPolyConstraint (LEQ vcm r) = prettyShowVarConstMap vcm ++ " <= " ++ show r +prettyShowPolyConstraint (GEQ vcm r) = prettyShowVarConstMap vcm ++ " >= " ++ show r +prettyShowPolyConstraint (T.EQ vcm r) = prettyShowVarConstMap vcm ++ " == " ++ show r + +-- |Convert an 'ObjectiveFunction' into a human-readable 'String' +prettyShowObjectiveFunction :: ObjectiveFunction -> String +prettyShowObjectiveFunction (Min vcm) = "min: " ++ prettyShowVarConstMap vcm +prettyShowObjectiveFunction (Max vcm) = "max: " ++ prettyShowVarConstMap vcm diff --git a/src/Linear/Simplex/Simplex.hs b/src/Linear/Simplex/Simplex.hs new file mode 100644 --- /dev/null +++ b/src/Linear/Simplex/Simplex.hs @@ -0,0 +1,289 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} + +{-| +Module : Linear.Simplex.Simplex +Description : Implements the twoPhaseSimplex method +Copyright : (c) Junaid Rasheed, 2020-2022 +License : BSD-3 +Maintainer : jrasheed178@gmail.com +Stability : experimental + +Module implementing the two-phase simplex method. +'findFeasibleSolution' performs phase one of the two-phase simplex method. +'optimizeFeasibleSystem' performs phase two of the two-phase simplex method. +'twoPhaseSimplex' performs both phases of the two-phase simplex method. +-} +module Linear.Simplex.Simplex (findFeasibleSolution, optimizeFeasibleSystem, twoPhaseSimplex) where +import Linear.Simplex.Types +import Linear.Simplex.Util +import Prelude hiding (EQ); +import Data.List +import Data.Bifunctor +import Data.Maybe (fromMaybe, mapMaybe) +import Data.Ratio (numerator, denominator, (%)) +-- import Debug.Trace (trace) + +trace s a = a + +-- |Find a feasible solution for the given system of 'PolyConstraint's by performing the first phase of the two-phase simplex method +-- All 'Integer' variables in the 'PolyConstraint' must be positive. +-- If the system is infeasible, return 'Nothing' +-- Otherwise, return the feasible system in 'DictionaryForm' as well as a list of slack variables, a list artificial variables, and the objective variable. +findFeasibleSolution :: [PolyConstraint] -> Maybe (DictionaryForm, [Integer], [Integer], Integer) +findFeasibleSolution unsimplifiedSystem = + if null artificialVars -- No artificial vars, we have a feasible system + then Just (systemWithBasicVarsAsDictionary, slackVars, artificialVars, objectiveVar) + else + case simplexPivot (createObjectiveDict artificialObjective objectiveVar : systemWithBasicVarsAsDictionary) of + Just phase1Dict -> + let + eliminateArtificialVarsFromPhase1Tableau = map (second (filter (\(v, _) -> v `notElem` artificialVars))) phase1Dict + in + case lookup objectiveVar eliminateArtificialVarsFromPhase1Tableau of + Nothing -> trace "objective row not found in phase 1 tableau" Nothing -- Should this be an error? + Just row -> + if fromMaybe 0 (lookup (-1) row) == 0 + then Just (eliminateArtificialVarsFromPhase1Tableau, slackVars, artificialVars, objectiveVar) + else trace "rhs not zero after phase 1, thus original tableau is infeasible" Nothing + Nothing -> Nothing + where + system = simplifySystem unsimplifiedSystem + + maxVar = + maximum $ map + (\case + LEQ vcm _ -> maximum (map fst vcm) + GEQ vcm _ -> maximum (map fst vcm) + EQ vcm _ -> maximum (map fst vcm) + ) + system + + (systemWithSlackVars, slackVars) = systemInStandardForm system maxVar [] + + maxVarWithSlackVars = if null slackVars then maxVar else maximum slackVars + + (systemWithBasicVars, artificialVars) = systemWithArtificialVars systemWithSlackVars maxVarWithSlackVars + + finalMaxVar = if null artificialVars then maxVarWithSlackVars else maximum artificialVars + + systemWithBasicVarsAsDictionary = tableauInDictionaryForm systemWithBasicVars + + artificialObjective = createArtificialObjective systemWithBasicVarsAsDictionary artificialVars + + objectiveVar = finalMaxVar + 1 + + -- |Convert a system of 'PolyConstraint's to standard form; a system of only equations ('EQ'). + -- Add slack vars where necessary. + -- This may give you an infeasible system if slack vars are negative when original variables are zero. + -- If a constraint is already EQ, set the basic var to Nothing. + -- Final system is a list of equalities for the given system. + -- To be feasible, all vars must be >= 0. + systemInStandardForm :: [PolyConstraint] -> Integer -> [Integer] -> ([(Maybe Integer, PolyConstraint)], [Integer]) + systemInStandardForm [] _ sVars = ([], sVars) + systemInStandardForm (EQ v r : xs) maxVar sVars = ((Nothing, EQ v r) : newSystem, newSlackVars) + where + (newSystem, newSlackVars) = systemInStandardForm xs maxVar sVars + systemInStandardForm (LEQ v r : xs) maxVar sVars = ((Just newSlackVar, EQ (v ++ [(newSlackVar, 1)]) r) : newSystem, newSlackVars) + where + newSlackVar = maxVar + 1 + (newSystem, newSlackVars) = systemInStandardForm xs newSlackVar (newSlackVar : sVars) + systemInStandardForm (GEQ v r : xs) maxVar sVars = ((Just newSlackVar, EQ (v ++ [(newSlackVar, -1)]) r) : newSystem, newSlackVars) + where + newSlackVar = maxVar + 1 + (newSystem, newSlackVars) = systemInStandardForm xs newSlackVar (newSlackVar : sVars) + + -- |Add artificial vars to a system of 'PolyConstraint's. + -- Artificial vars are added when: + -- Basic var is Nothing (When the original constraint was already an EQ). + -- Slack var is equal to a negative value (this is infeasible, all vars need to be >= 0). + -- Final system will be a feasible artificial system. + -- We keep track of artificial vars in the second item of the returned pair so they can be eliminated once phase 1 is complete. + -- If an artificial var would normally be negative, we negate the row so we can keep artificial variables equal to 1 + systemWithArtificialVars :: [(Maybe Integer, PolyConstraint)] -> Integer -> (Tableau, [Integer]) + systemWithArtificialVars [] _ = ([],[]) + systemWithArtificialVars ((mVar, EQ v r) : pcs) maxVar = + case mVar of + Nothing -> + if r >= 0 + then + ((newArtificialVar, (v ++ [(newArtificialVar, 1)], r)) : newSystemWithNewMaxVar, newArtificialVar : artificialVarsWithNewMaxVar) + else + ((newArtificialVar, (v ++ [(newArtificialVar, -1)], r)) : newSystemWithNewMaxVar, newArtificialVar : artificialVarsWithNewMaxVar) + Just basicVar -> + case lookup basicVar v of + Just basicVarCoeff -> + if r == 0 + then ((basicVar, (v, r)) : newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) + else + if r > 0 + then + if basicVarCoeff >= 0 -- Should only be 1 in the standard call path + then ((basicVar, (v, r)) : newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) + else ((newArtificialVar, (v ++ [(newArtificialVar, 1)], r)) : newSystemWithNewMaxVar, newArtificialVar : artificialVarsWithNewMaxVar) -- Slack var is negative, r is positive (when original constraint was GEQ) + else -- r < 0 + if basicVarCoeff <= 0 -- Should only be -1 in the standard call path + then ((basicVar, (v, r)) : newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) + else ((newArtificialVar, (v ++ [(newArtificialVar, -1)], r)) : newSystemWithNewMaxVar, newArtificialVar : artificialVarsWithNewMaxVar) -- Slack var is negative, r is negative (when original constraint was LEQ) + where + newArtificialVar = maxVar + 1 + + (newSystemWithNewMaxVar, artificialVarsWithNewMaxVar) = systemWithArtificialVars pcs newArtificialVar + + (newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) = systemWithArtificialVars pcs maxVar + + -- |Create an artificial objective using the given 'Integer' list of artificialVars and the given 'DictionaryForm'. + -- The artificial 'ObjectiveFunction' is the negated sum of all artificial vars. + createArtificialObjective :: DictionaryForm -> [Integer] -> ObjectiveFunction + createArtificialObjective rows artificialVars = Max negatedSumWithoutArtificialVars + where + rowsToAdd = filter (\(i, _) -> i `elem` artificialVars) rows + negatedRows = map (\(_, vcm) -> map (second negate) vcm) rowsToAdd + negatedSum = foldSumVarConstMap ((sort . concat) negatedRows) + negatedSumWithoutArtificialVars = filter (\(v, _) -> v `notElem` artificialVars) negatedSum + + +-- |Optimize a feasible system by performing the second phase of the two-phase simplex method. +-- We first pass an 'ObjectiveFunction'. +-- Then, the feasible system in 'DictionaryForm' as well as a list of slack variables, a list artificial variables, and the objective variable. +-- Returns a pair with the first item being the 'Integer' variable equal to the 'ObjectiveFunction' +-- and the second item being a map of the values of all 'Integer' variables appearing in the system, including the 'ObjectiveFunction'. +optimizeFeasibleSystem :: ObjectiveFunction -> DictionaryForm -> [Integer] -> [Integer] -> Integer -> Maybe (Integer, [(Integer, Rational)]) +optimizeFeasibleSystem unsimplifiedObjFunction phase1Dict slackVars artificialVars objectiveVar = + if null artificialVars + then displayResults . dictionaryFormToTableau <$> simplexPivot (createObjectiveDict objFunction objectiveVar : phase1Dict) + else displayResults . dictionaryFormToTableau <$> simplexPivot (createObjectiveDict phase2ObjFunction objectiveVar : tail phase1Dict) + where + objFunction = simplifyObjectiveFunction unsimplifiedObjFunction + + displayResults :: Tableau -> (Integer, [(Integer, Rational)]) + displayResults tableau = + ( + objectiveVar, + case objFunction of + Max _ -> + map + (second snd) + $ filter (\(basicVar,_) -> basicVar `notElem` slackVars ++ artificialVars) tableau + Min _ -> + map -- We maximized -objVar, so we negate the objVar to get the final value + (\(basicVar, row) -> if basicVar == objectiveVar then (basicVar, negate (snd row)) else (basicVar, snd row)) + $ filter (\(basicVar,_) -> basicVar `notElem` slackVars ++ artificialVars) tableau + ) + + phase2Objective = + (foldSumVarConstMap . sort) $ + concatMap + (\(var, coeff) -> + case lookup var phase1Dict of + Nothing -> [(var, coeff)] + Just row -> map (second (*coeff)) row + ) + (getObjective objFunction) + + phase2ObjFunction = if isMax objFunction then Max phase2Objective else Min phase2Objective + +-- |Perform the two phase simplex method with a given 'ObjectiveFunction' a system of 'PolyConstraint's. +-- Assumes the 'ObjectiveFunction' and 'PolyConstraint' is not empty. +-- Returns a pair with the first item being the 'Integer' variable equal to the 'ObjectiveFunction' +-- and the second item being a map of the values of all 'Integer' variables appearing in the system, including the 'ObjectiveFunction'. +twoPhaseSimplex :: ObjectiveFunction -> [PolyConstraint] -> Maybe (Integer, [(Integer, Rational)]) +twoPhaseSimplex objFunction unsimplifiedSystem = + case findFeasibleSolution unsimplifiedSystem of + Just r@(phase1Dict, slackVars, artificialVars, objectiveVar) -> optimizeFeasibleSystem objFunction phase1Dict slackVars artificialVars objectiveVar + Nothing -> Nothing + +-- |Perform the simplex pivot algorithm on a system with basic vars, assume that the first row is the 'ObjectiveFunction'. +simplexPivot :: DictionaryForm -> Maybe DictionaryForm +simplexPivot dictionary = + trace (show dictionary) $ + case mostPositive (head dictionary) of + Nothing -> + trace "all neg \n" + trace (show dictionary) + Just dictionary + Just pivotNonBasicVar -> + let + mPivotBasicVar = ratioTest (tail dictionary) pivotNonBasicVar Nothing Nothing + in + case mPivotBasicVar of + Nothing -> trace ("Ratio test failed on non-basic var: " ++ show pivotNonBasicVar ++ "\n" ++ show dictionary) Nothing + Just pivotBasicVar -> + trace "one pos \n" + trace (show dictionary) + simplexPivot (pivot pivotBasicVar pivotNonBasicVar dictionary ) + where + ratioTest :: DictionaryForm -> Integer -> Maybe Integer -> Maybe Rational -> Maybe Integer + ratioTest [] _ mCurrentMinBasicVar _ = mCurrentMinBasicVar + ratioTest ((basicVar, lp) : xs) mostNegativeVar mCurrentMinBasicVar mCurrentMin = + case lookup mostNegativeVar lp of + Nothing -> ratioTest xs mostNegativeVar mCurrentMinBasicVar mCurrentMin + Just currentCoeff -> + let + rhs = fromMaybe 0 (lookup (-1) lp) + in + if currentCoeff >= 0 || rhs < 0 + then + -- trace (show currentCoeff) + ratioTest xs mostNegativeVar mCurrentMinBasicVar mCurrentMin -- rhs was already in right side in original tableau, so should be above zero + -- Coeff needs to be negative since it has been moved to the RHS + else + case mCurrentMin of + Nothing -> ratioTest xs mostNegativeVar (Just basicVar) (Just (rhs / currentCoeff)) + Just currentMin -> + if (rhs / currentCoeff) >= currentMin + then ratioTest xs mostNegativeVar (Just basicVar) (Just (rhs / currentCoeff)) + else ratioTest xs mostNegativeVar mCurrentMinBasicVar mCurrentMin + + mostPositive :: (Integer, VarConstMap) -> Maybe Integer + mostPositive (_, lp) = + case findLargestCoeff lp Nothing of + Just (largestVar, largestCoeff) -> + if largestCoeff <= 0 + then Nothing + else Just largestVar + Nothing -> trace "No variables in first row when looking for most positive" Nothing + + where + findLargestCoeff :: VarConstMap -> Maybe (Integer, Rational) -> Maybe (Integer, Rational) + findLargestCoeff [] mCurrentMax = mCurrentMax + findLargestCoeff ((var, coeff) : xs) mCurrentMax = + if var == (-1) + then findLargestCoeff xs mCurrentMax + else + case mCurrentMax of + Nothing -> findLargestCoeff xs (Just (var, coeff)) + Just currentMax -> + if snd currentMax >= coeff + then findLargestCoeff xs mCurrentMax + else findLargestCoeff xs (Just (var, coeff)) + + -- |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 :: Integer -> Integer -> DictionaryForm -> DictionaryForm + pivot leavingVariable enteringVariable rows = + case lookup enteringVariable basicRow of + Just nonBasicCoeff -> + updatedRows + where + -- Move entering variable to basis, update other variables in row appropriately + pivotEquation = (enteringVariable, map (second (/ negate nonBasicCoeff)) ((leavingVariable, -1) : filter ((enteringVariable /=) . fst) basicRow)) + -- Substitute pivot equation into other rows + updatedRows = + map + (\(basicVar, vMap) -> + if leavingVariable == basicVar + then pivotEquation + else + case lookup enteringVariable vMap of + Just subsCoeff -> (basicVar, (foldSumVarConstMap . sort) (map (second (subsCoeff *)) (snd pivotEquation) ++ filter ((enteringVariable /=) . fst) vMap)) + Nothing -> (basicVar, vMap) + ) + rows + Nothing -> trace "non basic variable not found in basic row" undefined + where + (_, basicRow) = head $ filter ((leavingVariable ==) . fst) rows diff --git a/src/Linear/Simplex/Types.hs b/src/Linear/Simplex/Types.hs new file mode 100644 --- /dev/null +++ b/src/Linear/Simplex/Types.hs @@ -0,0 +1,46 @@ +{-| +Module : Linear.Simplex.Types +Description : Custom types +Copyright : (c) Junaid Rasheed, 2020-2022 +License : BSD-3 +Maintainer : jrasheed178@gmail.com +Stability : experimental +-} +module Linear.Simplex.Types where + +-- |List of 'Integer' variables with their 'Rational' coefficients. +-- There is an implicit addition between elements in this list. +-- Users must only provide positive integer variables. +-- +-- Example: [(2, 3), (6, (-1), (2, 1))] is equivalent to 3x2 + (-x6) + x2. +type VarConstMap = [(Integer, Rational)] + +-- |For specifying constraints in a system. +-- The LHS is a 'VarConstMap', and the RHS, is a 'Rational' number. +-- LEQ [(1, 2), (2, 1)] 3.5 is equivalent to 2x1 + x2 <= 3.5. +-- Users must only provide positive integer variables. +-- +-- Example: LEQ [(2, 3), (6, (-1), (2, 1))] 12.3 is equivalent to 3x2 + (-x6) + x2 <= 12.3. +data PolyConstraint = + LEQ VarConstMap Rational | + GEQ VarConstMap Rational | + EQ VarConstMap Rational deriving (Show, Eq); + +-- |Create an objective function. +-- We can either 'Max'imize or 'Min'imize a 'VarConstMap'. +data ObjectiveFunction = Max VarConstMap | Min VarConstMap deriving (Show, Eq) + +-- |A 'Tableau' of equations. +-- Each pair in the list is a row. +-- The first item in the pair specifies which 'Integer' variable is basic in the equation. +-- The second item in the pair is an equation. +-- The 'VarConstMap' in the second equation is a list of variables with their coefficients. +-- The RHS of the equation is a 'Rational' constant. +type Tableau = [(Integer, (VarConstMap, Rational))] + +-- |Type representing equations. +-- Each pair in the list is one equation. +-- The first item of the pair is the basic variable, and is on the LHS of the equation with a coefficient of one. +-- The RHS is represented using a `VarConstMap`. +-- The integer variable -1 is used to represent a 'Rational' on the RHS +type DictionaryForm = [(Integer, VarConstMap)] diff --git a/src/Linear/Simplex/Util.hs b/src/Linear/Simplex/Util.hs new file mode 100644 --- /dev/null +++ b/src/Linear/Simplex/Util.hs @@ -0,0 +1,153 @@ +{-# LANGUAGE LambdaCase #-} + +{-| +Module : Linear.Simplex.Util +Description : Helper functions +Copyright : (c) Junaid Rasheed, 2020-2022 +License : BSD-3 +Maintainer : jrasheed178@gmail.com +Stability : experimental + +Helper functions for performing the two-phase simplex method. +-} +module Linear.Simplex.Util where + +import Prelude hiding (EQ); +import Linear.Simplex.Types +import Data.List +import Data.Bifunctor + +-- |Is the given 'ObjectiveFunction' to be 'Max'imized? +isMax :: ObjectiveFunction -> Bool +isMax (Max _) = True +isMax (Min _) = False + +-- |Extract the objective ('VarConstMap') from an 'ObjectiveFunction' +getObjective :: ObjectiveFunction -> VarConstMap +getObjective (Max o) = o +getObjective (Min o) = o + +-- |Simplifies a system of 'PolyConstraint's by first calling 'simplifyPolyConstraint', +-- then reducing 'LEQ' and 'GEQ' with same LHS and RHS (and other similar situations) into 'EQ', +-- and finally removing duplicate elements using 'nub'. +simplifySystem :: [PolyConstraint] -> [PolyConstraint] +simplifySystem = nub . reduceSystem . map simplifyPolyConstraint + where + reduceSystem :: [PolyConstraint] -> [PolyConstraint] + reduceSystem [] = [] + -- Reduce LEQ with matching GEQ and EQ into EQ + reduceSystem ((LEQ lhs rhs) : pcs) = + let + matchingConstraints = + filter + (\case + GEQ lhs' rhs' -> lhs == lhs' && rhs == rhs' + EQ lhs' rhs' -> lhs == lhs' && rhs == rhs' + _ -> False + ) + pcs + in + if null matchingConstraints + then LEQ lhs rhs : reduceSystem pcs + else EQ lhs rhs : reduceSystem (pcs \\ matchingConstraints) + -- Reduce GEQ with matching LEQ and EQ into EQ + reduceSystem ((GEQ lhs rhs) : pcs) = + let + matchingConstraints = + filter + (\case + LEQ lhs' rhs' -> lhs == lhs' && rhs == rhs' + EQ lhs' rhs' -> lhs == lhs' && rhs == rhs' + _ -> False + ) + pcs + in + if null matchingConstraints + then GEQ lhs rhs : reduceSystem pcs + else EQ lhs rhs : reduceSystem (pcs \\ matchingConstraints) + -- Reduce EQ with matching LEQ and GEQ into EQ + reduceSystem ((EQ lhs rhs) : pcs) = + let + matchingConstraints = + filter + (\case + LEQ lhs' rhs' -> lhs == lhs' && rhs == rhs' + GEQ lhs' rhs' -> lhs == lhs' && rhs == rhs' + _ -> False + ) + pcs + in + if null matchingConstraints + then EQ lhs rhs : reduceSystem pcs + else EQ lhs rhs : reduceSystem (pcs \\ matchingConstraints) + +-- |Simplify an 'ObjectiveFunction' by first 'sort'ing and then calling 'foldSumVarConstMap' on the 'VarConstMap'. +simplifyObjectiveFunction :: ObjectiveFunction -> ObjectiveFunction +simplifyObjectiveFunction (Max varConstMap) = Max (foldSumVarConstMap (sort varConstMap)) +simplifyObjectiveFunction (Min varConstMap) = Min (foldSumVarConstMap (sort varConstMap)) + +-- |Simplify a 'PolyConstraint' by first 'sort'ing and then calling 'foldSumVarConstMap' on the 'VarConstMap'. +simplifyPolyConstraint :: PolyConstraint -> PolyConstraint +simplifyPolyConstraint (LEQ varConstMap rhs) = LEQ (foldSumVarConstMap (sort varConstMap)) rhs +simplifyPolyConstraint (GEQ varConstMap rhs) = GEQ (foldSumVarConstMap (sort varConstMap)) rhs +simplifyPolyConstraint (EQ varConstMap rhs) = EQ (foldSumVarConstMap (sort varConstMap)) rhs + +-- |Add a sorted list of 'VarConstMap's, folding where the variables are equal +foldSumVarConstMap :: [(Integer, Rational)] -> [(Integer, Rational)] +foldSumVarConstMap [] = [] +foldSumVarConstMap [(v, c)] = [(v, c)] +foldSumVarConstMap ((v1, c1) : (v2, c2) : vcm) = + if v1 == v2 + then + let newC = c1 + c2 + in + if newC == 0 + then foldSumVarConstMap vcm + else foldSumVarConstMap $ (v1, c1 + c2) : vcm + else (v1, c1) : foldSumVarConstMap ((v2, c2) : vcm) + +-- |Get a map of the value of every 'Integer' variable in a 'Tableau' +displayTableauResults :: Tableau -> [(Integer, Rational)] +displayTableauResults = map (\(basicVar, (_, rhs)) -> (basicVar, rhs)) + +-- |Get a map of the value of every 'Integer' variable in a 'DictionaryForm' +displayDictionaryResults :: DictionaryForm -> [(Integer, Rational)] +displayDictionaryResults dict = displayTableauResults$ dictionaryFormToTableau dict + +-- |Map the given 'Integer' variable to the given 'ObjectiveFunction', for entering into 'DictionaryForm'. +createObjectiveDict :: ObjectiveFunction -> Integer -> (Integer, VarConstMap) +createObjectiveDict (Max obj) objectiveVar = (objectiveVar, obj) +createObjectiveDict (Min obj) objectiveVar = (objectiveVar, map (second negate) obj) + +-- |Converts a 'Tableau' to 'DictionaryForm'. +-- We do this by isolating the basic variable on the LHS, ending up with all non basic variables and a 'Rational' constant on the RHS. +-- (-1) is used to represent the rational constant. +tableauInDictionaryForm :: Tableau -> DictionaryForm +tableauInDictionaryForm [] = [] +tableauInDictionaryForm ((basicVar, (vcm, r)) : rows) = + (basicVar, (-1, r / basicCoeff) : map (\(v, c) -> (v, negate c / basicCoeff)) nonBasicVars) : tableauInDictionaryForm rows + where + basicCoeff = if null basicVars then 1 else snd $ head basicVars + (basicVars, nonBasicVars) = partition (\(v, _) -> v == basicVar) vcm + +-- |Converts a 'DictionaryForm' to a 'Tableau'. +-- This is done by moving all non-basic variables from the right to the left. +-- The rational constant (represented by the 'Integer' variable -1) stays on the right. +-- The basic variables will have a coefficient of 1 in the 'Tableau'. +dictionaryFormToTableau :: DictionaryForm -> Tableau +dictionaryFormToTableau [] = [] +dictionaryFormToTableau ((basicVar, row) : rows) = + (basicVar, ((basicVar, 1) : map (second negate) nonBasicVars, r)) : dictionaryFormToTableau rows + where + (rationalConstant, nonBasicVars) = partition (\(v,_) -> v == (-1)) row + r = if null rationalConstant then 0 else (snd . head) rationalConstant -- If there is no rational constant found in the right side, the rational constant is 0. + +-- |If this function is given 'Nothing', return 'Nothing'. +-- Otherwise, we 'lookup' the 'Integer' given in the first item of the pair in the map given in the second item of the pair. +-- This is typically used to extract the value of the 'ObjectiveFunction' after calling 'Linear.Simplex.Simplex.twoPhaseSimplex'. +extractObjectiveValue :: Maybe (Integer, [(Integer, Rational)]) -> Maybe Rational +extractObjectiveValue Nothing = Nothing +extractObjectiveValue (Just (objVar, results)) = + case lookup objVar results of + Nothing -> error "Objective not found in results when extracting objective value" + r -> r diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,28 @@ +module Main where + +import Linear.Simplex.Simplex +import Linear.Simplex.Prettify +import Linear.Simplex.Util +import TestFunctions + +main :: IO () +main = runTests testsList + +runTests [] = putStrLn "All tests passed" +runTests (((testObjective, testConstraints), expectedResult) : tests) = + let testResult = twoPhaseSimplex testObjective testConstraints in + if testResult == expectedResult + then runTests tests + else do + putStrLn "The following test failed: \n" + putStrLn ("Objective Function (Non-prettified): " ++ show testObjective) + putStrLn ("Constraints (Non-prettified): " ++ show testConstraints) + putStrLn "====================================\n" + putStrLn ("Objective Function (Prettified): " ++ prettyShowObjectiveFunction testObjective) + putStrLn "Constraints (Prettified): " + putStrLn (concatMap ((\c -> "\t" ++ prettyShowPolyConstraint c ++ "\n")) testConstraints) + putStrLn "====================================\n" + putStrLn ("Expected Solution (Full): " ++ show expectedResult) + putStrLn ("Actual Solution (Full): " ++ show testResult) + putStrLn ("Expected Solution (Objective): " ++ show (extractObjectiveValue expectedResult)) + putStrLn ("Actual Solution (Objective): " ++ show (extractObjectiveValue testResult)) diff --git a/test/TestFunctions.hs b/test/TestFunctions.hs new file mode 100644 --- /dev/null +++ b/test/TestFunctions.hs @@ -0,0 +1,1078 @@ +module TestFunctions where + +import Prelude hiding (EQ) +import Linear.Simplex.Types +import Data.Ratio + +testsList :: [((ObjectiveFunction, [PolyConstraint]), Maybe (Integer, [(Integer, Rational)]))] +testsList = + [ + (test1, Just (7,[(7,29 % 1),(1,3 % 1),(2,4 % 1)])) + , (test2, Just (7,[(7,0 % 1)])) + , (test3, Nothing) + , (test4, Just (11,[(11,237 % 7),(1,24 % 7),(2,33 % 7)])) + , (test5, Just (9,[(9,3 % 5),(2,14 % 5),(3,17 % 5)])) + , (test6, Nothing) + , (test7, Just (8,[(8,1 % 1),(2,2 % 1),(1,3 % 1)])) + , (test8, Just (8,[(8,(-1) % 4),(2,9 % 2),(1,17 % 4)])) + , (test9, Just (7,[(7,5 % 1),(3,2 % 1),(4,1 % 1)])) + , (test10, Just (7,[(7,8 % 1),(1,2 % 1),(2,6 % 1)])) + , (test11, Just (8,[(8,20 % 1),(4,16 % 1),(3,6 % 1)])) + , (test12, Just (8,[(8,6 % 1),(4,2 % 1),(5,2 % 1)])) + , (test13, Just (6,[(6,150 % 1),(2,150 % 1)])) + , (test14, Just (6,[(6,40 % 3),(2,40 % 3)])) + , (test15, Nothing) + , (test16, Just (6,[(6,75 % 1),(1,75 % 2)])) + , (test17, Just (7,[(7,(-120) % 1),(1,20 % 1)])) + , (test18, Just (7,[(7,10 % 1),(3,5 % 1)])) + , (test19, Nothing) + , (test20, Nothing) + , (test21, Just (7,[(7,250 % 1),(2,50 % 1)])) + , (test22, Just (7,[(7,0 % 1)])) + , (test23, Nothing) + , (test24, Just (10,[(10,300 % 1),(3,150 % 1)])) + , (test25, Just (3,[(3,15 % 1),(1,15 % 1)])) + , (test26, Just (6,[(6,20 % 1),(1,10 % 1),(2,10 % 1)])) + , (test27, Just (3,[(3,0 % 1)])) + , (test28, Just (6,[(6,0 % 1),(2,10 % 1)])) + , (test29, Nothing) + , (test30, Nothing) + , (testPolyPaver1, Just (12,[(12,7 % 4),(2,5 % 2),(1,7 % 4),(3,0 % 1)])) + , (testPolyPaver2, Just (12,[(12,5 % 2),(2,5 % 3),(1,5 % 2),(3,0 % 1)])) + , (testPolyPaver3, Just (12,[(12,5 % 3),(2,5 % 3),(1,5 % 2),(3,0 % 1)])) + , (testPolyPaver4, Just (12,[(12,5 % 2),(2,5 % 2),(1,5 % 2),(3,0 % 1)])) + , (testPolyPaver5, Nothing) + , (testPolyPaver6, Nothing) + , (testPolyPaver7, Nothing) + , (testPolyPaver8, Nothing) + , (testPolyPaver9, Just (12,[(12,7 % 2),(2,5 % 9),(1,7 % 2),(3,0 % 1)])) + , (testPolyPaver10, Just (12,[(12,17 % 20),(2,7 % 2),(1,17 % 20),(3,0 % 1)])) + , (testPolyPaver11, Just (12,[(12,7 % 2),(2,7 % 2),(1,22 % 9)])) + , (testPolyPaver12, Just (12,[(12,5 % 9),(2,5 % 9),(1,7 % 2),(3,0 % 1)])) + , (testPolyPaverTwoFs1, Nothing) + , (testPolyPaverTwoFs2, Nothing) + , (testPolyPaverTwoFs3, Nothing) + , (testPolyPaverTwoFs4, Nothing) + , (testPolyPaverTwoFs5, Just (17,[(17,5 % 2),(2,45 % 22),(1,5 % 2),(4,0 % 1)])) + , (testPolyPaverTwoFs6, Just (17,[(17,45 % 22),(2,5 % 2),(1,45 % 22),(4,0 % 1)])) + , (testPolyPaverTwoFs7, Just (17,[(17,5 % 2),(2,5 % 2),(1,5 % 2),(4,0 % 1)])) + , (testPolyPaverTwoFs8, Just (17,[(17,45 % 22),(2,45 % 22),(1,5 % 2),(4,0 % 1)])) + , (testLeqGeqBugMin1, Just (5,[(5,3 % 1),(1,3 % 1),(2,3 % 1)])) + , (testLeqGeqBugMax1, Just (5,[(5,3 % 1),(1,3 % 1),(2,3 % 1)])) + , (testLeqGeqBugMin2, Just (5,[(5,3 % 1),(1,3 % 1),(2,3 % 1)])) + , (testLeqGeqBugMax2, Just (5,[(5,3 % 1),(1,3 % 1),(2,3 % 1)])) + , (testQuickCheck1, Just (10,[(10,(-370) % 1),(2,26 % 1),(1,5 % 3)])) + , (testQuickCheck2, Just (8,[(8,(-2) % 9),(1,14 % 9),(2,8 % 9)])) + , (testQuickCheck3, Just (7,[(7,(-8) % 1),(2,2 % 1)])) + ] + +testLeqGeqBugMin1 = + ( + Min [(1, 1)], + [ + GEQ [(1,1 % 1)] (3 % 1), + LEQ [(1,1 % 1)] (3 % 1), + GEQ [(2,1 % 1)] (3 % 1), + LEQ [(2,1 % 1)] (3 % 1) + ] + ) + +testLeqGeqBugMax1 = + ( + Min [(1, 1)], + [ + GEQ [(1,1 % 1)] (3 % 1), + LEQ [(1,1 % 1)] (3 % 1), + GEQ [(2,1 % 1)] (3 % 1), + LEQ [(2,1 % 1)] (3 % 1) + ] + ) + +testLeqGeqBugMin2 = + ( + Min [(1, 1)], + [ + GEQ [(1,1 % 1)] (3 % 1), + LEQ [(1,1 % 1)] (3 % 1), + GEQ [(2,1 % 1)] (3 % 1), + LEQ [(2,1 % 1)] (3 % 1) + ] + ) + +testLeqGeqBugMax2 = + ( + Min [(1, 1)], + [ + GEQ [(1,1 % 1)] (3 % 1), + LEQ [(1,1 % 1)] (3 % 1), + GEQ [(2,1 % 1)] (3 % 1), + LEQ [(2,1 % 1)] (3 % 1) + ] + ) + +-- From page 50 of 'Linear and Integer Programming Made Easy' +-- Solution: obj = 29, 1 = 3, 2 = 4, +test1 :: (ObjectiveFunction, [PolyConstraint]) +test1 = + ( + Max [(1, 3), (2, 5)], + [ + LEQ [(1, 3), (2, 1)] 15, + LEQ [(1, 1), (2, 1)] 7, + LEQ [(2, 1)] 4, + LEQ [(1, -1), (2, 2)] 6 + ] + ) + +test2 :: (ObjectiveFunction, [PolyConstraint]) +test2 = + ( + Min [(1, 3), (2, 5)], + [ + LEQ [(1, 3), (2, 1)] 15, + LEQ [(1, 1), (2, 1)] 7, + LEQ [(2, 1)] 4, + LEQ [(1, -1), (2, 2)] 6 + ] + ) + +test3 :: (ObjectiveFunction, [PolyConstraint]) +test3 = + ( + Max [(1, 3), (2, 5)], + [ + GEQ [(1, 3), (2, 1)] 15, + GEQ [(1, 1), (2, 1)] 7, + GEQ [(2, 1)] 4, + GEQ [(1, -1), (2, 2)] 6 + ] + ) + +test4 :: (ObjectiveFunction, [PolyConstraint]) +test4 = + ( + Min [(1, 3), (2, 5)], + [ + GEQ [(1, 3), (2, 1)] 15, + GEQ [(1, 1), (2, 1)] 7, + GEQ [(2, 1)] 4, + GEQ [(1, -1), (2, 2)] 6 + ] + ) + +-- From https://www.eng.uwaterloo.ca/~syde05/phase1.pdf +-- Solution: obj = 3/5, 2 = 14/5, 3 = 17/5 +-- requires two phases +test5 :: (ObjectiveFunction, [PolyConstraint]) +test5 = + ( + Max [(1, 1), (2, -1), (3, 1)], + [ + LEQ [(1, 2), (2, -1), (3, 2)] 4, + LEQ [(1, 2), (2, -3), (3, 1)] (-5), + LEQ [(1, -1), (2, 1), (3, -2)] (-1) + ] + ) + +test6 :: (ObjectiveFunction, [PolyConstraint]) +test6 = + ( + Min [(1, 1), (2, -1), (3, 1)], + [ + LEQ [(1, 2), (2, -1), (3, 2)] 4, + LEQ [(1, 2), (2, -3), (3, 1)] (-5), + LEQ [(1, -1), (2, 1), (3, -2)] (-1) + ] + ) +test7 :: (ObjectiveFunction, [PolyConstraint]) +test7 = + ( + Max [(1, 1), (2, -1), (3, 1)], + [ + GEQ [(1, 2), (2, -1), (3, 2)] 4, + GEQ [(1, 2), (2, -3), (3, 1)] (-5), + GEQ [(1, -1), (2, 1), (3, -2)] (-1) + ] + ) +test8 :: (ObjectiveFunction, [PolyConstraint]) +test8 = + ( + Min [(1, 1), (2, -1), (3, 1)], + [ + GEQ [(1, 2), (2, -1), (3, 2)] 4, + GEQ [(1, 2), (2, -3), (3, 1)] (-5), + GEQ [(1, -1), (2, 1), (3, -2)] (-1) + ] + ) + +-- From page 49 of 'Linear and Integer Programming Made Easy' +-- Solution: obj = -5, 3 = 2, 4 = 1, objVar was negated so actual val is 5 wa +-- requires two phases +test9 :: (ObjectiveFunction, [PolyConstraint]) +test9 = + ( + Min [(1, 1), (2, 1), (3, 2), (4, 1)], + [ + EQ [(1, 1), (3, 2), (4, -2)] 2, + EQ [(2, 1), (3, 1), (4, 4)] 6 + ] + ) + +test10 :: (ObjectiveFunction, [PolyConstraint]) +test10 = + ( + Max [(1, 1), (2, 1), (3, 2), (4, 1)], + [ + EQ [(1, 1), (3, 2), (4, -2)] 2, + EQ [(2, 1), (3, 1), (4, 4)] 6 + ] + ) + +-- Adapted from page 52 of 'Linear and Integer Programming Made Easy' +-- Removed variables which do not appear in the system (these should be artificial variables) +-- Solution: obj = 20, 3 = 6, 4 = 16 wq +test11 :: (ObjectiveFunction, [PolyConstraint]) +test11 = + ( + Max [(3, -2), (4, 2), (5, 1)], + [ + EQ [(3, -2), (4, 1), (5, 1)] 4, + EQ [(3, 3), (4, -1), (5, 2)] 2 + ] + ) + +test12 :: (ObjectiveFunction, [PolyConstraint]) +test12 = + ( + Min [(3, -2), (4, 2), (5, 1)], + [ + EQ [(3, -2), (4, 1), (5, 1)] 4, + EQ [(3, 3), (4, -1), (5, 2)] 2 + ] + ) + +-- From page 59 of 'Linear and Integer Programming Made Easy' +-- Solution: obj = 150, 1 = 0, 2 = 150 +-- requires two phases +test13 :: (ObjectiveFunction, [PolyConstraint]) +test13 = + ( + Max [(1, 2), (2, 1)], + [ + LEQ [(1, 4), (2, 1)] 150, + LEQ [(1, 2), (2, -3)] (-40) + ] + ) + +test14 :: (ObjectiveFunction, [PolyConstraint]) +test14 = + ( + Min [(1, 2), (2, 1)], + [ + LEQ [(1, 4), (2, 1)] 150, + LEQ [(1, 2), (2, -3)] (-40) + ] + ) + +test15 :: (ObjectiveFunction, [PolyConstraint]) +test15 = + ( + Max [(1, 2), (2, 1)], + [ + GEQ [(1, 4), (2, 1)] 150, + GEQ [(1, 2), (2, -3)] (-40) + ] + ) + +test16 :: (ObjectiveFunction, [PolyConstraint]) +test16 = + ( + Min [(1, 2), (2, 1)], + [ + GEQ [(1, 4), (2, 1)] 150, + GEQ [(1, 2), (2, -3)] (-40) + ] + ) + +-- From page 59 of 'Linear and Integer Programming Made Easy' +-- Solution: obj = 120, 1 = 20, 2 = 0, 3 = 0, objVar was negated so actual val is -120 +test17 :: (ObjectiveFunction, [PolyConstraint]) +test17 = + ( + Min [(1, -6), (2, -4), (3, 2)], + [ + LEQ [(1, 1), (2, 1), (3, 4)] 20, + LEQ [(2, -5), (3, 5)] 100, + LEQ [(1, 1), (3, 1), (1, 1)] 400 + ] + ) + +test18 :: (ObjectiveFunction, [PolyConstraint]) +test18 = + ( + Max [(1, -6), (2, -4), (3, 2)], + [ + LEQ [(1, 1), (2, 1), (3, 4)] 20, + LEQ [(2, -5), (3, 5)] 100, + LEQ [(1, 1), (3, 1), (1, 1)] 400 + ] + ) + +test19 :: (ObjectiveFunction, [PolyConstraint]) +test19 = + ( + Min [(1, -6), (2, -4), (3, 2)], + [ + GEQ [(1, 1), (2, 1), (3, 4)] 20, + GEQ [(2, -5), (3, 5)] 100, + GEQ [(1, 1), (3, 1), (1, 1)] 400 + ] + ) + +test20 :: (ObjectiveFunction, [PolyConstraint]) +test20 = + ( + Max [(1, -6), (2, -4), (3, 2)], + [ + GEQ [(1, 1), (2, 1), (3, 4)] 20, + GEQ [(2, -5), (3, 5)] 100, + GEQ [(1, 1), (3, 1), (1, 1)] 400 + ] + ) + +-- From page 59 of 'Linear and Integer Programming Made Easy' +-- Solution: obj = 250, 1 = 0, 2 = 50, 3 = 0 +test21 :: (ObjectiveFunction, [PolyConstraint]) +test21 = + ( + Max [(1, 3), (2, 5), (3, 2)], + [ + LEQ [(1, 5), (2, 1), (3, 4)] 50, + LEQ [(1, 1), (2, -1), (3, 1)] 150, + LEQ [(1, 2), (2, 1), (3, 2)] 100 + ] + ) + +test22 :: (ObjectiveFunction, [PolyConstraint]) +test22 = + ( + Min [(1, 3), (2, 5), (3, 2)], + [ + LEQ [(1, 5), (2, 1), (3, 4)] 50, + LEQ [(1, 1), (2, -1), (3, 1)] 150, + LEQ [(1, 2), (2, 1), (3, 2)] 100 + ] + ) + +test23 :: (ObjectiveFunction, [PolyConstraint]) +test23 = + ( + Max [(1, 3), (2, 5), (3, 2)], + [ + GEQ [(1, 5), (2, 1), (3, 4)] 50, + GEQ [(1, 1), (2, -1), (3, 1)] 150, + GEQ [(1, 2), (2, 1), (3, 2)] 100 + ] + ) + +test24 :: (ObjectiveFunction, [PolyConstraint]) +test24 = + ( + Min [(1, 3), (2, 5), (3, 2)], + [ + GEQ [(1, 5), (2, 1), (3, 4)] 50, + GEQ [(1, 1), (2, -1), (3, 1)] 150, + GEQ [(1, 2), (2, 1), (3, 2)] 100 + ] + ) + +test25 :: (ObjectiveFunction, [PolyConstraint]) +test25 = + ( + Max [(1, 1)], + [ + LEQ [(1, 1)] 15 + ] + ) + +test26 :: (ObjectiveFunction, [PolyConstraint]) +test26 = + ( + Max [(1, 2)], + [ + LEQ [(1, 2)] 20, + GEQ [(2, 1)] 10 + ] + ) + +test27 :: (ObjectiveFunction, [PolyConstraint]) +test27 = + ( + Min [(1, 1)], + [ + LEQ [(1, 1)] 15 + ] + ) + +test28 :: (ObjectiveFunction, [PolyConstraint]) +test28 = + ( + Min [(1, 2)], + [ + LEQ [(1, 2)] 20, + GEQ [(2, 1)] 10 + ] + ) + +test29 :: (ObjectiveFunction, [PolyConstraint]) +test29 = + ( + Max [(1, 1)], + [ + LEQ [(1, 1)] 15, + GEQ [(1, 1)] 15.01 + ] + ) + +test30 :: (ObjectiveFunction, [PolyConstraint]) +test30 = + ( + Max [(1, 1)], + [ + LEQ [(1, 1)] 15, + GEQ [(1, 1)] 15.01, + GEQ [(2, 1)] 10 + ] + ) + +-- Tests for systems similar to those from PolyPaver2 +testPolyPaver1 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver1 = + ( + Min [(1 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver2 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver2 = + ( + Max [(1 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver3 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver3 = + ( + Min [(2 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver4 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver4 = + ( + Max [(2 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver5 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver5 = + ( + Max [(1 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 1.5 + x2l = 0.0 + x2r = 1.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver6 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver6 = + ( + Min [(1 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 1.5 + x2l = 0.0 + x2r = 1.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver7 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver7 = + ( + Max [(2 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 1.5 + x2l = 0.0 + x2r = 1.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver8 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver8 = + ( + Min [(2 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 1.5 + x2l = 0.0 + x2r = 1.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver9 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver9 = + ( + Max [(1 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 3.5 + x2l = 0.0 + x2r = 3.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver10 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver10 = + ( + Min [(1 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 3.5 + x2l = 0.0 + x2r = 3.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver11 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver11 = + ( + Max [(2 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 3.5 + x2l = 0.0 + x2r = 3.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaver12 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaver12 = + ( + Min [(2 , 1)], + [ + LEQ [(1, dx1l), (2, dx2l), (3, (-1))] ((-yl) + (dx1l * x1l) + (dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, dx1r), (2, dx2r), (3, (-1))] ((-yr) + (dx1r * x1l) + (dx2r * x2l)), -- -5 + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 3.5 + x2l = 0.0 + x2r = 3.5 + dx1l = -1 + dx1r = -0.9 + dx2l = -0.9 + dx2r = -0.8 + yl = 4 + yr = 5 + +testPolyPaverTwoFs1 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs1 = + ( + Max [(1 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -1 + f2dx1r = -0.9 + f2dx2l = -0.9 + f2dx2r = -0.8 + f2yl = 1 + f2yr = 2 + +testPolyPaverTwoFs2 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs2 = + ( + Min [(1 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -1 + f2dx1r = -0.9 + f2dx2l = -0.9 + f2dx2r = -0.8 + f2yl = 1 + f2yr = 2 + +testPolyPaverTwoFs3 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs3 = + ( + Max [(2 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -1 + f2dx1r = -0.9 + f2dx2l = -0.9 + f2dx2r = -0.8 + f2yl = 1 + f2yr = 2 + +testPolyPaverTwoFs4 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs4 = + ( + Min [(2 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -1 + f2dx1r = -0.9 + f2dx2l = -0.9 + f2dx2r = -0.8 + f2yl = 1 + f2yr = 2 + +testPolyPaverTwoFs5 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs5 = + ( + Max [(1 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, -- don't need variable >= 0, already assumed + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -0.66 + f2dx1r = -0.66 + f2dx2l = -0.66 + f2dx2r = -0.66 + f2yl = 3 + f2yr = 4 + +testPolyPaverTwoFs6 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs6 = + ( + Min [(1 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, -- don't need variable >= 0, already assumed + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -0.66 + f2dx1r = -0.66 + f2dx2l = -0.66 + f2dx2r = -0.66 + f2yl = 3 + f2yr = 4 + +testPolyPaverTwoFs7 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs7 = + ( + Max [(2 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, -- don't need variable >= 0, already assumed + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -0.66 + f2dx1r = -0.66 + f2dx2l = -0.66 + f2dx2r = -0.66 + f2yl = 3 + f2yr = 4 + +testPolyPaverTwoFs8 :: (ObjectiveFunction, [PolyConstraint]) +testPolyPaverTwoFs8 = + ( + Min [(2 , 1)], + [ + LEQ [(1, f1dx1l), (2, f1dx2l), (3, (-1))] ((-f1yl) + (f1dx1l * x1l) + (f1dx2l * x2l)), -- -4, This will need an artificial variable + GEQ [(1, f1dx1r), (2, f1dx2r), (3, (-1))] ((-f1yr) + (f1dx1r * x1l) + (f1dx2r * x2l)), + LEQ [(1, f2dx1l), (2, f2dx2l), (4, (-1))] ((-f2yl) + (f2dx1l * x1l) + (f2dx2l * x2l)), + GEQ [(1, f2dx1r), (2, f2dx2r), (4, (-1))] ((-f2yr) + (f2dx1r * x1l) + (f2dx2r * x2l)), + GEQ [(1, 1)] x1l, -- don't need variable >= 0, already assumed + LEQ [(1, 1)] x1r, + GEQ [(2, 1)] x2l, + LEQ [(2, 1)] x2r, + LEQ [(3, 1)] 0, + LEQ [(4, 1)] 0 + ] + ) + where + x1l = 0.0 + x1r = 2.5 + x2l = 0.0 + x2r = 2.5 + f1dx1l = -1 + f1dx1r = -0.9 + f1dx2l = -0.9 + f1dx2r = -0.8 + f1yl = 4 + f1yr = 5 + f2dx1l = -0.66 + f2dx1r = -0.66 + f2dx2l = -0.66 + f2dx2r = -0.66 + f2yl = 3 + f2yr = 4 + +-- Test cases produced by old simplex-haskell/SoPlex QuickCheck prop + +-- SoPlex gives -400 for the following system but -370 is the optimized solution +-- simplex-haskell gives -370 +-- SoPlex gives -370 if we simplify the system before sending it to SoPlex +testQuickCheck1 = + ( + Max [(1, -6), (1, -8), (1, 9), (1, 10), (1, 8), (2, -15), (1, 13), (1, -14), (2, 0)], + [ + EQ [(1, 5), (1, 6), (2, -2), (1, 7), (1, 6), (2, 0)] (-12), + GEQ [(1, 11), (1, 0), (1, -5), (1, -12), (1, -14), (2, 11)] (-7), + GEQ [(1, -12), (1, -7), (1, -2), (2, -9), (1, 3), (1, 5), (1, -15), (2, 14)] (-8), GEQ [(1, 13), (1, 1), (1, -11), (2, 0)] 5, + LEQ [(1, -10), (1, -14), (1, 4), (1, -2), (1, -10), (1, -5), (1, -11)] (-1) + ] + ) + +-- If we do not call simplifyPolyConstraints before we start the simplex algorithm, the following return a wrong solution +-- Correct solution is -2/9 +testQuickCheck2 = + ( + Max [(1, -3), (2, 5)], + [ + LEQ [(2, -1), (1, -6), (2, 7)] 4, + LEQ [(1, 1), (2, -4), (3, 3)] (-2), + LEQ [(2, 6), (1, -4), (2, 1)] 0] + ) + +-- This test will fail if the objective function is not simplified +testQuickCheck3 = + ( + Min [(2, 0), (2, -4)], + [ + GEQ [(1, 5), (2, 4)] (-4), + LEQ [(1, -1), (2, -1)] 2, + LEQ [(2, 1)] 2, + GEQ [(1, -5), (2, -1), (2, 1)] (-5) + ] + )