program/Evaluation.hs

   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 -- FIXME this is not really ported to separate preference and expertise
  13
  14 evaluateMatching :: PMConfig -> PMInstance -> PMatching -> MatchingEvaluation
  15 evaluateMatching cfg inst@(PMInstance numRvrs numProps rloadA prefA _ _ _) (PMatching matching) =
  16         let reviewersByProposal = accumArray (flip (:)) []
  17                 (0, numProps-1) $ map (\(i,j) -> (j,i)) matching
  18                 :: Array Int [Int] in
  19         aixmap (\j rl ->
  20                 -- Sort this proposal's reviews, best first.
  21                 let jPrefsInc = sort $ map (\i -> prefA ! (i,j)) rl in
  22                 -- Charge each review's assignmentCost.
  23                 sum $ zipWith (\wt prf -> wt * assignmentCost cfg prf)
  24                         (reviewEvalWeights cfg)
  25                         -- A missing review counts as a preference of 50 (really bad).
  26                         (jPrefsInc ++ repeat 50)
  27                 )
  28                 reviewersByProposal
  29
  30 doEvaluateMatching :: PMConfig -> PMInstance -> MatchingEvaluation
  31 doEvaluateMatching cfg inst =
  32         let matching = doMatching cfg inst in
  33         evaluateMatching cfg inst matching
  34
  35 -- Sorted from negative cost changes (better in e2)
  36 -- to positive cost changes (worse in e2).
  37 sortedDiffEvaluations :: MatchingEvaluation -> MatchingEvaluation -> [Wt]
  38 sortedDiffEvaluations e1 e2 =
  39         sort $ zipWith (-) (elems e1) (elems e2)