[1] Instrumentarea reducerii ferestrelor din orar (I + II)
[2] Schimbarea claselor dintr-o coloană în alta
[3] Orar pentru lecţiile unei zile (I + II)
Avem un orar al unei zile de lucru dintr-o şcoală cu un singur schimb – de exemplu acesta (obţinut prin programul daySchoolSchedule.R din [3]):
1 2 3 4 5 6 7 1 2 3 4 5 6 7
P59 5E 5D - - - - - P43 11C 11D 7D 8A - - -
P65 7D 7E - - - - - P33 - - 7C 12A 10A 9D -
P64 9C 9D - - - - - P50 - - - 5C 9E 6B -
P56 10B 5C - - - - - P20 7B 7A - 10C 5D - -
P71 9A 12A - - - - - P21 9E 12E - 11E - - -
P67 8C - 7E - - - - P40 - - 11D 11B 9C 8B -
P72 10E 11E - - - - - P18 - 6C - 7B 6E 7A -
P63 11A 9A 11B - - - - P55 - - 8C - 12A 5D -
P58 6E 10B - - - - - P16 - - 9A 10A 5C 11A -
P26 8A 10E 8B 10D - - - P42 - - - 9B - 10B 9E
P48 8F 7B 6B - - - - P34 - 5A 5B 8B 11E - -
P49 8D 9B 12B - - - - P31 - - 6C 11C 9B 5E -
P29 8E 8A - 12C - - - P11 - 5E - 7E 8D 7D -
P66 9D - 11E - - - - P19 - - 8F 5A 7B 6E -
P47 7E 8E 8A - - - - P41 - - - 8E 7A 9E -
P51 6C 8D 9B - - - - P12 - - 11C 12D 11D 7E -
P60 12D 11C 12E - - - - P04 - - 7A 6C 6B 7C -
P14 7C 10A 10B - - - - P28 11B - 6A 12B 10C 9C -
P57 5A 6B 5D - - - - P32 11E - - 5E 5A 11C -
P10 12B 11B 8D - 10D - - P37 - - - 9A 6C 11E -
P45 5B 6E - - 12C - - P08 5C 12C - 6D 12D - -
P46 10C 12D 7B - - - - P22 - 6D - 10E 8E 7B -
P44 6A 9E 5C - - - - P13 - 8B 10D 8F 7D 10E -
P54 12E 12B 6E - - - - P39 - - - 8C 8F 8E 7C
P62 - - - 10B 9D 10A - P23 - - - 11D 9A 10C 7D
P52 11D 7C 5A - - - - P06 - - 12A 9E 12E 12D -
P17 6D 8C - 11A 11B - - P09 10A 11A - 7C 11C 8F -
P35 12A 10C 6D - 11A - - P01 10D - 11A 6A 8C 8A 8B
P24 6B 6A 12D - - - - P25 12C - - 5D 7E 9B -
P27 8B 7D 10E 5B - - - P03 7A - 5E 7D 8A 8C -
P53 - 9C 10C 7A 6D - - P07 - - 9D 9C 10E 12A 8A
P38 9B 5B 9E - - - - P36 - - 10A 9D 6A 8D 8C
P30 5D 8F - 6B 5E - - P02 - - 9C 6E 7C 6C 9B
P15 - - 8E 8D 8B 10D - P05 - 10D 12C 12E 10B 9A -
41 41 41 41 39 31 7
În acest exemplu, avem 68 de profesori "Pnn" – de fapt, indecşi de linie ai matricei orelor 1..7 din acea zi ale claselor; ordinea liniilor corespunde crescător coeficienţilor "betweenness" din graful în care doi profesori sunt adiacenţi dacă au măcar o clasă comună (v. [3]), ceea ce aproximează superior listarea în ordinea numărului de ore ale fiecăruia. Numărul de clase este 41 ("A".."E" pe nivelele 5..7 şi 9..12 şi "A".."F" pe nivelul 8); toate clasele încep programul de lucru la prima oră din zi (în prima coloană apar exact 41 de clase); există şi clase care au numai 4 sau 5 ore, iar pe ultima coloană vedem că 7 dintre clase au câte 7 ore.
Pe lângă cele 41×4+39+31+7=241 de ore propriu-zise, orarul iniţial conţine 25 de ferestre, repartizate câte una sau două, la 22 de profesori (de exemplu, P25 face prima oră la 12C, apoi are două ferestre şi la ora a 4-a intră la 5D); dar am zice că avem un caz fericit, fiindcă ferestrele din orarele produse prin daySchoolSchedule.R reprezintă cel mai adesea, 14% (cel mult) din totalul orelor (ar fi fost 33 ferestre, nu 25).
Experimentele din [1] şi [2] ne-au condus la conturarea unei strategii coerente (fără elemente aleatorii) de reducere a numărului de ferestre din orarul iniţial; plecăm nu de la ferestre, ci de la orele propriu-zise ale claselor.
Pentru fiecare coloană 1..7, mutăm pe rând fiecare clasă din coloana respectivă pe fiecare dintre celelalte coloane, aplicăm de fiecare dată o reducere „standard” de ferestre şi reţinem acel caz în care obţinem cel mai mic număr de ferestre.
Pentru exemplul de mai sus sunt de analizat astfel cam 6000 de cazuri (7×41×21 = 6027, unde 21 este numărul combinărilor de 7 luate câte 2); orarul reţinut în final are deja numai 10 ferestre (în loc de cele 25 iniţiale), iar prin programul prezentat mai jos (încă susceptibil de îmbunătăţiri) rezultatul se obţine cam în 15 minute.
Reluăm programul iniţiat în [1]; avem de făcut anumite simplificări şi completări, dar deocamdată cam repetăm doar, unele lucruri:
# recast.R (reduce numărul de ferestre din orarul unei zile) library(tidyverse) TMT <- read_csv("orar.csv", col_types = "cccccccc") # slice_sample(TMT, n=5) MXT <- as.matrix(TMT[, 2:ncol(TMT)]) # print.table(MXT[sample(nrow(MXT),5), ]) row.names(MXT) <- TMT$prof nHm <- ncol(MXT) # nr. maxim de ore ale unei clase (7) get_bin_patt <- function(morr) { # şabloanele binare ale orarelor profesorilor apply(morr, 1, function(L) { byte <- 0L for(j in 1:ncol(morr)) if(L[j] != '-') byte <- bitwOr(byte, bitwShiftL(1, j-1)) byte }) } where_is_one <- function(w) # indecşii biţilor '1' dintr-un şablon orar which(bitwAnd(w, c(1, 2, 4, 8, 16, 32, 64)) > 0) cnt_holes <- function(w) { # Numărul biţi '0' între biţi '1' ("ferestre") bits <- where_is_one(w) n <- length(bits) bits[n] - bits[1] + 1 - n } cnt_all_gaps <- function(bin_patt) # 'bin_patt': vectorul şabloanelor orare sum(unlist(lapply(bin_patt, cnt_holes))) # numărul ferestrelor din orar
Faţă de [1], am schimbat unele denumiri de funcţii şi am adăugat o variabilă pentru numărul maxim de ore ale claselor (în [1] avem exemplificări ale formei CSV şi matriceale a orarului şi lămuriri asupra şabloanelor binare).
Preluăm din [2], fără nicio modificare:
move_cls <- function(morr, h1, h2, ql) { L1 <- morr[, h1] L2 <- morr[, h2] if(! (ql %in% L2 & ql %in% L1)) return(NULL) path_cls <- function(Q, rL) { if(rL == 1) {l1 <- L1; l2 <- L2} else {l1 <- L2; l2 <- L1} pth <- vector("integer", 0) i <- which(l1 == Q) if(length(i) == 0) return(NULL) pth <- c(pth, i) q <- Q repeat { i <- which(l2 == q) if(length(i) == 0) return(NULL) pth <- c(pth, i) q <- l1[i] if(q == '-' | q == Q) break } pth } path <- path_cls(ql, 1) # ; print(path) if(is.null(path)) return(NULL) ql2 <- L2[path[1]] if(ql2 != '-') { pth2 <- path_cls(ql2, 2) # ; print(pth2) if(is.null(pth2)) return(NULL) else path <- c(path, pth2) } morr[path, c(h1, h2)] <- morr[path, c(h2, h1)] morr }
Fiecare clasă trebuie să apară (cel mult) o singură dată pe coloană; mutarea unei clase într-o altă coloană implică mai multe schimburi de clase, de-a lungul unui lanţ Kempe (reconstituit în mod implicit de path_cls()) din graful în care arcele unesc clase de pe o aceeaşi linie (v. [1]).
În [2] formulasem şi o funcţie prin care să intervertim două coloane; între timp ne-am dat seama că este mai bine să mutăm câte o clasă (în toate modurile posibile) şi să evaluăm ce putem obţine prin anumite „reparaţii” în fiecare caz, decât să mutăm simultan toate clasele coloanei şi apoi, să vedem (şi să reparăm cumva) rezultatul.
„Reparăm” o fereastră mutând pe locul respectiv una sau alta dintre clasele aflate pe linia respectivă; desigur, pot rezulta astfel alte ferestre, pe liniile implicate prin operaţia de mutare a clasei.
Dar nu ne interesăm de toate posibilităţile de reparare; considerăm două mutări „principale”, indiferent câte ferestre ar fi pe linia respectivă – anume, acoperirea primei ferestre cu prima, respectiv cu ultima clasă; iar pentru cazul unei singure ferestre şi pentru cazul a două ferestre, adăugăm încă două sau trei mutări fireşti – de exemplu, mutăm prima clasă pe locul liber (dacă există) de după ultima, sau mutăm ultima clasă pe locul liber (dacă există) dinaintea primeia:
cover_gaps <- function(morr) { binp <- get_bin_patt(morr) B <- which(unlist(lapply(binp, cnt_holes)) > 0) cover <- function(id) { # posibilităţi de acoperire a ferestrelor, pe o linie pt <- where_is_one(binp[id]) n <- length(pt) H1 <- pt[1] Hn <- pt[n] cls <- morr[id, ] # ; print(cls) #(afişează linia curentă) igp <- which(cls == '-') igp <- igp[igp > H1 & igp < Hn] lh1 <- c(H1, Hn) # una, două, sau mai multe ferestre lh2 <- c(igp[1], igp[1]) lql <- c(cls[H1],cls[Hn]) ig <- length(igp) if(ig == 1) { # o singură fereastră if(igp[1] == H1 + 1L & Hn < nHm) { lh1 <- c(lh1, H1) lh2 <- c(lh2, Hn + 1L) lql <- c(lql, cls[H1]) } else { if(igp[1] == Hn - 1L & H1 > 1) { lh1 <- c(lh1, Hn) lh2 <- c(lh2, H1 - 1L) lql <- c(lql, cls[Hn]) } } } else { if(ig == 2) { # două ferestre lh1 <- c(lh1, c(H1, Hn)) lh2 <- c(lh2, c(igp[2], igp[2])) lql <- c(lql, c(cls[H1], cls[Hn])) } } D <- data.frame(h1 = lh1, h2 = lh2, ql = lql) row.names(D) <- NULL D } map_df(B, cover) }
În funcţia interioară cover(), în [1] consideram un obiect "data.frame" căruia îi adăugam repetat noi rânduri; acum am folosit trei vectori, pe care i-am extins după caz, asamblându-i în final într-un "data.frame" (am sperat că astfel creşte puţin, eficienţa de execuţie – care în cazul modificării unui obiect, suferă cumva din cauza copierilor intermediare obişnuite).
Este important de „perfecţionat” în privinţa vitezei de execuţie, funcţia cover_gaps() – fiindcă ea va fi apelată după fiecare mutare dintr-o coloană în alta, a unei clase:
choose_min <- function(mxt) { # 'mxt': orarul rezultat după mutarea unei clase swp <- cover_gaps(mxt) # lista reparaţiilor „standard” de ferestre swp$ng <- 100 for(i in 1:nrow(swp)) { # aplică pe rând, reparaţiile mor <- move_cls(mxt, swp[i,1], swp[i,2], swp[i,3]) if(! is.null(mor)) { B <- get_bin_patt(mor) swp$ng[i] <- sum(unlist(lapply(B, cnt_holes))) # numărul de ferestre } } im <- which.min(swp$ng) # reţine primul orar cu minimum de ferestre list(move_cls(mxt, swp[im,1], swp[im,2], swp[im,3]), swp$ng[im]) }
În choose_min() am preluat orarul rezultat după o mutare de clasă, am obţinut din cover_gaps() lista reparaţiilor de ferestre, am aplicat prin move_cls() fiecare dintre aceste reparaţii şi am înregistrat numărul de ferestre rezultat astfel; în final returnăm primul orar dintre cele „reparate”, care are numărul minim de ferestre.
Este de bănuit că şi choose_min() s-ar putea formula mai eficient…
Instrumentarea care urmează (susceptibilă de anumite variaţiuni şi rescrieri) se bazează pe o observaţie chiar simplă: aplicând choose_min() orarului produs anterior prin choose_min(), obţinem un orar care eventual, are şi mai puţine ferestre:
NG1 <- cnt_all_gaps(get_bin_patt(MXT)) # numărul de ferestre din orarul curent recast <- function(mxt) { # pe orarul curent r1 <- r2 <- 0 repeat { Lmxt <- choose_min(mxt) mxt <- Lmxt[[1]] NG2 <- Lmxt[[2]] # numărul de ferestre după aplicarea reparaţiilor if(NG2 < NG1) { NG1 <<- NG2 } else { if(NG2 == NG1) { # r2 <- 0 ## ? r1 <- r1 + 1 if(r1 == 4) { break } } else { # r1 <- 0 ## ? r2 <- r2 + 1 if(r2 == 6) break } } } mxt }
În variabila globală 'NG1' înregistrăm numărul de ferestre din orarul curent (iniţial, orarul din 'MXT'), iar în variabila locală 'NG2' avem numărul de ferestre din orarul reparat curent prin choose_min(). Dacă aplicând choose_min(), obţinem un orar cu mai puţine ferestre faţă de cel căruia i s-a aplicat (NG2 < NG1), atunci reaplicăm choose_min() noului orar; dacă de un anumit număr de ori (am ales 4) constatăm că numărul de ferestre nu se micşorează (NG2 = NG1), atunci încheiem, returnând ultimul orar produs de choose_min(); iar dacă de un anumit număr de ori (am ales 6) obţinem orare cu NG2 > NG1, atunci supozăm că numărul de ferestre nu poate fi micşorat în condiţiile curente (având în vedere gama de „reparaţii” pe care am considerat-o) şi acceptăm un asemenea orar (cu număr de ferestre mai mare decât cel iniţial, sperând să-l putem reduce ulterior).
Următoarea funcţie mută pe rând (prin move_cls()), fiecare clasă dintr-o coloană indicată, într-o altă coloană dată a orarului şi aplică recast() fiecăruia dintre orarele rezultate; se returnează acela dintre rezultatele aplicării recast(), care are cel mai puţine ferestre:
disturb <- function(morr, h1, h2) { Q1 <- morr[, h1]; Q1 <- Q1[Q1 != '-']; names(Q1) <- NULL res <- morr ng1 <- cnt_all_gaps(get_bin_patt(res)) NG1 <<- ng1 for(q in Q1) { rcs <- move_cls(morr, h1, h2, q) if(!is.null(rcs)) { rcs <- recast(rcs) if(!is.null(rcs)) { ng2 <- cnt_all_gaps(get_bin_patt(rcs)) if(ng2 < ng1) { res <- rcs ng1 <- ng2 # NG1 <<- ng2 ## ? } } } } list(res, ng1) }
În următoarea funcţie aplicăm disturb() fiecărei perechi de coloane distincte din orarul curent, returnând acela dintre orarele produse astfel, care are cel mai mic număr de ferestre:
cb7 <- combn(ncol(MXT), 2) # combinările de 7 luate câte 2 search_disturb <- function(rcs) { ng1 <- cnt_all_gaps(get_bin_patt(rcs)) # numărul de ferestre din orarul curent res <- rcs for(i in 1:ncol(cb7)) { h1 <- cb7[1, i]; h2 <- cb7[2, i] lRC <- disturb(rcs, h1, h2) ng2 <- lRC[[2]] # numărul de ferestre, după perturbarea curentă if(ng2 < ng1) { res <- lRC[[1]] ng1 <- ng2 } } list(res, ng1) }
Plecând de la orarul curent, funcţia următoare înlănţuie search_disturb() până când numărul curent de ferestre se stabilizează la o cea mai mică valoare:
tochain_disturb <- function(rcs) { SD <- search_disturb(rcs) ng1 <- SD[[2]] repeat { SD <- search_disturb(SD[[1]]) ng2 <- SD[[2]] if(ng2 < ng1) ng1 <- ng2 else break } SD }
Pentru orarul iniţial prezentat la început (cu 25 de ferestre) tochain_disturb(MXT) ne dă cam în 15 minute, următorul orar (cu 10 ferestre, câte una singură – fie a doua, fie a treia oră din zi – la 10 profesori care au câte cel puţin 4 ore):
1 2 3 4 5 6 7 1 2 3 4 5 6 7
P59 5E 5D - - - - - P43 11D 8A 7D 11C - - -
P65 - - - 7D 7E - - P33 - - 7C 12A 10A 9D -
P64 9C 9D - - - - - P50 - - - 5C 9E 6B -
P56 10B 5C - - - - - P20 7B 7A - 10C 5D - -
P71 9A 12A - - - - - P21 9E 12E 11E - - - -
P67 7E 8C - - - - - P40 - - 11D 9C 11B 8B -
P72 11E 10E - - - - - P18 6C 6E - 7A 7B - -
P63 11A 9A 11B - - - - P55 - - - - 12A 5D 8C
P58 - - - - 10B 6E - P16 - - 9A 10A 5C 11A -
P26 10E 8B 10D 8A - - - P42 - - - - 9B 10B 9E
P48 8F 7B 6B - - - - P34 - 5A 5B 11E 8B - -
P49 9B 8D 12B - - - - P31 - - 6C 9B 11C 5E -
P29 8A 12C 8E - - - - P11 - - 8D 7E 5E 7D -
P66 9D 11E - - - - - P19 - - 8F 6E 5A 7B -
P47 8E 7E 8A - - - - P41 - - - 9E 7A 8E -
P51 8D 6C 9B - - - - P12 - - 11C 11D 12D 7E -
P60 12D 11C 12E - - - - P04 - - 7A 6B 6C 7C -
P14 10A 7C 10B - - - - P28 11B 10C - 12B 6A 9C -
P57 5A 6B 5D - - - - P32 - - 5E 5A 11E 11C -
P10 12B 11B - 10D 8D - - P37 - - - 6C 9A 11E -
P45 6E 5B 12C - - - - P08 - - 5C 12C 6D 12D -
P46 10C 12D 7B - - - - P22 6D 8E 10E 7B - - -
P44 5C 9E 6A - - - - P13 10D 7D - 8B 10E 8F -
P54 12E 12B 6E - - - - P39 - - - 8E 8F 8C 7C
P62 - - - 10B 9D 10A - P23 - - - 9A 11D 10C 7D
P52 7C 11D 5A - - - - P06 - - 12A 12D 12E 9E -
P17 8C 6D 11A 11B - - - P09 11C 11A 10A 8F 7C - -
P35 12A - 6D 11A 10C - - P01 8B 10D 8C 6A 11A 8A -
P24 6B 6A 12D - - - - P25 - - 7E 5D 12C 9B -
P27 - - 8B 5B 7D 10E - P03 7D 5E - 8C 8A 7A -
P53 7A 9C 10C 6D - - - P07 - - 9D 10E 9C 12A 8A
P38 5B 9B 9E - - - - P36 6A 10A - 9D 8C 8D -
P30 5D 8F - 5E 6B - - P02 - - 9C 7C 6E 6C 9B
P15 - - - 8D 8E 10D 8B P05 12C 10B - 12E 10D 9A -
Procedura de reducere modelată mai sus este chiar întortocheată: tochain_disturb() repetă de un anumit număr de ori search_disturb(), care iterează disturb() pe toate perechile de coloane, care la rândul ei aplică move_cls() fiecărei clase din coloana curentă şi apoi aplică recast() fiecăruia dintre orarele intermediare; rezultatul este totuşi mulţumitor (inclusiv, ca timp de execuţie), chiar şi pentru un orar iniţial mai „încărcat” (cum este cel considerat aici).
„Mulţumitor”… pentru o bucată de timp! Pare avantajos, că nu am implicat elemente aleatorii – din orarul iniţial obţinem totdeauna (la orice execuţie a programului) un acelaşi orar final (cu mai puţine ferestre decât cel iniţial); dar ştim deja că randomizând totuşi cât de cât lucrurile, ne creem şansa de a obţine diverse orare finale, chiar cu şi mai puţine ferestre (şi uneori, într-un timp mai scurt).
vezi Cărţile mele (de programare)