New features from Tuesday call:

- Ability to fix matched pairs
- Number of required reviews is per-paper (think of as fixing a paper to
  an outsider)
- Different load tolerance for ERC

diff --git a/program/Evaluation.hs b/program/Evaluation.hs
index 201f176..1b4be42 100644 (file)
--- a/program/Evaluation.hs
+++ b/program/Evaluation.hs
@@ -12,7 +12,7 @@ type MatchingEvaluation = Array Int Wt
 -- FIXME this is not really ported to separate preference and expertise
 
 evaluateMatching :: PMConfig -> PMInstance -> PMatching -> MatchingEvaluation
-evaluateMatching cfg inst@(PMInstance numRvrs numProps rloadA prefA _) (PMatching matching) =
+evaluateMatching cfg inst@(PMInstance numRvrs numProps rloadA prefA _ _ _) (PMatching matching) =
        let reviewersByProposal = accumArray (flip (:)) []
                (0, numProps-1) $ map (\(i,j) -> (j,i)) matching
                :: Array Int [Int] in

diff --git a/program/Main.hs b/program/Main.hs
index e3dbfff..0bbfdda 100644 (file)
--- a/program/Main.hs
+++ b/program/Main.hs
@@ -3,6 +3,7 @@ import PMDefaults
 import ProposalMatcher
 import System.IO
 import Data.Array.IArray
+import Data.Array.Unboxed
 import ArrayStuff
 import Text.CSV
 
@@ -18,15 +19,22 @@ main = do
        incsv <- hGetContents stdin
        -- handle errors another day, or let the platform do it
        let Right inll = parseTSV "standard input" incsv
-       let loadList = head inll
+       let loadList = tail (head inll)
        let numRvrs = length loadList
        let loadA = listArray (0, numRvrs-1) (map read loadList)
        let numProps = length (tail inll) `div` 2
        -- explicit type on the next line appears to be necessary
        let pxarr = listOfListsToArray2D (tail inll) :: Array (Int,Int) String
        -- careful, we end up transposing the array in here
-       let prefA = funcArray ((0,0), (numRvrs-1,numProps-1)) (\(i,j) -> read $ pxarr ! (2*j, i))
-       let expA = funcArray ((0,0), (numRvrs-1,numProps-1)) (\(i,j) -> read $ pxarr ! (2*j+1, i))
-       let theInst = PMInstance numRvrs numProps loadA prefA expA
+       let prefFixA = funcArray ((0,0), (numRvrs-1,numProps-1)) (\(i,j) ->
+               let
+                       cell = pxarr ! (2*j, i+1)
+                       (fix, pstr) = if last cell == '*' then (True, init cell) else (False, cell)
+                       pref = read pstr
+               in (pref, fix)) :: Array (Int,Int) (Wt,Bool)
+       let prefA = amap2 fst prefFixA; fixA = amap2 snd prefFixA
+       let expA = funcArray ((0,0), (numRvrs-1,numProps-1)) (\(i,j) -> read $ pxarr ! (2*j+1, i+1))
+       let pnrA = funcArray (0, numProps-1) (\j -> read $ pxarr ! (2*j, 0))
+       let theInst = PMInstance numRvrs numProps loadA prefA expA fixA pnrA
        let PMatching theMatching = doMatching pmDefaults theInst
        hPutStr stdout $ printTSV $ map (\(i, j) -> map show [i, j]) theMatching

