program/Evaluation.hs

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