Saltar al contenido

Problema de programación de horarios con programación lineal entera

Después de consultar especialistas en el tema, programadores de varias ramas y maestros dimos con la respuesta al problema y la dejamos plasmada en este post.

Solución:

Aquí hay un enfoque ILP. Se puede modificar para modificar los requisitos, por ejemplo, si un curso tiene un laboratorio, no debe tomar ninguno o ambos, tal vez insista en tener como máximo un instructor con la calificación más baja, como máximo dos clases antes de las 9 a.m., tener cursos que se reúnan en varios días, etc. .

Lo ingresé todo a mano, aunque claramente uno podría usar Importación y procesamiento posterior.

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

Con esta configuración podemos usar FindMaximum y similares.

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 *)

(Igual pero con 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 *)

Para encontrar todos los programas que están vinculados a la función objetivo, se podría usar 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) *)

Dado que todo esto es ILP bajo el capó, no esperaría que manejara grandes problemas. De antemano, no tengo una buena suposición de hasta dónde podría escalar.

Otra cosa a tener en cuenta es que no hice ningún esfuerzo para obtener la máxima ventaja de evitar conflictos. Solo miré pares de clases. Los triples que tienen una intersección de tiempo de encuentro no trivial darían lugar a desigualdades más estrechas (es decir, más restrictivas) de la forma x+y+z<=1. Esas mejores desigualdades podrían marcar la diferencia en la medida en que se podría escalar este enfoque.

Parece que la maximización de las calificaciones conduce a la maximización del uso de créditos. Mi código (pero no respuesta) a continuación. Es búsqueda secuencial pero funciona.

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

Y el resultado es:

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

Producción:

2 Ecuaciones Diferenciales 3. Jueves 8:00-10:00 Dr. Smith 8.

3 Química 2. Lunes 8:00-10:00 Dr. Cho 9.

7 Laboratorio de Química 1. Miércoles 9:00-10:00 Dr. Xaviers 10.

9 Física 3. Lunes 10:15-12:15 Dr. Rosta 6.

11 Matemáticas 3. Jueves 10:15-12:15 Dr. Jones 7.

O

2 Ecuaciones Diferenciales 3. Jueves 8:00-10:00 Dr. Smith 8.

6 Química 2. Viernes 13:15-15:15 Dra. Xaviers 9.

7 Laboratorio de Química 1. Miércoles 9:00-10:00 Dr. Xaviers 10.

9 Física 3. Lunes 10:15-12:15 Dr. Rosta 6.

11 Matemáticas 3. Jueves 10:15-12:15 Dr. Jones 7.

Finalizando este artículo puedes encontrar los comentarios de otros usuarios, tú además tienes la opción de dejar el tuyo si te gusta.

¡Haz clic para puntuar esta entrada!
(Votos: 0 Promedio: 0)



Utiliza Nuestro Buscador

Deja una respuesta

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *