New paper-side gadget for PC + ERC

diff --git a/program/PMDefaults.hs b/program/PMDefaults.hs
index 7bb277f..be000e8 100644 (file)
--- a/program/PMDefaults.hs
+++ b/program/PMDefaults.hs
@@ -21,7 +21,7 @@ minCostFlow = NaiveMinCostFlow.minCostFlow,
 --minCostFlow = CS2MinCostFlow.minCostFlow,
 
 -- The number of reviews each proposal should get.
-reviewsEachProposal = 3,
+reviewsEachProposal = 4,
 
 -- === Interpretation of the preference values ===
 
@@ -39,7 +39,7 @@ prefIsConflict = \p -> p <= -100,
 -- load of (relativeLoad * ceiling(numProps * reviewsEachProposal /
 -- totalRelativeLoad)).  For now this is an additive constant; perhaps it should
 -- be proportional to the target load.
-loadTolerance = 1,
+loadTolerance = 3,
 
 -- Cost to overload by one review.
 -- tx = 0 at target load, 1 at end of tolerance.

diff --git a/program/ProposalMatcher.hs b/program/ProposalMatcher.hs
index 1047c4a..4a4b67b 100644 (file)
--- a/program/ProposalMatcher.hs
+++ b/program/ProposalMatcher.hs
@@ -4,6 +4,7 @@ import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.Tree
 import Data.List
 
+import ArrayStuff
 import PMInstance
 import PMConfig
 
@@ -41,20 +42,28 @@ indexEdges i ((v1, v2, re):es) =
        let (imax, ies) = indexEdges (i+1) es in
        (imax, (v1, v2, re{ reIdx = i }) : ies)
 
+implies :: Bool -> Bool -> Bool
+x `implies` y = (not x) || y
+
 doReduction :: PMConfig -> PMInstance -> ReductionResult
 doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
        let
+               -- Need to figure out who is PC/ERC
+               isPC = (funcArray (0, numRvrs-1) (\i -> (rloadA ! i) == 1)) :: Array Int Bool
+               isPCPaper = (funcArray (0, numProps-1) (\j -> all (\i -> (isPC ! i) `implies` (prefIsConflict cfg $ (prefA ! (i, j)))) [0 .. numRvrs - 1])) :: Array Int Bool
                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
+               -- We will waste a lot of nodes.  Who cares, no one will visit them.
+               propNode j k = 2 + 3*numRvrs + 7*j + k
+               numNodes = 2 + 3*numRvrs + 7*numProps
                edIdx (i, j) = i*numProps + j
                in
        let
                totalReviews = (reviewsEachProposal cfg) * numProps
                totalRelativeLoad = foldl (+) 0 (map (rloadA !) [0 .. numRvrs - 1])
-               targetLoad i = ceiling (widenInteger totalReviews * (rloadA ! i) / totalRelativeLoad)
+               -- floor goes best with loadTolerance 2
+               targetLoad i = floor (widenInteger totalReviews * (rloadA ! i) / totalRelativeLoad) - 1
                -- A...H refer to idea book p.429
                edgesABC = do
                        i <- [0 .. numRvrs - 1]
@@ -63,7 +72,7 @@ doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
                        let nonfreeEdgesA = do
                                l <- [tl .. tl + (loadTolerance cfg) - 1]
                                let costA = marginalLoadCost cfg ((widenInteger (l - tl) + 1/2) / widenInteger (loadTolerance cfg))
-                               [(source, rvrNode i 0, REdge undefined 1 costA)]
+                               return (source, rvrNode i 0, REdge undefined 1 costA)
                        let edgesBC = do
                                l <- [0 .. tl + (loadTolerance cfg) - 1]
                                let costB = marginalBoringCost cfg ((widenInteger l + 1/2) / widenInteger tl)
@@ -80,19 +89,42 @@ doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
                        -- We must generate an edge even if there is a conflict
                        -- of interest; otherwise we'll fail to read its flow
                        -- value in doMatching.
+                       let xp_ = expExpertness cfg xp
+                       let k = if (isPC ! i)
+                               then xp_ + 3  -- Can assume it is a PC paper, otherwise it would conflict anyway.
+                               else xp_
                        [(rvrNode i (prefBoringness cfg pref),
-                               propNode j (expExpertness cfg xp),
+                               propNode j k,
                                REdge (edIdx (i, j))
                                        (if prefIsConflict cfg pref then 0 else 1)
                                        (assignmentCost cfg pref))]
                edgesEFGH = do
                        j <- [0 .. numProps - 1]
-                       let edgeE = (propNode j 2, propNode j 0, REdge undefined 1 (-(expertBonus cfg)))
-                       let edgeF = (propNode j 2, propNode j 1, REdge undefined (reviewsEachProposal cfg) 0)
-                       let edgeGFirst = (propNode j 1, propNode j 0, REdge undefined 1 (-(knowledgeableBonus cfg)))
-                       let edgeGRest = (propNode j 1, propNode j 0, REdge undefined (reviewsEachProposal cfg - 1) 0)
-                       let edgeH = (propNode j 0, sink, REdge undefined (reviewsEachProposal cfg) 0)
-                       [edgeE, edgeF, edgeGFirst, edgeGRest, edgeH]
+                       -- This is now different...
+                       if isPCPaper ! j
+                               then do -- Mostly traditional.
+                                       -- Expert bonus
+                                       let edgeFFirst = (propNode j 2, propNode j 1, REdge undefined 1 (-(expertBonus cfg)))
+                                       let edgeFRest = (propNode j 2, propNode j 1, REdge undefined (reviewsEachProposal cfg - 1) 0)
+                                       -- Second kowledgeable bonus
+                                       let edgeGFirst = (propNode j 1, propNode j 0, REdge undefined 1 (-(knowledgeableBonus cfg)))
+                                       let edgeGRest = (propNode j 1, propNode j 0, REdge undefined (reviewsEachProposal cfg - 2) 0)
+                                       -- Require one knowledgeable
+                                       let edgeH1 = (propNode j 1, sink, REdge undefined 1 0)
+                                       let edgeH = (propNode j 0, sink, REdge undefined (reviewsEachProposal cfg - 1) 0)
+                                       [edgeFFirst, edgeFRest, edgeGFirst, edgeGRest, edgeH1, edgeH]
+                               else do -- New gadget; man, a lot of edges
+                                       -- Structure to distribute knowledgeable PC members
+                                       let edgesP = [(propNode j k, propNode j 6, REdge undefined (reviewsEachProposal cfg - 1) 0) | k <- [4 .. 5]]
+                                       let edgesR = [(propNode j k, propNode j (k - 3), REdge undefined 1 0) | k <- [4 .. 5]]
+                                       -- "Designated knowledgeable" with expert bonus
+                                       let edgeF = (propNode j 2, propNode j 1, REdge undefined 1 (-(expertBonus cfg)))
+                                       let edgeH1 = (propNode j 1, sink, REdge undefined 1 0)
+                                       -- "Designated PC" with knowledgeable bonus
+                                       let edgeGFirst = (propNode j 6, propNode j 3, REdge undefined 1 (-(knowledgeableBonus cfg)))
+                                       let edgeGRest = (propNode j 6, propNode j 3, REdge undefined (reviewsEachProposal cfg - 2) 0)
+                                       let edgeH = (propNode j 3, sink, REdge undefined (reviewsEachProposal cfg - 1) 0)
+                                       edgesP ++ edgesR ++ [edgeF, edgeH1, edgeGFirst, edgeGRest, edgeH]
                theNodes = [(x, ()) | x <- [0 .. numNodes - 1]]
                -- Index the non-D edges
                unindexedEdges = edgesABC ++ edgesEFGH

diff --git a/program/Test.hs b/program/Test.hs
index 6dc2ecc..d97edb6 100644 (file)
--- a/program/Test.hs
+++ b/program/Test.hs
@@ -66,7 +66,7 @@ myPrefsArray = array ((0,0), (myNumRvrs-1,myNumProps-1)) [
 
 myPrefs = transposeArray $ listArray ((0,0), (myNumProps-1,myNumRvrs-1)) $
        map prefOldToNew [
-       15, 10, 15, 40, 20,
+       40, 40, 40, 30, 40,
        30,  7, 10, 15, 15,
        15, 25, 20, 20, 15
        ] :: UArray (Int, Int) Wt
@@ -78,7 +78,8 @@ myExps = transposeArray $ listArray ((0,0), (myNumProps-1,myNumRvrs-1)) [
         2,  1,  1,  2,  2
        ] :: UArray (Int, Int) Wt
 
-myInst = PMInstance myNumRvrs myNumProps (constArray (0, myNumRvrs-1) 1) myPrefs myExps
+--myInst = PMInstance myNumRvrs myNumProps (constArray (0, myNumRvrs-1) 1) myPrefs myExps
+myInst = PMInstance myNumRvrs myNumProps (listArray (0, myNumRvrs-1) [1, 1, 1, 0.9, 1]) myPrefs myExps
 
 rdnResult = doReduction pmDefaults myInst
 ReductionResult rrg rrso rrsi rreib rredi = rdnResult