- Add code to visualize an instance and matching as a graph (bipartite, rather

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

module InstanceGenerator where
import Instance
import System.Random
import RandomizedMonad
import Data.Array.IArray
import ArrayStuff

randomMap :: RandomGen g => g -> (g -> a -> b) -> [a] -> [b]
randomMap g f l = case l of
	[] -> []
	h:t -> let (g1, g2) = split g in (f g1 h):(randomMap g2 f t)
randomRep :: RandomGen g => g -> (g -> a) -> Int -> [a]
randomRep g f n = if n == 0 then []
	else let (g1, g2) = split g in (f g1):(randomRep g2 f (n-1))

numTopics = 20

-- Expertise on each of the topics
type ReviewerInfo = Array Int Double

randomReviewerInfo = do
	list <- sequence $ replicate numTopics $
		withProb [(0.15, return 2), (0.4, return 1)] (return 0)
	return $ listArray (0, numTopics-1) list

-- 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]
			)
		)
--}

randomProposalInfo = do
	topics <- randomProposalTopics
	diff <- mrandomR (3, 5)
	return (topics, fromInteger diff)

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

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
	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)
	return $ Instance numRvrs numProps loadA prefA