Skip to content

Commit b1ec5cc

Browse files
rasheedjarasheedja
committed
[wip] split modules up reasonably
1 parent 79a5a6f commit b1ec5cc

File tree

31 files changed

+2233
-1516
lines changed

31 files changed

+2233
-1516
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: 21 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -27,12 +27,25 @@ source-repository head
2727

2828
library
2929
exposed-modules:
30-
Linear.Simplex.DeriveBounds
30+
Linear.Simplex.Constraint.Generic.Types
31+
Linear.Simplex.Constraint.Simple.Types
32+
Linear.Simplex.Constraint.Simple.Util
33+
Linear.Simplex.Constraint.Types
34+
Linear.Simplex.Constraint.Util
35+
Linear.Simplex.Expr.Types
36+
Linear.Simplex.Expr.Util
3137
Linear.Simplex.Prettify
3238
Linear.Simplex.Solver.TwoPhase
39+
Linear.Simplex.StandardForm
3340
Linear.Simplex.Standardize
41+
Linear.Simplex.System.Simple.Types
42+
Linear.Simplex.System.Simple.Util
43+
Linear.Simplex.Term.Types
44+
Linear.Simplex.Term.Util
3445
Linear.Simplex.Types
3546
Linear.Simplex.Util
47+
Linear.Simplex.Var.Types
48+
Linear.Simplex.Var.Util
3649
other-modules:
3750
Paths_simplex_method
3851
hs-source-dirs:
@@ -51,11 +64,16 @@ library
5164
, time
5265
default-language: Haskell2010
5366

54-
test-suite simplex-haskell-test
67+
test-suite simplex-method-test
5568
type: exitcode-stdio-1.0
5669
main-is: Spec.hs
5770
other-modules:
58-
Linear.Simplex.TypesSpec
71+
Linear.Simplex.Constraint.Simple.TypesSpec
72+
Linear.Simplex.Expr.TypesSpec
73+
Linear.Simplex.StandardFormSpec
74+
Linear.Simplex.System.Simple.TypesSpec
75+
Linear.Simplex.Term.TypesSpec
76+
TestUtil
5977
Paths_simplex_method
6078
hs-source-dirs:
6179
test

‎src/Linear/Simplex/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.Simplex.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.Simplex.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/Simplex/Constraint/Simple/Types.hs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
-- |
2+
-- Module: Linear.Simplex.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.Simplex.Constraint.Simple.Types where
9+
10+
import Linear.Simplex.Constraint.Generic.Types
11+
import Linear.Simplex.Expr.Types
12+
import Linear.Simplex.Var.Types
13+
14+
-- data TermsOnlyVars = VarTerm' Var | CoeffTerm' SimplexNum Var
15+
-- deriving (Show, Read, Eq, Generic)
16+
-- data ExprVarsOnly = ExprVarsOnly [TermsOnlyVars]
17+
18+
-- Internal TODO: change to Terms :: [Term] or [Term]
19+
-- consider a term type with only variables
20+
-- then have another type SimpleConstraint = GenericConstraint TermsOnlyVars SimplexNum
21+
type SimpleConstraint = GenericConstraint Expr SimplexNum

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

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

‎src/Linear/Simplex/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.Simplex.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.Simplex.Constraint.Types where
9+
10+
import qualified Data.Set as Set
11+
import GHC.Generics (Generic)
12+
import Linear.Simplex.Constraint.Generic.Types
13+
import Linear.Simplex.Expr.Types
14+
import Linear.Simplex.Var.Types
15+
16+
-- Input
17+
type Constraint = GenericConstraint Expr Expr

‎src/Linear/Simplex/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.Simplex.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.Simplex.Constraint.Util where
9+
10+
import qualified Data.Set as Set
11+
import Linear.Simplex.Constraint.Generic.Types
12+
import Linear.Simplex.Constraint.Types
13+
import Linear.Simplex.Expr.Types
14+
import Linear.Simplex.Expr.Util
15+
import Linear.Simplex.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/Simplex/DeriveBounds.hs‎

Lines changed: 0 additions & 112 deletions
This file was deleted.

0 commit comments

Comments
 (0)