Add conflicts of interest to the InstanceGenerator and make some other cleanups.

diff --git a/program/InstanceGenerator.hs b/program/InstanceGenerator.hs
index ab56d5f..fbd95b2 100644 (file)
--- a/program/InstanceGenerator.hs
+++ b/program/InstanceGenerator.hs
@@ -8,43 +8,40 @@ import ArrayStuff
 numTopics = 20
 
 -- Expertise on each of the topics
-type ReviewerInfo = Array Int Double
+data ReviewerInfo = ReviewerInfo {
+       riTopicExpertness :: Array Int Double,
+       riConflicts       :: [Int]
+}
 
-randomReviewerInfo = do
-       list <- sequence $ replicate numTopics $
+randomReviewerInfo numProps = do
+       expns <- indRandomArray (0, numTopics-1) $
                withProb [(0.15, return 2), (0.4, return 1)] (return 0)
-       return $ listArray (0, numTopics-1) list
+       -- 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."
+       conflicts <- withProb [(0.7, do
+                       cp <- mrandomR (0, numProps-1)
+                       return [cp]
+               )] (return [])
+       return (ReviewerInfo expns conflicts)
 
 -- One topic or two different topics
 data ProposalTopics = PTopic1 Int | PTopic2 Int Int
 
---type ProposalAuthors = Maybe Int
-
-type ProposalInfo = (ProposalTopics, Wt)
-
-randomProposalTopics = do
-       t1 <- mrandomR (0, numTopics-1)
-       withProb [(0.5, return $ PTopic1 t1)] (do
-               t2 <- filterRandomized (/= t1) $ mrandomR (0, numTopics-1)
-               return $ PTopic2 t1 t2
-               )
-
--- Add conflict of interest later.
-{--
-randomProposalAuthors = do
-       withProb [(0.5, return [])] (do
-               a1 <- mrandomR (0, numRvrs-1)
-               withProb [(0.5, return [a1])] (do
-                       a2 <- filterRandomized (/= a1) $ mrandomR (0, numRvrs-1)
-                       return [a1,a2]
-                       )
-               )
---}
+data ProposalInfo = ProposalInfo {
+       piTopics     :: ProposalTopics,
+       piDifficulty :: Wt
+}
 
 randomProposalInfo = do
-       topics <- randomProposalTopics
+       topics <- do
+               t1 <- mrandomR (0, numTopics-1)
+               withProb [(0.5, return $ PTopic1 t1)] (do
+                       t2 <- filterRandomized (/= t1) $ mrandomR (0, numTopics-1)
+                       return $ PTopic2 t1 t2
+                       )
        diff <- mrandomR (3, 5)
-       return (topics, fromInteger diff)
+       return (ProposalInfo topics (fromInteger diff))
 
 expertnessToPref expertness = if expertness == 0 then 7
        else if expertness == 1 then 5
@@ -52,20 +49,19 @@ expertnessToPref expertness = if expertness == 0 then 7
 
 randomInstance :: Int -> Int -> Randomized Instance
 randomInstance numRvrs numProps = do
-       reviewerInfosList <- sequence $ replicate numRvrs $ randomReviewerInfo
-       -- reviewerProfs is an array of arrays.
-       -- A pair-indexed array might be better...
-       let reviewerInfos = listArray (0, numRvrs-1) reviewerInfosList :: Array Int ReviewerInfo
-       proposalInfosList <- sequence $ replicate numProps $ randomProposalInfo
-       let proposalInfos = listArray (0, numProps-1) proposalInfosList :: Array Int ProposalInfo
-       let loadA = funcArray (0, numRvrs-1) $ const 1
+       reviewerInfos <- indRandomArray (0, numRvrs-1) $ randomReviewerInfo numProps
+               :: Randomized (Array Int ReviewerInfo)
+       proposalInfos <- indRandomArray (0, numProps-1) $ randomProposalInfo
+               :: Randomized (Array Int ProposalInfo)
+       let loadA = constArray (0, numRvrs-1) 1
        let prefA = funcArray ((0, 0), (numRvrs-1, numProps-1)) (\(i,j) ->
                let
-                       ii = reviewerInfos ! i
-                       jj = proposalInfos ! j
-                       topicPref = case fst jj of
-                               PTopic1 t1 -> expertnessToPref (ii ! t1)
-                               PTopic2 t1 t2 -> (expertnessToPref (ii ! t1)
-                                       + expertnessToPref (ii ! t2)) / 2
-               in topicPref * snd jj - 4)
+                       ReviewerInfo iTE iC = reviewerInfos ! i
+                       ProposalInfo jT jD = proposalInfos ! j
+                       isConflict = elem j iC
+                       topicPref = case jT of
+                               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 $ Instance numRvrs numProps loadA prefA

diff --git a/program/RandomizedMonad.hs b/program/RandomizedMonad.hs
index 37f2b98..f3b50d4 100644 (file)
--- a/program/RandomizedMonad.hs
+++ b/program/RandomizedMonad.hs
@@ -3,9 +3,12 @@ module RandomizedMonad (
        runRandom, runRandomStd, runRandomNewStd,
        mrandomR, mrandom,
        withProb,
-       filterRandomized
+       filterRandomized,
+       indRandomArray
 ) where
 import System.Random
+import Data.Array.IArray
+import Data.Ix
 
 -- Needs -XRank2Types
 newtype Randomized a = Randomized (forall g. RandomGen g => (g -> a))
@@ -59,3 +62,11 @@ filterRandomized :: (a -> Bool) -> Randomized a -> Randomized a
 filterRandomized f ra = do
        a <- ra
        if f a then return a else filterRandomized f ra
+
+-- Randomized array with elements chosen independently following a given
+-- randomized element.
+indRandomArray :: (IArray a e, Ix i) =>
+       (i, i) -> Randomized e -> Randomized (a i e)
+indRandomArray bds rElement = do
+       list <- sequence $ replicate (rangeSize bds) rElement
+       return (listArray bds list)