Skip to content

Commit 08340ff

Browse files
rasheedjarasheedja
committed
wip
1 parent 9a2809d commit 08340ff

File tree

15 files changed

+88
-70
lines changed

15 files changed

+88
-70
lines changed

‎src/Linear/Constraint/Simple/Types.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,3 +12,6 @@ import Linear.Expr.Types (ExprVarsOnly)
1212
import Linear.Var.Types (SimplexNum)
1313

1414
type SimpleConstraint = GenericConstraint ExprVarsOnly SimplexNum
15+
16+
class CanBeSimpleConstraint a where
17+
toSimpleConstraint :: a -> SimpleConstraint

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

Lines changed: 7 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import Linear.Constraint.Generic.Types
1313
( GenericConstraint (..)
1414
)
1515
import Linear.Constraint.Simple.Types (SimpleConstraint)
16-
import Linear.Constraint.Types (Constraint)
16+
import Linear.Constraint.Types (Constraint (..))
1717
import Linear.Expr.Types (Expr (..), ExprVarsOnly (..))
1818
import Linear.Expr.Util
1919
( exprToExprVarsOnly
@@ -37,15 +37,15 @@ substVarSimpleConstraintExpr ::
3737
substVarSimpleConstraintExpr var varReplacement (a :<= b) =
3838
let newExpr = substVarExpr var varReplacement (exprVarsOnlyToExpr a)
3939
newConstraint = newExpr :<= Expr [ConstTerm b]
40-
in constraintToSimpleConstraint newConstraint
40+
in constraintToSimpleConstraint $ Constraint newConstraint
4141
substVarSimpleConstraintExpr var varReplacement (a :>= b) =
4242
let newExpr = substVarExpr var varReplacement (exprVarsOnlyToExpr a)
4343
newConstraint = newExpr :>= Expr [ConstTerm b]
44-
in constraintToSimpleConstraint newConstraint
44+
in constraintToSimpleConstraint $ Constraint newConstraint
4545
substVarSimpleConstraintExpr var varReplacement (a :== b) =
4646
let newExpr = substVarExpr var varReplacement (exprVarsOnlyToExpr a)
4747
newConstraint = newExpr :== Expr [ConstTerm b]
48-
in constraintToSimpleConstraint newConstraint
48+
in constraintToSimpleConstraint $ Constraint newConstraint
4949

5050
substVarSimpleConstraint ::
5151
Var -> ExprVarsOnly -> SimpleConstraint -> SimpleConstraint
@@ -56,9 +56,9 @@ substVarSimpleConstraint var varReplacement (a :== b) = substVarExprVarsOnly var
5656
constraintToSimpleConstraint :: Constraint -> SimpleConstraint
5757
constraintToSimpleConstraint constraint =
5858
case constraint of
59-
(a :<= b) -> uncurry (:<=) (calcLhsRhs a b)
60-
(a :>= b) -> uncurry (:>=) (calcLhsRhs a b)
61-
(a :== b) -> uncurry (:==) (calcLhsRhs a b)
59+
Constraint (a :<= b) -> uncurry (:<=) (calcLhsRhs a b)
60+
Constraint (a :>= b) -> uncurry (:>=) (calcLhsRhs a b)
61+
Constraint (a :== b) -> uncurry (:==) (calcLhsRhs a b)
6262
where
6363
calcLhsRhs a b = (lhs, rhs)
6464
where
@@ -76,48 +76,6 @@ constraintToSimpleConstraint constraint =
7676
error $
7777
"constraintToSimpleConstraint: lhs is not ExprVarsOnly. Details: " <> err
7878

79-
-- normalize simple constraints by moving all constants to the right
80-
-- normalizeSimpleConstraint :: SimpleConstraint -> SimpleConstraint
81-
-- normalizeSimpleConstraint (expr :<= num) =
82-
-- let exprList = exprToList expr
83-
84-
-- isConstTerm (ConstTerm _) = True
85-
-- isConstTerm _ = False
86-
87-
-- (sumExprConstTerms, nonConstTerms) = L.partition isConstTerm exprList
88-
89-
-- constTermsVal = sum . map (\case (ConstTerm c) -> c; _ -> 0) $ sumExprConstTerms
90-
91-
-- newExpr = listToExpr nonConstTerms
92-
-- newNum = num - constTermsVal
93-
-- in newExpr :<= newNum
94-
-- normalizeSimpleConstraint (expr :>= num) =
95-
-- let exprList = exprToList expr
96-
97-
-- isConstTerm (ConstTerm _) = True
98-
-- isConstTerm _ = False
99-
100-
-- (sumExprConstTerms, nonConstTerms) = L.partition isConstTerm exprList
101-
102-
-- constTermsVal = sum . map (\case (ConstTerm c) -> c; _ -> 0) $ sumExprConstTerms
103-
104-
-- newExpr = listToExpr nonConstTerms
105-
-- newNum = num - constTermsVal
106-
-- in newExpr :>= newNum
107-
-- normalizeSimpleConstraint (expr :== num) =
108-
-- let exprList = exprToList expr
109-
110-
-- isConstTerm (ConstTerm _) = True
111-
-- isConstTerm _ = False
112-
113-
-- (sumExprConstTerms, nonConstTerms) = L.partition isConstTerm exprList
114-
115-
-- constTermsVal = sum . map (\case (ConstTerm c) -> c; _ -> 0) $ sumExprConstTerms
116-
117-
-- newExpr = listToExpr nonConstTerms
118-
-- newNum = num - constTermsVal
119-
-- in newExpr :== newNum
120-
12179
-- | Simplify coeff constraints by dividing the coefficient from both sides
12280
simplifyCoeff :: SimpleConstraint -> SimpleConstraint
12381
simplifyCoeff expr@(ExprVarsOnly [CoeffTermVO coeff var] :<= num)

‎src/Linear/Constraint/Types.hs‎

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,12 @@ import qualified Data.Set as Set
1111
import GHC.Generics (Generic)
1212
import Linear.Constraint.Generic.Types (GenericConstraint)
1313
import Linear.Expr.Types (Expr)
14+
import Test.QuickCheck (Arbitrary (..))
1415

1516
-- Input
16-
type Constraint = GenericConstraint Expr Expr
17+
-- TODO: Consider LinearConstraint
18+
newtype Constraint = Constraint {unConstraint :: GenericConstraint Expr Expr}
19+
deriving (Show, Eq, Read, Generic)
20+
21+
instance Arbitrary Constraint where
22+
arbitrary = Constraint <$> arbitrary

‎src/Linear/Constraint/Util.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,11 @@ import qualified Data.Set as Set
1111
import Linear.Constraint.Generic.Types
1212
( GenericConstraint ((:<=), (:==), (:>=))
1313
)
14-
import Linear.Constraint.Types (Constraint)
14+
import Linear.Constraint.Types (Constraint (..))
1515
import Linear.Expr.Util (exprVars)
1616
import Linear.Var.Types (Var)
1717

1818
constraintVars :: Constraint -> Set.Set Var
19-
constraintVars (lhs :<= rhs) = exprVars lhs <> exprVars rhs
20-
constraintVars (lhs :>= rhs) = exprVars lhs <> exprVars rhs
21-
constraintVars (lhs :== rhs) = exprVars lhs <> exprVars rhs
19+
constraintVars (Constraint (lhs :<= rhs)) = exprVars lhs <> exprVars rhs
20+
constraintVars (Constraint (lhs :>= rhs)) = exprVars lhs <> exprVars rhs
21+
constraintVars (Constraint (lhs :== rhs)) = exprVars lhs <> exprVars rhs

‎src/Linear/Expr/Types.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,8 @@ import GHC.Generics (Generic)
1111
import Linear.Term.Types (Term, TermVarsOnly)
1212
import Test.QuickCheck (Arbitrary (..))
1313

14-
-- TODO: Use normal lists
1514
-- treat empty expr as 0
15+
-- Consider a version with a num instance, use + and * operators for the input
1616
newtype Expr = Expr {unExpr :: [Term]}
1717
deriving
1818
( Show

‎src/Linear/Expr/Util.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -121,8 +121,7 @@ exprToExprVarsOnly expr@(Expr ts) = do
121121
then
122122
if sumExprConstTerms expr == 0
123123
then Right $ ExprVarsOnly []
124-
else
125-
Left $ "safeExprToExprVarsOnly: Expr contains ConstTerm. Expr: " <> show expr
124+
else Left $ "safeExprToExprVarsOnly: Expr contains ConstTerm. Expr: " <> show expr
126125
else Right $ unsafeExprToExprVarsOnly expr
127126
where
128127
isConstTerm :: Term -> Bool

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,15 +2,15 @@ module Linear.Simplex.Solver.Types where
22

33
import qualified Data.Map as Map
44
import GHC.Generics (Generic)
5-
import Linear.Expr.Types (Expr)
5+
import Linear.Expr.Types (ExprVarsOnly)
66
import Linear.System.Linear.Types (CanBeLinearSystem)
77
import Linear.Var.Types (SimplexNum, Var)
88

99
data OptimisationDirection = Minimize | Maximize
1010
deriving (Show, Eq, GHC.Generics.Generic)
1111

1212
data Objective = Objective
13-
{ expr :: Linear.Expr.Types.Expr -- TODO: this should be ExprVarsOnly
13+
{ expr :: Linear.Expr.Types.ExprVarsOnly
1414
, direction :: OptimisationDirection
1515
}
1616
deriving (Show, Eq, GHC.Generics.Generic)

‎src/Linear/SlackForm/Types.hs‎

Lines changed: 17 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -7,18 +7,30 @@
77
-- Stability: experimental
88
module Linear.SlackForm.Types where
99

10+
import qualified Data.Set as Set
1011
import GHC.Generics (Generic)
11-
import Linear.Expr.Types (Expr)
12-
import Linear.System.Linear.Types (LinearSystem)
12+
import Linear.Constraint.Linear.Types (LinearEquation (..))
13+
import Linear.Expr.Types (ExprVarsOnly)
14+
import Linear.Expr.Util (exprVarsOnlyVars)
15+
import Linear.System.Linear.Types (LinearSystem (..))
16+
import Linear.System.Simple.Types
1317
import Linear.Var.Types (SimplexNum, Var)
1418

1519
-- Expr == SimplexNum
20+
-- TODO: think about a better name for this type, CanonicalForm?
1621
data SlackForm = SlackForm
17-
{ maxObjective :: Expr -- TODO: should be ExprVarsOnly
22+
{ maxObjective :: ExprVarsOnly
1823
, constraints :: LinearSystem
19-
, vars :: [Var] -- all vars are non-negative
24+
, vars :: Set.Set Var -- all vars are non-negative
2025
}
2126
deriving (Show, Eq, Read, Generic)
2227

2328
class CanBeSlackForm a where
24-
toSlackForm :: a -> SlackForm
29+
toSlackForm :: a -> ExprVarsOnly -> SlackForm
30+
31+
instance CanBeSlackForm LinearSystem where
32+
toSlackForm ls obj =
33+
SlackForm
34+
obj
35+
ls
36+
(Set.unions $ map (exprVarsOnlyVars . lhs) ls.unLinearSystem)

‎src/Linear/SlackForm/Util.hs‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -126,7 +126,6 @@ eliminateUnrestrictedLowerBounds constraints varBoundMap eliminatedVarsMap = aux
126126
newConstraints =
127127
LinearSystem $
128128
map (CLU.substVarWith var substOldVarWith) (unLinearSystem constraints) -- TODO: simplify?
129-
-- TODO: Update this name
130129
updatedEliminatedVarsMap = Map.insert var (exprVarsOnlyToExpr substOldVarWith) eliminatedVarsMap
131130
in eliminateUnrestrictedLowerBounds
132131
newConstraints

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ import GHC.Generics (Generic)
1111
import Linear.Constraint.Linear.Types (LinearEquation)
1212
import Linear.Expr.Types (Expr)
1313

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

0 commit comments

Comments
 (0)