diff --git a/program/PMConfig.hs b/program/PMConfig.hs
index 7e50fac..fe181fa 100644 (file)
--- a/program/PMConfig.hs
+++ b/program/PMConfig.hs
@@ -12,12 +12,14 @@ import IMinCostFlow
 data PMConfig = PMConfig {
        minCostFlow :: MinCostFlowImpl,
        reviewsEachProposal :: Int,
+       pcReviewsEachProposal :: Int,
        expIsExpert :: Wt -> Bool,
        expIsKnowledgeable :: Wt -> Bool,
        prefIsBoring :: Wt -> Bool,
        prefIsVeryBoring :: Wt -> Bool,
        prefIsConflict :: Wt -> Bool,
        loadTolerance :: Int,
+       ercLoadTolerance :: Int,
        marginalLoadCost :: Wt -> Wt,
        marginalBoringCost :: Wt -> Wt,
        marginalVeryBoringCost :: Wt -> Wt,

diff --git a/program/PMDefaults.hs b/program/PMDefaults.hs
index be000e8..b3e290b 100644 (file)
--- a/program/PMDefaults.hs
+++ b/program/PMDefaults.hs
@@ -23,6 +23,9 @@ minCostFlow = NaiveMinCostFlow.minCostFlow,
 -- The number of reviews each proposal should get.
 reviewsEachProposal = 4,
 
+-- Applies to non-PC papers
+pcReviewsEachProposal = 3,
+
 -- === Interpretation of the preference values ===
 
 expIsExpert = \x -> x >= 3,
@@ -39,7 +42,9 @@ 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 = 3,
+loadTolerance = 2,
+
+ercLoadTolerance = 3,
 
 -- Cost to overload by one review.
 -- tx = 0 at target load, 1 at end of tolerance.

diff --git a/program/PMInstance.hs b/program/PMInstance.hs
index aba03b2..1cc8caa 100644 (file)
--- a/program/PMInstance.hs
+++ b/program/PMInstance.hs
@@ -15,7 +15,11 @@ data PMInstance = PMInstance {
        pmiNumProposals :: Int,
        pmiRLoad :: UArray Int Wt,
        pmiRPPref :: UArray (Int, Int) Wt, -- preference: -100 (COI), -99 to 100
-       pmiRPExp :: UArray (Int, Int) Wt -- expertise: 0 to 3
+       pmiRPExp :: UArray (Int, Int) Wt, -- expertise: 0 to 3
+       -- New 2011-07-19
+       -- Should we "jam" all three values that are functions of (i, j)/
+       pmiRPFix :: UArray (Int, Int) Bool,
+       pmiPNumReviews :: UArray Int Int
 }
 
 -- Let us shoehorn in the new pref scale.

diff --git a/program/PMInstanceGenerator.hs b/program/PMInstanceGenerator.hs
index 47a5ce4..9cafacd 100644 (file)
--- a/program/PMInstanceGenerator.hs
+++ b/program/PMInstanceGenerator.hs
@@ -80,4 +80,7 @@ randomInstance cfg numRvrs numProps = do
                                PTopic2 jt1 jt2 -> 1 + ((iTE ! jt1)
                                        + (iTE ! jt2)) / 2
                in topicExp)
-       return $ PMInstance numRvrs numProps loadA prefA expA
+       -- defaults
+       let fixA = constArray ((0,0), (numRvrs-1,numProps-1)) False
+       let pnrA = constArray (0, numProps-1) (reviewsEachProposal cfg)
+       return $ PMInstance numRvrs numProps loadA prefA expA fixA pnrA

diff --git a/program/ProposalMatcher.hs b/program/ProposalMatcher.hs
index 4a4b67b..c82855e 100644 (file)
--- a/program/ProposalMatcher.hs
+++ b/program/ProposalMatcher.hs
@@ -3,8 +3,10 @@ import Data.Array.IArray
 import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.Tree
 import Data.List
+import Data.Either
 
 import ArrayStuff
+import MonadStuff
 import PMInstance
 import PMConfig
 
@@ -46,7 +48,7 @@ implies :: Bool -> Bool -> Bool
 x `implies` y = (not x) || y
 
 doReduction :: PMConfig -> PMInstance -> ReductionResult
-doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
+doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA fixA pnrA) =
        let
                -- Need to figure out who is PC/ERC
                isPC = (funcArray (0, numRvrs-1) (\i -> (rloadA ! i) == 1)) :: Array Int Bool
@@ -60,7 +62,7 @@ doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
                edIdx (i, j) = i*numProps + j
                in
        let
-               totalReviews = (reviewsEachProposal cfg) * numProps
+               totalReviews = sum $ elems pnrA    -- (reviewsEachProposal cfg) * numProps
                totalRelativeLoad = foldl (+) 0 (map (rloadA !) [0 .. numRvrs - 1])
                -- floor goes best with loadTolerance 2
                targetLoad i = floor (widenInteger totalReviews * (rloadA ! i) / totalRelativeLoad) - 1
@@ -68,20 +70,21 @@ doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
                edgesABC = do
                        i <- [0 .. numRvrs - 1]
                        let tl = targetLoad i
