program/PMInstanceGenerator.hs

   1 module PMInstanceGenerator where
   2 import PMInstance
   3 import PMConfig
   4 import System.Random
   5 import RandomizedMonad
   6 import Data.Array.IArray
   7 import ArrayStuff
   8
   9 -- Expertise on each of the topics
  10 data ReviewerInfo = ReviewerInfo {
  11         riTopicExpertness :: Array Int Double,
  12         riConflicts       :: [Int]
  13 }
  14
  15 randomReviewerInfo cfg numProps = do
  16         -- "Older" reviewers are more likely to be expert on topics.
  17         age <- mrandomR (0.5, 1.0)
  18         expns <- indRandomArray (0, numTopics cfg - 1) $
  19                 withProb [(0.15 * age, return 2), (0.4 * age, return 1)] (return 0)
  20         -- Samir: "Its often the case that each reviewer has a COI with say
  21         -- one proposal submitted either by their University (different faculty)
  22         -- or by a recent co-author."
  23         conflicts <- withProb [(0.7, do
  24                         cp <- mrandomR (0, numProps-1)
  25                         return [cp]
  26                 )] (return [])
  27         return (ReviewerInfo expns conflicts)
  28
  29 -- One topic or two different topics
  30 data ProposalTopics = PTopic1 Int | PTopic2 Int Int
  31
  32 data ProposalInfo = ProposalInfo {
  33         piTopics     :: ProposalTopics,
  34         piDifficulty :: Wt
  35 }
  36
  37 randomTopic cfg = withWeight $
  38         map (\i -> (widenInteger (i+1) ** topicZipfExponent cfg, return i))
  39                 [0 .. numTopics cfg - 1]
  40
  41 randomProposalInfo cfg = do
  42         topics <- do
  43                 t1 <- randomTopic cfg
  44                 withProb [(0.5, return $ PTopic1 t1)] (do
  45                         t2 <- filterRandomized (/= t1) $ randomTopic cfg
  46                         return $ PTopic2 t1 t2
  47                         )
  48         diff <- mrandomR (3, 5)
  49         return (ProposalInfo topics (fromInteger diff))
  50
  51 expertnessToPref expertness = if expertness == 0 then 7
  52         else if expertness == 1 then 5
  53         else 3
  54
  55 randomInstance :: PMConfig -> Int -> Int -> Randomized PMInstance
  56 randomInstance cfg numRvrs numProps = do
  57         reviewerInfos <- indRandomArray (0, numRvrs-1) $ randomReviewerInfo cfg numProps
  58                 :: Randomized (Array Int ReviewerInfo)
  59         proposalInfos <- indRandomArray (0, numProps-1) $ randomProposalInfo cfg
  60                 :: Randomized (Array Int ProposalInfo)
  61         let loadA = constArray (0, numRvrs-1) 1
  62         let prefA = funcArray ((0, 0), (numRvrs-1, numProps-1)) (\(i,j) ->
  63                 let
  64                         ReviewerInfo iTE iC = reviewerInfos ! i
  65                         ProposalInfo jT jD = proposalInfos ! j
  66                         isConflict = elem j iC
  67                         topicPref = case jT of
  68                                 PTopic1 jt1 -> expertnessToPref (iTE ! jt1)
  69                                 PTopic2 jt1 jt2 -> (expertnessToPref (iTE ! jt1)
  70                                         + expertnessToPref (iTE ! jt2)) / 2
  71                 in if isConflict then 40 else topicPref * jD - 4)
  72         return $ PMInstance numRvrs numProps loadA prefA