Merge branch 'master' into popl2012
[match/match.git] / program / PMInstanceGenerator.hs
index 1143f61..9cafacd 100644 (file)
@@ -1,21 +1,22 @@
 module PMInstanceGenerator where
 import PMInstance
+import PMConfig
 import System.Random
 import RandomizedMonad
 import Data.Array.IArray
 import ArrayStuff
 
-numTopics = 20
-
 -- Expertise on each of the topics
 data ReviewerInfo = ReviewerInfo {
        riTopicExpertness :: Array Int Double,
        riConflicts       :: [Int]
 }
 
-randomReviewerInfo numProps = do
-       expns <- indRandomArray (0, numTopics-1) $
-               withProb [(0.15, return 2), (0.4, return 1)] (return 0)
+randomReviewerInfo cfg numProps = do
+       -- "Older" reviewers are more likely to be expert on topics.
+       age <- mrandomR (0.5, 1.0)
+       expns <- indRandomArray (0, numTopics cfg - 1) $
+               withProb [(0.15 * age, return 2), (0.4 * age, return 1)] (return 0)
        -- Samir: "Its often the case that each reviewer has a COI with say
        -- one proposal submitted either by their University (different faculty)
        -- or by a recent co-author."
@@ -33,11 +34,15 @@ data ProposalInfo = ProposalInfo {
        piDifficulty :: Wt
 }
 
-randomProposalInfo = do
+randomTopic cfg = withWeight $
+       map (\i -> (widenInteger (i+1) ** topicZipfExponent cfg, return i))
+               [0 .. numTopics cfg - 1]
+
+randomProposalInfo cfg = do
        topics <- do
-               t1 <- mrandomR (0, numTopics-1)
+               t1 <- randomTopic cfg
                withProb [(0.5, return $ PTopic1 t1)] (do
-                       t2 <- filterRandomized (/= t1) $ mrandomR (0, numTopics-1)
+                       t2 <- filterRandomized (/= t1) $ randomTopic cfg
                        return $ PTopic2 t1 t2
                        )
        diff <- mrandomR (3, 5)
@@ -47,11 +52,11 @@ expertnessToPref expertness = if expertness == 0 then 7
        else if expertness == 1 then 5
        else 3
 
-randomInstance :: Int -> Int -> Randomized PMInstance
-randomInstance numRvrs numProps = do
-       reviewerInfos <- indRandomArray (0, numRvrs-1) $ randomReviewerInfo numProps
+randomInstance :: PMConfig -> Int -> Int -> Randomized PMInstance
+randomInstance cfg numRvrs numProps = do
+       reviewerInfos <- indRandomArray (0, numRvrs-1) $ randomReviewerInfo cfg numProps
                :: Randomized (Array Int ReviewerInfo)
-       proposalInfos <- indRandomArray (0, numProps-1) $ randomProposalInfo
+       proposalInfos <- indRandomArray (0, numProps-1) $ randomProposalInfo cfg
                :: Randomized (Array Int ProposalInfo)
        let loadA = constArray (0, numRvrs-1) 1
        let prefA = funcArray ((0, 0), (numRvrs-1, numProps-1)) (\(i,j) ->
@@ -63,5 +68,19 @@ randomInstance numRvrs numProps = do
                                PTopic1 jt1 -> expertnessToPref (iTE ! jt1)
                                PTopic2 jt1 jt2 -> (expertnessToPref (iTE ! jt1)
                                        + expertnessToPref (iTE ! jt2)) / 2
-               in if isConflict then 40 else topicPref * jD - 4)
-       return $ PMInstance numRvrs numProps loadA prefA
+               -- Use a formula designed for the old pref scale with the new.
+               in if isConflict then -100 else prefOldToNew (topicPref * jD - 4))
+       let expA = funcArray ((0, 0), (numRvrs-1, numProps-1)) (\(i,j) ->
+               let
+                       ReviewerInfo iTE iC = reviewerInfos ! i
+                       ProposalInfo jT jD = proposalInfos ! j
+                       isConflict = elem j iC
+                       topicExp = case jT of
+                               PTopic1 jt1 -> 1 + (iTE ! jt1)
+                               PTopic2 jt1 jt2 -> 1 + ((iTE ! jt1)
+                                       + (iTE ! jt2)) / 2
+               in topicExp)
+       -- 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