- More evaluation.

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

module PMInstanceGenerator where
import PMInstance
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
	-- "Older" reviewers are more likely to be expert on topics.
	age <- mrandomR (0.5, 1.0)
	expns <- indRandomArray (0, numTopics-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
}

randomProposalInfo = do
	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 (ProposalInfo topics (fromInteger diff))

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
		:: 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
			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 $ PMInstance numRvrs numProps loadA prefA