Skip to content

Commit 75643ce

Browse files
rasheedjarasheedja
committed
split modules up reasonably
+ create new types for TermVarsOnly, ExprVarsOnly + Make Expr a non-empty list of terms + solver class for the future
1 parent 79a5a6f commit 75643ce

File tree

37 files changed

+2426
-1507
lines changed

37 files changed

+2426
-1507
lines changed

‎fourmolu.yaml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
indentation: 2
2-
column-limit: 120
2+
column-limit: 80
33
function-arrows: trailing
44
comma-style: leading
55
import-export-style: leading
@@ -12,5 +12,5 @@ let-style: inline
1212
in-style: left-align
1313
single-constraint-parens: always
1414
unicode: never
15-
respectful: true
15+
respectful: false
1616
fixities: []

‎package.yaml‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,9 +52,11 @@ library:
5252
source-dirs: src
5353

5454
tests:
55-
simplex-haskell-test:
55+
simplex-method-test:
5656
defaults: hspec/hspec@main
57+
main: Spec.hs
58+
source-dirs: test
5759
dependencies:
58-
- simplex-method
5960
- hspec
6061
- QuickCheck
62+
- simplex-method

‎simplex-method.cabal‎

Lines changed: 27 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -27,12 +27,30 @@ source-repository head
2727

2828
library
2929
exposed-modules:
30-
Linear.Simplex.DeriveBounds
30+
Linear.Constraint.Generic.Types
31+
Linear.Constraint.Linear.Types
32+
Linear.Constraint.Simple.Types
33+
Linear.Constraint.Simple.Util
34+
Linear.Constraint.Types
35+
Linear.Constraint.Util
36+
Linear.Expr.Types
37+
Linear.Expr.Util
3138
Linear.Simplex.Prettify
3239
Linear.Simplex.Solver.TwoPhase
40+
Linear.Simplex.Solver.Types
3341
Linear.Simplex.Standardize
3442
Linear.Simplex.Types
3543
Linear.Simplex.Util
44+
Linear.SlackForm.Types
45+
Linear.SlackForm.Util
46+
Linear.System.Linear.Types
47+
Linear.System.Simple.Types
48+
Linear.System.Simple.Util
49+
Linear.System.Types
50+
Linear.Term.Types
51+
Linear.Term.Util
52+
Linear.Var.Types
53+
Linear.Var.Util
3654
other-modules:
3755
Paths_simplex_method
3856
hs-source-dirs:
@@ -51,11 +69,17 @@ library
5169
, time
5270
default-language: Haskell2010
5371

54-
test-suite simplex-haskell-test
72+
test-suite simplex-method-test
5573
type: exitcode-stdio-1.0
5674
main-is: Spec.hs
5775
other-modules:
58-
Linear.Simplex.TypesSpec
76+
Linear.Constraint.Simple.TypesSpec
77+
Linear.Expr.TypesSpec
78+
Linear.SlackForm.UtilSpec
79+
Linear.System.Simple.TypesSpec
80+
Linear.Term.TypesSpec
81+
Linear.Var.UtilSpec
82+
TestUtil
5983
Paths_simplex_method
6084
hs-source-dirs:
6185
test

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

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
-- |
2+
-- Module : Linear.Constraint.Generic.Types
3+
-- Description : Types for constraints in linear programming problems
4+
-- Copyright : (c) Junaid Rasheed, 2020-2024
5+
-- License : BSD-3
6+
-- Maintainer : jrasheed178@gmail.com
7+
-- Stability : experimental
8+
module Linear.Constraint.Generic.Types where
9+
10+
import Control.Applicative (liftA2)
11+
import GHC.Generics (Generic)
12+
import Test.QuickCheck (Arbitrary, arbitrary, genericShrink, oneof)
13+
14+
data GenericConstraint a b = a :<= b | a :>= b | a :== b
15+
deriving (Show, Read, Eq, Generic)
16+
17+
instance (Arbitrary a, Arbitrary b) => Arbitrary (GenericConstraint a b) where
18+
arbitrary =
19+
oneof
20+
[ liftA2 (:<=) arbitrary arbitrary
21+
, liftA2 (:>=) arbitrary arbitrary
22+
, liftA2 (:==) arbitrary arbitrary
23+
]
24+
25+
getGenericConstraintLHS :: GenericConstraint a b -> a
26+
getGenericConstraintLHS (a :<= _) = a
27+
getGenericConstraintLHS (a :>= _) = a
28+
getGenericConstraintLHS (a :== _) = a
29+
30+
getGenericConstraintRHS :: GenericConstraint a b -> b
31+
getGenericConstraintRHS (_ :<= b) = b
32+
getGenericConstraintRHS (_ :>= b) = b
33+
getGenericConstraintRHS (_ :== b) = b

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

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,27 @@
1+
-- |
2+
-- Description: Types for linear constraints.
3+
-- Copyright: (c) Junaid Rasheed, 2024
4+
-- License: BSD-3
5+
-- Maintainer: Junaid Rasheed <jrasheed178@gmail.com>
6+
-- Stability: experimental
7+
module Linear.Constraint.Linear.Types where
8+
9+
import GHC.Generics (Generic)
10+
import Linear.Expr.Types
11+
import Linear.Var.Types
12+
13+
-- TODO: Expr -> ExprVarsOnly
14+
-- lhs == rhs
15+
data LinearEquation = LinearEquation
16+
{ lhs :: Expr
17+
, rhs :: SimplexNum
18+
}
19+
deriving (Show, Eq, Read, Generic)
20+
21+
-- class CanBeLinearEquation a where
22+
-- toLinearEquation :: a -> LinearEquation
23+
-- fromLinearEquation :: LinearEquation -> a
24+
25+
-- instance CanBeLinearEquation LinearEquation where
26+
-- toLinearEquation = id
27+
-- fromLinearEquation = id

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

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
-- |
2+
-- Module: Linear.Constraint.Simple.Types
3+
-- Description: Types for simple linear constraints
4+
-- Copyright: (c) Junaid Rasheed, 2020-2024
5+
-- License: BSD-3
6+
-- Maintainer: jrasheed178@gmail.com
7+
-- Stability: experimental
8+
module Linear.Constraint.Simple.Types where
9+
10+
import Linear.Constraint.Generic.Types (GenericConstraint)
11+
import Linear.Expr.Types (Expr)
12+
import Linear.Var.Types (SimplexNum)
13+
14+
type SimpleConstraint = GenericConstraint Expr SimplexNum

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