+                       let lt = if isPC ! i then loadTolerance cfg else ercLoadTolerance cfg
                        let freeEdgeA = (source, rvrNode i 0, REdge undefined tl 0)
                        let nonfreeEdgesA = do
-                               l <- [tl .. tl + (loadTolerance cfg) - 1]
-                               let costA = marginalLoadCost cfg ((widenInteger (l - tl) + 1/2) / widenInteger (loadTolerance cfg))
+                               l <- [tl .. tl + lt - 1]
+                               let costA = marginalLoadCost cfg ((widenInteger (l - tl) + 1/2) / widenInteger lt)
                                return (source, rvrNode i 0, REdge undefined 1 costA)
                        let edgesBC = do
-                               l <- [0 .. tl + (loadTolerance cfg) - 1]
+                               l <- [0 .. tl + lt - 1]
                                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 ((widenInteger l + 1/2) / widenInteger tl)
                                let edgeC = (rvrNode i 1, rvrNode i 2, REdge undefined 1 costC)
                                [edgeB, edgeC]
                        [freeEdgeA] ++ nonfreeEdgesA ++ edgesBC
-               edgesD = do
+               edgesDFix = do
                        i <- [0 .. numRvrs - 1]
                        j <- [0 .. numProps - 1]
                        let pref = prefA ! (i, j)
@@ -90,44 +93,53 @@ doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
                        -- of interest; otherwise we'll fail to read its flow
                        -- value in doMatching.
                        let xp_ = expExpertness cfg xp
-                       let k = if (isPC ! i)
+                       let pn = propNode j $ 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 k,
-                               REdge (edIdx (i, j))
+                       let rn = rvrNode i (prefBoringness cfg pref)
+                       if fixA ! (i, j)
+                               -- Max flow will emulate one unit of flow through the edge,
+                               -- at a cost of increasing the total flow value by 1.
+                               then [Right (rn, sink, REdge undefined 1 0),
+                                       Right (source, pn, REdge undefined 1 0)]
+                               else [Left (rn, pn, REdge (edIdx (i, j))
                                        (if prefIsConflict cfg pref then 0 else 1)
                                        (assignmentCost cfg pref))]
+               edgesD = lefts edgesDFix
+               edgesFix = rights edgesDFix
                edgesEFGH = do
                        j <- [0 .. numProps - 1]
                        -- This is now different...
+                       let numReviews = pnrA ! j
                        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)
+                                       let edgeFRest = (propNode j 2, propNode j 1, REdge undefined (numReviews - 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)
+                                       let edgeGRest = (propNode j 1, propNode j 0, REdge undefined (numReviews - 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)
+                                       let edgeH = (propNode j 0, sink, REdge undefined (numReviews - 1) 0)
                                        [edgeFFirst, edgeFRest, edgeGFirst, edgeGRest, edgeH1, edgeH]
                                else do -- New gadget; man, a lot of edges
+                                       let numPCReviews = pcReviewsEachProposal cfg
+                                       if numReviews < numPCReviews then fail "numReviews for paper < numPCReviews" else nop
                                        -- 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]]
