First attempt at evaluating the quality of matchings.

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

module Evaluation where
import PMInstance
import ProposalMatcher

import Data.Array.IArray
import Data.List
import ArrayStuff

type MatchingEvaluation = Array Int Wt

evaluateMatching :: PMConfig -> PMInstance -> PMatching -> MatchingEvaluation
evaluateMatching cfg inst@(PMInstance numRvrs numProps rloadA prefA) matching =
	let reviewersByProposal = accumArray (flip (:)) []
		(0, numProps-1) $ map (\(i,j) -> (j,i)) matching
		:: Array Int [Int] in
	aixmap (\j rl ->
		-- Sort this proposal's reviews, best first.
		let jPrefsInc = sort $ map (\i -> prefA ! (i,j)) rl in
		-- Charge each review's assignmentCost.
		sum $ zipWith (\wt prf -> (numAsWt wt) * assignmentCost cfg prf)
			-- The assignment costs are weighted by
			-- reviewsEachProposal, ..., 1 from best to worst.
			-- (It's most important for the best to be good.)
			(take (reviewsEachProposal cfg) $
				iterate (subtract 1) (reviewsEachProposal cfg))
			-- A missing review counts as a preference of 50 (really bad).
			(jPrefsInc ++ repeat 50)
			)
		reviewersByProposal

doEvaluateMatching :: PMConfig -> PMInstance -> MatchingEvaluation
doEvaluateMatching cfg inst =
	let matching = doMatching cfg inst in
	evaluateMatching cfg inst matching

-- Sorted from negative cost changes (better in e2)
-- to positive cost changes (worse in e2).
sortedDiffEvaluations :: MatchingEvaluation -> MatchingEvaluation -> [Wt]
sortedDiffEvaluations e1 e2 =
	sort $ zipWith (-) (elems e1) (elems e2)