import Data.Graph.Inductive.Tree
import Data.List
-import Instance
-import IMinCostFlow
-
-data PMConfig = PMConfig {
- minCostFlow :: MinCostFlowImpl,
- reviewsEachProposal :: Int,
- prefIsExpert :: Wt -> Bool,
- prefIsKnowledgeable :: Wt -> Bool,
- prefIsBoring :: Wt -> Bool,
- prefIsVeryBoring :: Wt -> Bool,
- prefIsConflict :: Wt -> Bool,
- loadTolerance :: Int,
- marginalLoadCost :: Wt -> Wt,
- marginalBoringCost :: Wt -> Wt,
- marginalVeryBoringCost :: Wt -> Wt,
- assignmentCost :: Wt -> Wt,
- knowledgeableBonus :: Wt,
- expertBonus :: Wt
-}
+import PMInstance
+import PMConfig
prefBoringness cfg p = if prefIsVeryBoring cfg p then 2
else if prefIsBoring cfg p then 1 else 0
let (imax, ies) = indexEdges (i+1) es in
(imax, (v1, v2, re{ reIdx = i }) : ies)
-doReduction :: PMConfig -> Instance -> ReductionResult
-doReduction cfg (Instance numRvrs numProps rloadA prefA) =
+doReduction :: PMConfig -> PMInstance -> ReductionResult
+doReduction cfg (PMInstance numRvrs numProps rloadA prefA) =
let
source = 0
sink = 1
let
totalReviews = (reviewsEachProposal cfg) * numProps
totalRelativeLoad = foldl (+) 0 (map (rloadA !) [0 .. numRvrs - 1])
- targetLoad i = ceiling (numAsWt totalReviews * (rloadA ! i) / totalRelativeLoad)
+ targetLoad i = ceiling (widenInteger totalReviews * (rloadA ! i) / totalRelativeLoad)
-- A...H refer to idea book p.429
edgesABC = do
i <- [0 .. numRvrs - 1]
let freeEdgeA = (source, rvrNode i 0, REdge undefined tl 0)
let nonfreeEdgesA = do
l <- [tl .. tl + (loadTolerance cfg) - 1]
- let costA = marginalLoadCost cfg ((numAsWt (l - tl) + 1/2) / numAsWt (loadTolerance cfg))
+ let costA = marginalLoadCost cfg ((widenInteger (l - tl) + 1/2) / widenInteger (loadTolerance cfg))
[(source, rvrNode i 0, REdge undefined 1 costA)]
let edgesBC = do
l <- [0 .. tl + (loadTolerance cfg) - 1]
- let costB = marginalBoringCost cfg ((numAsWt l + 1/2) / numAsWt tl)
+ let costB = marginalBoringCost cfg ((widenInteger l + 1/2) / widenInteger tl)
let edgeB = (rvrNode i 0, rvrNode i 1, REdge undefined 1 costB)
- let costC = marginalVeryBoringCost cfg ((numAsWt l + 1/2) / numAsWt tl)
+ let costC = marginalVeryBoringCost cfg ((widenInteger l + 1/2) / widenInteger tl)
let edgeC = (rvrNode i 1, rvrNode i 2, REdge undefined 1 costC)
[edgeB, edgeC]
[freeEdgeA] ++ nonfreeEdgesA ++ edgesBC
ReductionResult (mkGraph theNodes theEdges) source sink (0, imax-1) edIdx
-- Returns a list of reviews as ordered pairs (reviewer#, proposal#).
-doMatching :: PMConfig -> Instance -> [(Int, Int)]
-doMatching cfg inst@(Instance numRvrs numProps _ _) =
+doMatching :: PMConfig -> PMInstance -> PMatching
+doMatching cfg inst@(PMInstance numRvrs numProps _ _) =
let ReductionResult graph source sink idxBounds edIdx = doReduction cfg inst in
let flowArray = minCostFlow cfg idxBounds reIdx reCap reCost graph (source, sink) in
let pairs = do
then [(i, j)]
else []
in
- sort pairs -- for prettiness
+ PMatching (sort pairs) -- for prettiness