Fix bug in prioritization

This commit is contained in:
Rodrigo Setti 2017-08-16 00:57:53 -07:00
parent 41387d5308
commit e52e0a8eaf
No known key found for this signature in database
GPG Key ID: 3E2EB67B3A72ABD3
5 changed files with 74 additions and 12 deletions

View File

@ -20,7 +20,8 @@ import MasterPlan.Backend.Graph
import MasterPlan.Data
import qualified MasterPlan.Parser as P
import Options.Applicative
import System.IO (hPutStr, stderr, stdin)
import System.Exit (die)
import System.IO (stdin)
-- |Type output from the command line parser
data Opts = Opts { inputPath :: Maybe FilePath
@ -111,7 +112,7 @@ masterPlan ∷ Opts → IO ()
masterPlan opts =
do contents <- maybe (TIO.hGetContents stdin) TIO.readFile $ inputPath opts
case P.runParser (fromMaybe "stdin" $ inputPath opts) contents of
Left e -> hPutStr stderr e
Left e -> die e
Right sys@(ProjectSystem b) ->
do let sys' = prioritizeSys $ ProjectSystem $ M.mapMaybe
(filterBinding sys $ projFilter opts) b

57
examples/example2.plan Normal file
View File

@ -0,0 +1,57 @@
other "use other tools" = notText + proprietary + limited;
notText {
title "not textual format"
description "hard to parse or edit"
cost 10
};
proprietary {
description "data is locked! risky!"
trust 20%
cost 1
};
limited {
description "missing features..."
cost 5
trust 90%
};
decision { description "which PM tool to use?" } = mp + other + notUseAnything;
mp "use master plan" = (write -> render -> maintain)
* (satisfied + addYourFeature);
write {
title "write .plan file"
cost 1
};
render {
title "render diagram"
description "automatically prioritized. Like this one!"
cost 1
};
maintain {
description "refine, update, and re-render"
cost 2
};
satisfied {
description "master-plan meet my needs"
trust 70%
};
addYourFeature {
title "add your feature"
description "it's open source and Haskell (fun)"
cost 5
};
notUseAnything {
title "not use anything"
trust 10%
};

BIN
examples/example2.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 103 KiB

View File

@ -105,7 +105,7 @@ data RenderOptions = RenderOptions { colorByProgress :: Bool -- ^Whether to col
-- | The main rendering function
render FilePath -> RenderOptions-> ProjectSystem IO ()
render fp (RenderOptions colorByP w h rootK props) sys =
let noRootEroor = text $ "no project named \"" ++ getProjectKey rootK ++ "\" found."
let noRootEroor = texterific $ "no project named \"" ++ getProjectKey rootK ++ "\" found."
dia = fromMaybe noRootEroor $ renderTree colorByP props <$> evalState (toRenderModel sys rootK) []
in renderRasterific fp (dims2D (fromInteger w) (fromInteger h)) $ bgFrame 1 white $ centerXY dia

View File

@ -44,14 +44,14 @@ import Data.String (IsString)
-- * Types
newtype Trust = Trust { getTrust :: Float }
deriving (Show, Eq, Data, Ord, Num, Real, RealFrac, Fractional)
deriving (Show, Eq, Data, Typeable, Ord, Num, Real, RealFrac, Fractional)
newtype Cost = Cost { getCost :: Float }
deriving (Show, Eq, Data, Ord, Num, Real, RealFrac, Fractional)
deriving (Show, Eq, Data, Typeable, Ord, Num, Real, RealFrac, Fractional)
newtype Progress = Progress { getProgress :: Float }
deriving (Show, Eq, Data, Ord, Num, Real, RealFrac, Fractional)
deriving (Show, Eq, Data, Typeable, Ord, Num, Real, RealFrac, Fractional)
newtype ProjectKey = ProjectKey { getProjectKey :: String }
deriving (Show, Eq, Data, Ord, IsString)
deriving (Show, Eq, Data, Typeable, Ord, IsString)
-- |Structure of a project expression
data ProjectExpr = Sum (NE.NonEmpty ProjectExpr)
@ -198,12 +198,16 @@ prioritizeSys sys = everywhere (mkT $ prioritizeProj sys) sys
-- |Sort project in order that minimizes cost
prioritizeProj ProjectSystem ProjectExpr ProjectExpr
prioritizeProj sys (Sum ps) =
let f p = getCost (cost sys p) / getTrust (trust sys p)
in Sum $ NE.sortWith (nanToInf . f) $ prioritizeProj sys <$> ps
let f p = getCost (cost sys' p) / getTrust (trust sys' p)
sys' = prioritizeSys sys
in Sum $ NE.sortWith (nanToInf . f) $ prioritizeProj sys' <$> ps
prioritizeProj sys (Product ps) =
let f p = getCost (cost sys p) / (1 - getTrust (trust sys p))
in Product $ NE.sortWith (nanToInf . f) $ prioritizeProj sys <$> ps
prioritizeProj _ p = p
let f p = getCost (cost sys' p) / (1 - getTrust (trust sys' p))
sys' = prioritizeSys sys
in Product $ NE.sortWith (nanToInf . f) $ prioritizeProj sys' <$> ps
prioritizeProj sys (Sequence ps) =
Sequence $ prioritizeProj sys <$> ps
prioritizeProj _ p = p
-- |Helper function to transform any Nan (not a number) to positive infinity
nanToInf :: RealFloat a => a -> a