Lines changed: 118 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,118 @@
1+
-- |
2+
-- Module: Linear.Constraint.Simple.Util
3+
-- Description: Utility functions for simple constraints
4+
-- Copyright: (c) Junaid Rasheed, 2020-2024
5+
-- License: BSD-3
6+
-- Maintainer: jrasheed178@gmail.com
7+
-- Stability: experimental
8+
module Linear.Constraint.Simple.Util where
9+
10+
import qualified Data.List as L
11+
import Data.List.NonEmpty (NonEmpty (..))
12+
import qualified Data.List.NonEmpty as NE
13+
import qualified Data.Set as Set
14+
import Linear.Constraint.Generic.Types
15+
import Linear.Constraint.Simple.Types
16+
import Linear.Constraint.Types
17+
import Linear.Expr.Types
18+
import Linear.Expr.Util
19+
import Linear.Term.Types
20+
import Linear.Var.Types
21+
22+
substVarSimpleConstraint :: Var -> Expr -> SimpleConstraint -> SimpleConstraint
23+
substVarSimpleConstraint var varReplacement (a :<= b) = substVarExpr var varReplacement a :<= b
24+
substVarSimpleConstraint var varReplacement (a :>= b) = substVarExpr var varReplacement a :>= b
25+
substVarSimpleConstraint var varReplacement (a :== b) = substVarExpr var varReplacement a :== b
26+
27+
constraintToSimpleConstraint :: Constraint -> SimpleConstraint
28+
constraintToSimpleConstraint constraint =
29+
case constraint of
30+
(a :<= b) -> uncurry (:<=) (calcLhsRhs a b)
31+
(a :>= b) -> uncurry (:>=) (calcLhsRhs a b)
32+
(a :== b) -> uncurry (:==) (calcLhsRhs a b)
33+
where
34+
calcLhsRhs a b = (lhs, rhs)
35+
where
36+
aConsts = sumExprConstTerms a
37+
bConsts = sumExprConstTerms b
38+
rhs = bConsts - aConsts
39+
40+
aWithoutConst = simplifyExpr . zeroConstExpr $ a
41+
bWithoutConst = simplifyExpr . zeroConstExpr $ b
42+
43+
lhs = subtractExpr aWithoutConst bWithoutConst
44+
calcRhs a b = rhs
45+
where
46+
aConsts = sumExprConstTerms a
47+
bConsts = sumExprConstTerms b
48+
rhs = bConsts - aConsts
49+
50+
aWithoutConst = simplifyExpr . zeroConstExpr $ a
51+
bWithoutConst = simplifyExpr . zeroConstExpr $ b
52+
53+
lhs = subtractExpr aWithoutConst bWithoutConst
54+
55+
-- normalize simple constraints by moving all constants to the right
56+
normalizeSimpleConstraint :: SimpleConstraint -> SimpleConstraint
57+
normalizeSimpleConstraint (expr :<= num) =
58+
let exprList = exprToList expr
59+
60+
isConstTerm (ConstTerm _) = True
61+
isConstTerm _ = False
62+
63+
(sumExprConstTerms, nonConstTerms) = L.partition isConstTerm exprList
64+
65+
constTermsVal = sum . map (\case (ConstTerm c) -> c; _ -> 0) $ sumExprConstTerms
66+
67+
newExpr = listToExpr nonConstTerms
68+
newNum = num - constTermsVal
69+
in newExpr :<= newNum
70+
normalizeSimpleConstraint (expr :>= num) =
71+
let exprList = exprToList expr
72+
73+
isConstTerm (ConstTerm _) = True
74+
isConstTerm _ = False
75+
76+
(sumExprConstTerms, nonConstTerms) = L.partition isConstTerm exprList
77+
78+
constTermsVal = sum . map (\case (ConstTerm c) -> c; _ -> 0) $ sumExprConstTerms
79+
80+
newExpr = listToExpr nonConstTerms
81+
newNum = num - constTermsVal
82+
in newExpr :>= newNum
83+
normalizeSimpleConstraint (expr :== num) =
84+
let exprList = exprToList expr
85+
86+
isConstTerm (ConstTerm _) = True
87+
isConstTerm _ = False
88+
89+
(sumExprConstTerms, nonConstTerms) = L.partition isConstTerm exprList
90+
91+
constTermsVal = sum . map (\case (ConstTerm c) -> c; _ -> 0) $ sumExprConstTerms
92+
93+
newExpr = listToExpr nonConstTerms
94+
newNum = num - constTermsVal
95+
in newExpr :== newNum
96+
97+
-- | Simplify coeff constraints by dividing the coefficient from both sides
98+
simplifyCoeff :: SimpleConstraint -> SimpleConstraint
99+
simplifyCoeff expr@(Expr (CoeffTerm coeff var :| []) :<= num)
100+
| coeff == 0 = expr
101+
| coeff > 0 = Expr (VarTerm var :| []) :<= (num / coeff)
102+
| coeff < 0 = Expr (VarTerm var :| []) :>= (num / coeff)
103+
simplifyCoeff expr@(Expr (CoeffTerm coeff var :| []) :>= num)
104+
| coeff == 0 = expr
105+
| coeff > 0 = Expr (VarTerm var :| []) :>= (num / coeff)
106+
| coeff < 0 = Expr (VarTerm var :| []) :<= (num / coeff)
107+
simplifyCoeff expr@(Expr (CoeffTerm coeff var :| []) :== num) = if coeff == 0 then expr else Expr (VarTerm var :| []) :== (num / coeff)
108+
simplifyCoeff expr = expr
109+
110+
simplifySimpleConstraint :: SimpleConstraint -> SimpleConstraint
111+
simplifySimpleConstraint (expr :<= num) = simplifyCoeff . normalizeSimpleConstraint $ simplifyExpr expr :<= num
112+
simplifySimpleConstraint (expr :>= num) = simplifyCoeff . normalizeSimpleConstraint $ simplifyExpr expr :>= num
113+
simplifySimpleConstraint (expr :== num) = simplifyCoeff . normalizeSimpleConstraint $ simplifyExpr expr :== num
114+
115+
simpleConstraintVars :: SimpleConstraint -> Set.Set Var
116+
simpleConstraintVars (expr :<= _) = exprVars expr
117+
simpleConstraintVars (expr :>= _) = exprVars expr
118+
simpleConstraintVars (expr :== _) = exprVars expr

