X-Git-Url: https://mattmccutchen.net/match/match.git/blobdiff_plain/89b7fd0dac0bef62999e7448fce184c19fe5bc6b..e5c5cbd9d48ecf8de5e7b0c20d7164b4b7bf340b:/program/PMInstanceGenerator.hs

diff --git a/program/PMInstanceGenerator.hs b/program/PMInstanceGenerator.hs
index 97a546a..9cafacd 100644
--- a/program/PMInstanceGenerator.hs
+++ b/program/PMInstanceGenerator.hs
@@ -1,22 +1,21 @@
 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
+randomReviewerInfo cfg numProps = do
 	-- "Older" reviewers are more likely to be expert on topics.
 	age <- mrandomR (0.5, 1.0)
-	expns <- indRandomArray (0, numTopics-1) $
+	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)
@@ -35,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)
@@ -49,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) ->
@@ -65,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