[1] Orarul unei şcoli cu două schimburi, folosind R
[2] Constraint programming approach for school timetabling,
Christos Valouxis, Efthymios Housos (Computers & Operations Research, 2003)
În româneşte nu avem referiri, dar de peste 50 de ani "School Timetable Problem" provoacă şi generează numeroase lucrări de doctorat şi articole în reviste ştiinţifice importante (v. de exemplu A Survey of Automated Timetabling şi de exemplu, [2]).
Cam peste tot, STP apare ca problemă combinatorială de căutare şi optimizare, servind concretizării şi dezvoltării multor teorii, tehnici şi euristici care au adus câştiguri importante pentru matematică, informatică şi programare.
Obs. Bineînţeles, au avut de câştigat şi firmele de software comercial – cu efectul lateral de capcană: fiindcă acum oricine poate face orarul şcolii (folosind ascTimetables), fără să ştie nimic despre "STP" (după cum poate face atâtea şi atâtea altele fără să ştie cine ştie ce), apare ca fiind inutil să mai înveţi ceva – „câştigul” devenind cu timpul (nu numai la noi, dar şi în „lumea a treia”), profilarea pe microsoftizare şi dresare funţionărească, a învăţământului informatic actual (procură, instalează, click pe cutare butoane/meniuri/iconiţe).
În principiu (cam peste tot), STP constă în a repartiza anumite „resurse” (tupluri de profesori, grupuri de elevi, săli de clasă) pe anumite „sloturi de timp” – cupluri (Zi, Oră), de exemplu (Tuesday, 9.00-9.50) – astfel încât să se evite suprapunerile şi să fie satisfăcute anumite preferinţe iniţiale.
Noi vom fi avut norocul de a ne ocupa de orarul şcolii mult înainte de a avea acces la articole ştiinţifice, sau la aplicaţii precum "ascTimetables" (v. Momente ale problemei orarului); nu ne-a dat prin cap să considerăm „sloturi” (Zi, Oră) – dimpotrivă, ni s-a părut firesc să vizăm separat zilele de lucru şi respectiv, orele unei zile (dar este adevărat probabil, că numai cuplându-le, în loc de a le separa, se poate ţine seama de toate condiţiile imaginabile (dacă dispunem de timp)).
Orarul şcolar implică 5 variabile: obiect (materiile şcolare de parcurs), profesor (cei meniţi să asigure parcurgerea materiilor), clasă (grupează câte un anumit număr de elevi ai şcolii), zi a săptămânii şi oră din zi; orarul alocă pentru fiecare profesor, câte o zi şi câte o oră din acea zi, în care acesta să intre la una sau alta dintre clasele care i-au fost repartizate, pentru a parcurge la aceste clase materia pe care este încadrat (pe un număr de ore precizat) în acea şcoală.
Profesorii sunt daţi, împreună cu clasele (şi obiectele) pe care sunt încadraţi – constituind în fond un „set de date”, care se poate organiza şi extinde după cum ne convine; variabilele „libere” sunt ziua şi ora, iar acestea trebuie alocate în aşa fel încât să se evite suprapunerile (doi profesori nu pot intra simultan, la o aceeaşi clasă).
Fiind vorba de două variabile libere, vedem două etape distincte (şi în principiu, independente): mai întâi distribuim orele profesorilor pe zilele de lucru (cu eventuală ajustare finală), apoi – distribuim lecţiile repartizate într-o aceeaşi zi, pe intervalele orare ale zilei (iarăşi, cu ajustare finală).
Am arătat deja în câteva articole (v. [1]) că, folosind metodele de lucru cu seturi de date din limbajul R, putem modela şi concis şi suficient de eficient, cele două etape menţionate. Dar anterior, am ignorat unele situaţii (de exemplu cea reflectată în [2], în care avem profesori care la cel puţin două clase au câte două ore într-o aceeaşi zi) şi pe de altă parte, nu am avut în vedere nicio condiţie de limitare a numărului de ferestre; arătăm mai jos cum am îndreptat aceste lipsuri, rescriind programul de repartizare pe orele 1..7 a lecţiilor programate pentru ziua respectivă.
Pentru ceva ilustrări se folosesc de obicei seturi mici de date; de exemplu în [2] este vizată o şcoală cu 17 profesori şi 6 clase, cu o încărcătură săptămânală de 202 ore. Noi ne-am luat obiceiul să angajăm date reale, pentru teste şi puneri la punct; am ales o încadrare a profesorilor pe care am mai vizat-o anterior: o şcoală cu 76 de profesori şi 41 de clase (funcţionând într-un singur schimb), cu un total săptămânal de 1202 lecţii. Prin programul distribute_by_days.R (v. [1]) am obţinut o repartizare pe zile destul de echilibrată a celor 1202 ore şi avem în final, într-un anumit subdirector, 5 fişiere CSV care indică pentru câte o zi, clasele repartizate fiecărui profesor în ziua respectivă (cu un total zilnic de 240 sau 241 de ore).
Bineînţeles că putem viza la fel de bine datele din [2], sau din oricare altă şcoală – punând într-un anumit subdirector fişierele CSV aferente unei repartizări pe zile a încadrării profesorilor din acea şcoală. Ca să scurtăm exprimarea, vom zice lecţie pentru un cuplu (profesor, clasă) oarecare al zilei respective.
În fişierul "schedulesDay.R" vom constitui câteva funcţii „utilitare” ajutătoare şi apoi vom rescrie funcţia principală mountHtoDay() din [1]:
# schedulesDay.R library(tidyverse)
În final, schedulesDay.R va cumula cam 100-130 linii de cod-sursă.
Facem o convenţie (dar uşor de respectat): fie perDiem/ subdirectorul în care am plasat fişierele – fie "day{1-5}Lessons.CSV" – care înregistrează repartizarea pe câte o zi a încadrării profesorilor. Într-un astfel de fişier CSV, fiecare linie conţine două câmpuri: profesorul şi respectiv, clasele care îi sunt repartizate în acea zi:
prof, clase P01, 11A 11A 12A 6D
Ceea ce dorim este un „tabel” – obiect tibble, în „dialectul” tidyverse – în care fiecare linie consemnează câte o lecţie (în ordinea profesorilor):
prof cls P01 11A P01 11A P01 12A P01 6D
Anexând ulterior o coloană ora (cu valori potrivite pe fiecare linie), acest tabel va deveni un orar posibil pentru ziua respectivă.
Următoarea funcţie (cu elemente întâlnite deja în mai multe programe prezentate anterior) transformă fişierul CSV al unei zile în obiectul tibble dorit mai sus:
csv2tidy <- function(iDay, path="perDiem/") { nameCSV <- paste0(path, "day", iDay, "Lessons.CSV") str2vec <- function(Txt) unlist(strsplit(Txt, " ")) read_csv(nameCSV, col_types = "cc") %>% mutate(ncl = unlist(lapply(.$clase, function(q) length(str2vec(q))))) %>% uncount(.$ncl) %>% split(., .$clase) %>% map_df(., function(G) data.frame(prof = G$prof, cls = str2vec(G$clase[1])) ) %>% as_tibble() }
De două lucruri vom avea nevoie, ca să putem nimeri valori potrivite în coloana intenţionată ora: o anumită ordine, oarecum fixată, a profesorilor şi un mod de a ţine evidenţa valorilor deja plasate în coloana ora. Prin următoarea funcţie transformăm coloana prof în factor ordonat şi anexăm un vector în care fiecare octet component indică pe biţi valorile din coloana ora plasate până la „momentul curent” pe liniile asociate câte unuia dintre profesori:
setProfBits <- function(tbPrCl, FUN = profOrder) { task <- tbPrCl %>% mutate(prof = factor(prof, levels=FUN(prof), ordered=TRUE)) %>% arrange(prof, cls) hBits <- rep(0L, nlevels(task$prof)) # alocările de ore (biţi) la profesori names(hBits) <- levels(task$prof) list(task, hBits) }
Ordinea în care vom începe să completăm valorile din coloana intenţionată ora este foarte importantă; putem începe cu profesorii care în ziua respectivă au cel mai mare număr de ore, sau invers, cu aceia care au mai puţine ore; sau putem grupa profesorii după numărul de clase comune, sau poate după vreun alt criteriu. În toate cazurile, avem de scris o funcţie care să furnizeze profesorii în ordinea dorită şi de indicat această funcţie în argumentul FUN din apelul setProfBits(); noi am indicat sample() – angajând profesorii într-o ordine aleatorie, plecând totuşi de la ordinea dată de numărul de ore ale profesorului în ziua respectivă:
profOrder <- function(v_prof) { sample(names(sort(table(v_prof)))) }
Ar fi de văzut cumva corelaţiile dintre ordinea profesorilor şi ordinea în care vom itera clasele; introducem o funcţie în care fie specificăm direct vectorul claselor, în ordinea dorită, fie specificăm o modalitate anumită de ordonare a vectorului claselor (aici, ordonăm aleatoriu):
clsOrder <- function(v_cls) { sample(v_cls) # c("11D", "8F", "8E", "11C", ...) }
A doua componentă a obiectului list returnat de setProfBits() este un „vector cu nume”, prin care fiecărui profesor (în ordinea asigurată de funcţia indicată în argumentul FUN) i se asociază un octet în care bitul de rang k=0..6 va fi setat imediat ce profesorului respectiv i s-a alocat la o anumită clasă, ora a (k+1)-a din ziua respectivă. Vom avea nevoie de câteva funcţii prin care să controlăm ferestrele (biţi '0' aflaţi între biţi '1') apărute pe parcurs.
Următoarea funcţie furnizează numărul de biţi '1' dintr-un întreg:
bit_count <- function(v) { nb1 <- 0 while(v > 0) { nb1 <- nb1 + bitwAnd(v, 1) v <- bitwShiftR(v, 1) } nb1 }
Următoarea funcţie returnează numărul de blocuri care nu conţin '0', dintr-un octet (sau "integer"); dacă rezultatul este 1, atunci vom şti că profesorul căruia îi aparţine octetul respectiv nu are ferestre, iar dacă rezultatul este 2 atunci avem una sau mai multe ferestre consecutive:
block_count <- function(v) { bit_count(bitwXor(v, bitwShiftR(v, 1))) %/% 2 + bitwAnd(v, 1) }
În sfârşit, numărul de ferestre (biţi '0' între blocuri de biţi '1') este dat de funcţia:
H17 <- as.integer(c(1, 2, 4, 8, 16, 32, 64)) # măştile binare ale orelor 1..7 holes <- function(v) { nh <- 0 for(f in H17) if(bitwAnd(v, f) > 0) break; for(l in rev(H17)) if(bitwAnd(v, l) > 0) break; f <- which(H17 == f) l <- which(H17 == l) if(l == f) return(0) for(i in f:l) if(bitwAnd(v, H17[i]) == 0) nh <- nh + 1 nh }
Un orar cu zero ferestre – dacă este posibil – va fi laborios de generat; vom exclude totuşi situaţia în care un profesor ar avea mai mult de două ferestre – cerând ca rezultatele holes() să nu depăşească 2 – şi mai mult, vom cere ca în cazul când apar două ferestre, acestea să fie consecutive (impunând rezultatelor block_count() să nu depăşească valoarea 2).
Dacă o clasă are 4 ore în ziua respectivă, atunci acestea pot fi plasate în orar în 4*3*2=24 de moduri, corespunzător permutărilor de 4 elemente; analog, pentru clase cu 5..7 ore. Din [1] avem lista matricelor de permutări pentru 4..7 ore:
Pore <- readRDS("lstPerm47.RDS") # lista matricelor de permutări (de 4..7 ore)
Fie K grupul de linii din tabelul prof/cls al lecţiilor unei clase oarecare; K are ko=4..7 linii, reprezentând lecţiile din acea zi ale clasei. Vom eticheta liniile respective printr-o permutare oarecare a valorilor 1..ko (extrasă din matricea Pore[[ko-3]]), înscrisă pe o coloană ora anexată lui K.
Această alocare pe orele zilei a liniilor din K poate să inducă un conflict cu alocarea făcută anterior unei alte clase – în cazul când clasele au un profesor comun şi acestuia i s-a alocat o aceeaşi oră din zi, în ambele coloane ora; în acest caz, înscriem pe coloana ora a clasei curente K o altă permutare a valorilor 1..ko şi repetăm până când conflictul este eliminat (şi vom putea trece mai departe, pe rând, la celelalte clase).
Se vede acum, la ce ne foloseşte vectorul de „octeţi de alocare” asociat prin setProfBits(): ne va permite să constatăm dacă etichetarea ora pentru clasa curentă K intră sau nu în conflict cu etichetările efectuate anterior pe alte clase, pentru profesorii comuni acestora.
Ceea ce angajăm în spatele acestui proces de etichetare este următorul postulat: există o ordine (şi nu doar una!) de abordare a claselor (şi a profesorilor), pentru care etichetarea prin ora a lecţiilor respective decurge fără coliziuni (cel puţin, pentru cazul când nu ne-am propune să controlăm prea strict numărul şi poziţia ferestrelor).
Dacă pentru clasa curentă K nu găsim o permutare 1..ko care să nu se suprapună unor etichetări anterioare, atunci pur şi simplu stopăm procesul curent de etichetare, curăţăm octeţii de alocare, reordonăm clasele (aleatoriu, sau eventual după vreun anumit criteriu) şi lansăm din nou procesul de etichetare; în baza postulatului menţionat, avem şanse destule de a nimeri o asemenea ordine a claselor în care etichetarea dorită să decurgă fără conflict.
NTRY <- 0 # pentru a contoriza eventual (global), încercările făcute pe parcurs mountHtoDay <- function(Z) { # tibble <ord>prof|cls, split()-at pe clase mountHtoCls <- function(Q) { # alocă pe 1..7, lecţiile unei clase mpr <- Pore[[nrow(Q)-3]] # matricea de permutări corespunzătoare clasei bhp <- bith[Q$prof] # biţii alocaţi anterior, profesorilor clasei for(i in 1:ncol(mpr)) { po <- mpr[, i] bis <- bitwShiftL(1, po - 1) if(any(bitwAnd(bhp, bis) > 0)) next # caută o permutare care să evite biţi '1' alocaţi deja # Dacă un profesor are 2 sau mai multe ore pe zi, # la una sau la mai multe clase: for(jn in 1:(nrow(Q)-1)) { if(names(bhp)[jn] == names(bhp)[jn+1]) bis[jn] <- bis[jn+1] <- bis[jn] + bis[jn+1] } blks <- bitwOr(bhp, bis) # cumulează biţii vechilor şi noii alocări Cond1 <- unlist(lapply(blks, holes)) if(any(Cond1 > 2)) next # controlează numărul de ferestre Cond2 <- unlist(lapply(blks, block_count)) if(any(Cond2 > 2)) next # controlează dispoziţia ferestrelor # actualizează global, octeţii de alocare: bith[Q$prof] <<- blks # cat("*") # cat(Q$cls[1], " ") return(Q %>% mutate(ora = po)) # înscrie orarul clasei curente } return(NULL) # pentru clasa curentă NU s-a reuşit un orar } while(TRUE) { # partea principală a funcţiei mountHtoDay() succ <- TRUE bith <- Bits # reiniţializează octeţii de alocare pe orele zilei lstCls <- clsOrder(names(Z)) # ordonează/reordonează lista claselor odf <- data.frame() # va reuni orarele claselor for(K in lstCls) { W <- mountHtoCls(Z[[K]]) # încearcă un orar pe clasa curentă if(is.null(W)) { succ <- FALSE # cat("/") ## semnalează încercările eşuate NTRY <<- NTRY + 1 # contorizează eventual, încercările break # abandonează în caz de insucces } odf <- rbind(odf, W) # alipeşte orarul clasei curente } if(succ) break } return(list(odf, bith)) # orarul zilei (prof|cls|ora) şi biţii profesorilor }
Confruntând de sus în jos cu programul iniţial (v. [1]), putem constata aceste diferenţe (avantajoase): am evitat să implicăm o copie suplimentară S a clasei curente Q (folosim direct coloanele po ale matricei de permutări, în loc de S$ora); am reuşit să tratăm direct (eliminând anyDuplicated()) situaţia în care un profesor are două sau mai multe ore la una sau la mai multe clase; am inclus un control asupra numărului şi poziţiei ferestrelor; am tratat într-un "for" (cu break şi rbind()), etichetarea succesivă mountHtoCls() (prin map_df() se parcurgeau inutil toate clasele, deşi apăruse deja o „blocare” care impunea stoparea etichetării curente). În plus, avem acum şi o modalitate de specificare a ordinii profesorilor şi claselor.
Prin mountHtoDay() vom putea obţine diverse orare prof|cls|ora, pentru ziua respectivă; afişându-le într-un format sau altul, vom putea eventual că analizăm cum depinde numărul de ferestre de ordinea profesorilor şi de ordinea în care au fost abordate clasele. Adăugăm în "schedulesDay.R" aceste funcţii:
orarByProf <- function(dorar) { # prof|cls|ora
orz <- dorar %>%
split(.$prof) %>%
map_df(., function(K)
pivot_wider(K, names_from="ora", values_from="cls"))
orz <- orz[, c('prof', sort(colnames(orz)[-1]))]
} # write_csv(orz, file = "orar.csv", na = "-", col_names=TRUE, append=TRUE)
orarByCls <- function(dorar) { # prof|cls|ora
levs <- unique(dorar$cls)
dorar %>%
mutate(cls = factor(cls, levels=levs, ordered=TRUE)) %>%
split(.$cls) %>%
map_df(., function(K) {
Q <- K[order(K$ora), ]
data.frame(cls = paste0(Q$cls[1], " "),
orar = paste(Q$prof, collapse=" "))})
} # orz <- orarByCls(orar); print(orz, right=FALSE, row.names=FALSE)
Prin orarByProf() putem reda orarul într-un fişier CSV, în care ordinea liniilor este dată de ordinea profesorilor considerată la generarea orarului prin mountHtoDay() (aici redăm pe trei coloane, de sus în jos şi de la stânga spre dreapta):
prof,1,2,3,4,5,6,7 P04,6C,6B,7A,7C,-,-,- P30,8F,-,-,6B,5E,5D,- P02,7C,6E,6C,9B,-,9C,- P28,12B,11B,6A,9C,10C,-,- P41,8E,7A,-,9E,-,-,- P31,-,-,5E,6C,9B,11C,- P51,9B,6C,8D,-,-,-,- P46,10C,7B,12D,-,-,-,- P19,-,-,8F,5A,6E,7B,- P16,9A,5C,10A,11A,-,-,- P17,6D,-,8C,11B,11A,-,- P29,-,-,-,-,12C,8E,8A P33,9D,10A,12A,-,7C,-,- P58,6E,10B,-,-,-,-,- P32,11C,11E,-,-,5A,5E,- P52,5A,11D,7C,-,-,-,- P34,8B,5A,5B,11E,-,-,- P14,10B,7C,-,10A,-,-,- P54,12E,12B,6E,-,-,-,- P22,10E,8E,6D,7B,-,-,- P18,7B,-,-,7A,6C,6E,- P40,11B,9C,8B,11D,-,-,- P01,10D,8A,11A,8C,6A,8B,- P62,-,-,-,10B,9D,10A,- P66,11E,9D,-,-,-,-,- P45,12C,5B,-,6E,-,-,- P43,-,-,11D,11C,7D,8A,- P08,5C,12D,12C,6D,-,-,- P25,5D,7E,9B,12C,-,-,- P49,-,-,-,12B,8D,9B,- P36,8C,6A,9D,8D,10A,-,- P13,-,7D,10E,8B,10D,8F,- P67,-,-,-,-,-,7E,8C P15,8D,8B,10D,8E,-,-,- P07,9C,10E,8A,9D,-,12A,- P64,-,-,-,-,9C,9D,- P21,9E,12E,11E,-,-,-,- P10,-,10D,12B,-,11B,8D,- P37,-,-,-,9A,11E,6C,- P38,5B,9B,9E,-,-,-,- P03,8A,5E,-,7D,8C,7A,- P56,-,-,-,-,5C,10B,- P63,11A,9A,11B,-,-,-,- P44,-,-,5C,6A,9E,-,- P42,-,-,-,-,10B,9E,9B P59,5E,5D,-,-,-,-,- P26,-,-,-,10E,8A,10D,8B P35,-,12A,10C,-,6D,11A,- P55,12A,8C,5D,-,-,-,- P47,-,-,7E,8A,8E,-,- P72,-,-,-,-,10E,11E,- P11,7E,8D,7D,5E,-,-,- P50,-,9E,-,5C,6B,-,- P39,-,-,8E,-,8F,8C,7C P48,6B,8F,-,-,7B,-,- P12,11D,-,11C,7E,12D,-,- P20,-,-,7B,5D,7A,10C,- P23,7D,10C,9A,-,11D,-,- P57,-,-,5A,-,5D,6B,- P71,-,-,-,12A,9A,-,- P53,7A,6D,9C,10C,-,-,- P06,-,-,-,12E,12A,12D,9E P27,-,-,-,5B,8B,10E,7D P24,6A,-,6B,12D,-,-,- P09,10A,11A,-,8F,11C,7C,- P05,-,12C,10B,10D,12E,9A,- P60,12D,11C,12E,-,-,-,- P65,-,-,-,-,7E,7D,-
Se vede uşor că avem 25 de ferestre – 17 de câte o singură oră şi 4 de câte două ore consecutive. Urmărind apariţiile pe linii, de sus în jos, ale diverselor clase, am putea ajunge la bănuiala că ordinea profesorilor corespunde (în general) cu aceea în care fiecare să aibă cât mai puţine clase în comun, cu cei care îl preced.
Prin orarByCls() putem reda orarul pe clase, în ordinea în care mountHtoDay() le-a montat orarul:
cls orar 10A P09 P33 P16 P14 P36 P62 7E P11 P25 P47 P12 P65 P67 10C P46 P23 P35 P53 P28 P20 12E P54 P21 P60 P06 P05 12D P60 P08 P46 P24 P12 P06 6C P04 P51 P02 P31 P18 P37 10D P01 P10 P15 P05 P13 P26 8C P36 P55 P17 P01 P03 P39 P67 10E P22 P07 P13 P26 P72 P27 9A P16 P63 P23 P37 P71 P05 11D P12 P52 P43 P40 P23 5A P52 P34 P57 P19 P32 12C P45 P05 P08 P25 P29 5B P38 P45 P34 P27 6E P58 P02 P54 P45 P19 P18 9B P51 P38 P25 P02 P31 P49 P42 6D P17 P53 P22 P08 P35 12B P28 P54 P10 P49 8F P30 P48 P19 P09 P39 P13 9D P33 P66 P36 P07 P62 P64 5E P59 P03 P31 P11 P30 P32 11B P40 P28 P63 P17 P10 7B P18 P46 P20 P22 P48 P19 11E P66 P32 P21 P34 P37 P72 8A P03 P01 P07 P47 P26 P43 P29 5C P08 P16 P44 P50 P56 10B P14 P58 P05 P62 P42 P56 6A P24 P36 P28 P44 P01 11C P32 P60 P12 P43 P09 P31 8D P15 P11 P51 P36 P49 P10 12A P55 P35 P33 P71 P06 P07 7D P23 P13 P11 P03 P43 P65 P27 5D P25 P59 P55 P20 P57 P30 6B P48 P04 P24 P30 P50 P57 9E P21 P50 P38 P41 P44 P42 P06 7A P53 P41 P04 P18 P20 P03 7C P02 P14 P52 P04 P33 P09 P39 9C P07 P40 P53 P28 P64 P02 8E P41 P22 P39 P15 P47 P29 8B P34 P15 P40 P13 P27 P01 P26 11A P63 P09 P01 P16 P17 P35
Avem şi clase cu câte 4 ore (5B şi 12B), şi cu câte 5, 6 sau 7 ore; toate clasele încep programul de la prima oră a zilei.
Urmărind de sus în jos (începând cu 7E) apariţiile pe linii ale profesorilor, putem iarăşi bănui principiul de ordonare corelată a claselor şi profesorilor sesizat şi mai sus: clasele sunt într-o asemenea ordine încât profesorii unei aceleiaşi clase apar de cât mai puţine ori pe liniile care preced linia clasei respective; vom vedea mai încolo, cum am putea elucida experimental aspectele acestei bănuieli.
Dar trebuie să observăm că pentru investigaţiile intenţionate, aceste formate de redare a orarului nu sunt convenabile, fiindcă ar trebui acompaniate de câte o informaţie suplimentară: prin orarByProf() am avea nevoie şi de lista claselor, iar prin orarByCls() am avea nevoie de lista profesorilor (în ordinea considerată în mountHtoDay() pentru producerea orarului).
Pentru o anumită ordine a profesorilor şi a claselor, orarul zilei rezultă chiar instantaneu; problema este de a găsi sau a caracteriza aceste ordonări. Orarul redat mai sus a fost obţinut prin programul următor, angajând ordonări clsOrder() şi profOrder() găsite printr-un program de investigare pe care îl vom reda mai târziu:
# exex.R (exemplu de exploatare) source("schedulesDay.R") tbPC <- csv2tidy(3) # lecţiile repartizate în ziua a 3-a clsOrder <- function(v_cls) c("7E", "12E", "6C", "8C", "9A", "5A", "5B", "9B", "12B", "9D", "11B", "11E", "5C", "6A", "8D", "7D", "6B", "7A", "9C", "8B", "10A", "10C", "12D", "10D", "10E", "11D", "12C", "6E", "6D", "8F", "5E", "7B", "8A", "10B", "11C", "12A", "5D", "9E", "7C", "8E", "11A") # ordinea claselor din exemplificarea de mai sus profOrder <- function(vp) c("P04", "P28", "P51", "P16", "P33", "P52", "P54", "P40", "P66", "P08", "P36", "P15", "P21", "P38", "P63", "P59", "P55", "P11", "P48", "P23", "P53", "P24", "P60", "P30", "P41", "P46", "P17", "P58", "P34", "P22", "P01", "P45", "P25", "P13", "P07", "P10", "P03", "P44", "P26", "P47", "P50", "P12", "P57", "P06", "P09", "P65", "P02", "P31", "P19", "P29", "P32", "P14", "P18", "P62", "P43", "P49", "P67", "P64", "P37", "P56", "P42", "P35", "P72", "P39", "P20", "P71", "P27", "P05") # ordinea profesorilor din orarul redat mai sus task <- setProfBits(tbPC) #> head(task[[1]], 5) ## verificare interactivă (în consola R) # prof cls #1 P04 6B #2 P04 6C #3 P04 7A #4 P04 7C #5 P28 10C Bits <- task[[2]] TB <- task[[1]] %>% split(.$cls) orZ <- mountHtoDay(TB) orz <- orarByProf(orZ[[1]]) # orarul redat mai sus, pe profesori write_csv(orz, file = "orar3.csv", na = "-", col_names=TRUE, append=TRUE) orz2 <- orarByCls(orZ[[1]]) # orarul redat mai sus, pe clase print(orz2, right=FALSE, row.names=FALSE)
Orarul (l-am redat deja mai sus, pe coloane) a rezultat într-o fracţiune de secundă. Cum am evidenţiat deja, avem 25 de ferestre (prin programul iniţial din [1], obţineam nu mai puţin de 50-60 ferestre); nu ne vom ocupa aici şi de „reducerea ferestrelor”.
Să observăm acum că pentru investigaţii, rezultatul returnat de mountHtoDay() este suficient: $prof este un factor şi îşi păstrează atributele iniţiale (adică, în termenii de mai sus, nivelele $prof din orZ[[1]] coincid cu cele din task); iar lista claselor în ordinea în care au fost abordate pentru producerea orarului (după split()-area aplicată lui task[[1]]) se poate recupera prin unique(orZ[[1]]$cls) (cum deja avem mai sus în definiţia orarByCls()).
În corpul funcţiei mountHtoDay() am inclus (mai sus – sub semnul de comentariu, "# ") două comenzi cat(): se afişează '*' de fiecare dată când mountHtoCls() încearcă să monteze $ora pentru clasa curentă şi se afişează '/' când această încercare eşuează. Iată un exemplu de program care speculează această posibilitate de urmărire a demersurilor aferente obţinerii unui orar:
# traceMount() rm(list=ls()) source("schedulesDay.R") ptime <- function() print(strftime(Sys.time(), format="%H:%M:%S"), quote=FALSE) ptime() tbPC <- csv2tidy(3) task <- setProfBits(tbPC) # fixează o anumită ordine a profesorilor for(i in 1:2) { TB <- task[[1]] %>% split(.$cls) Bits <- task[[2]] orZ <- mountHtoDay(TB) # orare pe clase, într-o ordine sau alta a acestora ngaps <- sum(unlist(lapply(orZ[[2]], holes))) cat(paste(ngaps, NTRY, "\n")) ptime() }
> source("traceMount.R") [1] 11:47:26 ***********************/**********************/********************/ *******************/**************************/********************/ **************************/**************************************/ **********************************/**************************/ *****************************/********************/*************/ *********************/*****************************/***************/ **********************/*****************************/*************************/ *********************************/*****************************************39 20 [1] 11:47:29 ************************/*****************************/ *******************************/*****************************/ ************************************/*****************/ ***************************************/************************/ *****************************************43 28 [1] 11:47:30
Rezultatele afişate au această interpretare: pentru obţinerea primului orar, s-au făcut 20 de reordonări ale claselor (avem 20 de caractere '/'): pentru prima dintre aceste ordini, coloana $ora a putut fi anexată fără conflicte numai primelor 20 de clase (înainte de primul '/', avem 20 de caractere '*'); reordonând clasele, încercarea de a stabili succesiv, fără coliziuni, orarele acestora a eşuat iarăşi, la a 23-a clasă (între primul '/' şi al doilea '/' avem 23 de caractere '*'); ş.a.m.d.
Abia după a 20-a reordonare a claselor, încercarea respectivă are succes (numărul de "*" de după ultimul '/' este egal cu numărul de clase); orarul rezultat are 39 de ferestre (şi s-a obţinut în 47:29 - 47:26 = 3 secunde).
Continuând, al doilea orar a rezultat după 28-20=8 reordonări de clase (pe aceeaşi ordine a profesorilor ca şi în cazul primului orar) şi are 43 de ferestre.
Pe lângă evidenţierea mecanismului funcţiei mountHtoDay(), acest program ar mai avea un rol: repetând execuţia lui de un număr suficient de mare de ori (de exemplu, schimbând 1:2 din "for()" cu 1:50, sau chiar 1:100), obţinem orare cu diverse valori pentru numărul de ferestre şi numărul de încercări – încât am putea conveni în cunoştinţă de cauză, asupra unei limite maxime pentru numărul de încercări şi eventual, asupra unui interval realist pentru numărul de ferestre (dacă printre 100 de orare rezultate astfel, nu avem niciunul cu mai puţin de 30 ferestre, atunci este cam nerealist să cerem lui mountHtoDay() un orar cu 10 ferestre).
Investigaţia sugerată în câteva locuri mai sus, ar consta în a genera prin mountHtoDay() un număr cât se poate de mare de orare şi a compara cumva orarele obţinute, încercând să deducem anumite dependenţe între numărul de ferestre din orarul rezultat şi ordinea profesorilor şi claselor pe care s-a bazat producerea orarului.
Vom încerca să surprindem caracteristicile comune orarelor cu „puţine” ferestre – mai puţin decât 15% din totalul de ore ale zilei – şi respectiv, ale celor cu „multe” ferestre – peste 24% din totalul de ore.
Deocamdată formulăm un program prin care generăm orare din cele două categorii:
# cedulas.R # Generează un anumit număr de orare "bune" - cu numărul de ferestre # de cel mult 15%, sau cel puţin 24% din numărul de lecţii ale zilei. source("schedulesDay.R") tbPC <- csv2tidy(3) nhd <- nrow(tbPC) # numărul total de ore din ziua respectivă lim_gaps <- c(floor(nhd*15/100), # Căutăm orare cu mai puţin de 15% ferestre floor(nhd*24/100)) # şi orare cu mai mult de 24% ferestre. CDL <- data.frame() # va reţine succesiv orarele găsite nrp <- 10 # numărul de orare peste o aceeaşi ordine $prof NTR <- vector("list", nrp) # informaţii contextuale pentru fiecare orar găsit nOut <- 10 # orare "bune" cu acelaşi factor $prof, dar cu alte ordonări de clase print(strftime(Sys.time(), format="%H:%M:%S"), quote=FALSE) for(N in 1:nrp) { # cat(N, "\n") task <- setProfBits(tbPC) TB <- task[[1]] %>% split(.$cls) Bits <- task[[2]] out <- 0 # contorizează orarele "bune" (sub 15%, sau peste 24% ferestre) nced <- 0 # orarele constituite până a ajunge la unul "bun" lOut <- matrix(data=rep(0, 3*nOut), nrow=3, ncol=nOut, byrow=TRUE) while(TRUE) { orZ <- mountHtoDay(TB) nced <- nced + 1 ngaps <- sum(unlist(lapply(orZ[[2]], holes))) if(ngaps < lim_gaps[1] || ngaps > lim_gaps[2]) { # cat("*") CDL <- rbind(CDL, orZ[[1]]) out <- out + 1 lOut[, out] <- c(ngaps, nced, NTRY) NTRY <- 0 # reordonări de clase, până la constituirea unui nou orar nced <- 0 if(out >= nOut) break } } NTR[[N]] <- lOut } print(strftime(Sys.time(), format="%H:%M:%S"), quote=FALSE)
Dar rularea acestui program durează enorm, ba chiar ar putea dura o veşnicie: poate exista o asemenea ordine a profesorilor pentru care marea majoritate a orarelor care s-ar obţine (reordonând clasele) să aibă un număr de ferestre cuprins între cele două limite lim_gaps – caz în care nu se mai poate ieşi într-un timp rezonabil, din ciclul while(TRUE) (chiar aşa am păţit: am lansat programul – foarte optimist: cu nrp <- 100 – la ora 22:00:00 şi a doua zi dimineaţa am constatat că abia se ajunsese la N=2; peste încă vreo două ceasuri, tot nu se trecuse de N=2…)
Pentru a evita situaţia menţionată, ar trebui să impunem cumva o limită maximală pentru numărul de încercări NTRY. Dar probabil că şi mai bine ar fi, să considerăm nu „date reale” (pe care anumite corelaţii sunt totuşi greu de surprins) cum avem mai sus, ci date artificiale cu volum minimal şi anume construite pentru a reflecta cât mai bine aspectele pe care dorim să le investigăm. Oh, Dei!…
vezi Cărţile mele (de programare)