Fişierul "frame.rds" reflectă încadrarea profesorilor, în „format lung”; fiecare linie de date (prof | obj | cls) reprezintă o singură oră, angajând un profesor, un obiect de învăţământ şi una dintre clasele şcolii; pentru fiecare profesor avem n înregistrări consecutive, n fiind numărul de ore pe săptămână ale acestuia.
# basic_framing.R library(tidyverse) FRM <- readRDS("frame.rds") # încadrarea şcolii (prof | obj | cls) Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi") Sch1 <- c("11A", "11B", "11C", "11D", "11E", "11F", "11G", "12A", "12B", "12C", "12D", "12E", "12F", "12G", "7", "8" ) Sch2 <- c("9A", "9B", "9C", "9D", "9E", "9F", "9G", "10A", "10B", "10C", "10D", "10E", "10F", "10G", "5", "6") Cls <- c(Sch1, Sch2) # clasele şcolii (repartizate în două schimburi) Prof <- unique(FRM$prof) # profesorii şcolii nrPr <- length(Prof)
Prin execuţia acestui program, fişierul "frame.rds" este internalizat într-un obiect de tip tibble (introdus prin pachetul tidyverse), având în cazul concret de aici, 914 linii de date (deci în şcoala respectivă se defăşoară în total, 914 ore pe săptămână).
Se pune problema de a repartiza (cât se poate de omogen) orele respective, pe zilele săptămânii. Esenţial pentru algoritmul pe care îl folosim pentru aceasta (a vedea părţile [1] anterioare) este faptul că variabila $prof este de clasă "factor ordonat" – astfel că după separarea pe clase a liniilor din FRM, liniile corespunzătoare unui aceluiaşi profesor rămân consecutive între liniile aceleiaşi clase; algoritmul constă în a adăuga un nou factor ordonat, prin care liniile fiecărui profesor al clasei sunt etichetate consecutiv cu zilele de lucru.
În practica obişnuită, ar fi suficientă o singură partiţionare (oarecare) a orelor pe zile (respectând totuşi condiţia minimală, de a avea numărul cuvenit de ore pe zi la fiecare clasă): o vom putea modifica manual (relativ uşor) pentru a ţine seama de diversele condiţii concrete privitoare la plasarea pe zile a orelor profesorilor.
Ne propunem să generăm întâi un număr suficient de mare de distribuţii pe zile a orelor respective, sperând să nimerim astfel şi să putem depista una cât mai promiţătoare; funcţia generate_distributions() din programul redat mai jos va produce o listă cu numărul indicat de distribuţii.
În principiu, repartizarea pe zile decurge astfel: se izolează într-un obiect Q (de tip tibble) liniile din FRM care corespund unei aceleiaşi clase; pe o copie internă S a lui Q – returnată în final ca distribuţie a orelor acelei clase – se adaugă o coloană de tip factor ordonat S$zl, având ca nivele zilele de lucru; fiindcă în Q liniile asociate unui aceluiaşi profesor sunt consecutive – orele fiecărui profesor al clasei vor fi alocate prin coloana $zl în zile diferite (exceptând doar situaţia în care profesorul are mai mult de 5 ore pe săptămână la clasa respectivă).
Pe măsură ce numărul de clase astfel tratate se măreşte, creşte şi numărul de ore pe zi la profesorii acestor clase; se impune să avem un control global, pentru a refuza o distribuţie în care vreun profesor să aibă mai mult de (să zicem) 7 ore pe zi. Dacă pentru clasa curentă alocarea făcută în S nu convine (rezultă o zi cu 8 ore la un profesor, de exemplu) – atunci S se reiniţializează cu Q, iar liniile respective sunt ordonate aleatoriu (păstrând însă proprietatea liniilor unui aceluiaşi profesor de a fi consecutive) şi pe această nouă ordine a liniilor, se instituie din nou factorul zilelor $zl.
Dacă repetând astfel (pe cât permit resursele de memorie pentru „stiva de apeluri”), nu se poate trece de clasa curentă – atunci se ia totul de la capăt, schimbând însă, aleatoriu, ordinea claselor.
Funcţia alloc_by_class() are trei părţi constituente: matricea Zore prin care se va controla numărul de ore pe zi care se cumulează pe parcurs la profesori; funcţia recursivă days2rnd() prin care se alocă pe zile orele clasei indicate (manevrând cum am sugerat mai sus Q primit ca parametru, S şi Zore); partea „principală” este o comandă tryCatch() în care se despart pe clase liniile din FRM şi (prin map_df()) se reunesc într-un obiect data.frame rezultatele returnate de days2rnd() pentru fiecare clasă – iar în caz de eroare (la depăşirea capacităţii stivei de apeluri) se încearcă (sub un nou tryCatch()) reapelarea funcţiei alloc_by_class() dar acum, permutând aleatoriu clasele furnizate iniţial (a observa „imbricarea” de tryCatch()…):
# distribute_by_days.R source("basic_framing.R") alloc_by_class <- function(vCls) { # Clasele ale căror ore trebuie alocate pe zile Zore <- matrix(data=rep(0L, 5*nrPr), nrow=5, ncol=nrPr, byrow=TRUE, dimnames=list(Zile, Prof)) days2rnd <- function(Q) { # 'Q' conţine liniile din FRM cu o aceeaşi 'cls' S <- Q %>% arrange(match(prof, sample(unique(prof))), prof) %>% mutate(zl = gl(n=5, k=1, length = nrow(.), ordered=TRUE, labels = Zile)) %>% as.data.frame(.) more <- t(as.matrix(table(S[c('prof', 'zl')]))) mex <- Zore + more # actualizează matricea globală 'Zore' if(!any(mex > 7) & sum(mex==7) < 3 & all(abs(diff(mex)) < 3)) { Zore <<- Zore + more return(S) # o distribuţie care îndeplineşte condiţiile } return(days2rnd(Q)) # Reia dacă nu-s îndeplinite condiţiile } # (programul va fi stopat dacă reapelarea nu mai este posibilă) tryCatch( { FRM %>% filter(cls %in% vCls) %>% split(., .$cls) %>% map_df(., function(K) days2rnd(K)) }, error = function(err) { # message(err) tryCatch(alloc_by_class(sample(vCls)), error = function(e) NULL) } ) # Returnează distribuţia pe zile a orelor claselor indicate } generate_distributions <- function(n_dis=20L, v_cls=Cls, file_name) { lapply(1:n_dis, function(i) alloc_by_class(v_cls)) %>% compact() %>% # elimină NULL, dacă există saveRDS(., file=file_name) }
Prin programele din [1] (de unde am sintetizat programul redat mai sus), obţineam o listă conţinând în jur de 50 de distribuţii, în loc de 100 câte indicam (dar în [1] foloseam un singur tryCatch() şi lipsea ideea de a reapela pentru o permutare oarecare a claselor); acum, obţinem (în general) exact atâtea distribuţii câte cerem prin parametrul n_dis – cu o condiţie (observată prin experimente): în corpul funcţiei care gestionează eroarea în tryCatch(), să nu folosim parametrul notat mai sus cu "err"; de exemplu, decomentând linia message(err), vom putea vedea pe ecran un mesaj ca "C stack usage 7973012 is too close to the limit", de fiecare dată când încercarea de alocare pentru clasa curentă eşuează (caz în care programul ar fi fost stopat, dacă nu foloseam tryCatch()) – în schimb, în loc de 20 de distribuţii cât am cerut, am obţinut numai 17 (împreună cu 9 mesaje "is too close to the limit").
În toate experimentele – cu n_dis=10, 20 sau 100 – am obţinut (fără linia message(err)) seturi cu exact n_dis distribuţii ale orelor; este drept că timpii de execuţie nu sunt mici: au rezultat câte 20 de distribuţii în cel mai puţin 9 minute, cel mai frecvent 10-13 minute şi în cel mai mult, 23 de minute; am obţinut seturi de câte 100 de distribuţii cam în 1.5 ore (între 1h:10m şi 1h:38m).
Executând generate_distributions(), în diverse momente, am obţinut în directorul curent peste 30 de fişiere "Dis*.rds" (socotind şi pe cele obţinute anterior în [1]) – reprezentând fiecare câte o listă de distribuţii pe zile a orelor din FRM (fie cu 10, fie cu 20, 17, sau cu câte 100 de distribuţii, fie – din [1] – cu 46..61 de distribuţii).
Prin următorul program obţinem fişierul "lDis.rds" conţinând lista tuturor distribuţiilor obţinute, precum şi fişierul "lZore.rds", conţinând matricele alocării pe zile a orelor fiecărui profesor în cadrul fiecărei distribuţii (în fond, refăcând pentru fiecare distribuţie, matricea Zore din alloc_by_class):
# dis_and_mat.R library(tidyverse) lRDS <- list.files(pattern = "^Dis.*rds$") # lista fişierelor "Dis*.rds" lds <- lapply(lRDS, function(fi) readRDS(fi)) # > table(unlist(lapply(lds, function(ld) length(ld)))) # 4 5 6 7 9 10 17 20 46 49 55 56 61 100 # 1 1 3 1 1 2 1 7 2 1 3 3 1 7 ## (7 seturi de câte 100 distribuţii, 7 de câte 20, etc.) lds <- do.call(c, lds) # concatenează (prin c()) listele # > length(lds) #[1] 1455 ##(obiecte 'data.frame') saveRDS(lds, file="lDis.rds") # 1455 distribuţii pe zile a orelor din FRM lZore <- lapply(lds, function(Q) as.matrix(table(Q[c("prof", "zl")]))) saveRDS(lZore, file="lZore.rds") # 1455 matrici "Zore"
La prima vedere, 1455 de distribuţii cât avem (ca obiecte 'data.frame') în fişierul final "lDis.rds" pare mult – dar de fapt, este infim faţă de gama tuturor distribuţiilor pe zile care sunt posibile pentru orele din FRM. Cu alte cuvinte, este foarte mică şansa ca între cele aşa de „multe” distribuţii generate, să o fi obţinut şi pe aceea care chiar ar fi cea mai promiţătoare…
Mai întâi – cum am justificat în [1], încât nu este cazul să şi verificăm – în oricare dintre distribuţiile obţinute, fiecare clasă are numărul cuvenit de ore pe zi (fie câte 6, fie câte 5 sau 6, fie câte 6 sau 7 – după cum numărul de ore pe săptămână este 30, respectiv între 25 şi 30, sau mai mare ca 30).
Conform condiţiilor de generare din days2rnd() (folosite şi în programul de generare din [1]), nu avem în distribuţiile obţinute, profesori care să cumuleze mai mult de 7 ore pe zi, iar numărul de „7 ore pe zi” este cel mult 2, în fiecare distribuţie; să vedem câte distribuţii au zero, una, respectiv două situaţii „7 ore pe zi”:
# grope.R (tatonează proprietăţile distribuţiilor) library(tidyverse) lDis <- readRDS("lDis.rds") # lista distribuţiilor (1455 'data.frame') lZore <- readRDS("lZore.rds") # matricile orelor pe zile, pentru profesori oz7 <- unlist(lapply(lZore, function(M) sum(M == 7))) # numărul de „7 ore pe zi” > table(oz7) # de la prompt-ul consolei R oz7 0 1 2 2 19 1434
Avem deci (spre deosebire de situaţia din [1]) şi două distribuţii în care profesorii au cel mult câte 6 ore pe zi; acestea ar fi deocamdată, cel mai „promiţătoare” şi trebuie să fie primele analizate – apoi, cele 19 distribuţii cu câte un singur „7 ore pe zi” şi apoi, celelalte. Să reţinem indicii din lista lDis corespunzători primelor 21 de distribuţii:
id.7oz0 <- which(oz7 == 0L) # 786, 1165 id.7oz1 <- which(oz7 == 1L) # 34,83,92,113,205,223,361,570,671,704, # 755,826,939,951,1011,1139,1276,1306,1323
Prin lDis[id.7oz0] şi lZore[id.7oz0] vom putea accesa cele două distribuţii din primul caz şi respectiv, cele două matrici asociate acestora (analog, pentru al doilea caz).
În sfârşit, după ultima dintre cele trei condiţionări din days2rnd(), toate distribuţiile obţinute au şi această proprietate: pentru fiecare profesor, numărul de ore pe zi diferă de la o zi la următoarea zi, cu cel mult 2; prin această condiţie de generare (v. şi [1]) încercam să omogenizăm cumva, pe cât se poate, distribuţia pe zile a orelor profesorului.
Am vrea ca distribuţiile individuale – distribuţia orelor profesorului pe zilele de lucru – să fie, pentru o proporţie cât mai mare a profesorilor, cât mai echilibrate (sau omogene); de exemplu, nu convine cazul când ar avea o singură oră într-o zi şi 7 ore într-o alta. Desigur, dacă profesorul are puţine ore pe săptămână – cel mult 5-6 ore – atunci va fi preferabilă o distribuţie ne-omogenă (orice profesor va prefera distribuţia celor 5 ore ale sale în numai 2-3 zile, nu câte o oră în fiecare zi).
Dacă profesorul are n ore pe săptămână, atunci o distribuţie omogenă ar fi una în care fiecare zi ar avea fie (n DIV 5), fie (n DIV 5 + 1) ore; pentru a măsura cât se abate de la distribuţia omogenă, o distribuţie individuală dată – putem folosi „coeficientul de variaţie” (raportul dintre „abaterea standard” sd() şi media valorilor, mean()); dar vrem să defavorizăm distribuţiile individuale cu diferenţă prea mare între numărul de ore pe o zi şi alta – încât multiplicăm coeficientul de variaţie cu diff(range()) (v. [1]):
cf_omg <- function(ore_zi) { ore <- ore_zi[ore_zi != 0] round(sd(ore)/mean(ore)*diff(range(ore)), 2) }
Am exclus situaţia „zero ore pe zi”, fiindcă o distribuţie ca (0, 0, 1, 1, 0) ar avea – considerând toate cele 5 valori – coeficientul de variaţie 1.37 (respingând distribuţia, cum vom vedea mai jos), în loc să aibă – ignorând cele trei zerouri – 0 (acceptând distribuţia), cum ar fi normal pentru cazul a doar două ore pe săptămână; este drept, pe de altă parte, că situaţia de „0 ore pe zi” pentru profesori cu mai multe ore pe săptămână (nu doar 5-6) este foarte rară (prin programul de generare de mai sus).
Funcţia următoare anexează matricei de distribuţii individuale indicate, o coloană pe care sunt calculaţi „coeficienţii de omogenitate” corespunzători liniilor:
bind_omg <- function(M) cbind(M, apply(M, 1, cf_omg)) Lu Ma Mi Jo Vi cf_omg 1 1 3 5 6 7 3.28 2 2 3 4 6 7 2.36 3 2 3 5 5 7 2.22 4 2 3 5 6 6 1.65 5 2 4 4 5 7 2.06 6 2 4 4 6 6 1.52 7 2 4 5 5 6 1.38 8 3 3 4 5 7 1.52 9 3 3 4 6 6 1.03 10 3 3 5 5 6 0.91 11 3 4 4 5 6 0.78 12 3 4 5 5 5 0.41 13 4 4 4 4 6 0.41 14 4 4 4 5 5 0.12
Pe exemplul redat mai sus avem 14 distribuţii individuale pentru cazul a 22 de ore pe săptămână; acestea au fost deduse manual: am pus 1 în prima zi şi rămân de pus 21 de ore; în a doua zi nu putem pune 1 fiindcă plasarea restului de 20 de ore în 3 zile ar duce la (1, 1, 6, 7, 7), încălcând condiţia noastră asupra orelor în zile consecutive (numărul de ore din ziua a doua ar diferi cu mai mult de 2 de numărul de ore din a treia zi); la fel – nu putem pune nici 2; punând 3 în a doua zi, rezultă analog, distribuţia de pe prima linie (şi la fel, găsim celelalte linii)
Cele 14 distribuţii găsite astfel sunt singurele pe 22 de ore, care satisfac toate cele trei condiţii din alloc_by_class(). Cea mai convenabilă („omogenă”) dintre ele este ultima, (4,4,4,5,5); încă acceptabile, sunt cele al căror coeficient (din ultima coloană) este mai mic decât 0.5; categoric de respins, sunt cele de coeficient mai mare ca 1.
Să categorisim cele 1455 de distribuţii obţinute în lista lDis, după numărul de distribuţii individuale care au coeficientul de omogenitate mai mare ca 0.5:
lSD <- lapply(1:length(lZore), function(id) { S <- apply(lZore[[id]], 1, cf_omg) length(which(S > 0.5)) }) > table(unlist(lSD)) 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 1 4 8 16 44 58 91 163 188 188 213 159 143 94 41 22 12 6 4
Deducem că dintre cei 59 de profesori, au distribuţii individuale neconvenabile cel mai puţin 14 (dar numai într-o singură distribuţie din lDis) şi cel mai mult 32 (în patru distribuţii din lDis). Acceptabile şi de investigat comparativ în privinţa altor proprietăţi avantajoase, ar fi cele 222 de distribuţii din lista lDis care conţin cel mult 20 de distribuţii individuale neconvenabile (adică cu câte cel puţin 59-20=39 de distribuţii individuale acceptabile).
Să vedem deocamdată, matricea cu cel mai multe distribuţii individuale acceptabile:
> which(lSD == 14) # indexul distribuţiei este 1057 > D14 <- bind_omg(lZore[[1057]]) # adaugă coloana coeficienţilor de omogenitate > D14[order(D14[, 6]), ] # ordonează liniile după coeficienţi (şi afişează) Lu Ma Mi Jo Vi Lu Ma Mi Jo Vi P20 4 4 4 4 4 0.00 P51 1 1 1 2 0 0.40 P48 1 1 1 1 1 0.00 P14 5 4 5 5 3 0.41 P43 1 1 1 0 0 0.00 P46 0 2 1 1 0 0.43 P56 1 1 1 0 0 0.00 P52 0 1 2 1 0 0.43 P57 0 0 1 1 0 0.00 P53 2 0 0 1 1 0.43 P01 5 6 6 6 5 0.10 P54 1 2 0 0 1 0.43 P03 6 6 5 5 6 0.10 P55 1 2 1 0 0 0.43 P17 4 5 4 4 4 0.11 P22 5 4 3 3 4 0.44 P10 5 4 5 5 4 0.12 P23 5 3 4 4 3 0.44 P11 5 5 4 5 4 0.12 P24 4 3 5 4 3 0.44 P12 4 4 5 5 4 0.12 P25 5 4 4 3 3 0.44 P13 4 4 5 4 5 0.12 P18 3 3 4 5 5 0.50 P34 3 3 3 4 3 0.14 P27 4 4 4 2 4 0.50 P36 3 3 3 3 4 0.14 P29 2 4 4 4 4 0.50 P37 3 4 3 3 3 0.14 P39 2 3 3 4 4 0.52 P26 4 4 4 3 3 0.15 P02 7 6 6 4 5 0.61 P30 4 3 4 4 3 0.15 P40 4 2 2 2 3 0.69 P31 4 3 3 4 4 0.15 P41 3 3 3 3 1 0.69 P33 3 4 4 3 3 0.16 P08 4 6 6 5 3 0.81 P45 1 0 2 2 2 0.29 P19 4 5 5 4 2 0.92 P06 4 5 5 6 6 0.32 P32 5 4 4 3 2 0.95 P04 5 6 6 6 4 0.33 P44 1 1 3 3 1 1.22 P21 5 4 3 4 4 0.35 P05 6 7 6 4 3 1.26 P49 1 2 2 0 0 0.35 P16 5 6 4 2 4 1.41 P47 2 1 1 1 1 0.37 P42 4 2 1 1 3 1.78 P09 4 4 6 5 4 0.39 P35 2 1 3 5 5 2.24 P07 6 6 5 4 4 0.40 P28 5 6 4 2 1 2.88 P15 4 5 4 5 3 0.40 P38 6 4 2 1 3 3.01 P50 2 0 1 1 1 0.40 P58 0 0 0 0 1 NA P59 0 0 0 0 1 NA
Pentru profesorii cu câte o singură oră pe săptămână (P58 şi P59), coeficienţii n-au mai fost calculaţi (cf_omg() a returnat NA). Distribuţiile individuale (din tabelul de mai sus) de coeficient cel mult 0.16 sunt „perfecte” – exceptând probabil cazurile de sub 6 ore pe săptămână (P48, P43, P56 şi P57; în loc de (0,0,1,1,0) ar fi de dorit de exemplu, (0,0,2,0,0)). Distribuţiile de coeficient mai mare ca 0.16 şi mai mic de 0.52 sunt „acceptabile” (exceptând iarăşi, pe acelea corespunzătoare unui număr mic (4..7) de ore pe săptămână) – deşi vreo două dintre acestea merită să fie corectate puţin, ulterior (de exemplu, cele de coeficient 0.5). Distribuţiile de coeficient mai mare ca 0.5 (în număr de 14) sunt (cu una sau două excepţii) „de respins” (rămânând să fie neapărat îndreptate, ulterior).
Distribuţia lDis[[1057]] (reprezentată ca număr de ore pe zi, prin matricea redată mai sus) este destul de reuşită, 75% dintre distribuţiile individuale conţinute fiind acceptabile (şi aproape jumătate dintre acestea sunt „perfecte”).
Probabil că am abandona celelalte distribuţii din lista lDis, urmând să vedem cum am putea face unele „îndreptări” (asupra celeia depistate mai sus)…
De fapt, încă suntem pe un drum oarecum greşit: orice îndreptare am proiecta, trebuie să ţinem seama şi de clasele asociate orelor respective; se poate ca o distribuţie individuală să fie printre cele 75% care sunt „perfecte” sau măcar acceptabile, dar clasele implicate să fie şi dintr-un schimb şi din celălalt (încât 4 ore pe zi din distribuţia „perfectă” (4, 4, 4, 5, 5) ar putea însemna „o oră dimineaţa şi trei ore după-masa” – ceea ce este totuşi inacceptabil, nicidecum „perfect”).
Putem ţine seama în alloc_by_class() şi de schimbul de care ţin clasele implicate?
vezi Cărţile mele (de programare)