Merge branch 'master' into popl2012

[match/match.git] / program / PMInstanceGenerator.hs

module PMInstanceGenerator where
import PMInstance
import PMConfig
import System.Random
import RandomizedMonad
import Data.Array.IArray
import ArrayStuff

-- Expertise on each of the topics
data ReviewerInfo = ReviewerInfo {
	riTopicExpertness :: Array Int Double,
	riConflicts       :: [Int]
}

randomReviewerInfo cfg numProps = do
	-- "Older" reviewers are more likely to be expert on topics.
	age <- mrandomR (0.5, 1.0)
	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)
	-- 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

data ProposalInfo = ProposalInfo {
	piTopics     :: ProposalTopics,
	piDifficulty :: Wt
}

randomTopic cfg = withWeight $
	map (\i -> (widenInteger (i+1) ** topicZipfExponent cfg, return i))
		[0 .. numTopics cfg - 1]

randomProposalInfo cfg = do
	topics <- do
		t1 <- randomTopic cfg
		withProb [(0.5, return $ PTopic1 t1)] (do
			t2 <- filterRandomized (/= t1) $ randomTopic cfg
			return $ PTopic2 t1 t2
			)
	diff <- mrandomR (3, 5)
	return (ProposalInfo topics (fromInteger diff))

expertnessToPref expertness = if expertness == 0 then 7
	else if expertness == 1 then 5
	else 3

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 cfg
		:: Randomized (Array Int ProposalInfo)
	let loadA = constArray (0, numRvrs-1) 1
	let prefA = funcArray ((0, 0), (numRvrs-1, numProps-1)) (\(i,j) ->
		let
			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
		-- 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