diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 7de7f26..92d3748 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -17,21 +17,17 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: haskell-actions/run-fourmolu@v7 + - uses: haskell-actions/run-fourmolu@v9 + with: + version: "0.14.0.0" build: name: GHC ${{ matrix.ghc-version }} on ${{ matrix.os }} runs-on: ${{ matrix.os }} strategy: fail-fast: false matrix: - os: [ubuntu-latest] - ghc-version: ['9.6', '9.4', '9.2', '9.0', '8.10'] - - include: - - os: windows-latest - ghc-version: '9.6' - - os: macos-latest - ghc-version: '9.6' + os: [windows-latest, macos-latest, ubuntu-latest] + ghc-version: ['9.6', '9.4', '9.2', '9.0'] steps: - uses: actions/checkout@v3 @@ -41,54 +37,94 @@ jobs: id: setup with: ghc-version: ${{ matrix.ghc-version }} - # Defaults, added for clarity: - cabal-version: 'latest' - cabal-update: true + enable-stack: true - - name: Installed minor versions of GHC and Cabal + - name: Installed minor versions of GHC, Cabal, and Stack shell: bash run: | GHC_VERSION=$(ghc --numeric-version) CABAL_VERSION=$(cabal --numeric-version) + STACK_VERSION=$(stack --numeric-version) echo "GHC_VERSION=${GHC_VERSION}" >> "${GITHUB_ENV}" echo "CABAL_VERSION=${CABAL_VERSION}" >> "${GITHUB_ENV}" + echo "STACK_VERSION=${STACK_VERSION}" >> "${GITHUB_ENV}" - name: Configure the build run: | - cabal configure --enable-tests --enable-benchmarks --disable-documentation - cabal build --dry-run + # cabal configure --enable-tests --enable-benchmarks --disable-documentation + # cabal build --dry-run + stack build --test --bench --no-haddock --dry-run # The last step generates dist-newstyle/cache/plan.json for the cache key. - - name: Restore cached dependencies + - name: Restore .stack-work cache + uses: actions/cache/restore@v3 + id: cache-restore-stack-work + with: + path: .stack-work + key: ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-stack-${{ env.STACK_VERSION }}-stack-work-${{ hashFiles('stack.yaml') }}-${{ hashFiles('package.yaml') }}-${{ hashFiles('**/*.hs') }} + restore-keys: | + ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-stack-${{ env.STACK_VERSION }}-stack-work- + + - name: Restore ~/.stack cache (Unix) + uses: actions/cache/restore@v3 + id: cache-restore-stack-global-unix + if: runner.os == 'Linux' || runner.os == 'macOS' + with: + path: ~/.stack + key: ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-stack-${{ env.STACK_VERSION }}-stack-global-${{ hashFiles('stack.yaml') }}-${{ hashFiles('package.yaml') }} + restore-keys: | + ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-stack-${{ env.STACK_VERSION }}-stack-global- + + - name: Restore %APPDATA%\stack, %LOCALAPPDATA%\Programs\stack cache (Windows) uses: actions/cache/restore@v3 - id: cache + id: cache-restore-stack-global-windows + if: runner.os == 'Windows' with: - path: ${{ steps.setup.outputs.cabal-store }} - key: ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-cabal-${{ env.CABAL_VERSION }}-plan-${{ hashFiles('**/plan.json') }} + path: | + ~\AppData\Roaming\stack + ~\AppData\Local\Programs\stack + key: ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-stack-${{ env.STACK_VERSION }}-stack-global-${{ hashFiles('stack.yaml') }}-${{ hashFiles('package.yaml') }} restore-keys: | - ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-cabal-${{ env.CABAL_VERSION }}- + ${{ runner.os }}-ghc-${{ env.GHC_VERSION }}-stack-${{ env.STACK_VERSION }}-stack-global- + + - name: Build dependencies + run: stack build --only-dependencies - - name: Install dependencies - run: cabal build all --only-dependencies + - name: Build the package + run: stack build - # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail. - - name: Save cached dependencies + - name: Save .stack-work cache uses: actions/cache/save@v3 - # Caches are immutable, trying to save with the same key would error. - if: ${{ !steps.cache.outputs.cache-hit - || steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }} + id: cache-save-stack-work + if: steps.cache-restore-stack-work.outputs.cache-hit != 'true' with: - path: ${{ steps.setup.outputs.cabal-store }} - key: ${{ steps.cache.outputs.cache-primary-key }} - - - name: Build - run: cabal build all + path: .stack-work + key: ${{ steps.cache-restore-stack-work.outputs.cache-primary-key }} + + - name: Save %APPDATA%\stack, %LOCALAPPDATA%\Programs\stack cache (Windows) + uses: actions/cache/save@v3 + if: runner.os == 'Windows' + && steps.cache-restore-stack-global-windows.outputs.cache-hit != 'true' + with: + path: | + ~\AppData\Roaming\stack + ~\AppData\Local\Programs\stack + key: ${{ steps.cache-restore-stack-global-windows.outputs.cache-primary-key }} + + - name: Save ~/.stack cache (Unix) + uses: actions/cache/save@v3 + id: cache-save-stack-global + if: (runner.os == 'Linux' || runner.os == 'macOS') + && steps.cache-restore-stack-global-unix.outputs.cache-hit != 'true' + with: + path: ~/.stack + key: ${{ steps.cache-restore-stack-global-unix.outputs.cache-primary-key }} - name: Run tests - run: cabal test all + run: stack test - name: Check cabal file run: cabal check - name: Build documentation - run: cabal haddock all \ No newline at end of file + run: stack haddock \ No newline at end of file diff --git a/ChangeLog.md b/ChangeLog.md index 341ac1f..5e6fb45 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,9 +2,18 @@ ## Unreleased changes +## [v0.2.0.0](https://github.com/rasheedja/LPPaver/tree/v0.2.0.0) + - Setup CI - Use fourmolu formatter -- Switch to Cabal +- Add better types +- Use lens +- Use RecordDot syntax +- Add logging +- Improve Docs +- More Tests +- Bump Stackage LTS +- Rename Linear.Simplex.Simplex -> Linear.Simplex.TwoPhase.Simplex ## [v0.1.0.0](https://github.com/rasheedja/LPPaver/tree/v0.1.0.0) diff --git a/LICENSE b/LICENSE index ca254af..f0aec98 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Junaid Rasheed (c) 2020-2022 +Copyright Junaid Rasheed (c) 2020-2023 All rights reserved. diff --git a/README.md b/README.md index 1bf5244..f391970 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ ## Quick Overview -The `Linear.Simplex.Simplex` module contain both phases of the simplex method. +The `Linear.Simplex.Solver.TwoPhase` module contain both phases of the two-phase simplex method. ### Phase One @@ -20,21 +20,21 @@ The `PolyConstraint` type, as well as other custom types required by this librar ```haskell data PolyConstraint = - LEQ VarConstMap Rational | - GEQ VarConstMap Rational | - EQ VarConstMap Rational deriving (Show, Eq); + LEQ Vars Rational | + GEQ Vars Rational | + EQ Vars Rational deriving (Show, Eq); ``` -And `VarConstMap` is defined as: +And `Vars` is defined as: ```haskell -type VarConstMap = [(Integer, Rational)] +type Vars = [(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. +A `Vars` 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`. +And a `PolyConstraint` is an inequality/equality where the LHS is a `Vars` 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. @@ -42,24 +42,24 @@ Passing a `[PolyConstraint]` to `findFeasibleSolution` will return a feasible so The feasible system is returned as the type `DictionaryForm`: ```haskell -type DictionaryForm = [(Integer, VarConstMap)] +type DictionaryForm = [(Integer, Vars)] ``` -`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. +`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 `Vars`. In this `Vars`, 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) +data ObjectiveFunction = Max Vars | Min Vars 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`. +`optimizeFeasibleSystem` Maximizes/Minimizes the linear equation represented as a `Vars` 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. @@ -87,7 +87,7 @@ There are similar functions for `DictionaryForm` as well as other custom types i ## Usage notes -You must only use positive `Integer` variables in a `VarConstMap`. +You must only use positive `Integer` variables in a `Vars`. 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 diff --git a/fourmolu.yaml b/fourmolu.yaml index cb7e946..9b7746d 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -1,15 +1,15 @@ indentation: 2 -column-limit: none +column-limit: 120 function-arrows: trailing comma-style: leading -import-export-style: diff-friendly +import-export-style: leading indent-wheres: true record-brace-space: true newlines-between-decls: 1 -haddock-style: multi-line -haddock-style-module: -let-style: auto -in-style: right-align +haddock-style: single-line +haddock-style-module: single-line +let-style: inline +in-style: left-align single-constraint-parens: always unicode: never respectful: true diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..b45be0d --- /dev/null +++ b/package.yaml @@ -0,0 +1,56 @@ +name: simplex-method +version: 0.2.0.0 +github: "rasheedja/simplex-method" +license: BSD3 +author: "Junaid Rasheed" +maintainer: "jrasheed178@gmail.com" +copyright: "BSD-3" + +extra-source-files: +- README.md +- ChangeLog.md + +# Metadata used when publishing your package +synopsis: Implementation of the two-phase simplex method in exact rational arithmetic +category: Math, Maths, Mathematics, Optimisation, Optimization, Linear Programming + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.14 && < 5 +- containers >= 0.6.5.1 && < 0.7 +- generic-lens >= 2.2.0 && < 2.3 +- lens >= 5.2.2 && < 5.3 +- monad-logger >= 0.3.40 && < 0.4 +- text >= 2.0.2 && < 2.1 +- time + +default-extensions: + DataKinds + DeriveFunctor + DeriveGeneric + DisambiguateRecordFields + DuplicateRecordFields + FlexibleContexts + LambdaCase + OverloadedLabels + OverloadedRecordDot + OverloadedStrings + RecordWildCards + TemplateHaskell + TupleSections + TypeApplications + NamedFieldPuns + +library: + source-dirs: src + +tests: + simplex-haskell-test: + main: Spec.hs + source-dirs: test + dependencies: + - simplex-method diff --git a/simplex-method.cabal b/simplex-method.cabal index 80ceb5b..fc9f040 100644 --- a/simplex-method.cabal +++ b/simplex-method.cabal @@ -1,11 +1,11 @@ -cabal-version: 3.6 +cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack name: simplex-method -version: 0.1.0.0 +version: 0.2.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 @@ -14,7 +14,7 @@ bug-reports: https://github.com/rasheedja/simplex-method/issues author: Junaid Rasheed maintainer: jrasheed178@gmail.com copyright: BSD-3 -license: BSD-3-Clause +license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: @@ -25,33 +25,45 @@ source-repository head type: git location: https://github.com/rasheedja/simplex-method -common common-extensions - default-extensions: - LambdaCase - TupleSections - library - import: common-extensions exposed-modules: Linear.Simplex.Prettify - Linear.Simplex.Simplex + Linear.Simplex.Solver.TwoPhase Linear.Simplex.Types Linear.Simplex.Util + other-modules: + Paths_simplex_method hs-source-dirs: src + default-extensions: + DataKinds DeriveFunctor DeriveGeneric DisambiguateRecordFields DuplicateRecordFields FlexibleContexts LambdaCase OverloadedLabels OverloadedRecordDot OverloadedStrings RecordWildCards TemplateHaskell TupleSections TypeApplications NamedFieldPuns build-depends: - base >=4.7 && <5 + base >=4.14 && <5 + , containers >=0.6.5.1 && <0.7 + , generic-lens >=2.2.0 && <2.3 + , lens >=5.2.2 && <5.3 + , monad-logger >=0.3.40 && <0.4 + , text >=2.0.2 && <2.1 + , time default-language: Haskell2010 test-suite simplex-haskell-test - import: common-extensions type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: TestFunctions + Paths_simplex_method hs-source-dirs: test + default-extensions: + DataKinds DeriveFunctor DeriveGeneric DisambiguateRecordFields DuplicateRecordFields FlexibleContexts LambdaCase OverloadedLabels OverloadedRecordDot OverloadedStrings RecordWildCards TemplateHaskell TupleSections TypeApplications NamedFieldPuns build-depends: - base >=4.7 && <5 + base >=4.14 && <5 + , containers >=0.6.5.1 && <0.7 + , generic-lens >=2.2.0 && <2.3 + , lens >=5.2.2 && <5.3 + , monad-logger >=0.3.40 && <0.4 , simplex-method + , text >=2.0.2 && <2.1 + , time default-language: Haskell2010 diff --git a/src/Linear/Simplex/Prettify.hs b/src/Linear/Simplex/Prettify.hs index c422590..b19cc44 100644 --- a/src/Linear/Simplex/Prettify.hs +++ b/src/Linear/Simplex/Prettify.hs @@ -1,36 +1,42 @@ -{- | -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 +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE RankNTypes #-} -Converts "Linear.Simplex.Types" types into human-readable 'String's --} +-- | +-- Module : Linear.Simplex.Prettify +-- Description : Prettifier for "Linear.Simplex.Types" types +-- Copyright : (c) Junaid Rasheed, 2020-2023 +-- 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 Control.Lens +import Data.Generics.Labels () +import Data.Map qualified as M import Data.Ratio -import Linear.Simplex.Types as T +import Linear.Simplex.Types -- | Convert a 'VarConstMap' into a human-readable 'String' -prettyShowVarConstMap :: VarConstMap -> String -prettyShowVarConstMap [] = "" -prettyShowVarConstMap [(v, c)] = prettyShowRational c ++ " * x" ++ show v ++ "" +prettyShowVarConstMap :: VarLitMapSum -> String +prettyShowVarConstMap = aux . M.toList where - prettyShowRational r = - if r < 0 - then "(" ++ r' ++ ")" - else r' + aux [] = "" + aux ((vName, vCoeff) : vs) = prettyShowRational vCoeff ++ " * " ++ show vName ++ " + " ++ aux vs 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 + 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) -- | 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 +prettyShowPolyConstraint (Linear.Simplex.Types.EQ vcm r) = prettyShowVarConstMap vcm ++ " == " ++ show r -- | Convert an 'ObjectiveFunction' into a human-readable 'String' prettyShowObjectiveFunction :: ObjectiveFunction -> String diff --git a/src/Linear/Simplex/Simplex.hs b/src/Linear/Simplex/Simplex.hs deleted file mode 100644 index 71b2a3d..0000000 --- a/src/Linear/Simplex/Simplex.hs +++ /dev/null @@ -1,283 +0,0 @@ -{- | -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 Data.Bifunctor -import Data.List -import Data.Maybe (fromMaybe, mapMaybe) -import Data.Ratio (denominator, numerator, (%)) -import Linear.Simplex.Types -import Linear.Simplex.Util -import Prelude hiding (EQ) - --- 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/Solver/TwoPhase.hs b/src/Linear/Simplex/Solver/TwoPhase.hs new file mode 100644 index 0000000..c7dfe83 --- /dev/null +++ b/src/Linear/Simplex/Solver/TwoPhase.hs @@ -0,0 +1,570 @@ +-- | +-- Module : Linear.Simplex.Simplex.TwoPhase +-- Description : Implements the twoPhaseSimplex method +-- Copyright : (c) Junaid Rasheed, 2020-2023 +-- 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.Solver.TwoPhase (findFeasibleSolution, optimizeFeasibleSystem, twoPhaseSimplex) where + +import Prelude hiding (EQ) + +import Control.Lens +import Control.Monad (unless) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Logger +import Data.Bifunctor +import Data.List +import qualified Data.Map as M +import Data.Maybe (fromJust, fromMaybe, mapMaybe) +import Data.Ratio (denominator, numerator, (%)) +import qualified Data.Text as Text +import GHC.Real (Ratio) +import Linear.Simplex.Types +import Linear.Simplex.Util + +-- | Find a feasible solution for the given system of 'PolyConstraint's by performing the first phase of the two-phase simplex method +-- All variables in the 'PolyConstraint' must be positive. +-- If the system is infeasible, return 'Nothing' +-- Otherwise, return the feasible system in 'Dict' as well as a list of slack variables, a list artificial variables, and the objective variable. +findFeasibleSolution :: (MonadIO m, MonadLogger m) => [PolyConstraint] -> m (Maybe FeasibleSystem) +findFeasibleSolution unsimplifiedSystem = do + logMsg LevelInfo $ "findFeasibleSolution: Looking for solution for " <> showT unsimplifiedSystem + if null artificialVars -- No artificial vars, we have a feasible system + then do + logMsg LevelInfo "findFeasibleSolution: Feasible solution found with no artificial vars" + pure . Just $ FeasibleSystem systemWithBasicVarsAsDictionary slackVars artificialVars objectiveVar + else do + logMsg LevelInfo $ + "findFeasibleSolution: Needed to create artificial vars. System with artificial vars (in Tableau form) " + <> showT systemWithBasicVars + mPhase1Dict <- simplexPivot artificialPivotObjective systemWithBasicVarsAsDictionary + case mPhase1Dict of + Just phase1Dict -> do + logMsg LevelInfo $ + "findFeasibleSolution: System after pivoting with objective" + <> showT artificialPivotObjective + <> ": " + <> showT phase1Dict + let eliminateArtificialVarsFromPhase1Tableau = + M.map + ( \DictValue {..} -> + DictValue + { varMapSum = M.filterWithKey (\k _ -> k `notElem` artificialVars) varMapSum + , .. + } + ) + phase1Dict + case M.lookup objectiveVar eliminateArtificialVarsFromPhase1Tableau of + Nothing -> do + logMsg LevelWarn $ + "findFeasibleSolution: Objective row not found after eliminatiing artificial vars. This is unexpected. System without artificial vars (in Dict form) " + <> showT eliminateArtificialVarsFromPhase1Tableau + -- If the objecitve row is not found, the system is feasible iff + -- the artificial vars sum to zero. The value of an artificial + -- variable is 0 if non-basic, and the RHS of the row if basic + let artificialVarsVals = map (\v -> maybe 0 (.constant) (M.lookup v eliminateArtificialVarsFromPhase1Tableau)) artificialVars + let artificialVarsValsSum = sum artificialVarsVals + if artificialVarsValsSum == 0 + then do + logMsg LevelInfo $ + "findFeasibleSolution: Artifical variables sum up to 0, thus original tableau is feasible. System without artificial vars (in Dict form) " + <> showT eliminateArtificialVarsFromPhase1Tableau + pure . Just $ + FeasibleSystem + { dict = eliminateArtificialVarsFromPhase1Tableau + , slackVars = slackVars + , artificialVars = artificialVars + , objectiveVar = objectiveVar + } + else do + logMsg LevelInfo $ + "findFeasibleSolution: Artifical variables sum up to " + <> showT artificialVarsValsSum + <> ", thus original tableau is infeasible. System without artificial vars (in Dict form) " + <> showT eliminateArtificialVarsFromPhase1Tableau + pure Nothing + Just row -> + if row.constant == 0 + then do + logMsg LevelInfo $ + "findFeasibleSolution: Objective RHS is zero after pivoting, thus original tableau is feasible. feasible system (in Dict form) " + <> showT eliminateArtificialVarsFromPhase1Tableau + pure . Just $ + FeasibleSystem + { dict = eliminateArtificialVarsFromPhase1Tableau + , slackVars = slackVars + , artificialVars = artificialVars + , objectiveVar = objectiveVar + } + else do + unless (row.constant < 0) $ do + let errMsg = + "findFeasibleSolution: Objective RHS is negative after pivoting. This should be impossible. System without artificial vars (in Dict form) " + <> show eliminateArtificialVarsFromPhase1Tableau + logMsg LevelError $ Text.pack errMsg + error errMsg + logMsg LevelInfo $ + "findFeasibleSolution: Objective RHS not zero after phase 1, thus original tableau is infeasible. System without artificial vars (in Dict form) " + <> showT eliminateArtificialVarsFromPhase1Tableau + pure Nothing + Nothing -> do + logMsg LevelInfo $ + "findFeasibleSolution: Infeasible solution found, could not pivot with objective " + <> showT artificialPivotObjective + <> " over system (in Dict form) " + <> showT systemWithBasicVarsAsDictionary + pure Nothing + where + system = simplifySystem unsimplifiedSystem + + maxVar = + maximum $ + map + ( \case + LEQ vcm _ -> maximum (map fst $ M.toList vcm) + GEQ vcm _ -> maximum (map fst $ M.toList vcm) + EQ vcm _ -> maximum (map fst $ M.toList 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 + + artificialPivotObjective = createArtificialPivotObjective 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] -> Var -> [Var] -> ([(Maybe Var, PolyConstraint)], [Var]) + 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 (M.insert newSlackVar 1 v) r) : newSystem, newSlackVars) + where + newSlackVar = maxVar + 1 + (newSystem, newSlackVars) = systemInStandardForm xs newSlackVar (newSlackVar : sVars) + systemInStandardForm (GEQ v r : xs) maxVar sVars = ((Just newSlackVar, EQ (M.insert newSlackVar (-1) v) 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 Var, PolyConstraint)] -> Var -> (Tableau, [Var]) + systemWithArtificialVars [] _ = (M.empty, []) + systemWithArtificialVars ((mVar, EQ v r) : pcs) maxVar = + case mVar of + Nothing -> + if r >= 0 + then + ( M.insert newArtificialVar (TableauRow {lhs = M.insert newArtificialVar 1 v, rhs = r}) newSystemWithNewMaxVar + , newArtificialVar : artificialVarsWithNewMaxVar + ) + else + ( M.insert newArtificialVar (TableauRow {lhs = M.insert newArtificialVar (-1) v, rhs = r}) newSystemWithNewMaxVar + , newArtificialVar : artificialVarsWithNewMaxVar + ) + Just basicVar -> + case M.lookup basicVar v of + Just basicVarCoeff -> + if r == 0 + then (M.insert basicVar (TableauRow {lhs = v, rhs = r}) newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) + else + if r > 0 + then + if basicVarCoeff >= 0 -- Should only be 1 in the standard call path + then (M.insert basicVar (TableauRow {lhs = v, rhs = r}) newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) + else + ( M.insert newArtificialVar (TableauRow {lhs = M.insert newArtificialVar 1 v, rhs = 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 (M.insert basicVar (TableauRow {lhs = v, rhs = r}) newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) + else + ( M.insert newArtificialVar (TableauRow {lhs = M.insert newArtificialVar (-1) v, rhs = r}) newSystemWithNewMaxVar + , newArtificialVar : artificialVarsWithNewMaxVar -- Slack var is negative, r is negative (when original constraint was LEQ) + ) + Nothing -> error "1" -- undefined + where + newArtificialVar = maxVar + 1 + + (newSystemWithNewMaxVar, artificialVarsWithNewMaxVar) = systemWithArtificialVars pcs newArtificialVar + + (newSystemWithoutNewMaxVar, artificialVarsWithoutNewMaxVar) = systemWithArtificialVars pcs maxVar + systemWithArtificialVars _ _ = error "systemWithArtificialVars: given system includes non-EQ constraints" + + -- \| Takes a 'Dict' and a '[Var]' as input and returns a 'PivotObjective'. + -- The 'Dict' represents the tableau of a linear program with artificial + -- variables, and '[Var]' represents the artificial variables. + + -- The function first filters out the rows of the tableau that correspond + -- to the artificial variables, and negates them. It then computes the sum + -- of the negated rows, which represents the 'PivotObjective'. + createArtificialPivotObjective :: Dict -> [Var] -> PivotObjective + createArtificialPivotObjective rows artificialVars = + PivotObjective + { variable = objectiveVar + , function = foldVarLitMap $ map (.varMapSum) negatedRowsWithoutArtificialVars + , constant = sum $ map (.constant) negatedRowsWithoutArtificialVars + } + where + -- Filter out non-artificial entries + rowsToAdd = M.filterWithKey (\k _ -> k `elem` artificialVars) rows + negatedRows = M.map (\(DictValue rowVarMapSum rowConstant) -> DictValue (M.map negate rowVarMapSum) (negate rowConstant)) rowsToAdd + -- Negate rows, discard keys and artificial vars since the pivot objective does not care about them + negatedRowsWithoutArtificialVars = + map + ( \(_, DictValue {..}) -> + DictValue + { varMapSum = M.map negate $ M.filterWithKey (\k _ -> k `notElem` artificialVars) varMapSum + , constant = negate constant + } + ) + $ M.toList rowsToAdd + +-- | 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 :: (MonadIO m, MonadLogger m) => ObjectiveFunction -> FeasibleSystem -> m (Maybe Result) +optimizeFeasibleSystem objFunction fsys@(FeasibleSystem {dict = phase1Dict, ..}) = do + logMsg LevelInfo $ + "optimizeFeasibleSystem: Optimizing feasible system " <> showT fsys <> " with objective " <> showT objFunction + if null artificialVars + then do + logMsg LevelInfo $ + "optimizeFeasibleSystem: No artificial vars, system is feasible. Pivoting system (in dict form) " + <> showT phase1Dict + <> " with objective " + <> showT normalObjective + fmap (displayResults . dictionaryFormToTableau) <$> simplexPivot normalObjective phase1Dict + else do + logMsg LevelInfo $ + "optimizeFeasibleSystem: Artificial vars present. Pivoting system (in dict form) " + <> showT phase1Dict + <> " with objective " + <> showT adjustedObjective + fmap (displayResults . dictionaryFormToTableau) <$> simplexPivot adjustedObjective phase1Dict + where + -- \| displayResults takes a 'Tableau' and returns a 'Result'. The 'Tableau' + -- represents the final tableau of a linear program after the simplex + -- algorithm has been applied. The 'Result' contains the value of the + -- objective variable and a map of the values of all variables appearing + -- in the system, including the objective variable. + -- + -- The function first filters out the rows of the tableau that correspond + -- to the slack and artificial variables. It then extracts the values of + -- the remaining variables and stores them in a map. If the objective + -- function is a maximization problem, the map contains the values of the + -- variables as they appear in the final tableau. If the objective function + -- is a minimization problem, the map contains the values of the variables + -- as they appear in the final tableau, except for the objective variable, + -- which is negated. + displayResults :: Tableau -> Result + displayResults tableau = + Result + { objectiveVar = objectiveVar + , varValMap = extractVarVals + } + where + extractVarVals = + let tableauWithOriginalVars = + M.filterWithKey + ( \basicVarName _ -> + basicVarName `notElem` slackVars ++ artificialVars + ) + tableau + in case objFunction of + Max _ -> + M.map + ( \tableauRow -> + tableauRow.rhs + ) + tableauWithOriginalVars + Min _ -> + M.mapWithKey -- We maximized -objVar, so we negate the objVar to get the final value + ( \basicVarName tableauRow -> + if basicVarName == objectiveVar + then negate $ tableauRow.rhs + else tableauRow.rhs + ) + tableauWithOriginalVars + + -- \| Objective to use when optimising the linear program if no artificial + -- variables were necessary in the first phase. It is essentially the original + -- objective function, with a potential change of sign based on the type of + -- problem (Maximization or Minimization). + normalObjective :: PivotObjective + normalObjective = + PivotObjective + { variable = objectiveVar + , function = if isMax objFunction then objFunction.objective else M.map negate objFunction.objective + , constant = 0 + } + + -- \| Objective to use when optimising the linear program if artificial + -- variables were necessary in the first phase. It is an adjustment to the + -- original objective function, where the linear coefficients are modified + -- by back-substitution of the values of the artificial variables. + adjustedObjective :: PivotObjective + adjustedObjective = + PivotObjective + { variable = objectiveVar + , function = calcVarMap + , constant = calcConstants + } + where + -- \| Compute the adjustment to the constant term of the objective + -- function. It adds up the products of the original coefficients and + -- the corresponding constant term (rhs) of each artificial variable + -- in the phase 1 'Dict'. + calcConstants :: SimplexNum + calcConstants = + sum + $ map + ( \(var, coeff) -> + let multiplyWith = if isMax objFunction then coeff else -coeff + in case M.lookup var phase1Dict of + Nothing -> 0 + Just row -> row.constant * multiplyWith + ) + $ M.toList objFunction.objective + + -- \| Compute the adjustment to the coefficients of the original + -- variables in the objective function. It performs back-substitution + -- of the variables in the original objective function using the + -- current value of each artificial variable in the phase 1 'Dict'. + calcVarMap :: VarLitMapSum + calcVarMap = + foldVarLitMap $ + map + ( M.fromList + . ( \(var, coeff) -> + let multiplyWith = if isMax objFunction then coeff else -coeff + in case M.lookup var phase1Dict of + Nothing -> + [(var, multiplyWith)] + Just row -> map (second (* multiplyWith)) (M.toList $ row.varMapSum) + ) + ) + (M.toList objFunction.objective) + +-- | 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 :: (MonadIO m, MonadLogger m) => ObjectiveFunction -> [PolyConstraint] -> m (Maybe Result) +twoPhaseSimplex objFunction unsimplifiedSystem = do + logMsg LevelInfo $ + "twoPhaseSimplex: Solving system " <> showT unsimplifiedSystem <> " with objective " <> showT objFunction + phase1Result <- findFeasibleSolution unsimplifiedSystem + case phase1Result of + Just feasibleSystem -> do + logMsg LevelInfo $ + "twoPhaseSimplex: Feasible system found for " + <> showT unsimplifiedSystem + <> "; Feasible system: " + <> showT feasibleSystem + optimizedSystem <- optimizeFeasibleSystem objFunction feasibleSystem + logMsg LevelInfo $ + "twoPhaseSimplex: Optimized system found for " + <> showT unsimplifiedSystem + <> "; Optimized system: " + <> showT optimizedSystem + pure optimizedSystem + Nothing -> do + logMsg LevelInfo $ "twoPhaseSimplex: Phase 1 gives infeasible result for " <> showT unsimplifiedSystem + pure Nothing + +-- | Perform the simplex pivot algorithm on a system with basic vars, assume that the first row is the 'ObjectiveFunction'. +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 + Nothing -> do + logMsg LevelInfo $ + "simplexPivot: Pivoting complete as no positive variables found in objective " + <> showT objective + <> " over system (in Dict form) " + <> showT dictionary + pure $ Just (insertPivotObjectiveToDict objective dictionary) + 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 + case mPivotBasicVar of + Nothing -> do + logMsg LevelInfo $ + "simplexPivot: Ratio test failed with non-basic variable " + <> showT pivotNonBasicVar + <> " over system (in Dict form) " + <> showT dictionary + pure Nothing + Just pivotBasicVar -> do + logMsg LevelInfo $ "simplexPivot: Basic pivoting variable determined by ratio test " <> showT pivotBasicVar + logMsg LevelInfo $ + "simplexPivot: Pivoting with basic var " + <> showT pivotBasicVar + <> ", non-basic var " + <> showT pivotNonBasicVar + <> ", objective " + <> showT objective + <> " over system (in Dict form) " + <> showT dictionary + let pivotResult = pivot pivotBasicVar pivotNonBasicVar (insertPivotObjectiveToDict objective dictionary) + pivotedObj = + let pivotedObjEntry = fromMaybe (error "simplexPivot: Can't find objective after pivoting") $ M.lookup objectiveVar pivotResult + in objective & #function .~ pivotedObjEntry.varMapSum & #constant .~ pivotedObjEntry.constant + pivotedDict = M.delete objectiveVar pivotResult + logMsg LevelInfo $ + "simplexPivot: Pivoted, Recursing with new pivoting objective " + <> showT pivotedObj + <> " for new pivoted system (in Dict form) " + <> showT pivotedDict + simplexPivot + pivotedObj + pivotedDict + where + ratioTest :: Dict -> Var -> Maybe Var -> Maybe Rational -> Maybe Var + ratioTest dict = aux (M.toList dict) + 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 + 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 + 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 + newEnteringVarTerm = (leavingVariable, -1) + divideByNegatedEnteringVariableCoeff = (/ negate enteringVariableCoeff) + + -- Substitute pivot equation into other rows + updatedRows :: Dict + updatedRows = + M.fromList $ map (uncurry f2) $ M.toList dict + where + f entryVar entryVal = + if leavingVariable == entryVar + then pivotEnteringRow + else case M.lookup enteringVariable (entryVal.varMapSum) of + Just subsCoeff -> + entryVal + & #varMapSum + .~ combineVarLitMapSums + (pivotEnteringRow.varMapSum <&> (subsCoeff *)) + (filterOutEnteringVarTerm (entryVal.varMapSum)) + & #constant + .~ ((subsCoeff * (pivotEnteringRow.constant)) + entryVal.constant) + Nothing -> entryVal + + f2 :: Var -> DictValue -> (Var, DictValue) + f2 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.filterWithKey (\vName _ -> vName /= enteringVariable) diff --git a/src/Linear/Simplex/Types.hs b/src/Linear/Simplex/Types.hs index 19cb78e..5ea9019 100644 --- a/src/Linear/Simplex/Types.hs +++ b/src/Linear/Simplex/Types.hs @@ -1,52 +1,123 @@ -{- | -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 +-- Description : Custom types +-- Copyright : (c) Junaid Rasheed, 2020-2023 +-- 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. +import Control.Lens +import Data.Generics.Labels () +import Data.List (sort) +import qualified Data.Map as M +import GHC.Generics (Generic) - Example: [(2, 3), (6, (-1), (2, 1))] is equivalent to 3x2 + (-x6) + x2. --} -type VarConstMap = [(Integer, Rational)] +type Var = Int -{- | 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. +type SimplexNum = Rational - Example: LEQ [(2, 3), (6, (-1), (2, 1))] 12.3 is equivalent to 3x2 + (-x6) + x2 <= 12.3. --} +type SystemRow = PolyConstraint + +type System = [SystemRow] + +-- A 'Tableau' where the basic variable may be empty. +-- All non-empty basic vars are slack vars +data SystemWithSlackVarRow = SystemInStandardFormRow + { mSlackVar :: Maybe Var + -- ^ This is Nothing iff the row does not have a slack variable + , row :: TableauRow + } + +type SystemWithSlackVars = [SystemWithSlackVarRow] + +data FeasibleSystem = FeasibleSystem + { dict :: Dict + , slackVars :: [Var] + , artificialVars :: [Var] + , objectiveVar :: Var + } + deriving (Show, Read, Eq, Generic) + +data Result = Result + { objectiveVar :: Var + , varValMap :: VarLitMap + -- TODO: + -- Maybe VarLitMap + -- , feasible :: Bool + -- , optimisable :: Bool + } + deriving (Show, Read, Eq, Generic) + +data SimplexMeta = SimplexMeta + { objective :: ObjectiveFunction + , feasibleSystem :: Maybe FeasibleSystem + , optimisedResult :: Maybe Result + } + +type VarLitMap = M.Map Var SimplexNum + +-- | List of variables with their 'SimplexNum' coefficients. +-- There is an implicit addition between elements in this list. +-- +-- Example: [Var "x" 3, Var "y" -1, Var "z" 1] is equivalent to 3x + (-y) + z. +type VarLitMapSum = VarLitMap + +-- | For specifying constraints in a system. +-- The LHS is a 'Vars', and the RHS, is a 'SimplexNum' number. +-- LEQ [(1, 2), (2, 1)] 3.5 is equivalent to 2x1 + x2 <= 3.5. +-- Users must only provide positive integer variables. +-- +-- Example: LEQ [Var "x" 3, Var "y" -1, Var "x" 1] 12.3 is equivalent to 3x + (-y) + x <= 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)] + = LEQ {lhs :: VarLitMapSum, rhs :: SimplexNum} + | GEQ {lhs :: VarLitMapSum, rhs :: SimplexNum} + | EQ {lhs :: VarLitMapSum, rhs :: SimplexNum} + deriving (Show, Read, Eq, Generic) + +-- | Create an objective function. +-- We can either 'Max'imize or 'Min'imize a 'VarTermSum'. +data ObjectiveFunction = Max {objective :: VarLitMapSum} | Min {objective :: VarLitMapSum} + deriving (Show, Read, Eq, Generic) + +-- | TODO: Maybe we want this type +-- TODO: A better/alternative name +data Equation = Equation + { lhs :: VarLitMapSum + , rhs :: SimplexNum + } + +-- | Value for 'Tableau'. lhs = rhs. +data TableauRow = TableauRow + { lhs :: VarLitMapSum + , rhs :: SimplexNum + } + deriving (Show, Read, Eq, Generic) + +-- | A simplex 'Tableu' of equations. +-- Each entry in the map is a row. +type Tableau = M.Map Var TableauRow + +-- | Values for a 'DictEntry'. +data DictValue = DictValue + { varMapSum :: VarLitMapSum + , constant :: SimplexNum + } + deriving (Show, Read, Eq, Generic) + +-- | A simplex 'Dict' +-- One quation represents the objective function. +-- Each pair in the list is one equation in the system we're working with. +-- data Dict = Dict +-- { objective :: DictObjective +-- , entries :: DictEntries +-- } +-- deriving (Show, Read, Eq, Generic) +type Dict = M.Map Var DictValue + +data PivotObjective = PivotObjective + { variable :: Var + , function :: VarLitMapSum + , constant :: SimplexNum + } + deriving (Show, Read, Eq, Generic) diff --git a/src/Linear/Simplex/Util.hs b/src/Linear/Simplex/Util.hs index f661a76..99b1495 100644 --- a/src/Linear/Simplex/Util.hs +++ b/src/Linear/Simplex/Util.hs @@ -1,17 +1,27 @@ -{- | -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 +-- Description : Helper functions +-- Copyright : (c) Junaid Rasheed, 2020-2023 +-- License : BSD-3 +-- Maintainer : jrasheed178@gmail.com +-- Stability : experimental +-- +-- Helper functions for performing the two-phase simplex method. module Linear.Simplex.Util where +import Control.Lens +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Logger (LogLevel (..), LogLine, MonadLogger, logDebug, logError, logInfo, logWarn) import Data.Bifunctor +import Data.Generics.Labels () +import Data.Generics.Product (field) import Data.List +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) +import Data.Time.Format.ISO8601 (iso8601Show) import Linear.Simplex.Types import Prelude hiding (EQ) @@ -20,17 +30,11 @@ 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'. --} +-- | 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 +simplifySystem = nub . reduceSystem where reduceSystem :: [PolyConstraint] -> [PolyConstraint] reduceSystem [] = [] @@ -44,7 +48,7 @@ simplifySystem = nub . reduceSystem . map simplifyPolyConstraint _ -> False ) pcs - in if null matchingConstraints + 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 @@ -57,7 +61,7 @@ simplifySystem = nub . reduceSystem . map simplifyPolyConstraint _ -> False ) pcs - in if null matchingConstraints + 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 @@ -70,79 +74,111 @@ simplifySystem = nub . reduceSystem . map simplifyPolyConstraint _ -> False ) pcs - in if null matchingConstraints + 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)) +-- | Converts a 'Dict' to a 'Tableau' using 'dictEntryToTableauEntry'. +-- FIXME: maybe remove this line. The basic variables will have a coefficient of 1 in the 'Tableau'. +dictionaryFormToTableau :: Dict -> Tableau +dictionaryFormToTableau = + Map.mapWithKey + ( \basicVar (DictValue {..}) -> + TableauRow + { lhs = Map.insert basicVar 1 $ negate <$> varMapSum + , rhs = constant + } + ) --- | 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 +-- | Converts a 'Tableau' to a 'Dict'. +-- We do this by isolating the basic variable on the LHS, ending up with all non basic variables and a 'SimplexNum' constant on the RHS. +tableauInDictionaryForm :: Tableau -> Dict +tableauInDictionaryForm = + Map.mapWithKey + ( \basicVar (TableauRow {..}) -> + let basicVarCoeff = fromMaybe 1 $ Map.lookup basicVar lhs + in DictValue + { varMapSum = + Map.map + (\c -> negate c / basicVarCoeff) + $ Map.delete basicVar lhs + , constant = rhs / basicVarCoeff + } + ) --- | 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) +-- | 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.Solver.TwoPhase.twoPhaseSimplex'. +extractObjectiveValue :: Maybe Result -> Maybe SimplexNum +extractObjectiveValue = fmap $ \result -> + case Map.lookup result.objectiveVar result.varValMap of + Nothing -> error "Objective not found in results when extracting objective value" + Just r -> r --- | Get a map of the value of every 'Integer' variable in a 'Tableau' -displayTableauResults :: Tableau -> [(Integer, Rational)] -displayTableauResults = map (\(basicVar, (_, rhs)) -> (basicVar, rhs)) +-- | 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 --- | Get a map of the value of every 'Integer' variable in a 'DictionaryForm' -displayDictionaryResults :: DictionaryForm -> [(Integer, Rational)] -displayDictionaryResults dict = displayTableauResults $ dictionaryFormToTableau dict +foldDictValue :: [DictValue] -> DictValue +foldDictValue [] = error "Empty list of DictValues given to foldDictValue" +foldDictValue [x] = x +foldDictValue (DictValue {varMapSum = vm1, constant = c1} : DictValue {varMapSum = vm2, constant = c2} : dvs) = + let combinedDictValue = + DictValue + { varMapSum = foldVarLitMap [vm1, vm2] + , constant = c1 + c2 + } + in foldDictValue $ combinedDictValue : dvs --- | 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) +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 -{- | 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 + 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 foldDictValue" + ) + ) + combinedVars + in foldVarLitMap $ combinedVarMap : vms -{- | 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. +insertPivotObjectiveToDict :: PivotObjective -> Dict -> Dict +insertPivotObjectiveToDict objective = Map.insert objective.variable (DictValue {varMapSum = objective.function, constant = objective.constant}) -{- | 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 +showT :: (Show a) => a -> T.Text +showT = T.pack . show + +logMsg :: (MonadIO m, MonadLogger m) => LogLevel -> T.Text -> m () +logMsg lvl msg = do + currTime <- T.pack . iso8601Show <$> liftIO getCurrentTime + let msgToLog = currTime <> ": " <> msg + case lvl of + LevelDebug -> $logDebug msgToLog + LevelInfo -> $logInfo msgToLog + LevelWarn -> $logWarn msgToLog + LevelError -> $logError msgToLog + LevelOther otherLvl -> error "logMsg: LevelOther is not implemented" + +extractTableauValues :: Tableau -> Map.Map Var SimplexNum +extractTableauValues = Map.map (.rhs) + +extractDictValues :: Dict -> Map.Map Var SimplexNum +extractDictValues = Map.map (.constant) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..eab5650 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,68 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: lts-21.22 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: {} + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.5" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor + +system-ghc: true diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..e8d3cc7 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: afd5ba64ab602cabc2d3942d3d7e7dd6311bc626dcb415b901eaf576cb62f0ea + size: 640060 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/22.yaml + original: lts-21.22 diff --git a/test/Spec.hs b/test/Spec.hs index f1c9919..4a8ad55 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,28 +1,42 @@ module Main where +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Logger + import Linear.Simplex.Prettify -import Linear.Simplex.Simplex +import Linear.Simplex.Solver.TwoPhase +import Linear.Simplex.Types import Linear.Simplex.Util + import TestFunctions main :: IO () -main = runTests testsList +main = runStdoutLoggingT $ filterLogger (\_logSource logLevel -> logLevel > LevelInfo) $ runTests testsList -runTests [] = putStrLn "All tests passed" +runTests :: (MonadLogger m, MonadFail m, MonadIO m) => [((ObjectiveFunction, [PolyConstraint]), Maybe Result)] -> m () +runTests [] = do + liftIO $ putStrLn "All tests passed" + pure () 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)) + do + testResult <- twoPhaseSimplex testObjective testConstraints + if testResult == expectedResult + then runTests tests + else do + let msg = + "\nThe following test failed: " + <> ("\nObjective Function (Non-prettified): " ++ show testObjective) + <> ("\nConstraints (Non-prettified): " ++ show testConstraints) + <> "\n====================================" + <> ("\nObjective Function (Prettified): " ++ prettyShowObjectiveFunction testObjective) + <> "\nConstraints (Prettified): " + <> "\n" + <> concatMap (\c -> "\t" ++ prettyShowPolyConstraint c ++ "\n") testConstraints + <> "\n====================================" + <> ("\nExpected Solution (Full): " ++ show expectedResult) + <> ("\nActual Solution (Full): " ++ show testResult) + <> ("\nExpected Solution (Objective): " ++ show (extractObjectiveValue expectedResult)) + <> ("\nActual Solution (Objective): " ++ show (extractObjectiveValue testResult)) + <> "\n" + fail msg diff --git a/test/TestFunctions.hs b/test/TestFunctions.hs index cc0852b..b2af317 100644 --- a/test/TestFunctions.hs +++ b/test/TestFunctions.hs @@ -1,107 +1,114 @@ module TestFunctions where +import qualified Data.Map as M import Data.Ratio import Linear.Simplex.Types import Prelude hiding (EQ) -testsList :: [((ObjectiveFunction, [PolyConstraint]), Maybe (Integer, [(Integer, Rational)]))] +testsList :: [((ObjectiveFunction, [PolyConstraint]), Maybe Result)] testsList = - [ (test1, Just (7, [(7, 29 % 1), (1, 3 % 1), (2, 4 % 1)])) - , (test2, Just (7, [(7, 0 % 1)])) + [ (test1, Just (Result 7 (M.fromList [(7, 29), (1, 3), (2, 4)]))) + , (test2, Just (Result 7 (M.fromList [(7, 0)]))) , (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)])) + , (test4, Just (Result 11 (M.fromList [(11, 237 % 7), (1, 24 % 7), (2, 33 % 7)]))) + , (test5, Just (Result 9 (M.fromList [(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)])) + , (test7, Just (Result 8 (M.fromList [(8, 1), (2, 2), (1, 3)]))) + , (test8, Just (Result 8 (M.fromList [(8, (-1) % 4), (2, 9 % 2), (1, 17 % 4)]))) + , (test9, Just (Result 7 (M.fromList [(7, 5), (3, 2), (4, 1)]))) + , (test10, Just (Result 7 (M.fromList [(7, 8), (1, 2), (2, 6)]))) + , (test11, Just (Result 8 (M.fromList [(8, 20), (4, 16), (3, 6)]))) + , (test12, Just (Result 8 (M.fromList [(8, 6), (4, 2), (5, 2)]))) + , (test13, Just (Result 6 (M.fromList [(6, 150), (2, 150)]))) + , (test14, Just (Result 6 (M.fromList [(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)])) + , (test16, Just (Result 6 (M.fromList [(6, 75), (1, 75 % 2)]))) + , (test17, Just (Result 7 (M.fromList [(7, (-120)), (1, 20)]))) + , (test18, Just (Result 7 (M.fromList [(7, 10), (3, 5)]))) , (test19, Nothing) , (test20, Nothing) - , (test21, Just (7, [(7, 250 % 1), (2, 50 % 1)])) - , (test22, Just (7, [(7, 0 % 1)])) + , (test21, Just (Result 7 (M.fromList [(7, 250), (2, 50)]))) + , (test22, Just (Result 7 (M.fromList [(7, 0)]))) , (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)])) + , (test24, Just (Result 10 (M.fromList [(10, 300), (3, 150)]))) + , (test25, Just (Result 3 (M.fromList [(3, 15), (1, 15)]))) + , (test26, Just (Result 6 (M.fromList [(6, 20), (1, 10), (2, 10)]))) + , (test27, Just (Result 3 (M.fromList [(3, 0)]))) + , (test28, Just (Result 6 (M.fromList [(6, 0), (2, 10)]))) , (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)])) + , (test31, Just (Result 5 (M.fromList [(2, 1 % 1), (5, 0 % 1)]))) + , (test32, Nothing) + , (testPolyPaver1, Just (Result 12 (M.fromList [(12, 7 % 4), (2, 5 % 2), (1, 7 % 4), (3, 0)]))) + , (testPolyPaver2, Just (Result 12 (M.fromList [(12, 5 % 2), (2, 5 % 3), (1, 5 % 2), (3, 0)]))) + , (testPolyPaver3, Just (Result 12 (M.fromList [(12, 5 % 3), (2, 5 % 3), (1, 5 % 2), (3, 0)]))) + , (testPolyPaver4, Just (Result 12 (M.fromList [(12, 5 % 2), (2, 5 % 2), (1, 5 % 2), (3, 0)]))) , (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)])) + , (testPolyPaver9, Just (Result 12 (M.fromList [(12, 7 % 2), (2, 5 % 9), (1, 7 % 2), (3, 0)]))) + , (testPolyPaver10, Just (Result 12 (M.fromList [(12, 17 % 20), (2, 7 % 2), (1, 17 % 20), (3, 0)]))) + , (testPolyPaver11, Just (Result 12 (M.fromList [(12, 7 % 2), (2, 7 % 2), (1, 22 % 9)]))) + , (testPolyPaver12, Just (Result 12 (M.fromList [(12, 5 % 9), (2, 5 % 9), (1, 7 % 2), (3, 0)]))) , (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)])) + , (testPolyPaverTwoFs5, Just (Result 17 (M.fromList [(17, 5 % 2), (2, 45 % 22), (1, 5 % 2), (4, 0)]))) + , (testPolyPaverTwoFs6, Just (Result 17 (M.fromList [(17, 45 % 22), (2, 5 % 2), (1, 45 % 22), (4, 0)]))) + , (testPolyPaverTwoFs7, Just (Result 17 (M.fromList [(17, 5 % 2), (2, 5 % 2), (1, 5 % 2), (4, 0)]))) + , (testPolyPaverTwoFs8, Just (Result 17 (M.fromList [(17, 45 % 22), (2, 45 % 22), (1, 5 % 2), (4, 0)]))) + , (testLeqGeqBugMin1, Just (Result 5 (M.fromList [(5, 3), (1, 3), (2, 3)]))) + , (testLeqGeqBugMax1, Just (Result 5 (M.fromList [(5, 3), (1, 3), (2, 3)]))) + , (testLeqGeqBugMin2, Just (Result 5 (M.fromList [(5, 3), (1, 3), (2, 3)]))) + , (testLeqGeqBugMax2, Just (Result 5 (M.fromList [(5, 3), (1, 3), (2, 3)]))) + , (testQuickCheck1, Just (Result 10 (M.fromList [(10, (-370)), (2, 26), (1, 5 % 3)]))) + , (testQuickCheck2, Just (Result 8 (M.fromList [(8, (-2) % 9), (1, 14 % 9), (2, 8 % 9)]))) + , (testQuickCheck3, Just (Result 7 (M.fromList [(7, (-8)), (2, 2)]))) ] +testLeqGeqBugMin1 :: (ObjectiveFunction, [PolyConstraint]) testLeqGeqBugMin1 = - ( Min [(1, 1)] + ( Min (M.fromList [(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) + [ GEQ (M.fromList [(1, 1)]) 3 + , LEQ (M.fromList [(1, 1)]) 3 + , GEQ (M.fromList [(2, 1)]) 3 + , LEQ (M.fromList [(2, 1)]) 3 ] ) +testLeqGeqBugMax1 :: (ObjectiveFunction, [PolyConstraint]) testLeqGeqBugMax1 = - ( Min [(1, 1)] + ( Min (M.fromList [(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) + [ GEQ (M.fromList [(1, 1)]) 3 + , LEQ (M.fromList [(1, 1)]) 3 + , GEQ (M.fromList [(2, 1)]) 3 + , LEQ (M.fromList [(2, 1)]) 3 ] ) +testLeqGeqBugMin2 :: (ObjectiveFunction, [PolyConstraint]) testLeqGeqBugMin2 = - ( Min [(1, 1)] + ( Min (M.fromList [(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) + [ GEQ (M.fromList [(1, 1)]) 3 + , LEQ (M.fromList [(1, 1)]) 3 + , GEQ (M.fromList [(2, 1)]) 3 + , LEQ (M.fromList [(2, 1)]) 3 ] ) +testLeqGeqBugMax2 :: (ObjectiveFunction, [PolyConstraint]) testLeqGeqBugMax2 = - ( Min [(1, 1)] + ( Min (M.fromList [(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) + [ GEQ (M.fromList [(1, 1)]) 3 + , LEQ (M.fromList [(1, 1)]) 3 + , GEQ (M.fromList [(2, 1)]) 3 + , LEQ (M.fromList [(2, 1)]) 3 ] ) @@ -109,45 +116,45 @@ testLeqGeqBugMax2 = -- Solution: obj = 29, 1 = 3, 2 = 4, test1 :: (ObjectiveFunction, [PolyConstraint]) test1 = - ( Max [(1, 3), (2, 5)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, 3), (2, 1)]) 15 + , LEQ (M.fromList [(1, 1), (2, 1)]) 7 + , LEQ (M.fromList [(2, 1)]) 4 + , LEQ (M.fromList [(1, -1), (2, 2)]) 6 ] ) test2 :: (ObjectiveFunction, [PolyConstraint]) test2 = - ( Min [(1, 3), (2, 5)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, 3), (2, 1)]) 15 + , LEQ (M.fromList [(1, 1), (2, 1)]) 7 + , LEQ (M.fromList [(2, 1)]) 4 + , LEQ (M.fromList [(1, -1), (2, 2)]) 6 ] ) test3 :: (ObjectiveFunction, [PolyConstraint]) test3 = - ( Max [(1, 3), (2, 5)] + ( Max (M.fromList [(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 + [ GEQ (M.fromList [(1, 3), (2, 1)]) 15 + , GEQ (M.fromList [(1, 1), (2, 1)]) 7 + , GEQ (M.fromList [(2, 1)]) 4 + , GEQ (M.fromList [(1, -1), (2, 2)]) 6 ] ) test4 :: (ObjectiveFunction, [PolyConstraint]) test4 = - ( Min [(1, 3), (2, 5)] + ( Min (M.fromList [(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 + [ GEQ (M.fromList [(1, 3), (2, 1)]) 15 + , GEQ (M.fromList [(1, 1), (2, 1)]) 7 + , GEQ (M.fromList [(2, 1)]) 4 + , GEQ (M.fromList [(1, -1), (2, 2)]) 6 ] ) @@ -156,41 +163,41 @@ test4 = -- requires two phases test5 :: (ObjectiveFunction, [PolyConstraint]) test5 = - ( Max [(1, 1), (2, -1), (3, 1)] + ( Max (M.fromList [(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) + [ LEQ (M.fromList [(1, 2), (2, -1), (3, 2)]) 4 + , LEQ (M.fromList [(1, 2), (2, -3), (3, 1)]) (-5) + , LEQ (M.fromList [(1, -1), (2, 1), (3, -2)]) (-1) ] ) test6 :: (ObjectiveFunction, [PolyConstraint]) test6 = - ( Min [(1, 1), (2, -1), (3, 1)] + ( Min (M.fromList [(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) + [ LEQ (M.fromList [(1, 2), (2, -1), (3, 2)]) 4 + , LEQ (M.fromList [(1, 2), (2, -3), (3, 1)]) (-5) + , LEQ (M.fromList [(1, -1), (2, 1), (3, -2)]) (-1) ] ) test7 :: (ObjectiveFunction, [PolyConstraint]) test7 = - ( Max [(1, 1), (2, -1), (3, 1)] + ( Max (M.fromList [(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) + [ GEQ (M.fromList [(1, 2), (2, -1), (3, 2)]) 4 + , GEQ (M.fromList [(1, 2), (2, -3), (3, 1)]) (-5) + , GEQ (M.fromList [(1, -1), (2, 1), (3, -2)]) (-1) ] ) test8 :: (ObjectiveFunction, [PolyConstraint]) test8 = - ( Min [(1, 1), (2, -1), (3, 1)] + ( Min (M.fromList [(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) + [ GEQ (M.fromList [(1, 2), (2, -1), (3, 2)]) 4 + , GEQ (M.fromList [(1, 2), (2, -3), (3, 1)]) (-5) + , GEQ (M.fromList [(1, -1), (2, 1), (3, -2)]) (-1) ] ) @@ -199,19 +206,19 @@ test8 = -- requires two phases test9 :: (ObjectiveFunction, [PolyConstraint]) test9 = - ( Min [(1, 1), (2, 1), (3, 2), (4, 1)] + ( Min (M.fromList [(1, 1), (2, 1), (3, 2), (4, 1)]) , - [ EQ [(1, 1), (3, 2), (4, -2)] 2 - , EQ [(2, 1), (3, 1), (4, 4)] 6 + [ EQ (M.fromList [(1, 1), (3, 2), (4, -2)]) 2 + , EQ (M.fromList [(2, 1), (3, 1), (4, 4)]) 6 ] ) test10 :: (ObjectiveFunction, [PolyConstraint]) test10 = - ( Max [(1, 1), (2, 1), (3, 2), (4, 1)] + ( Max (M.fromList [(1, 1), (2, 1), (3, 2), (4, 1)]) , - [ EQ [(1, 1), (3, 2), (4, -2)] 2 - , EQ [(2, 1), (3, 1), (4, 4)] 6 + [ EQ (M.fromList [(1, 1), (3, 2), (4, -2)]) 2 + , EQ (M.fromList [(2, 1), (3, 1), (4, 4)]) 6 ] ) @@ -220,19 +227,19 @@ test10 = -- Solution: obj = 20, 3 = 6, 4 = 16 wq test11 :: (ObjectiveFunction, [PolyConstraint]) test11 = - ( Max [(3, -2), (4, 2), (5, 1)] + ( Max (M.fromList [(3, -2), (4, 2), (5, 1)]) , - [ EQ [(3, -2), (4, 1), (5, 1)] 4 - , EQ [(3, 3), (4, -1), (5, 2)] 2 + [ EQ (M.fromList [(3, -2), (4, 1), (5, 1)]) 4 + , EQ (M.fromList [(3, 3), (4, -1), (5, 2)]) 2 ] ) test12 :: (ObjectiveFunction, [PolyConstraint]) test12 = - ( Min [(3, -2), (4, 2), (5, 1)] + ( Min (M.fromList [(3, -2), (4, 2), (5, 1)]) , - [ EQ [(3, -2), (4, 1), (5, 1)] 4 - , EQ [(3, 3), (4, -1), (5, 2)] 2 + [ EQ (M.fromList [(3, -2), (4, 1), (5, 1)]) 4 + , EQ (M.fromList [(3, 3), (4, -1), (5, 2)]) 2 ] ) @@ -241,37 +248,37 @@ test12 = -- requires two phases test13 :: (ObjectiveFunction, [PolyConstraint]) test13 = - ( Max [(1, 2), (2, 1)] + ( Max (M.fromList [(1, 2), (2, 1)]) , - [ LEQ [(1, 4), (2, 1)] 150 - , LEQ [(1, 2), (2, -3)] (-40) + [ LEQ (M.fromList [(1, 4), (2, 1)]) 150 + , LEQ (M.fromList [(1, 2), (2, -3)]) (-40) ] ) test14 :: (ObjectiveFunction, [PolyConstraint]) test14 = - ( Min [(1, 2), (2, 1)] + ( Min (M.fromList [(1, 2), (2, 1)]) , - [ LEQ [(1, 4), (2, 1)] 150 - , LEQ [(1, 2), (2, -3)] (-40) + [ LEQ (M.fromList [(1, 4), (2, 1)]) 150 + , LEQ (M.fromList [(1, 2), (2, -3)]) (-40) ] ) test15 :: (ObjectiveFunction, [PolyConstraint]) test15 = - ( Max [(1, 2), (2, 1)] + ( Max (M.fromList [(1, 2), (2, 1)]) , - [ GEQ [(1, 4), (2, 1)] 150 - , GEQ [(1, 2), (2, -3)] (-40) + [ GEQ (M.fromList [(1, 4), (2, 1)]) 150 + , GEQ (M.fromList [(1, 2), (2, -3)]) (-40) ] ) test16 :: (ObjectiveFunction, [PolyConstraint]) test16 = - ( Min [(1, 2), (2, 1)] + ( Min (M.fromList [(1, 2), (2, 1)]) , - [ GEQ [(1, 4), (2, 1)] 150 - , GEQ [(1, 2), (2, -3)] (-40) + [ GEQ (M.fromList [(1, 4), (2, 1)]) 150 + , GEQ (M.fromList [(1, 2), (2, -3)]) (-40) ] ) @@ -279,41 +286,41 @@ test16 = -- 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)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, 1), (2, 1), (3, 4)]) 20 + , LEQ (M.fromList [(2, -5), (3, 5)]) 100 + , LEQ (M.fromList [(1, 1), (3, 1), (1, 1)]) 400 ] ) test18 :: (ObjectiveFunction, [PolyConstraint]) test18 = - ( Max [(1, -6), (2, -4), (3, 2)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, 1), (2, 1), (3, 4)]) 20 + , LEQ (M.fromList [(2, -5), (3, 5)]) 100 + , LEQ (M.fromList [(1, 1), (3, 1), (1, 1)]) 400 ] ) test19 :: (ObjectiveFunction, [PolyConstraint]) test19 = - ( Min [(1, -6), (2, -4), (3, 2)] + ( Min (M.fromList [(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 + [ GEQ (M.fromList [(1, 1), (2, 1), (3, 4)]) 20 + , GEQ (M.fromList [(2, -5), (3, 5)]) 100 + , GEQ (M.fromList [(1, 1), (3, 1), (1, 1)]) 400 ] ) test20 :: (ObjectiveFunction, [PolyConstraint]) test20 = - ( Max [(1, -6), (2, -4), (3, 2)] + ( Max (M.fromList [(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 + [ GEQ (M.fromList [(1, 1), (2, 1), (3, 4)]) 20 + , GEQ (M.fromList [(2, -5), (3, 5)]) 100 + , GEQ (M.fromList [(1, 1), (3, 1), (1, 1)]) 400 ] ) @@ -321,109 +328,127 @@ test20 = -- Solution: obj = 250, 1 = 0, 2 = 50, 3 = 0 test21 :: (ObjectiveFunction, [PolyConstraint]) test21 = - ( Max [(1, 3), (2, 5), (3, 2)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, 5), (2, 1), (3, 4)]) 50 + , LEQ (M.fromList [(1, 1), (2, -1), (3, 1)]) 150 + , LEQ (M.fromList [(1, 2), (2, 1), (3, 2)]) 100 ] ) test22 :: (ObjectiveFunction, [PolyConstraint]) test22 = - ( Min [(1, 3), (2, 5), (3, 2)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, 5), (2, 1), (3, 4)]) 50 + , LEQ (M.fromList [(1, 1), (2, -1), (3, 1)]) 150 + , LEQ (M.fromList [(1, 2), (2, 1), (3, 2)]) 100 ] ) test23 :: (ObjectiveFunction, [PolyConstraint]) test23 = - ( Max [(1, 3), (2, 5), (3, 2)] + ( Max (M.fromList [(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 + [ GEQ (M.fromList [(1, 5), (2, 1), (3, 4)]) 50 + , GEQ (M.fromList [(1, 1), (2, -1), (3, 1)]) 150 + , GEQ (M.fromList [(1, 2), (2, 1), (3, 2)]) 100 ] ) test24 :: (ObjectiveFunction, [PolyConstraint]) test24 = - ( Min [(1, 3), (2, 5), (3, 2)] + ( Min (M.fromList [(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 + [ GEQ (M.fromList [(1, 5), (2, 1), (3, 4)]) 50 + , GEQ (M.fromList [(1, 1), (2, -1), (3, 1)]) 150 + , GEQ (M.fromList [(1, 2), (2, 1), (3, 2)]) 100 ] ) test25 :: (ObjectiveFunction, [PolyConstraint]) test25 = - ( Max [(1, 1)] + ( Max (M.fromList [(1, 1)]) , - [ LEQ [(1, 1)] 15 + [ LEQ (M.fromList [(1, 1)]) 15 ] ) test26 :: (ObjectiveFunction, [PolyConstraint]) test26 = - ( Max [(1, 2)] + ( Max (M.fromList [(1, 2)]) , - [ LEQ [(1, 2)] 20 - , GEQ [(2, 1)] 10 + [ LEQ (M.fromList [(1, 2)]) 20 + , GEQ (M.fromList [(2, 1)]) 10 ] ) test27 :: (ObjectiveFunction, [PolyConstraint]) test27 = - ( Min [(1, 1)] + ( Min (M.fromList [(1, 1)]) , - [ LEQ [(1, 1)] 15 + [ LEQ (M.fromList [(1, 1)]) 15 ] ) test28 :: (ObjectiveFunction, [PolyConstraint]) test28 = - ( Min [(1, 2)] + ( Min (M.fromList [(1, 2)]) , - [ LEQ [(1, 2)] 20 - , GEQ [(2, 1)] 10 + [ LEQ (M.fromList [(1, 2)]) 20 + , GEQ (M.fromList [(2, 1)]) 10 ] ) test29 :: (ObjectiveFunction, [PolyConstraint]) test29 = - ( Max [(1, 1)] + ( Max (M.fromList [(1, 1)]) , - [ LEQ [(1, 1)] 15 - , GEQ [(1, 1)] 15.01 + [ LEQ (M.fromList [(1, 1)]) 15 + , GEQ (M.fromList [(1, 1)]) 15.01 ] ) test30 :: (ObjectiveFunction, [PolyConstraint]) test30 = - ( Max [(1, 1)] + ( Max (M.fromList [(1, 1)]) , - [ LEQ [(1, 1)] 15 - , GEQ [(1, 1)] 15.01 - , GEQ [(2, 1)] 10 + [ LEQ (M.fromList [(1, 1)]) 15 + , GEQ (M.fromList [(1, 1)]) 15.01 + , GEQ (M.fromList [(2, 1)]) 10 + ] + ) + +test31 :: (ObjectiveFunction, [PolyConstraint]) +test31 = + ( Min (M.fromList [(1, 1)]) + , + [ GEQ (M.fromList [(1, 1), (2, 1)]) 1 + , GEQ (M.fromList [(1, 1), (2, 1)]) 1 + ] + ) + +test32 :: (ObjectiveFunction, [PolyConstraint]) +test32 = + ( Min (M.fromList [(1, 1)]) + , + [ GEQ (M.fromList [(1, 1), (2, 1)]) 2 + , LEQ (M.fromList [(1, 1), (2, 1)]) 1 ] ) -- Tests for systems similar to those from PolyPaver2 testPolyPaver1 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver1 = - ( Min [(1, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -440,15 +465,15 @@ testPolyPaver1 = testPolyPaver2 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver2 = - ( Max [(1, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -465,15 +490,15 @@ testPolyPaver2 = testPolyPaver3 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver3 = - ( Min [(2, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -490,15 +515,15 @@ testPolyPaver3 = testPolyPaver4 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver4 = - ( Max [(2, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -515,15 +540,15 @@ testPolyPaver4 = testPolyPaver5 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver5 = - ( Max [(1, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -540,15 +565,15 @@ testPolyPaver5 = testPolyPaver6 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver6 = - ( Min [(1, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -565,15 +590,15 @@ testPolyPaver6 = testPolyPaver7 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver7 = - ( Max [(2, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -590,15 +615,15 @@ testPolyPaver7 = testPolyPaver8 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver8 = - ( Min [(2, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -615,15 +640,15 @@ testPolyPaver8 = testPolyPaver9 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver9 = - ( Max [(1, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -640,15 +665,15 @@ testPolyPaver9 = testPolyPaver10 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver10 = - ( Min [(1, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -665,15 +690,15 @@ testPolyPaver10 = testPolyPaver11 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver11 = - ( Max [(2, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -690,15 +715,15 @@ testPolyPaver11 = testPolyPaver12 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaver12 = - ( Min [(2, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, dx1l), (2, dx2l), (3, (-1))]) (-yl + dx1l * x1l + dx2l * x2l) + , GEQ (M.fromList [(1, dx1r), (2, dx2r), (3, (-1))]) (-yr + dx1r * x1l + dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 ] ) where @@ -715,18 +740,18 @@ testPolyPaver12 = testPolyPaverTwoFs1 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs1 = - ( Max [(1, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -749,18 +774,18 @@ testPolyPaverTwoFs1 = testPolyPaverTwoFs2 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs2 = - ( Min [(1, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -783,18 +808,18 @@ testPolyPaverTwoFs2 = testPolyPaverTwoFs3 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs3 = - ( Max [(2, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -817,18 +842,18 @@ testPolyPaverTwoFs3 = testPolyPaverTwoFs4 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs4 = - ( Min [(2, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -851,18 +876,18 @@ testPolyPaverTwoFs4 = testPolyPaverTwoFs5 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs5 = - ( Max [(1, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -885,18 +910,18 @@ testPolyPaverTwoFs5 = testPolyPaverTwoFs6 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs6 = - ( Min [(1, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -919,18 +944,18 @@ testPolyPaverTwoFs6 = testPolyPaverTwoFs7 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs7 = - ( Max [(2, 1)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -953,18 +978,18 @@ testPolyPaverTwoFs7 = testPolyPaverTwoFs8 :: (ObjectiveFunction, [PolyConstraint]) testPolyPaverTwoFs8 = - ( Min [(2, 1)] + ( Min (M.fromList [(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 + [ LEQ (M.fromList [(1, f1dx1l), (2, f1dx2l), (3, (-1))]) (-f1yl + f1dx1l * x1l + f1dx2l * x2l) + , GEQ (M.fromList [(1, f1dx1r), (2, f1dx2r), (3, (-1))]) (-f1yr + f1dx1r * x1l + f1dx2r * x2l) + , LEQ (M.fromList [(1, f2dx1l), (2, f2dx2l), (4, (-1))]) (-f2yl + f2dx1l * x1l + f2dx2l * x2l) + , GEQ (M.fromList [(1, f2dx1r), (2, f2dx2r), (4, (-1))]) (-f2yr + f2dx1r * x1l + f2dx2r * x2l) + , GEQ (M.fromList [(1, 1)]) x1l + , LEQ (M.fromList [(1, 1)]) x1r + , GEQ (M.fromList [(2, 1)]) x2l + , LEQ (M.fromList [(2, 1)]) x2r + , LEQ (M.fromList [(3, 1)]) 0 + , LEQ (M.fromList [(4, 1)]) 0 ] ) where @@ -987,38 +1012,37 @@ testPolyPaverTwoFs8 = -- 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 :: (ObjectiveFunction, [PolyConstraint]) testQuickCheck1 = - ( Max [(1, -6), (1, -8), (1, 9), (1, 10), (1, 8), (2, -15), (1, 13), (1, -14), (2, 0)] + ( Max (M.fromList [(1, 12), (2, -15)]) , - [ 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) + [ EQ (M.fromList [(1, 24), (2, -2)]) (-12) + , GEQ (M.fromList [(1, -20), (2, 11)]) (-7) + , GEQ (M.fromList [(1, -28), (2, 5)]) (-8) + , GEQ (M.fromList [(1, 3), (2, 0)]) 5 + , LEQ (M.fromList [(1, -48)]) (-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 :: (ObjectiveFunction, [PolyConstraint]) testQuickCheck2 = - ( Max [(1, -3), (2, 5)] + ( Max (M.fromList [(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 + [ LEQ (M.fromList [(1, -6), (2, 6)]) 4 + , LEQ (M.fromList [(1, 1), (2, -4), (3, 3)]) (-2) + , LEQ (M.fromList [(2, 7), (1, -4)]) 0 ] ) -- This test will fail if the objective function is not simplified +testQuickCheck3 :: (ObjectiveFunction, [PolyConstraint]) testQuickCheck3 = - ( Min [(2, 0), (2, -4)] + ( Min (M.fromList [(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) + [ GEQ (M.fromList [(1, 5), (2, 4)]) (-4) + , LEQ (M.fromList [(1, -1), (2, -1)]) 2 + , LEQ (M.fromList [(2, 1)]) 2 + , GEQ (M.fromList [(1, -5), (2, -1), (2, 1)]) (-5) ] )