Skip to content

Commit f5c1035

Browse files
rasheedjarasheedja
committed
wip
1 parent 834d2ed commit f5c1035

File tree

9 files changed

+88
-51
lines changed

9 files changed

+88
-51
lines changed

‎src/Linear/Simplex/Solver/Types.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ module Linear.Simplex.Solver.Types where
33
import qualified Data.Map as Map
44
import GHC.Generics (Generic)
55
import Linear.Expr.Types (ExprVarsOnly)
6-
import Linear.System.Linear.Types (CanBeLinearSystem)
76
import Linear.Var.Types (SimplexNum, Var)
87

98
data OptimisationDirection = Minimize | Maximize
@@ -15,11 +14,12 @@ data Objective = Objective
1514
}
1615
deriving (Show, Eq, GHC.Generics.Generic)
1716

17+
-- TODO: Is it useful to include the system in the result?
1818
data Result = Result
1919
{ varMap :: Map.Map Var SimplexNum
2020
, objVal :: SimplexNum
2121
}
2222
deriving (Show, Read, Eq, GHC.Generics.Generic)
2323

24-
class (CanBeLinearSystem s) => Solver s where
25-
solve :: s -> Objective -> Result
24+
-- class (CanBeLinearSystem s) => Solver s where
25+
-- solve :: s -> Objective -> Result

‎src/Linear/SlackForm/Types.hs‎

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,11 +10,12 @@ module Linear.SlackForm.Types where
1010
import qualified Data.Set as Set
1111
import GHC.Generics (Generic)
1212
import Linear.Constraint.Linear.Types (LinearEquation (..))
13-
import Linear.Expr.Types (ExprVarsOnly)
13+
import Linear.Expr.Types (ExprVarsOnly, Expr)
1414
import Linear.Expr.Util (exprVarsOnlyVars)
1515
import Linear.System.Linear.Types (LinearSystem (..))
1616
import Linear.System.Simple.Types
1717
import Linear.Var.Types (SimplexNum, Var)
18+
import qualified Data.Map as Map
1819

1920
-- Expr == SimplexNum
2021
-- TODO: think about a better name for this type, CanonicalForm?
@@ -25,6 +26,15 @@ data SlackForm = SlackForm
2526
}
2627
deriving (Show, Eq, Read, Generic)
2728

29+
data CanonicalForm = CanonicalForm
30+
{ constraints :: LinearSystem
31+
, originalVars :: Set.Set Var
32+
, systemVars :: Set.Set Var
33+
, systemSlackVars :: Set.Set Var -- all vars are non-negative
34+
, eliminatedVarsMap :: Map.Map Var Expr
35+
}
36+
deriving (Show, Eq, Read, Generic)
37+
2838
class CanBeSlackForm a where
2939
toSlackForm :: a -> ExprVarsOnly -> SlackForm
3040

‎src/Linear/SlackForm/Util.hs‎

Lines changed: 22 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,9 @@ import Linear.Term.Types
3333
, TermVarsOnly (..)
3434
)
3535
import Linear.Var.Types (Bounds (..), Var, VarBounds)
36+
import Linear.System.Simple.Util (deriveBounds)
37+
import Linear.SlackForm.Types (CanonicalForm(..))
38+
import qualified Data.Set as Set
3639

3740
-- | Eliminate non-zero lower bounds via substitution
3841
-- Return the system with the eliminated variables and a map of the eliminated variables to their equivalent expressions
@@ -72,8 +75,9 @@ eliminateNonZeroLowerBounds constraints eliminatedVarsMap = aux [] constraints.u
7275
-- Add slack variables...
7376
-- Second step here https://en.wikipedia.org/wiki/Simplex_algorithm#Standard_form
7477
-- Return system of equalities and the slack variables
75-
addSlackVariables :: SimpleSystem -> ([Var], LinearSystem)
76-
addSlackVariables constraints =
78+
-- TODO: [Var] should be a set
79+
addSlackVars :: SimpleSystem -> ([Var], LinearSystem)
80+
addSlackVars constraints =
7781
let nextAvailableVar = SST.nextAvailableVar constraints
7882
in aux constraints.unSimpleSystem nextAvailableVar []
7983
where
@@ -134,3 +138,19 @@ eliminateUnrestrictedLowerBounds constraints varBoundMap eliminatedVarsMap = aux
134138
(Map.fromList bounds)
135139
updatedEliminatedVarsMap
136140
aux cs (_ : bounds) = aux cs bounds
141+
142+
simpleSystemToCanonicalForm :: SimpleSystem -> CanonicalForm
143+
simpleSystemToCanonicalForm system =
144+
CanonicalForm {
145+
constraints = finalSystem,
146+
originalVars = SST.simpleSystemVars system,
147+
systemVars = SLU.linearSystemVars finalSystem,
148+
systemSlackVars = Set.fromList slackVars,
149+
eliminatedVarsMap = eliminatedVarsMap
150+
}
151+
where
152+
(eliminatedNonZeroLowerBoundVarsMap, system1) = eliminateNonZeroLowerBounds system Map.empty
153+
system1Bounds = deriveBounds system1
154+
(slackVars, linearSystem) = addSlackVars system1
155+
(eliminatedVarsMap, finalSystem)= eliminateUnrestrictedLowerBounds linearSystem system1Bounds eliminatedNonZeroLowerBoundVarsMap
156+

