From 066d7f5355c79a94b6d3a6fb2008e0a506b289c7 Mon Sep 17 00:00:00 2001
From: Matt McCutchen <matt@mattmccutchen.net>
Date: Sat, 12 Jul 2008 09:51:02 -0400
Subject: [PATCH] Add conflicts of interest to the InstanceGenerator and make
 some other cleanups.

---
 program/InstanceGenerator.hs | 80 +++++++++++++++++-------------------
 program/RandomizedMonad.hs   | 13 +++++-
 2 files changed, 50 insertions(+), 43 deletions(-)

diff --git a/program/InstanceGenerator.hs b/program/InstanceGenerator.hs
index ab56d5f..fbd95b2 100644
--- 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
--- 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)
-- 
2.34.1