Skip to content

Commit f5ac83e

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 f5ac83e

File tree

37 files changed

+2537
-1524
lines changed

37 files changed

+2537
-1524
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.UtilSpec
77+
Linear.Expr.UtilSpec
78+
Linear.SlackForm.UtilSpec
79+
Linear.System.Simple.UtilSpec
80+
Linear.Term.UtilSpec
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 (Expr)
11+
import Linear.Var.Types (SimplexNum)
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: 129 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
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+
( GenericConstraint ((:<=), (:==), (:>=))
16+
)
17+
import Linear.Constraint.Simple.Types (SimpleConstraint)
18+
import Linear.Constraint.Types (Constraint)
19+
import Linear.Expr.Types (Expr (Expr))
20+
import Linear.Expr.Util
21+
( exprToList
22+
, exprVars
23+
, listToExpr
24+
, simplifyExpr
25+
, substVarExpr
26+
, subtractExpr
27+
, sumExprConstTerms
28+
, zeroConstExpr
29+
)
30+
import Linear.Term.Types (Term (CoeffTerm, ConstTerm, VarTerm))
31+
import Linear.Var.Types (Var)
32+
33+
substVarSimpleConstraint :: Var -> Expr -> SimpleConstraint -> SimpleConstraint
34+
substVarSimpleConstraint var varReplacement (a :<= b) = substVarExpr var varReplacement a :<= b
35+
substVarSimpleConstraint var varReplacement (a :>= b) = substVarExpr var varReplacement a :>= b
36+
substVarSimpleConstraint var varReplacement (a :== b) = substVarExpr var varReplacement a :== b
37+
38+
constraintToSimpleConstraint :: Constraint -> SimpleConstraint
39+
constraintToSimpleConstraint constraint =
40+
case constraint of
41+
(a :<= b) -> uncurry (:<=) (calcLhsRhs a b)
42+
(a :>= b) -> uncurry (:>=) (calcLhsRhs a b)
43+
(a :== b) -> uncurry (:==) (calcLhsRhs a b)
44+
where
45+
calcLhsRhs a b = (lhs, rhs)
46+
where
47+
aConsts = sumExprConstTerms a
48+
bConsts = sumExprConstTerms b
49+
rhs = bConsts - aConsts
50+
51+
aWithoutConst = simplifyExpr . zeroConstExpr $ a
52+
bWithoutConst = simplifyExpr . zeroConstExpr $ b
53+
54+
lhs = subtractExpr aWithoutConst bWithoutConst
55+
calcRhs a b = rhs
56+
where
57+
aConsts = sumExprConstTerms a
58+
bConsts = sumExprConstTerms b
59+
rhs = bConsts - aConsts
60+
61+
aWithoutConst = simplifyExpr . zeroConstExpr $ a
62+
bWithoutConst = simplifyExpr . zeroConstExpr $ b
63+
64+
lhs = subtractExpr aWithoutConst bWithoutConst
65+
66+
-- normalize simple constraints by moving all constants to the right
67+
normalizeSimpleConstraint :: SimpleConstraint -> SimpleConstraint
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+
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+
108+
-- | Simplify coeff constraints by dividing the coefficient from both sides
109+
simplifyCoeff :: SimpleConstraint -> SimpleConstraint
110+
simplifyCoeff expr@(Expr (CoeffTerm coeff var :| []) :<= num)
111+
| coeff == 0 = expr
112+
| coeff > 0 = Expr (VarTerm var :| []) :<= (num / coeff)
113+
| coeff < 0 = Expr (VarTerm var :| []) :>= (num / coeff)
114+
simplifyCoeff expr@(Expr (CoeffTerm coeff var :| []) :>= num)
115+
| coeff == 0 = expr
116+
| coeff > 0 = Expr (VarTerm var :| []) :>= (num / coeff)
117+
| coeff < 0 = Expr (VarTerm var :| []) :<= (num / coeff)
118+
simplifyCoeff expr@(Expr (CoeffTerm coeff var :| []) :== num) = if coeff == 0 then expr else Expr (VarTerm var :| []) :== (num / coeff)
119+
simplifyCoeff expr = expr
120+
121+
simplifySimpleConstraint :: SimpleConstraint -> SimpleConstraint
122+
simplifySimpleConstraint (expr :<= num) = simplifyCoeff . normalizeSimpleConstraint $ simplifyExpr expr :<= num
123+
simplifySimpleConstraint (expr :>= num) = simplifyCoeff . normalizeSimpleConstraint $ simplifyExpr expr :>= num
124+
simplifySimpleConstraint (expr :== num) = simplifyCoeff . normalizeSimpleConstraint $ simplifyExpr expr :== num
125+
126+
simpleConstraintVars :: SimpleConstraint -> Set.Set Var
127+
simpleConstraintVars (expr :<= _) = exprVars expr
128+
simpleConstraintVars (expr :>= _) = exprVars expr
129+
simpleConstraintVars (expr :== _) = exprVars expr

‎src/Linear/Constraint/Types.hs‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
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 (GenericConstraint)
13+
import Linear.Expr.Types (Expr)
14+
15+
-- Input
16+
type Constraint = GenericConstraint Expr Expr

‎src/Linear/Constraint/Util.hs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
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+
( GenericConstraint ((:<=), (:==), (:>=))
13+
)
14+
import Linear.Constraint.Types (Constraint)
15+
import Linear.Expr.Util (exprVars)
16+
import Linear.Var.Types (Var)
17+
18+
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

‎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)