‎src/Linear/System/Linear/Types.hs‎

Lines changed: 12 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -10,16 +10,22 @@ module Linear.System.Linear.Types where
1010
import GHC.Generics (Generic)
1111
import Linear.Constraint.Linear.Types (LinearEquation)
1212
import Linear.Expr.Types (Expr)
13+
import Text.ParserCombinators.ReadP (between)
1314

1415
-- TODO: name this system of equations or something
1516
newtype LinearSystem = LinearSystem {unLinearSystem :: [LinearEquation]}
1617
deriving (Show, Eq, Read, Generic)
1718

18-
class CanBeLinearSystem a where
19-
toLinearSystem :: a -> LinearSystem
19+
{- When would I ever want this? Do I need things to be able to be
20+
able to turn into linear systems? Yes. But do I want other people
21+
to be able to do that? It would be nice, but I think we do that in
22+
the future if people actually want it.
23+
-}
24+
-- class CanBeLinearSystem a where
25+
-- toLinearSystem :: a -> LinearSystem
2026

21-
instance CanBeLinearSystem LinearSystem where
22-
toLinearSystem = id
27+
-- instance CanBeLinearSystem LinearSystem where
28+
-- toLinearSystem = id
2329

24-
instance CanBeLinearSystem LinearEquation where
25-
toLinearSystem id = LinearSystem [id]
30+
-- instance CanBeLinearSystem LinearEquation where
31+
-- toLinearSystem id = LinearSystem [id]

‎src/Linear/System/Linear/Util.hs‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,12 @@
77
-- Stability: experimental
88
module Linear.System.Linear.Util where
99

10+
import qualified Data.Set as Set
11+
1012
import Linear.Constraint.Linear.Types (LinearEquation (..))
1113
import qualified Linear.Constraint.Linear.Util as CLU
1214
import Linear.System.Linear.Types (LinearSystem (..))
13-
import Linear.Var.Types (Var)
15+
import Linear.Var.Types (Var, VarBounds)
1416

1517
-- | Prepend a linear equation to a linear system
1618
prependLinearEquation :: LinearEquation -> LinearSystem -> LinearSystem
@@ -23,3 +25,6 @@ appendLinearEquation eq (LinearSystem eqs) = LinearSystem (eqs ++ [eq])
2325
findHighestVar :: LinearSystem -> Maybe Var
2426
findHighestVar (LinearSystem []) = Nothing
2527
findHighestVar (LinearSystem eqs) = Just $ maximum $ map CLU.findHighestVar eqs
28+
29+
linearSystemVars :: LinearSystem -> Set.Set Var
30+
linearSystemVars = Set.unions . map CLU.linearEquationVars . unLinearSystem

‎src/Linear/System/Simple/Util.hs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -48,9 +48,8 @@ deriveBounds simpleSystem = foldr updateBounds initialVarBounds simpleSystem.unS
4848

4949
-- Eliminate inequalities which are outside the bounds
5050
-- precondition: no zero coefficients
51-
-- TODO: better name
52-
removeUselessSystemBounds :: SimpleSystem -> VarBounds -> SimpleSystem
53-
removeUselessSystemBounds constraints bounds =
51+
removeObviousInequalities :: SimpleSystem -> VarBounds -> SimpleSystem
52+
removeObviousInequalities constraints bounds =
5453
SimpleSystem $
5554
filter
5655
( \case

‎src/Linear/Var/Types.hs‎

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,4 @@ data Bounds = Bounds
1515
}
1616
deriving (Show, Read, Eq, Generic)
1717

