| 1 | module Evaluation where |
| 2 | import PMInstance |
| 3 | import PMConfig |
| 4 | import ProposalMatcher |
| 5 | |
| 6 | import Data.Array.IArray |
| 7 | import Data.List |
| 8 | import ArrayStuff |
| 9 | |
| 10 | type MatchingEvaluation = Array Int Wt |
| 11 | |
| 12 | evaluateMatching :: PMConfig -> PMInstance -> PMatching -> MatchingEvaluation |
| 13 | evaluateMatching cfg inst@(PMInstance numRvrs numProps rloadA prefA) matching = |
| 14 | let reviewersByProposal = accumArray (flip (:)) [] |
| 15 | (0, numProps-1) $ map (\(i,j) -> (j,i)) matching |
| 16 | :: Array Int [Int] in |
| 17 | aixmap (\j rl -> |
| 18 | -- Sort this proposal's reviews, best first. |
| 19 | let jPrefsInc = sort $ map (\i -> prefA ! (i,j)) rl in |
| 20 | -- Charge each review's assignmentCost. |
| 21 | sum $ zipWith (\wt prf -> (numAsWt wt) * assignmentCost cfg prf) |
| 22 | -- The assignment costs are weighted by |
| 23 | -- reviewsEachProposal, ..., 1 from best to worst. |
| 24 | -- (It's most important for the best to be good.) |
| 25 | (take (reviewsEachProposal cfg) $ |
| 26 | iterate (subtract 1) (reviewsEachProposal cfg)) |
| 27 | -- A missing review counts as a preference of 50 (really bad). |
| 28 | (jPrefsInc ++ repeat 50) |
| 29 | ) |
| 30 | reviewersByProposal |
| 31 | |
| 32 | doEvaluateMatching :: PMConfig -> PMInstance -> MatchingEvaluation |
| 33 | doEvaluateMatching cfg inst = |
| 34 | let matching = doMatching cfg inst in |
| 35 | evaluateMatching cfg inst matching |
| 36 | |
| 37 | -- Sorted from negative cost changes (better in e2) |
| 38 | -- to positive cost changes (worse in e2). |
| 39 | sortedDiffEvaluations :: MatchingEvaluation -> MatchingEvaluation -> [Wt] |
| 40 | sortedDiffEvaluations e1 e2 = |
| 41 | sort $ zipWith (-) (elems e1) (elems e2) |