Schedule programing problem with integer linear programming

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.

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.