The random instance generator and other improvements.

[match/match.git] / program / ProposalMatch.hs

diff --git a/program/ProposalMatch.hs b/program/ProposalMatch.hs
deleted file mode 100644 (file)
index 028f22c..0000000
--- a/program/ProposalMatch.hs
+++ /dev/null
@@ -1,97 +0,0 @@
-module ProposalMatch where
-import UnitMinCostFlow
-import Data.Array.IArray
-import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.Tree
-import Data.List
-
-import ProposalMatchConfig
-
-data Instance = Instance
-       Int                -- numReviewers
-       Int                -- numProposals
-       (Int -> Wt)        -- reviewer -> relative load
-       (Int -> Int -> Wt) -- reviewer -> proposal -> pref
-
-prefBoringness p = if prefIsVeryBoring p then 2
-       else if prefIsBoring p then 1 else 0
-prefExpertness p = if prefIsExpert p then 2
-       else if prefIsKnowledgeable p then 1 else 0
-
-doReduction :: Instance -> Gr () Wt
-doReduction (Instance numRvrs numProps rloadF prefF) =
-       let
-               source = 0
-               sink = 1
-               rvrNode i boringness = 2 + 3*i + boringness
-               propNode j expertness = 2 + 3*numRvrs + 3*j + expertness
-               numNodes = 2 + 3*numRvrs + 3*numProps
-               in
-       let
-               totalReviews = reviewsEachProposal * numProps
-               totalRelativeLoad = foldl (+) 0 (map rloadF [0 .. numRvrs - 1])
-               targetLoad i = ceiling (numAsWt totalReviews * rloadF i / totalRelativeLoad)
-               -- A...H refer to idea book p.429
-               edgesABC = do
-                       i <- [0 .. numRvrs - 1]
-                       let tl = targetLoad i
-                       l <- [0 .. tl + loadTolerance - 1]
-                       let costA = if l < tl
-                               then 0
-                               else marginalLoadCost ((numAsWt (l - tl) + 1/2) / numAsWt loadTolerance)
-                       let edgeA = (source, rvrNode i 0, costA)
-                       let costB = marginalBoringCost ((numAsWt l + 1/2) / numAsWt tl)
-                       let edgeB = (rvrNode i 0, rvrNode i 1, costB)
-                       let costC = marginalVeryBoringCost ((numAsWt l + 1/2) / numAsWt tl)
-                       let edgeC = (rvrNode i 1, rvrNode i 2, costC)
-                       [edgeA, edgeB, edgeC]
-               edgesD = do
-                       i <- [0 .. numRvrs - 1]
-                       j <- [0 .. numProps - 1]
-                       let pref = prefF i j
-                       if prefIsConflict pref
-                               then []
-                               else [(rvrNode i (prefBoringness pref),
-                                       propNode j (prefExpertness pref),
-                                       assignmentCost pref)]
-               edgesE = do
-                       j <- [0 .. numProps - 1]
-                       [(propNode j 2, propNode j 0, -expertBonus)]
-               edgesFGH = do
-                       j <- [0 .. numProps - 1]
-                       l <- [0 .. reviewsEachProposal - 1]
-                       let edgeF = (propNode j 2, propNode j 1, 0)
-                       let edgeG = (propNode j 1, propNode j 0,
-                               if l == 0 then -knowledgeableBonus else 0)
-                       let edgeH = (propNode j 0, sink, 0)
-                       [edgeF, edgeG, edgeH]
-               theNodes = [(x, ()) | x <- [0 .. numNodes - 1]]
-               theEdges = edgesABC ++ edgesD ++ edgesE ++ edgesFGH
-               in
-       mkGraph theNodes theEdges
-
-todo = undefined
--- Returns a list of reviews as ordered pairs (reviewer#, proposal#).
-doMatching :: Instance -> [(Int, Int)]
-doMatching inst@(Instance numRvrs numProps rloadF prefF) =
-       -- Copied from doReduction.  There should be a better way to get these here.
-       let
-               source = 0
-               sink = 1
-               rvrNode i boringness = 2 + 3*i + boringness
-               propNode j expertness = 2 + 3*numRvrs + 3*j + expertness
-               firstPropNode = propNode 0 0
-               idPropNode n = (n - (2 + 3*numRvrs)) `div` 3
-               numNodes = 2 + 3*numRvrs + 3*numProps
-               in
-       let graph1 = doReduction inst in
-       let flow1 = flowDiff graph1 (snd (umcf source sink graph1)) in
-       let pairs = do
-               i <- [0 .. numRvrs - 1]
-               boringness <- [0, 1, 2]
-               n <- suc flow1 (rvrNode i boringness)
-               if n >= firstPropNode
-                       then [(i, idPropNode n)]
-                       else []
-               in
-       sort pairs -- for prettiness