Adaptation for POPL 2012.

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

diff --git a/program/PMInstance.hs b/program/PMInstance.hs
index 70d7529..aba03b2 100644 (file)
--- a/program/PMInstance.hs
+++ b/program/PMInstance.hs
@@ -7,20 +7,29 @@ import Formatter
 type Wt = Double -- Can be any RealFrac.
 widenInteger x = fromInteger (toInteger x)
 
-data PMInstance = PMInstance
-       Int                 -- numReviewers
-       Int                 -- numProposals
-       (UArray Int Wt)     -- ! reviewer -> relative load
-       (UArray (Int, Int) Wt) -- ! (reviewer, proposal) -> pref
-       deriving Eq
+data PMInstance = PMInstance {
+       -- I feel like I am in C, having to namespace these!  I guess one
+       -- solution would be to have a typeclass for every field name.  A
+       -- specialized solution might desugar to that.
+       pmiNumReviewers :: Int,
+       pmiNumProposals :: Int,
+       pmiRLoad :: UArray Int Wt,
+       pmiRPPref :: UArray (Int, Int) Wt, -- preference: -100 (COI), -99 to 100
+       pmiRPExp :: UArray (Int, Int) Wt -- expertise: 0 to 3
+}
+
+-- Let us shoehorn in the new pref scale.
+prefOldToNew p' = 100 - 5 * p'
+prefNewToOld p = 20 - 0.2 * p
 
 instance Show PMInstance where
-       show (PMInstance numRvrs numProps loadA prefA) =
-               let theRvrs = [0..numRvrs-1]; theProps = [0..numProps-1] in
-               "Instance with " ++ show numRvrs ++ " reviewers and " ++ show numProps ++ " proposals:\n" ++ formatTable (
+       show pmi =
+               let theRvrs = [0..pmiNumReviewers pmi - 1]; theProps = [0..pmiNumProposals pmi - 1] in
+               "Instance with " ++ show (pmiNumReviewers pmi) ++ " reviewers and " ++ show (pmiNumProposals pmi) ++ " proposals:\n" ++ formatTable (
                            (       ""              : map (\i -> "R#" ++ show i       ) theRvrs) :
-                           (       "RLoad"         : map (\i -> show (loadA ! i)     ) theRvrs) :
-                       map (\j -> ("P#" ++ show j) : map (\i -> show (prefA ! (i, j))) theRvrs) theProps
+                           (       "RLoad"         : map (\i -> show (pmiRLoad pmi ! i)     ) theRvrs) :
+                       map (\j -> ("P#" ++ show j) : map (\i -> show (pmiRPPref pmi ! (i, j)) ++ ":" ++ show (pmiRPExp pmi ! (i, j))) theRvrs) theProps
                )
 
-type PMatching = [(Int, Int)]
+newtype PMatching = PMatching [(Int, Int)]
+       deriving Show