Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.]

share|improve this question
add comment

2 Answers

up vote 7 down vote accepted

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)

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

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.

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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