‎src/Linear/Constraint/Types.hs‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
-- |
2+
-- Module: Linear.Constraint.Types
3+
-- Description: Types for linear constraints
4+
-- Copyright: (c) Junaid Rasheed, 2020-2024
5+
-- License: BSD-3
6+
-- Maintainer: jrasheed178@gmail.com
7+
-- Stability: experimental
8+
module Linear.Constraint.Types where
9+
10+
import qualified Data.Set as Set
11+
import GHC.Generics (Generic)
12+
import Linear.Constraint.Generic.Types
13+
import Linear.Expr.Types
14+
import Linear.Var.Types
15+
16+
-- Input
17+
type Constraint = GenericConstraint Expr Expr

‎src/Linear/Constraint/Util.hs‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
-- |
2+
-- Module: Linear.Constraint.Util
3+
-- Description: Utility functions for constraints
4+
-- Copyright: (c) Junaid Rasheed, 2020-2024
5+
-- License: BSD-3
6+
-- Maintainer: jrasheed178@gmail.com
7+
-- Stability: experimental
8+
module Linear.Constraint.Util where
9+
10+
import qualified Data.Set as Set
11+
import Linear.Constraint.Generic.Types
12+
import Linear.Constraint.Types
13+
import Linear.Expr.Types
14+
import Linear.Expr.Util
15+
import Linear.Var.Types
16+
17+
constraintVars :: Constraint -> Set.Set Var
18+
constraintVars (lhs :<= rhs) = exprVars lhs <> exprVars rhs
19+
constraintVars (lhs :>= rhs) = exprVars lhs <> exprVars rhs
20+
constraintVars (lhs :== rhs) = exprVars lhs <> exprVars rhs

‎src/Linear/Expr/Types.hs‎

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
-- |
2+
-- Module: Linear.Expr.Types
3+
-- Description: Types for linear expressions
4+
-- Copyright: (c) Junaid Rasheed, 2020-2024
5+
-- License: BSD-3
6+
-- Maintainer: jrasheed178@gmail.com
7+
-- Stability: experimental
8+
module Linear.Expr.Types where
9+
10+
import qualified Data.List.NonEmpty as NE
11+
import GHC.Base (liftA2)
12+
import GHC.Generics (Generic)
13+
import Linear.Term.Types (Term, TermVarsOnly)
14+
import Test.QuickCheck (Arbitrary (..))
15+
import Test.QuickCheck.Gen (suchThat)
16+
17+
newtype Expr = Expr {unExpr :: NE.NonEmpty Term}
18+
deriving
19+
( Show
20+
, Read
21+
, Eq
22+
, Generic
23+
)
24+
25+
newtype ExprVarsOnly = ExprVarsOnly {unExprVarsOnly :: NE.NonEmpty TermVarsOnly}
26+
deriving
27+
( Show
28+
, Read
29+
, Eq
30+
, Generic
31+
)
32+
33+
instance Arbitrary Expr where
34+
arbitrary = Expr . NE.fromList <$> arbitrary `suchThat` (not . null)

0 commit comments

Comments
 (0)