Skip to content

Commit

Permalink
Run formatter
Browse files Browse the repository at this point in the history
  • Loading branch information
@rasheedja
rasheedja committed Aug 11, 2023
1 parent 9a322d6 commit 160c253
Show file tree
Hide file tree
Showing 6 changed files with 76 additions and 67 deletions.
1 change: 0 additions & 1 deletion package.yaml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,6 @@ default-extensions:
RecordWildCards
TupleSections
TypeApplications
ImportQualifiedPost
OverloadedRecordDot
DuplicateRecordFields
NamedFieldPuns
Expand Down
4 changes: 2 additions & 2 deletions simplex-method.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ library
hs-source-dirs:
src
default-extensions:
DataKinds DeriveFunctor DeriveGeneric DuplicateRecordFields FlexibleContexts LambdaCase OverloadedLabels RecordWildCards TupleSections TypeApplications ImportQualifiedPost OverloadedRecordDot DuplicateRecordFields NamedFieldPuns DisambiguateRecordFields
DataKinds DeriveFunctor DeriveGeneric DuplicateRecordFields FlexibleContexts LambdaCase OverloadedLabels RecordWildCards TupleSections TypeApplications OverloadedRecordDot DuplicateRecordFields NamedFieldPuns DisambiguateRecordFields
build-depends:
base >=4.14 && <5
, containers >=0.6.5.1 && <0.7
Expand All @@ -53,7 +53,7 @@ test-suite simplex-haskell-test
hs-source-dirs:
test
default-extensions:
DataKinds DeriveFunctor DeriveGeneric DuplicateRecordFields FlexibleContexts LambdaCase OverloadedLabels RecordWildCards TupleSections TypeApplications ImportQualifiedPost OverloadedRecordDot DuplicateRecordFields NamedFieldPuns DisambiguateRecordFields
DataKinds DeriveFunctor DeriveGeneric DuplicateRecordFields FlexibleContexts LambdaCase OverloadedLabels RecordWildCards TupleSections TypeApplications OverloadedRecordDot DuplicateRecordFields NamedFieldPuns DisambiguateRecordFields
build-depends:
base >=4.14 && <5
, containers >=0.6.5.1 && <0.7
Expand Down
127 changes: 68 additions & 59 deletions src/Linear/Simplex/Simplex.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,16 +17,16 @@ module Linear.Simplex.Simplex (findFeasibleSolution, optimizeFeasibleSystem, two
import Control.Lens
import Data.Bifunctor
import Data.List
import Data.Map qualified as M
import qualified Data.Map as M
import Data.Maybe (fromJust, fromMaybe, mapMaybe)
import Data.Ratio (denominator, numerator, (%))
import GHC.Real (Ratio)
import Linear.Simplex.Types
import Linear.Simplex.Util
import Prelude hiding (EQ)

import Debug.Trace qualified as T
import qualified Data.Bifunctor as Bifunctor
import qualified Debug.Trace as T

trace s a = a

Expand Down Expand Up @@ -214,11 +214,11 @@ findFeasibleSolution unsimplifiedSystem =
optimizeFeasibleSystem :: ObjectiveFunction -> FeasibleSystem -> Maybe Result
optimizeFeasibleSystem unsimplifiedObjFunction fsys@(FeasibleSystem {dict = phase1Dict, ..}) =
T.trace ("feasible system: " <> show fsys) $
if null artificialVars
then -- then displayResults . dictionaryFormToTableau <$> simplexPivot (createObjectiveDict objFunction objectiveVar : phase1Dict)
-- else displayResults . dictionaryFormToTableau <$> simplexPivot (createObjectiveDict phase2ObjFunction objectiveVar : tail phase1Dict)
T.trace "null" $ displayResults . dictionaryFormToTableau <$> simplexPivot phase1PivotObjective phase1Dict
else T.trace "notnull" $ displayResults . dictionaryFormToTableau <$> simplexPivot phase2PivotObjective phase1Dict
if null artificialVars
then -- then displayResults . dictionaryFormToTableau <$> simplexPivot (createObjectiveDict objFunction objectiveVar : phase1Dict)
-- else displayResults . dictionaryFormToTableau <$> simplexPivot (createObjectiveDict phase2ObjFunction objectiveVar : tail phase1Dict)
T.trace "null" $ displayResults . dictionaryFormToTableau <$> simplexPivot phase1PivotObjective phase1Dict
else T.trace "notnull" $ displayResults . dictionaryFormToTableau <$> simplexPivot phase2PivotObjective phase1Dict
where
objFunction = simplifyObjectiveFunction unsimplifiedObjFunction

Expand Down Expand Up @@ -287,34 +287,39 @@ optimizeFeasibleSystem unsimplifiedObjFunction fsys@(FeasibleSystem {dict = phas

calcConstants :: SimplexNum
calcConstants =
sum $ map
( \(var, coeff) ->
let multiplyWith = if isMax objFunction then coeff else -coeff
in case M.lookup var phase1Dict of
Nothing -> 0
Just row -> (row ^. #constant) * multiplyWith
)
sum
$ map
( \(var, coeff) ->
let multiplyWith = if isMax objFunction then coeff else -coeff
in case M.lookup var phase1Dict of
Nothing -> 0
Just row -> (row ^. #constant) * multiplyWith
)
$ M.toList (objFunction ^. #objective)

calcVarMap :: VarLitMapSum
calcVarMap =
-- M.fromList
foldVarLitMap $
map (M.fromList . ( \(var, coeff) ->
let multiplyWith = if isMax objFunction then coeff else -coeff
in case M.lookup var phase1Dict of
Nothing ->
-- DictValue
-- { varMapSum = M.singleton var coeff
-- , constant = 0
-- }
[(var, multiplyWith)]
Just row -> map (second (* multiplyWith)) (M.toList $ row ^. #varMapSum)
-- row
-- & #varMapSum %~ M.map (* coeff)
-- & #constant %~ (* coeff) -- TODO: Apply 0
-- map (second (* coeff)) row
)) (M.toList (objFunction ^. #objective))
foldVarLitMap $
map
( M.fromList
. ( \(var, coeff) ->
let multiplyWith = if isMax objFunction then coeff else -coeff
in case M.lookup var phase1Dict of
Nothing ->
-- DictValue
-- { varMapSum = M.singleton var coeff
-- , constant = 0
-- }
[(var, multiplyWith)]
Just row -> map (second (* multiplyWith)) (M.toList $ row ^. #varMapSum)
-- row
-- & #varMapSum %~ M.map (* coeff)
-- & #constant %~ (* coeff) -- TODO: Apply 0
-- map (second (* coeff)) row
)
)
(M.toList (objFunction ^. #objective))

-- phase2ObjFunction =
-- undefined
Expand All @@ -334,16 +339,20 @@ twoPhaseSimplex objFunction unsimplifiedSystem =
-- | Perform the simplex pivot algorithm on a system with basic vars, assume that the first row is the 'ObjectiveFunction'.
simplexPivot :: PivotObjective -> Dict -> Maybe Dict
simplexPivot objective@(PivotObjective {variable = objectiveVar, function = objectiveFunc, constant = objectiveConstant}) dictionary =
T.trace ("obj: " <> show objective <> "\n" <> show dictionary)
T.trace (show dictionary) $
case mostPositive objectiveFunc of
T.trace
("obj: " <> show objective <> "\n" <> show dictionary)
T.trace
(show dictionary)
$ case mostPositive objectiveFunc of
Nothing ->
T.trace
"all neg \n"
T.trace ("obj: " <> show objective <> "\n" <> show dictionary)
T.trace
("obj: " <> show objective <> "\n" <> show dictionary)
T.trace
(show dictionary)
Just (insertPivotObjectiveToDict objective dictionary)
Just
(insertPivotObjectiveToDict objective dictionary)
Just pivotNonBasicVar ->
let mPivotBasicVar = ratioTest dictionary pivotNonBasicVar Nothing Nothing
in T.trace ("most pos: " <> show pivotNonBasicVar) $ case mPivotBasicVar of
Expand All @@ -352,14 +361,13 @@ simplexPivot objective@(PivotObjective {variable = objectiveVar, function = obje
let pivotResult = pivot pivotBasicVar pivotNonBasicVar (insertPivotObjectiveToDict objective dictionary)
pivotedObj =
let pivotedObjEntry = fromMaybe (error "Can't find obj after pivoting") $ M.lookup objectiveVar pivotResult
in objective & #function .~ (pivotedObjEntry ^. #varMapSum) & #constant .~ (pivotedObjEntry ^. #constant)
in objective & #function .~ (pivotedObjEntry ^. #varMapSum) & #constant .~ (pivotedObjEntry ^. #constant)
pivotedDict = M.delete objectiveVar pivotResult
in
T.trace "one pos \n" $
T.trace ("obj: " <> show objective <> "\n" <> show dictionary) $
simplexPivot
pivotedObj
pivotedDict
in T.trace "one pos \n" $
T.trace ("obj: " <> show objective <> "\n" <> show dictionary) $
simplexPivot
pivotedObj
pivotedDict
where
ratioTest :: Dict -> Var -> Maybe Var -> Maybe Rational -> Maybe Var
ratioTest dict = aux (M.toList dict)
Expand Down Expand Up @@ -426,7 +434,7 @@ simplexPivot objective@(PivotObjective {variable = objectiveVar, function = obje
(-1)
(filterOutEnteringVarTerm basicEquation)
& traverse
%~ divideByNegatedEnteringVariableCoeff
%~ divideByNegatedEnteringVariableCoeff
)
& #constant
%~ divideByNegatedEnteringVariableCoeff
Expand All @@ -439,42 +447,43 @@ simplexPivot objective@(PivotObjective {variable = objectiveVar, function = obje
updatedRows =
-- M.mapWithKey f dict
M.fromList $ map (uncurry f2) $ M.toList dict
-- Bifunctor.bimap f2 dict
where
-- Bifunctor.bimap f2 dict

-- Dict
-- { objective = f $ dict ^. #objectiveFunction
-- , entries = fmap f $ dict ^. #entries
-- }

f entryVar entryVal =
if leavingVariable == entryVar
then pivotEnteringRow --TODO: UPDATE KEY
then pivotEnteringRow -- TODO: UPDATE KEY
else case M.lookup enteringVariable (entryVal ^. #varMapSum) of
Just subsCoeff ->
entryVal
& #varMapSum
.~ combineVarLitMapSums
(pivotEnteringRow ^. #varMapSum <&> (subsCoeff *))
(filterOutEnteringVarTerm (entryVal ^. #varMapSum))
(pivotEnteringRow ^. #varMapSum <&> (subsCoeff *))
(filterOutEnteringVarTerm (entryVal ^. #varMapSum))
& #constant
.~
((subsCoeff * (pivotEnteringRow ^. #constant)) + entryVal ^. #constant)
.~ ((subsCoeff * (pivotEnteringRow ^. #constant)) + entryVal ^. #constant)
Nothing -> entryVal

f2 :: Var -> DictValue -> (Var, DictValue)
f2 entryVar entryVal =
if leavingVariable == entryVar
then (enteringVariable, pivotEnteringRow) --TODO: UPDATE KEY
if leavingVariable == entryVar
then (enteringVariable, pivotEnteringRow) -- TODO: UPDATE KEY
else case M.lookup enteringVariable (entryVal ^. #varMapSum) of
Just subsCoeff ->
(entryVar, entryVal
& #varMapSum
.~ combineVarLitMapSums
(pivotEnteringRow ^. #varMapSum <&> (subsCoeff *))
(filterOutEnteringVarTerm (entryVal ^. #varMapSum))
& #constant
.~
((subsCoeff * (pivotEnteringRow ^. #constant)) + entryVal ^. #constant))
( entryVar
, entryVal
& #varMapSum
.~ combineVarLitMapSums
(pivotEnteringRow ^. #varMapSum <&> (subsCoeff *))
(filterOutEnteringVarTerm (entryVal ^. #varMapSum))
& #constant
.~ ((subsCoeff * (pivotEnteringRow ^. #constant)) + entryVal ^. #constant)
)
Nothing -> (entryVar, entryVal)
Nothing -> error "pivot: non basic variable not found in basic row"
where
Expand Down
5 changes: 3 additions & 2 deletions src/Linear/Simplex/Types.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module Linear.Simplex.Types where
import Control.Lens
import Data.Generics.Labels ()
import Data.List (sort)
import Data.Map qualified as M
import qualified Data.Map as M
import GHC.Generics (Generic)

type Var = Int
Expand Down Expand Up @@ -50,7 +50,8 @@ data FeasibleSystem = FeasibleSystem
, slackVars :: [Var]
, artificialVars :: [Var]
, objectiveVar :: Var
} deriving (Show, Read, Eq, Generic)
}
deriving (Show, Read, Eq, Generic)

data Result = Result
{ objectiveVar :: Var
Expand Down
4 changes: 2 additions & 2 deletions src/Linear/Simplex/Util.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,8 @@ import Data.Bifunctor
import Data.Generics.Labels ()
import Data.Generics.Product (field)
import Data.List
import Data.Map qualified as Map
import Data.Map.Merge.Lazy qualified as MapMerge
import qualified Data.Map as Map
import qualified Data.Map.Merge.Lazy as MapMerge
import Data.Maybe (fromMaybe)
import Linear.Simplex.Types
import Prelude hiding (EQ)
Expand Down
2 changes: 1 addition & 1 deletion test/TestFunctions.hs
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
module TestFunctions where

import Data.Map qualified as M
import qualified Data.Map as M
import Data.Ratio
import Linear.Simplex.Types
import Prelude hiding (EQ)
Expand Down

0 comments on commit 160c253

Please sign in to comment.