Schedule programing problem with integer linear programming

Question

I know how to model this question on paper, but I don't know how doing it in Mathematica.

Imagine , there is a university student who want to choose courses for this semester and he got the university program chart that looks like below in excel format :

Lecturers Rating is out of 10 and it means which lecturer is giving a better score in the final exam and teaches better.

Course Credit is a restriction, each semester each student should choose courses that total of course credit must be greater than 7 and less than 12:

It is not allowed to pick two courses with the same name.

He/She wants to optimize two things :

1. He/She wants to maximize course credits that he/she could use (12)
2. He/She wants to pick up courses with better Lecturers

Also He/She wants to get the result like a schedule table like this:

Here is excel File form university.

Answer 1

Here is an ILP approach. It can be modified to alter requirements e.g. if a course has a lab, must take neither or both, maybe insist on at most one instructor with the lowest rating, at most two classes before 9 AM, have courses that meet on multiple days, etc.

I entered it all by hand although clearly one could use Import and further processing.

courses = {{"math", 3, "M", {8, 10}, 5}, {"de", 3, "Th", {8, 10}, 
    8}, {"chem", 2, "M", {8, 10}, 9}, {"physL", 1, "Th", {9, 10}, 
    4}, {"de", 3, "F", {13.25, 15.25}, 6}, {"chem", 2, 
    "F", {13.25, 15.25}, 9}, {"chemL", 1, "W", {9, 10}, 10}, {"physL",
     1, "W", {9, 10}, 7}, {"phys", 3, "M", {10.25, 12.25}, 
    6}, {"phys", 3, "W", {10.25, 12.25}, 5}, {"math", 3, 
    "Th", {10.25, 12.25}, 7}};

vars = Array[v, Length[courses]];
obj = vars.courses[[All, -1]];
c1 = Map[0 <= # <= 1 &, vars];
c2 = {Element[vars, Integers], 7 <= vars.courses[[All, 2]] <= 12};
c3 = Flatten[
    Table[If[
      courses[[j, 3]] == courses[[k, 3]] && 
       IntervalIntersection[Interval[courses[[j, 4]]], 
         Interval[courses[[k, 4]]] /. 
          Interval[{aa_, aa_}] :> Interval[]] =!= Interval[], 
      vars[[j]] + vars[[k]] <= 1]
     , {j, 1, Length[vars] - 1}, {k, j + 1, Length[vars]}]] /. 
   Null :> Sequence[];
c4 = Flatten[
    Table[If[courses[[j, 1]] == courses[[k, 1]], 
      vars[[j]] + vars[[k]] <= 1]
     , {j, 1, Length[vars] - 1}, {k, j + 1, Length[vars]}]] /. 
   Null :> Sequence[];
constraints = Union[Join[c1, c2, c3, c4]];

With this set up we can use FindMaximum and the like.

{max, sched} = FindMaximum[{obj, constraints}, vars];

max

(* Out[259]= 40. *)

vars /. sched

*(* Out[260]= {0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1} *)

Pick[courses, vars /. sched, 1]

(* Out[262]= {{"de", 3, "Th", {8, 10}, 8}, {"chem", 2, 
  "F", {13.25, 15.25}, 9}, {"chemL", 1, "W", {9, 10}, 10}, {"phys", 3,
   "M", {10.25, 12.25}, 6}, {"math", 3, "Th", {10.25, 12.25}, 7}} *)

( Same but with Maximize)

Maximize[{obj, constraints}, vars]

(* Out[273]= {40, {v[1] -> 0, v[2] -> 1, v[3] -> 1, v[4] -> 0, v[5] -> 0,
   v[6] -> 0, v[7] -> 1, v[8] -> 0, v[9] -> 1, v[10] -> 0, 
  v[11] -> 1}} *)

To find all schedules that are tied on the objective function one could use Reduce.

Reduce[Flatten[{obj == 40, constraints}], vars]

(* Out[275]= (v[1] == 0 && v[2] == 1 && v[3] == 0 && v[4] == 0 && 
   v[5] == 0 && v[6] == 1 && v[7] == 1 && v[8] == 0 && v[9] == 1 && 
   v[10] == 0 && v[11] == 1) || (v[1] == 0 && v[2] == 1 && v[3] == 1 &&
    v[4] == 0 && v[5] == 0 && v[6] == 0 && v[7] == 1 && v[8] == 0 && 
   v[9] == 1 && v[10] == 0 && v[11] == 1) *)

Since this is all ILP under the hood I would not expect it to handle huge problems. Offhand I do not have a good guess as to how far it might scale.

Another thing to note is that I made no effort to get the maximum advantage from avoiding conflicts. I only looked at pairs of classes. Triples that have nontrivial meeting time intersection would give rise to tighter (that is, more restrictive) inequalities of the form x+y+z<=1. Such better inequalities could make a difference in how far one might scale this approach.

Answer 2

It seems that maximization of ratings leads to maximization of credits using. My code (but not answer) below. It's sequential search but it works.

data = Import["university program chart.xlsx"];
dtt[d_] := 
  d /. {"Monday" -> 0, "Tuesday" -> 1 24 60 60, 
    "Wednesday" -> 2 24 60 60, "Thursday" -> 3 24 60 60, 
    "Friday" -> 4 24 60 60, "Saturday" -> 5 24 60 60};
strpr[line_] := Module[{ret = {0, 0, 0, 0, 0}},
   ret[[1]] = 
    Interval[(AbsoluteTime[{#, {"Hour", ":", "Minute"}}] & /@ 
        StringSplit[line[[5]], "-"]) + dtt[line[[4]]]];
   ret[[2]] = Round[line[[1]]];
   ret[[3]] = Round[line[[3]]];
   ret[[4]] = Round[line[[7]]];
   ret[[5]] = line[[2]];
   Return[ret];
   ];
ndata = strpr /@ (data[[1, 2 ;;]]);
mdata = Subsets[ndata][[2 ;;]];
kdata = Select[mdata, 
   7 <= Total[((#)\[Transpose])[[3]]] <= 12 && 
     Not[Or @@ 
       IntervalMemberQ @@@ 
        Subsets[Flatten[(#)\[Transpose][[1]]], {2}]] && 
     DuplicateFreeQ[#\[Transpose][[5]]] &];
util = Total[(#\[Transpose])[[4]]] & /@ kdata;
listofnumbers = 
  kdata[[#]]\[Transpose][[2]] & /@ Flatten[Position[util, Max[util]]];

And the result is:

TableForm /@ (data[[1, # + 1]] & /@ listofnumbers)

Output:

2 Differential Equations 3. Thursday 8:00-10:00 Dr. Smith 8.

3 Chemistry 2. Monday 8:00-10:00 Dr. Cho 9.

7 Chemistry Lab 1. Wednesday 9:00-10:00 Dr. Xaviers 10.

9 Physics 3. Monday 10:15-12:15 Dr. Rosta 6.

11 Math 3. Thursday 10:15-12:15 Dr. Jones 7.

Or

2 Differential Equations 3. Thursday 8:00-10:00 Dr. Smith 8.

6 Chemistry 2. Friday 13:15-15:15 Dr. Xaviers 9.

7 Chemistry Lab 1. Wednesday 9:00-10:00 Dr. Xaviers 10.

9 Physics 3. Monday 10:15-12:15 Dr. Rosta 6.

11 Math 3. Thursday 10:15-12:15 Dr. Jones 7.