[1] Chestiunea cuplajelor existente în orarul şcolar (I - VI)
Reinventăm programul nostru anterior "vrecast.R" (chiar cu alt nume):
# recast.R (reduce numărul de ferestre din orarul unei zile) source("stmt_utils.R") # bin_patterns(), cnt_holes(), to_table(); prnTime() load("Messing.RDS") # cuplajele Tw1, Tw2 şi clasele săptămânii Cls
Nu prea nimerim, cele mai potrivite denumiri pentru variabile, funcţii şi fişiere – dar Messing e bine ales: cuplajele „încurcă” foarte mult, problema orarului.
Messing.RDS injectează date de la nivelul săptămânii: vectorul claselor Cls şi listele (de redus după ziua curentă) Tw1 şi Tw2 (de la twin=cuplat/geamăn), privitoare la cuplaje. Funcţiile care urmează folosesc anumite variabile globale, pe care le vom specifica în grup, abia la sfârşit (şi nu la început, cum se recomandă de obicei) – din motive care ţin de execuţia programului (dacă nu, de gust): funcţiile noastre vizează orarul curent al unei zile, iar la sfârşit vom vrea să le aplicăm totuşi (prin ciclare) pe toate zilele.
Când socotim ferestrele, trebuie să ţinem seama de acest caz: profesor implicat în unul sau mai multe cuplaje, dar care nu are ore proprii în ziua respectivă.
De exemplu, p33 apare pe orarul zilei în cuplajul p06p33, dar nu apare şi singur – atunci, orice fereastră a profesorului fictiv p06p33 devine o fereastră („reală”, dar cumva ascunsă) pentru p33. Sau: p34 nu are ore proprii, dar intră în cuplajele p34p07 şi p34p09; orice fereastră comună celor doi profesori fictivi, devine fereastră a lui p34.
Înregistrăm pentru ziua curentă (dar mult mai simplu ca în vechea "special_cases()"), cuplajele (profesorii fictivi) care angajează câte un profesor fără ore proprii:
hidden_gaps <- function() { sbf <- setdiff(names(Tw1), nTz1) %>% map(function(P) map_chr(Tw1[[P]], function(Pf) if(Pf %in% nTz2) Pf else NA)) sbf[! is.na(sbf)] }
Tw1 are drept chei profesorii care intră în măcar un cuplaj, de-a lungul săptămânii; Tz1 selectează dintre aceştia, pe cei care au şi ore proprii, în ziua curentă. Deci diferenţa (prin setdiff()) dintre cei doi vectori de nume reprezintă profesorii care, în ziua respectivă, intră măcar într-un cuplaj dar nu au ore proprii; pentru fiecare dintre aceştia (folosind map() şi apoi map_chr()), se reţin acei profesori fictivi care apar în ziua curentă şi care angajează profesorul respectiv.
Va trebui (pe cât se va putea) ca profesorii fictivi astfel reţinuţi, să nu aibă ferestre comune – ele ar deveni ferestre „ascunse”, la profesorul fără ore proprii pe care-l angajează.
hidden_gaps() foloseşte nişte variabile „globale”, pe care va trebui să le introducem înainte de a invoca funcţia respectivă (în R, valorile se leagă la variabile doar în momentul execuţiei funcţiei, nu când aceasta este citită (încorporată în sesiunea de lucru)).
Fiecare clasă are cel mult 7 ore pe zi (considerăm o şcoală cu un singur schimb, sau orarul unui singur schimb). Şablonăm orarul pe ziua respectivă al unui profesor, prin biţii 0..6 ai unui integer (ai unui octet, dar în R întregii nu măsoară mai puţin de 32 de biţi); bitul de rang b=0..6 corespunde orei de rang (b+1) a zilei. Numărul de ferestre (din orarul profesorului) este dat de numărul de biţi 0 aflaţi între biţi 1:
# în stmt_utils.R h2bin <- as.integer(c(1, 2, 4, 8, 16, 32, 64)) # măştile orelor zilei cnt_holes <- function(sb) { # sb: şablonul binar al orelor profesorului bits <- which(bitwAnd(sb, h2bin) > 0) # rangurile biţilor '1' n <- length(bits) bits[n] - bits[1] + 1 - n } # Numărul de biţi '0' aflaţi între biţi '1' ("ferestre")
De regulă, operaţiile cu vectori sunt „vectorizate”: vectorul sb de lungime 1 este extins prin repetare, la lungimea celuilalt operand, h2bin şi apoi (intern) operaţia respectivă decurge „în paralel” pe componentele acestor vectori.
Am inclus cnt_holes() în fişierul "stmt_utils.R", fiindcă folosim funcţia respectivă şi în programul "daySchoolSchedule.R" – prin care am obţinut anterior, orarele zilelor, punând condiţia ca fiecare profesor să aibă zero, una sau cel mult două ferestre (dar anterior, în locul vectorului global h2bin, implicam o funcţie "where_is_one()").
Următoarea funcţie produce vectorul şabloanelor binare ale orelor profesorilor de pe orarul curent (faţă de versiunea anterioară "get_bin_patt()", am renunţat să ne bazăm pe apply() – ocolind astfel anumite „erori” sâcâitoare, specifice implementării lui apply()):
# în stmt_utils.R bin_patterns <- function(morr) { # pe matricea curentă a orelor dintr-o zi dm <- dim(morr) B <- vector("integer", dm[1]) for(i in 1:dm[1]) { byte <- 0L # "byte" este de fapt, un "integer" (32/64 biţi) for(j in 1:dm[2]) if(morr[i, j] != '-') byte <- bitwOr(byte, h2bin[j]) B[i] <- byte } names(B) <- rownames(morr) B } # şabloanele binare ale orarelor profesorilor, din matricea-orar dată
Vectorul B returnat în final este un „vector cu nume” – practic, un dicţionar având drept chei numele profesorilor şi drept valori, şabloanele binare ale orelor acestora; va fi important, că putem accesa valorile din B prin cheile acestora (cât şi prin ranguri).
Vom avea de apelat cnt_holes() şi bin_patterns() de foarte multe ori (după fiecare modificare a orarului iniţial), încât am căutat să ne folosim de orice posibilitate de a eficientiza codul; operatorul "{" reprezintă de fapt o funcţie care va returna ultima expresie evaluată în „blocul” respectiv – nu este necesar să apelăm şi "return()" (cum se recomandă pentru înlesnirea citirii codului respectiv); deasemenea, dacă „blocul” se rezumă la o singură instrucţiune (cum avem sub for(), în mai multe locuri) – atunci vom evita să mai apelăm "{".
Funcţia următoare calculează numărul total de ferestre, din vectorul şabloanelor binare asociat orarului curent:
cnt_all_gaps <- function(vsb) { # vectorul şabloanelor orare holes_cupl <- function() { ng <- 0 for(p in nTz1) # cazul celor care intră în vreun cuplaj ng <- vsb[Tz1[[p]]] %>% reduce(bitwOr, .init = vsb[p]) %>% cnt_holes(.) + ng for(s in Sbf) # ferestrele cuplajelor cu profesor fără ore proprii ng <- vsb[s] %>% reduce(., bitwOr) %>% cnt_holes(.) + ng ng } holes_cupl() + # plus ferestrele celor neimplicaţi în cuplaje sum(unlist(lapply(vsb[setdiff(names(vsb), nT12)], cnt_holes), use.names=FALSE)) }
Cel mai simplu caz (tratat direct, în final) este cel al profesorilor neimplicaţi în vreun cuplaj – deci aceia al căror nume nu figurează în vectorul global nT12 (acesta reuneşte cheile din Tz1 şi Tz2); prin lapply() am aplicat cnt_holes() pe şabloanele binare ale acestora şi am însumat (prin sum()) rezultatele.
Celelalte două cazuri sunt tratate în funcţia interioară („locală”) holes_cupl(). Pentru fiecare profesor care intră în vreun cuplaj (deci unul al cărui nume este o cheie din Tz1), se determină – prin reduce(), faţă de operaţia binară "OR" – octetul care acoperă atât şablonul binar al acelui profesor, cât şi şabloanele binare ale profesorilor fictivi care îl implică; aplicând cnt_holes() pe întregul rezultat astfel, găsim numărul de ferestre ale profesorului respectiv.
De exemplu – Tz1[["p08"]] este vectorul ("p08p11", "p08p25"); atunci, numărul de ferestre ale lui p08 este dat de numărul de biţi '0' interiori întregului rezultat prin "OR" din şabloanele binare curente pentru p08, p08p11 şi p08p25.
Cazul rămas corespunde cuplajelor cu un profesor fără ore proprii, indicate în variabila globală Sbf (rezultatul din hidden_gaps()); am dat mai sus un exemplu, pentru p34, fără ore proprii dar implicat în cuplajele p34p07 şi p34p09 (aplicând cnt_holes() întregului rezultat prin "OR" din şabloanele binare ale profesorilor fictivi p34p07 şi p34p09, obţinem numărul de ferestre ale lui p34).
Următoarea funcţie sintetizează apoi, numărul de ferestre dintr-o matrice orar dată:
count_gaps <- function(morr) morr %>% bin_patterns(.) %>% cnt_all_gaps(.)
Se cuvine poate, să precizăm că operatorul '%>%' (întâlnit deja în mai multe rânduri mai sus) transferă rezultatul evaluării expresiei din partea stângă, ca argument (indicat de obicei prin '.') al funcţiei invocate în partea dreaptă a operatorului.
Avem orarul curent sub forma unei matrice; liniile pot fi accesate prin numele profesorilor, iar pe coloane avem clasele alocate profesorilor în fiecare oră a zilei (sau '-', când profesorul este liber în acea oră). Desigur, nu avem suprapuneri (v. [1]): pe fiecare coloană, fiecare clasă apare cel mult o singură dată.
Operaţia de bază, pe care o vom folosi pentru a reduce treptat ferestrele, constă în mutarea unei clase într-o altă coloană – ceea ce implică (pentru a evita suprapunerile) mai multe schimburi de clase între cele două coloane (de-a lungul unui lanţ Kempe al grafului în care arcele unesc clase de pe o aceeaşi linie – cum am arătat anterior).
Am modelat această operaţie prin funcţia move_cls(), pe care am mai redat-o anterior; o reluăm aici, simplificând constatarea în final a eventualei apariţii de suprapuneri ascunse (posibile, dacă există cuplaje):
move_cls <- function(morr, h1, h2, ql) { L11 <- L1 <- morr[, h1] L2 <- morr[, h2] if(! (ql %in% L2 & ql %in% L1)) return(NULL) path_kempe <- function(Q) { pth <- vector("integer", 0) i <- match(Q, L1, 0L) if(i == 0L) return(NULL) pth <- c(pth, i) q <- Q repeat { i <- match(q, L2, 0L) if(i == 0L) return(NULL) pth <- c(pth, i) q <- L1[i] if(q == '-' || q == Q) break } pth } path <- path_kempe(ql) if(is.null(path)) return(NULL) ql2 <- L2[path[1]] if(ql2 != '-') { L1 <- L2; L2 <- L11 pth2 <- path_kempe(ql2) if(is.null(pth2)) return(NULL) path <- c(path, pth2) } # inversează coloanele h1 şi h2, pe liniile indicate de 'path' morr[path, c(h1, h2)] <- morr[path, c(h2, h1)] # evită suprapunerile ascunse, pe cele două coloane M <- morr[rows_Tw, c(h1, h2)] sn <- map_lgl(nTz2, function(prf) M[prf, 1] != "-" && sum(M[Tz2[[prf]], 1] != '-') > 0 || M[prf, 2] != "-" && sum(M[Tz2[[prf]], 2] != '-') > 0) if(any(sn)) return(NULL) morr }
Am „inversat” cele două coloane numai pe liniile pe care s-au produs interschimburi de clase – ceea ce ar trebui să fie mai eficient, decât angajând toate liniile matricei, cum procedam (expeditiv) anterior.
Anterior, angajam (expeditiv) o funcţie "vrf_over()", care verifica pe toate coloanele, dacă au apărut suprapuneri ascunse… Acum am corectat: trebuie verificat numai pe cele două coloane între care s-au schimbat clase.
Am selectat din matrice numai liniile corespunzătoare cuplajelor (indicate în variabila globală rows_Tw) şi numai valorile din cele două coloane; prin map_lgl(), am evidenţiat situaţia în care pe una sau alta dintre cele două coloane, apare şi o clasă cu profesor fictiv şi o clasă cu un profesor (fictiv sau nu) conexat acestuia (de exemplu, apare clasă şi la p08p25 şi la (p08p07 sau p08p11 sau p25 sau p08)) – caz în care am avea o suprapunere „ascunsă” de lecţii şi deci, mutarea propusă iniţial trebuie refuzată (returnând NULL).
În principiu, avem de corectat nişte ferestre „în masă” (nu pentru un anumit profesor), măsurând de fiecare dată numărul total de ferestre rezultat după fiecare move_cls(); continuăm procesul de corectare, plecând acum de la unul sau altul dintre orarele rezultate astfel, care are cel mai mic număr de ferestre.
Care ferestre, să încercăm să corectăm (urmărind să reducem treptat numărul acestora), pe orarul iniţial şi apoi pe orarele rezultate după fiecare move_cls()?
Pe orarul iniţial, la fiecare profesor nu avem – după "daySchoolSchedule.R" – mai mult de două ferestre (este drept că unele excepţii au putut apărea, prin execuţia ulterioară a programului de eliminare a eventualelor suprapuneri ascunse – "correct.R" din [3]).
Este firesc atunci, să ne rezumăm la ferestrele de câte o singură oră şi la cele de câte două ore (consecutive sau nu).
Din vectorul şabloanelor binare asociat matricei-orar curente (referit de data aceasta prin indecşi, nu prin nume), selectăm valorile care au între biţi '1' fie un singur bit '0', fie doi biţi '0' – acestea corespund acelor profesori care au una sau două ferestre.
Pentru fiecare dintre şabloanele binare selectate, determinăm poziţia bitului (sau celor doi biţi) '0' şi generăm „mutări de corectare” corespunzătoare; de exemplu, pentru şablonul "110111" înregistrăm două mutări de corectare a ferestrei existente în ora a 4-a (pe un şablon binar numărăm de la dreapta spre stânga), anume: (1, 4, cls1) şi (6, 4, cls2), prin care clasa 'cls1' va fi mutată din prima coloană în a 4-a, respectiv clasa 'cls2' va fi mutată din a 6-a coloană în coloana a 4-a (ocupând astfel, locul liber existent între orele profesorului căruia îi corespunde şablonul considerat – noul şablon fiind fie '111110', fie '11111').
Pe lângă mutările claselor extreme pe locul liber, exemplificate mai sus – pentru unele şabloane putem considera şi o a treia mutare de corectare; de exemplu, pentru '11010' putem adăuga (2, 6, cls) – mutând clasa din ora a 2-a nu pe locul liber din a 3-a oră, ci după clasa existentă în ora a 5-a.
Următoarea funcţie produce tabelul de mutări corectoare, pentru un orar dat:
cover_gaps <- function(morr) { binp <- bin_patterns(morr) # indecşii liniilor pe care avem una sau două ferestre B <- which(unlist(lapply(binp, cnt_holes), use.names=FALSE) %in% c(1, 2)) if(!length(B)) return(NULL) # alte cazuri (0 sau mai mult de 2 ferestre;) lh1 <- lh2 <- vector("integer", 0) lql <- vector("character", 0) for(id in B) { pt <- which(bitwAnd(binp[id], h2bin) > 0) n <- length(pt) H1 <- pt[1] Hn <- pt[n] cls <- morr[id, ] igp <- which(cls == '-') # indecşii ferestrelor din şablonul curent igp <- igp[igp > H1 & igp < Hn] lh1 <- c(lh1, c(H1, Hn)) # mutările claselor extreme pe locul liber lh2 <- c(lh2, c(igp[1], igp[1])) lql <- c(lql, c(cls[H1],cls[Hn])) if(length(igp) == 1) { # mutare într-un anumit caz de fereastră unică if(igp[1] == H1 + 1L & Hn < Hmax) { 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 { # mutări pentru cazul a două ferestre lh1 <- c(lh1, c(H1, Hn)) lh2 <- c(lh2, c(igp[2], igp[2])) lql <- c(lql, c(cls[H1], cls[Hn])) } } data.frame(h1 = lh1, h2 = lh2, ql = lql) }
Faţă de versiunea anterioară, am procedat mai simplu (renunţând şi la funcţia „locală” cover(), pe care o aplicam în final, prin map_df(), vectorului de şabloane binare care conţin măcar o fereastră) – dar probabil că nu cel mai simplu, cum am dori având în vedere că vom avea de apelat cover_gaps() de foarte multe ori (pentru fiecare nouă matrice-orar pe care vom relua reducerea de ferestre).
Putem muta o clasă între două coloane, dacă acea clasă figurează în ambele coloane (adică exceptăm aducerea unei clase pe o coloană de rang mai mare decât numărul de ore ale clasei). Mutând o clasă oarecare, dintr-o coloană în alta, rezultă o nouă matrice orar – cu mai multe sau cu mai puţine ferestre şi cu altă gamă de mutări corectoare; dacă au rezultat mai puţine ferestre faţă de orarul iniţial, atunci vom putea continua procesul de reducere treptată a numărului de ferestre, plecând acum de la orarul obţinut prin mutarea respectivă.
Următoarea funcţie aplică pe rând orarului indicat, toate mutările corectoare furnizate de cover_gaps() pentru acel orar, măsurând prin count_gaps() numărul de ferestre rezultat după fiecare mutare; în final, se alege la întâmplare, unul dintre orarele cu cel mai mic număr de ferestre (pe care vom continua apoi, procesul de reducere a numărului de ferestre):
choose_next <- function(mxt) { # 'mxt': orarul rezultat după mutarea unei clase swp <- cover_gaps(mxt) # lista reparaţiilor „standard” de ferestre if(is.null(swp)) return(NULL) ng <- map_dbl(1:nrow(swp), function(i) { mor <- move_cls(mxt, swp[i,1], swp[i,2], swp[i,3]) if(is.null(mor)) return(100) count_gaps(mor) }) m <- min(ng) if(m == 100) return(NULL) mi <- which(ng == m, useNames = FALSE) i <- sample.int(length(mi), 1) im <- mi[i] list(move_cls(mxt, swp[im,1], swp[im,2], swp[im,3]), ng[im]) }
Faţă de anteriorul "choose_min()", am renunţat să folosim ifelse(is.null(mor), 100, count_gaps(mor)) – cu if() avem (în cazul de faţă) o execuţie sensibil mai rapidă. Dar deosebirea importantă constă în alegerea aleatorie din final – astfel, la fiecare nouă execuţie a programului vom obţine un orar diferit de cel rezultat într-o execuţie anterioară, poate mai „bun” (printr-o primă execuţie obţinem un orar cu 6 ferestre – la o a doua execuţie rezultă un orar cu 4 ferestre; sau… invers); n-avem decât să reţinem rezultatele şi să alegem apoi, pe cel mai convenabil.
Regizăm trecerea de la un orar la altul (principial, cu mai puţine ferestre) în acest fel:
recast <- function(mxt) { # 'mxt' este orarul iniţial r1 <- r2 <- 0 # contorizează anumite oscilaţii ale numărului de ferestre repeat { Lmxt <- choose_next(mxt) # alege o mutare corectoare, pe orarul curent if(is.null(Lmxt)) break mxt <- Lmxt[[1]] # de-acum, 'mxt' este noul orar (după mutarea curentă) NG2 <- Lmxt[[2]] if(NG2 < NG1) { # NG1 reţine global, cel mai mic număr de ferestre NG1 <<- NG2 # ; cat(NG1, " ") break # returnează orarul curent, dacă are mai puţine ferestre } else { # altfel, reia alegerea mutării corectoare, după caz: if(NG2 == NG1) { r1 <- r1 + 1 if(r1 == 4) break # la repetarea de 4 ori a numărului de ferestre } else { r2 <- r2 + 1 if(r2 == 6) break # la 6 repetări cu număr mărit de ferestre } } } mxt # un orar cu mai puţine ferestre (de regulă) }
Inserând cat(), se va putea urmări cum se desfăşoară lucrurile evidenţiate prin liniile de comentariu (şi marcări sintactice) strecurate în redarea de mai sus a funcţiei.
Devansând puţin – lucrurile se desfăşoară cam aşa:
> source("recast.R") [1] 07:57:03 # timpul iniţial [1] 32 # numărul ferestrelor din orarul iniţial (NG1 = 32) [1] *** # prima încercare de recast() 29 27 26 25 24 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 # NG1 curent = 6 [1] *** # încercare de reducere şi mai mare (eşuată) [1] *** # a treia încercare, reuşită: au rămas 4 ferestre 5 4 [1] 4 [1] 08:11:07 # timpul final
Am plecat de la un orar care avea 32 de ferestre; prin recast(), după aplicarea unei anumite mutări corectoare, a rezultat un orar cu 29 de ferestre; aplicând şi acestuia, o anumită mutare din lista sa de mutări corectoare – a rezultat un orar cu 27 de ferestre; ş.a.m.d.
În final, după un anumit număr de iteraţii, s-a găsit un orar cu numai 6 ferestre (care desigur, diferă faţă de orarul iniţial numai prin ordinea orelor profesorilor). Încercarea de a reduce şi mai mult numărul de ferestre (bazată pe faptul că NG1 păstrează global numărul minim curent de ferestre), întâi a eşuat, apoi la următoarea încercare a reuşit – rezultând în final (după, în total, 4 minute) un orar cu numai 4 ferestre.
Experimentând, am constatat că rezultatele cele mai bune se obţin nu plecând de la setul de mutări corectoare constituit pentru orarul curent, ci plecând pe un drum mai ocolit: întâi facem o mutare oarecare de clasă şi abia apoi, pe orarul rezultat, angajăm lista mutărilor corectoare; putem genera astfel mult mai multe orare, decât dacă plecam direct de la mutările corectoare ale orarului iniţial – crescând astfel, şansele de a găsi un orar cu cât mai puţine ferestre.
Substratul acestei idei este următoarea aserţiune (plauzibilă): există o clasă pentru care mutarea ei într-o altă coloană conduce la un orar cu mai puţine ferestre; dar nu vedem cum am putea depista clasa şi coloana, încât lăsăm alegerea acestora în seama unui generator de valori aleatorii (sau „în seama calculatorului”).
Alegem la întâmplare o clasă (din vectorul global Cls) şi tot la întâmplare, două coloane (asigurându-ne că ambele, conţin clasa respectivă); schimbăm clasa între cele două coloane – repetând alegerile menţionate, dacă mutarea nu reuşeşte – şi pe orarul rezultat aplicăm recast() (şi returnăm rezultatul):
gen_rand_tmt <- function(morr) { repeat { ql <- sample(Cls, size = 1) # alege aleatoriu o clasă repeat { h12 <- Cmb[, sample(ncol(Cmb), 1)] # două coloane conţinând clasa if(ql %in% morr[, h12[1]] & ql %in% morr[, h12[2]]) break } mor <- move_cls(morr, h12[1], h12[2], ql) if(!is.null(mor)) break # orar cu schimbarea între coloane a clasei alese } recast(mor) # aplică mutări corectoare, reducând numărul ferestrelor }
Adoptăm orarul returnat în final, dacă are mai puţine ferestre decât precedentul; altfel (probabil, cel mai adesea) reapelăm gen_rand_tmt(), repetând până când numărul de ferestre se stabilizează la o anumită valoare (şi dacă numărul de repetări este suficient de mare, putem spera ca această valoare să fie acceptabil de mică):
search_better <- function(mxt, Niter = 5000, GD = Good) { ng <- NG <- count_gaps(mxt) if(ng <= GD) return(mxt) while(ng > GD) { Best <- mxt ng <- NG # print("***", quote=FALSE) repeat { for(i in 1:Niter) { Si <- gen_rand_tmt(Best) # derivează aleatoriu un "nou" orar ngi <- count_gaps(Si) # ; cat(ngi, " ") if(ngi <= ng) { # acceptă, dacă nu-s mai multe ferestre Best <- Si ng <- ngi } } if(ng == ngi || ng <= GD) # Best n-a mai putut fi îmbunat (sau ng <= GD) break # reia de la capăt (reiniţializând Best cu 'mxt', dacă ng > GD) } } Best }
Valoarea globală Good – indicată iniţial în parametrul 'GD' – precizează cumva, numărul aşteptat de ferestre, pentru orarul returnat în final; am ales rezonabil, 5% din totalul orelor claselor, pe ziua curentă – dar dacă nu s-au epuizat cele Niter iteraţii, atunci reducerea de ferestre va continua şi dincolo de această limită; de exemplu, pentru 167 de ore ale claselor, avem Good=8, iar limita de 8 ferestre se atinge eventual după 1000 de iteraţii, încât dacă Niter a fost fixat la 2000 să zicem, atunci vom putea ajunge eventual, la un orar cu numai 4 ferestre (pe de altă parte, putem fixa direct în GD, valoarea 5, sau chiar 4, în loc de Good).
Într-un anumit fişier avem orarele zilelor (obţinute prin programele anterioare daySchoolSchedule.R şi correct.R), sub forma unor matrici-orar pe clase; instituim o listă RC în care să obţinem folosind cele de mai sus, variante cu număr redus de ferestre, ale orarelor respective:
l5mo <- readRDS("correct.RDS") # matricele-orar după clase, ale zilelor Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi") RC <- vector("list", 5) # va înregistra orarele, după reducerea ferestrelor names(RC) <- Zile prnTime() # va afişa timpul curent
O „matrice-orar după clase” are liniile indexate (sau denumite) după clase şi indică pe fiecare linie, profesorii şi eventual cuplurile care intră la clasele respective în fiecare oră 1..7 a zilei (forma lăsată de correct.R pentru orarele pe care le produce):
> print.table(l5mo[[1]]) # ziua "Lu" 1 2 3 4 5 6 7 10A p01p02 p36 p12 p14 p13 p21 p15 10B p32 p22 p09 p18 p05 p15 - 10C p07 p38 p05 p25 p35 p16 - 10D p31 p12 p16 p09 p21 p19 - 10E p46 p28 p34p07 p39 p03 p27 p04 10F p03 p06p33 p45 p11 p20 p35 - 11A p25 p23 p35 p40 p01 p20 - 11B p28 p01p02 p13 p05 p02 p12 - 11C p30 p31 p28 p17 p18 - - 11D p27 p10 p04 p02 p58 - - 11E p26 p11p44 p10 p03 p09 - - 11F p14 p25 p23 p06 p26 p09 - 12A p36 p30 p01p02 p01 p17 p04 - 12B p22 p24 p30 p16 p29 p17 - 12C p29 p18 p42 p23 p19 p07 - 12D p49 p27 p08 p22 p15 - - 12E p08p47 p15 p19 p21 p08p25 p08p11 - 12F p12 p20 p06 p04 p07 p26 - 5G p45 p46 p17 p56 p04 p06 - 6G p24 p42 p56 p08 p45 p50 - 7G p62 p40 p21 p32 p24 p33 - 8G p61 p14 p20 p13 p46 p56 p05 9A p05 p32 p24 p36 p14 p02 - 9B p16 p03 p31 p10 p11 p22 - 9C p06p33 p37 p11 p07 p10 p03 - 9D p18 p29 p26 p19 p33 p39 - 9E p38 p34p09 p03 p27 p39 p13 - 9F p37 p08 p33 p45 p23 p10 -
Prin funcţiile din [3] (introduse în stmt_utils.R), ere_matrix() şi to_table(), transformăm matricele-orar pe clase în matrice-orar pe profesori; între timp, am extins to_table() astfel încât (dar numai pentru lizibilitate) liniile matricei-orar pe profesori să fie ordonate după cuplaje şi apoi, alfabetic.
Pentru fiecare zi, constituim variabilele globale necesare şi lansăm search_better(), alegând ca Niter 2000 şi ca GD 5; în final, afişăm timpul curent şi salvăm rezultatul:
for(z in 1:5) { Z <- to_table(l5mo[[z]]) # orarul iniţial al zilei curente profz <- unlist(unique(Z$prof)) # prof. (şi cei fictivi) pe ziua curentă Tz1 <- twin_day(Tw1, profz) Tz2 <- twin_day(Tw2, profz) nTz1 <- names(Tz1); nTz2 <- names(Tz2) Sbf <- hidden_gaps() # cuplajele cu profesor fără ore proprii MOP <- as.matrix(Z[, 2:ncol(Z)]) # matricea orelor profesorilor row.names(MOP) <- Z$prof nT12 <- union(nTz1, nTz2) rows_Tw <- rownames(MOP) %in% nT12 # selector pentru submatricea cuplajelor Hmax <- ncol(MOP) # nr. maxim de ore ale unei clase, în ziua respectivă Good <- sum(MOP != '-') / 100 * 5 # nr. aşteptat de ferestre, pe ziua curentă Cmb <- combn(Hmax, 2) # combinările de două coloane ale matricei curente NG1 <- count_gaps(MOP) # numărul iniţial de ferestre print(NG1) # numărul iniţial de ferestre W <- search_better(MOP, 2000, 5) # a reduce la cel mult 5 ferestre print(count_gaps(W)) prnTime() RC[[Zile[z]]] <- W # salvează orarul rezultat } save(RC, file="RC-10dec.RDS") # încheie "recast.R"
Redăm o mostră de execuţie a programului (bineînţeles că afişările intermediare de valori ne-au servit doar pentru a urmări cât de cât, mersul programului):
> source("recast.R") [1] 16:08:27 [1] 32 # ferestre iniţiale, în prima zi [1] *** 31 28 27 26 25 24 23 22 21 20 19 18 16 15 14 11 10 9 8 7 [1] *** 6 5 [1] 5 # ferestre rămase după reducere [1] 16:18:22 # timpul consumat de reducere: 10 min. [1] 37 # ferestre iniţiale în a 2-a zi [1] *** 35 34 33 32 31 30 29 28 26 25 24 23 22 21 19 18 17 16 15 14 13 11 10 9 8 7 5 4 3 [1] 3 # rămase după reducere [1] 16:23:06 # timpul consumat de reducere: 5 min. [1] 27 # ferestre iniţiale, ziua 3 [1] *** 25 24 23 22 21 20 19 18 17 15 14 13 12 11 10 9 6 5 [1] 5 # rămase după reducere [1] 16:28:33 # timpul consumat de reducere: 5 min. [1] 22 # ferestre iniţiale, ziua 4 [1] *** 19 17 16 15 14 13 11 9 8 7 6 5 4 [1] 4 # după reducere [1] 16:32:40 # timpul consumat de reducere: 4 min. [1] 37 # ferestre iniţiale, ziua 5 [1] *** 36 34 33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 [1] 4 # rămase [1] 16:38:22 # timpul consumat de reducere: 6 min.
În total, execuţia a durat 30 de minute – infim, faţă de cât ne lua procedeul „manual” anterior, prin aplicaţia interactivă dayRecast.html; durata medie de 5-6 minute pentru o zi, s-a menţinut într-un număr de reexecutări independente ale programului.
Fiecare nouă executare a programului produce pentru fiecare zi (presupunând totuşi, un număr rezonabil de repetări), un orar care diferă măcar în câteva locuri, de orarul obţinut într-o execuţie anterioară (cum era de aşteptat, dat fiind că programul mizează pe câteva elemente aleatorii). Bineînţeles că putem alege din diverse execuţii orarul câte unei anumite zile, sau putem rula repetat numai pentru o anumită zi (sau putem rula programul pe mai multe calculatoare, simultan); extrăgând din execuţii repetate, am putut obţine (pentru cazul de faţă) un set de orare zilnice care au câte numai 3 ferestre (câte una, la 3 profesori), exceptând o singură zi – aceea cu matricea-orar pe clase redată mai sus – pe care au rămas totuşi 4 ferestre (iniţial erau 32 de ferestre):
> print.table(RC[[1]]) # ziua "Lu" 1 2 3 4 5 6 7 p01 - - - - 12A 11A - # 1 (ora a 4-a) p01p02 11B 10A 12A - - - - p02 - - - 11D 11B 9A - p06 - 5G - - 11F 12F - # nu are ferestre, fiind cuplat prin "p06p33" p06p33 - - 10F 9C - - - p33 - 9D - - 7G 9F - # nu are ferestre, fiind cuplat prin "p06p33" p08 - 12D - - 9F 6G - p08p11 - - - 12E - - - p08p25 - - 12E - - - - p08p47 12E - - - - - - p11 10F 9B - - - 9C - # 1 (ora a 3-a) p11p44 - - - - 11E - - p25 11A 11F - 10C - - - # nu are fereastră, fiind cuplat prin "p08p25" p07 10C 12F 9C 12C - - - p34p07 - - - - 10E - - p09 - 10B 11E 11F 10D - - p34p09 - - - - - 9E - # p34 intră numai în cuplaj, orele 5 şi 6 p03 9B 9E 10E 11E 9C 10F - # urmează (alfabetic) cei neimplicaţi în cuplaje p04 12A 11D 12F 10E 5G - - p05 10B 11B 10C 8G 9A - - p10 11E 9C 11D 9F 9B - - p12 - - 10D 11B 12F 10A - p13 - - 10A 9E 8G 11B - p14 11F 8G - 9A 10A - - # 1 (ora a 3-a) p15 - - - 10B 12D 12E 10A p16 - 12B - 9B 10C 10D - # 1 (ora a 3-a) p17 - - 11C 5G 12B 12A - p18 - - 12C 11C 9D 10B - p19 - - 9D 10D 12E 12C - p20 - - 11A 12F 10F 8G - p21 10D 12E 7G 10A - - - p22 - - 12D 12B 10B 9B - p23 - - 9F 11A 12C 11F - p24 12B 9A 6G 7G - - - p26 12F 11E 11F 9D - - - p27 - - 9E 12D 11D 10E - p28 10E 11C 11B - - - - p29 9D 12C 12B - - - - p30 - - - 12A 11C 12B - p31 11C 10D 9B - - - - p32 9A 7G 10B - - - - p35 - - - 10F 11A 10C - p36 10A 12A 9A - - - - p37 9C 9F - - - - - p38 9E 10C - - - - - p39 - - - - 9E 9D 10E p40 7G 11A - - - - - p42 12C 6G - - - - - p45 9F 10F 5G 6G - - - p46 5G 10E 8G - - - - p49 12D - - - - - - p50 6G - - - - - - p56 - - - - 6G 5G 8G p58 11D - - - - - - p61 8G - - - - - - p62 - - - - - 7G -
Dar ce-ar zice oare, profesorii noştri (p01, p02, ş.a.m.d.) – e bun orarul, sau nu? De obicei, fiecare apreciază prin prisma propriilor interese.
Răspunsul ar trebui să depindă de principii, nu de indivizi şi de nazuri (mascate pompos prin „soft constraints”, în diverse lucrări asupra "timetable problem"); putem încă înţelege (dar nu credem) că 4 ferestre pe zi este prea mult (am vrea desigur, orare cu zero ferestre) – dar cerinţe de genul "p35 trebuie să aibă orele numai de la ora 8 la ora 11" (şi nu ultimele ore, cum apare în orar) ţin nu de principii juste, ci numai de nazuri individuale (şi important desigur, de „vezi că aşa a zis şefu'”).
Chiar n-ar trebui permise, presiuni asupra programului (programatorului), pentru a ţine seama de asemenea artificii; ar fi de ţinut partea unui principiu de bază pentru orice dezvoltare: "as simple as possible, but not simpler".
vezi Cărţile mele (de programare)