4
$\begingroup$

I would like to automate the process of selecting a number of proposal reviewers that fit a conflict of interest criterion. Let's say I have 5 reviewers and 5 applicants from 5 departments. The department of a person can be obtained from the function getdept:

depts = { "science",  "language",  "art", "history",  "education"};
reviewers = { "mary", "jane", "bob", "joe", "john"};
applicants = { "mary", "pete",  "al", "fred", "patty"};
getdept[person_] := 
 person /. {"mary" -> "science", "jane" -> "language", 
   "bob" -> "art", "joe" -> "history", "john" -> "education", 
   "pete" -> "language", "al" -> "art", "fred" -> "art", 
   "patty" -> "language"}

Each proposal must be read by three reviewers, none of whom can be from the same department as the applicant. I can generate a table of possible reviewers:

possrev = 
 Table[{i, 
   DeleteCases[reviewers, x_ /; getdept[x] === getdept[i]]}, {i, 
   applicants}]

And looking at the result in this trivial example, I can manually identify reviewers:

possrev[[All, 2]] // MatrixForm

Mathematica graphics

I'm stuck with how to select sublists. It looks to me as if I should end with a 3xN matrix where N is the number of applicants. No element in the resulting matrix would be represented more than three times. (We can assume that Length[reviewers] >= Length[applicants]). I suspect that there will not be unique solutions and I do not need all solutions (although that would be interesting).

Is it possible to find a solution matrix, assignments such that:

Length/@Union/@assignments = 3

and

Count[Flatten[assignments], #] & /@ reviewers <= 3 

[I think these are the correct mathematical representations of my criteria, but I may be mistaken.]

$\endgroup$
7
$\begingroup$

Edit

I like the following formulation much more than the previous one. Using lists without indexing is clearer for me:

b[i_, j_] := Boole[getdept[applicants[[i]]] != getdept[reviewers[[j]]]]
lr = Length@reviewers;
la = Length@applicants;
sc = SparseArray[{i_, j_} -> c[i, j], {la, lr}];
sconds = SparseArray[{i_, j_} :> (0 <= c[i, j] <= b[i, j]), {la, lr}];
sol = Solve[{
             And @@ Thread[Tr /@ sc == 3] &&            (*3 reviewrs per applicant*)
             And @@ Thread[Tr /@ Transpose[sc] <= 3] && (*at most 3 tasks per reviewer*)
             And @@ Flatten@sconds},                    (*conflict test*)
       Normal@Flatten@sc, Integers];
MatrixForm /@ (Normal /@ sc /. sol)

Previous incarnation

Perhaps:

b[i_, j_] := 1 /; (getdept[applicants[[i]]] != getdept[reviewers[[j]]])
b[i_, j_] := 0 /; (getdept[applicants[[i]]] == getdept[reviewers[[j]]])
lr = Length@reviewers;
la = Length@applicants;
t = Table[c[i, j], {i, la}, {j, lr}];
sol = Solve[{And @@ Table[ Sum[c[i, j], {j, lr}] == 3, {i, la}] && (*3 reviewrs per applicant*)
             And @@ Table[ Sum[c[i, j], {i, la}] <= 3, {j, lr}] && (*at most 3 tasks per reviewer*)
             And @@ Flatten@ Table[0 <= c[i, j] <= b[i, j], {i, la}, {j, lr}]}, (*conflict test*)
            Flatten@t, Integers];
MatrixForm /@ (t /. # & /@ sol)

So, the first solution is:

f = {#1 , "is reviewed by", #2} &;
Thread[f[applicants, ((t /. sol[[1]]).reviewers)]]

(*
 {{mary, is reviewed by, bob  + jane + john},
  {pete, is reviewed by, bob  + joe  + john},
  {al,   is reviewed by, jane + john + mary},
  {fred, is reviewed by, jane + joe  + mary},
  {patty,is reviewed by, bob  + joe  + mary}}
*)

And there are 24 of such solutions (Length@sol)

$\endgroup$
5
  • 2
    $\begingroup$ Very nice - If you could also include the RemoveInternalStrife[] condition that will allow me to step aside and have Mathematica run this committee. $\endgroup$ Oct 26 '13 at 12:31
  • 3
    $\begingroup$ @bobthechemist I resist doing such things. Mathematica could start claiming its worker rights. $\endgroup$ Oct 26 '13 at 16:12
  • 4
    $\begingroup$ The only danger of letting Mathematica run everything is that everyone will be renamed Wolfram... $\endgroup$
    – cormullion
    Oct 26 '13 at 19:12
  • $\begingroup$ Hmm, does the OP not get pinged when an answer gets edited? I missed your update. $\endgroup$ Oct 28 '13 at 11:50
  • $\begingroup$ @bobthechemist I think you should get a ping, but not completely sure about that. Ask a mod. $\endgroup$ Oct 28 '13 at 11:53
3
$\begingroup$

I think @belisarius code deals with general cases without the nice symmetries/regularity of the toy example. However, I post for interest(?):

This question is related to bipartite matching. In the following I have modified "mary" who can be a reviewer or applicant to "maryrev" and "maryapp".

Setting up (then):

depts = {"science", "language", "art", "history", "education"};

reviewers = {"maryrev", "jane", "bob", "joe", "john"};
applicants = {"maryapp", "pete", "al", "fred", "patty"};
getdept[person_] := 
 person /. {"maryapp" -> "science", "maryrev" -> "science", 
   "jane" -> "language", "bob" -> "art", "joe" -> "history", 
   "john" -> "education", "pete" -> "language", "al" -> "art", 
   "fred" -> "art", "patty" -> "language"}

The bipartite graph can be generated (and faciltate 'by hand solution'):

gr = Select[Flatten[Outer[Rule, reviewers, applicants]], 
  Not[getdept[#[[1]]] == getdept[#[[2]]]] &]
g = Graph[gr, VertexLabels -> "Name", VertexLabelStyle -> 20, 
  ImagePadding -> 60]

enter image description here

Aiming to find solutions:

candid = {EdgeList[g, _ \[DirectedEdge] #][[All, 1]], #} & /@ 
  applicants;
ca = candid[[All, 1]];
sub = Subsets[#, {3}] & /@ ca;
ot = List @@@ Flatten[Outer[cand, ##, 1] & @@ sub];
answer = Select[ot, Max[Tally[Join @@ #][[All, 2]]] <= 3 &];

Reassuringly,

Length[answer]

yields 24 (as per belisarius...not a guarantee they are same and if not I am likely wrong)

An example:

Thread[answer[[1]] -> candid[[All, 2]]]

yields:

{{"jane", "bob", "joe"} -> "maryapp", {"maryrev", "bob", "joe"} -> 
  "pete", {"maryrev", "jane", "john"} -> 
  "al", {"maryrev", "jane", "john"} -> 
  "fred", {"bob", "joe", "john"} -> "patty"}

Confirmation compliance with 'at most 3':

Tally[Join @@ answer[[1]]]

gives:

{{"jane", 3}, {"bob", 3}, {"joe", 3}, {"maryrev", 3}, {"john", 3}}

...significant thought and modification (for me) would be needed for irregular case with varying vertex out/in degrees...hence my support for belisarius answer

EDIT

confirmation of 'conflict' test:

test = Thread[{#, candid[[All, 2]]}] & /@ answer;
tf[u_] := Or @@ Thread[getdept /@ u[[1]] == getdept[u[[2]]]];
Or @@ Flatten[Map[tf, test, {2}]]

tf tests whether any reviewer is in same faculty. The final line tests all answers and yields False, i.e. in no solution is an applicant interviewed by a reviewer from same faculty.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.