18-
-- newtype VarBounds = VarBounds { unVarBounds :: M.Map Var Bounds }
19-
-- deriving (Show, Read, Eq, Generic)
20-
2118
type VarBounds = M.Map Var Bounds

‎test/Linear/SlackForm/UtilSpec.hs‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ import Linear.Constraint.Linear.Types (LinearEquation (..))
1515
import Linear.Constraint.Simple.Types (SimpleConstraint (..))
1616
import Linear.Expr.Types (Expr (..), ExprVarsOnly (..))
1717
import Linear.SlackForm.Util
18-
( addSlackVariables
18+
( addSlackVars
1919
, eliminateNonZeroLowerBounds
2020
, eliminateUnrestrictedLowerBounds
2121
)
@@ -145,7 +145,7 @@ spec = describe "Slack Form Transformations" $ do
145145
)
146146
(Map.toList updatedBounds)
147147
it
148-
"addSlackVariables correctly transforms inequalities to equalities (wikipedia case)"
148+
"addSlackVars correctly transforms inequalities to equalities (wikipedia case)"
149149
$ do
150150
let simpleSystem =
151151
SimpleSystem
@@ -160,11 +160,11 @@ spec = describe "Slack Form Transformations" $ do
160160
2 -- -x_4 + 3x_5 + x_7 = 2
161161
]
162162
expectedSlackVars = [6, 7]
163-
(slackVars, updatedSystem) = addSlackVariables simpleSystem
163+
(slackVars, updatedSystem) = addSlackVars simpleSystem
164164
updatedSystem `shouldBe` expectedSystem
165165
slackVars `shouldBe` expectedSlackVars
166166
it
167-
"addSlackVariables correctly transforms inequalities to equalities (test case 1)"
167+
"addSlackVars correctly transforms inequalities to equalities (test case 1)"
168168
$ do
169169
let simpleSystem =
170170
SimpleSystem
@@ -179,11 +179,11 @@ spec = describe "Slack Form Transformations" $ do
179179
3 -- -x_3 + 2x_4 - x_6 = 3
180180
]
181181
expectedSlackVars = [5, 6]
182-
(slackVars, updatedSystem) = addSlackVariables simpleSystem
182+
(slackVars, updatedSystem) = addSlackVars simpleSystem
183183
updatedSystem `shouldBe` expectedSystem
184184
slackVars `shouldBe` expectedSlackVars
185185
it
186-
"addSlackVariables correctly transforms inequalities to equalities (test case 2)"
186+
"addSlackVars correctly transforms inequalities to equalities (test case 2)"
187187
$ do
188188
let simpleSystem =
189189
SimpleSystem
@@ -198,11 +198,11 @@ spec = describe "Slack Form Transformations" $ do
198198
4 -- -x_3 + 2x_4 - x_6 = 4
199199
]
200200
expectedSlackVars = [5, 6]
201-
(slackVars, updatedSystem) = addSlackVariables simpleSystem
201+
(slackVars, updatedSystem) = addSlackVars simpleSystem
202202
updatedSystem `shouldBe` expectedSystem
203203
slackVars `shouldBe` expectedSlackVars
204204
it
205-
"addSlackVariables correctly transforms inequalities to equalities (test case 3)"
205+
"addSlackVars correctly transforms inequalities to equalities (test case 3)"
206206
$ do
207207
let simpleSystem =
208208
SimpleSystem
@@ -215,11 +215,11 @@ spec = describe "Slack Form Transformations" $ do
215215
, LinearEquation (ExprVarsOnly (CoeffTermVO (-1) 3 : [CoeffTermVO 2 4])) 4 -- -x_3 + 2x_4 = 4
216216
]
217217
expectedSlackVars = [5]
218-
(slackVars, updatedSystem) = addSlackVariables simpleSystem
218+
(slackVars, updatedSystem) = addSlackVars simpleSystem
219219
updatedSystem `shouldBe` expectedSystem
220220
slackVars `shouldBe` expectedSlackVars
221221
it
222-
"addSlackVariables correctly transforms inequalities to equalities (test case 4)"
222+
"addSlackVars correctly transforms inequalities to equalities (test case 4)"
223223
$ do
224224
let simpleSystem =
225225
SimpleSystem
@@ -232,7 +232,7 @@ spec = describe "Slack Form Transformations" $ do
232232
, LinearEquation (ExprVarsOnly (CoeffTermVO (-1) 3 : [CoeffTermVO 2 4])) 4 -- -x_3 + 2x_4 = 4
233233
]
234234
expectedSlackVars = []
235-
(slackVars, updatedSystem) = addSlackVariables simpleSystem
235+
(slackVars, updatedSystem) = addSlackVars simpleSystem
236236
updatedSystem `shouldBe` expectedSystem
237237
slackVars `shouldBe` expectedSlackVars
238238
it
@@ -245,7 +245,7 @@ spec = describe "Slack Form Transformations" $ do
245245
]
246246
systemBounds = deriveBounds simpleSystem
247247
(eliminatedNonZeroLowerBounds, systemWithoutNonZeroLowerBounds) = eliminateNonZeroLowerBounds simpleSystem Map.empty
248-
(slackVars, systemWithSlackVars) = addSlackVariables systemWithoutNonZeroLowerBounds
248+
(slackVars, systemWithSlackVars) = addSlackVars systemWithoutNonZeroLowerBounds
249249
(updatedEliminatedVarsMap, updatedSystem) =
250250
eliminateUnrestrictedLowerBounds
251251
systemWithSlackVars
@@ -276,7 +276,7 @@ spec = describe "Slack Form Transformations" $ do
276276
]
277277
systemBounds = deriveBounds simpleSystem
278278
(eliminatedNonZeroLowerBounds, systemWithoutNonZeroLowerBounds) = eliminateNonZeroLowerBounds simpleSystem Map.empty
279-
(slackVars, systemWithSlackVars) = addSlackVariables systemWithoutNonZeroLowerBounds
279+
(slackVars, systemWithSlackVars) = addSlackVars systemWithoutNonZeroLowerBounds
280280
(updatedEliminatedVarsMap, updatedSystem) =
281281
eliminateUnrestrictedLowerBounds
282282
systemWithSlackVars
@@ -314,7 +314,7 @@ spec = describe "Slack Form Transformations" $ do
314314
]
315315
systemBounds = deriveBounds simpleSystem
316316
(eliminatedNonZeroLowerBounds, systemWithoutNonZeroLowerBounds) = eliminateNonZeroLowerBounds simpleSystem Map.empty
317-
(slackVars, systemWithSlackVars) = addSlackVariables systemWithoutNonZeroLowerBounds
317+
(slackVars, systemWithSlackVars) = addSlackVars systemWithoutNonZeroLowerBounds
318318
expectedSlackVars = [4, 5, 6]
319319
(updatedEliminatedVarsMap, updatedSystem) =
320320
eliminateUnrestrictedLowerBounds
@@ -355,7 +355,7 @@ spec = describe "Slack Form Transformations" $ do
355355
]
356356
systemBounds = deriveBounds simpleSystem
357357
(eliminatedNonZeroLowerBounds, systemWithoutNonZeroLowerBounds) = eliminateNonZeroLowerBounds simpleSystem Map.empty
358-
(slackVars, systemWithSlackVars) = addSlackVariables systemWithoutNonZeroLowerBounds
358+
(slackVars, systemWithSlackVars) = addSlackVars systemWithoutNonZeroLowerBounds
359359
expectedSlackVars = [3, 4]
360360
(updatedEliminatedVarsMap, updatedSystem) =
361361
eliminateUnrestrictedLowerBounds
@@ -394,7 +394,7 @@ spec = describe "Slack Form Transformations" $ do
394394
]
395395
systemBounds = deriveBounds simpleSystem
396396
(eliminatedNonZeroLowerBounds, systemWithoutNonZeroLowerBounds) = eliminateNonZeroLowerBounds simpleSystem Map.empty
397-
(slackVars, systemWithSlackVars) = addSlackVariables systemWithoutNonZeroLowerBounds
397+
(slackVars, systemWithSlackVars) = addSlackVars systemWithoutNonZeroLowerBounds
398398
expectedSlackVars = [3, 4]
399399
(updatedEliminatedVarsMap, updatedSystem) =
400400
eliminateUnrestrictedLowerBounds

0 commit comments

Comments
 (0)