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