+                                       let edgesP = [(propNode j k, propNode j 6, REdge undefined numPCReviews 0) | k <- [4 .. 5]]
+                                       let edgesR = [(propNode j k, propNode j (k - 3), REdge undefined (numReviews - numPCReviews) 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)
+                                       let edgeF = (propNode j 2, propNode j 1, REdge undefined (numReviews - numPCReviews) (-(expertBonus cfg)))
+                                       let edgeH1 = (propNode j 1, sink, REdge undefined (numReviews - numPCReviews) 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)
+                                       let edgeGRest = (propNode j 6, propNode j 3, REdge undefined (numPCReviews - 2) 0)
+                                       let edgeH = (propNode j 3, sink, REdge undefined (numPCReviews - 1) 0)
                                        edgesP ++ edgesR ++ [edgeF, edgeH1, edgeGFirst, edgeGRest, edgeH]
                theNodes = [(x, ()) | x <- [0 .. numNodes - 1]]
                -- Index the non-D edges
-               unindexedEdges = edgesABC ++ edgesEFGH
+               unindexedEdges = edgesABC ++ edgesFix ++ edgesEFGH
                (imax, reindexedEdges) = indexEdges (numRvrs*numProps) unindexedEdges
                theEdges = edgesD ++ reindexedEdges
                in
@@ -135,13 +147,13 @@ doReduction cfg (PMInstance numRvrs numProps rloadA prefA expA) =
 
 -- Returns a list of reviews as ordered pairs (reviewer#, proposal#).
 doMatching :: PMConfig -> PMInstance -> PMatching
-doMatching cfg inst@(PMInstance numRvrs numProps _ _ _) =
+doMatching cfg inst@(PMInstance numRvrs numProps _ _ _ fixA _) =
        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
                i <- [0 .. numRvrs - 1]
                j <- [0 .. numProps - 1]
-               if flowArray ! edIdx (i, j) == 1
+               if fixA ! (i, j) || flowArray ! edIdx (i, j) == 1
                        then [(i, j)]
                        else []
                in

diff --git a/program/Test.hs b/program/Test.hs
index d97edb6..2bb5f54 100644 (file)
--- a/program/Test.hs
+++ b/program/Test.hs
@@ -79,7 +79,9 @@ myExps = transposeArray $ listArray ((0,0), (myNumProps-1,myNumRvrs-1)) [
        ] :: UArray (Int, Int) Wt
 
 --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
+myFix = constArray ((0,0), (myNumRvrs-1,myNumProps-1)) False
+myPNR = constArray (0, myNumProps-1) (reviewsEachProposal pmDefaults)
+myInst = PMInstance myNumRvrs myNumProps (listArray (0, myNumRvrs-1) [1, 1, 1, 0.9, 1]) myPrefs myExps myFix myPNR
 
 rdnResult = doReduction pmDefaults myInst
 ReductionResult rrg rrso rrsi rreib rredi = rdnResult

diff --git a/program/TestUtils.hs b/program/TestUtils.hs
index 8bc1e32..60b6f62 100644 (file)
--- a/program/TestUtils.hs
+++ b/program/TestUtils.hs
@@ -34,21 +34,22 @@ flowAnnotate g fa =
                (n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF
 
 showInstanceAsGraph :: PMInstance -> PMatching -> Gr String String
-showInstanceAsGraph (PMInstance numRvrs numProps rloadA prefA expA) (PMatching matchedPairs) =
+showInstanceAsGraph (PMInstance numRvrs numProps rloadA prefA expA fixA pnrA) (PMatching matchedPairs) =
        let
                rvrNode i = i
                propNode j = numRvrs + j
                numNodes = numRvrs + numProps
                theNodes = map (\i -> (rvrNode i, "R#" ++ show i ++
                                " (RLoad " ++ show (rloadA ! i) ++ ")")) [0..numRvrs-1] ++
-                       map (\j -> (propNode j, "P#" ++ show j)) [0..numProps-1]
+                       map (\j -> (propNode j, "P#" ++ show j ++ "[" ++ show (pnrA ! j) ++ "]")) [0..numProps-1]
                parenthesizeIf False s = s
                parenthesizeIf True s = "(" ++ s ++ ")"
                theEdges = do
                        i <- [0..numRvrs-1]
                        j <- [0..numProps-1]
                        return (rvrNode i, propNode j,
-                               parenthesizeIf (elem (i, j) matchedPairs) $ show (prefA ! (i, j)) ++ ":" ++ show (expA ! (i, j)))
+                               parenthesizeIf (elem (i, j) matchedPairs) $
+                               show (prefA ! (i, j)) ++ ":" ++ show (expA ! (i, j)) ++ (if fixA ! (i, j) then "*" else ""))
        in mkGraph theNodes theEdges
 
 goFile :: String -> IO ()

diff --git a/program/example.in b/program/example.in
index 5d46307..46c6ed8 100644 (file)
--- a/program/example.in
+++ b/program/example.in
@@ -1,7 +1,7 @@
-1      1       1       1       1
-25     50      25      -100    0
-2      2       1       3       1
--50    65      50      25      25
-0      3       2       2       2
-25     -25     0       0       25
-2      1       1       2       2
+       1       1       1       1       1
+4      25*     50      25      -100    0
+       2       2       1       3       1
+4      -50     65      50      25      25
+       0       3       2       2       2
+4      25      -25     0       0       25
+       2       1       1       2       2