Reluăm programul schedule.R din [1], cu mici modificări şi sublinieri:
# schedule.R (distribuie pseudo-omogen orele profesorilor şi claselor pe zile) 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 profs <- unique(FRM$prof) # profesorii şcolii nrPr <- length(profs) # numărul de ore alocate zilnic profesorilor Xore <- matrix(data=rep(0L, 5*nrPr), nrow=5, ncol=nrPr, byrow=TRUE, dimnames=list(Zile, profs)) setZile <- 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 <- Xore + more # actualizează matricea globală 'Xore' if(all(abs(diff(mex)) < 3) & !any(mex > 7) & sum(mex == 7) < 3) { Xore <<- Xore + more return(S) # o distribuţie care îndeplineşte condiţiile } return(setZile(Q)) # reia dacă nu-s îndeplinite condiţiile } # programul va fi stopat dacă reapelarea nu mai este posibilă allock <- function(vCls) { # clasele ale căror ore trebuie alocate pe zile Xore <<- 0L # urmăreşte câte ore au fost deja alocate de setZile() FRM %>% filter(cls %in% vCls) %>% split(., .$cls) %>% map_df(., function(K) setZile(K)) }
Faţă de [1], am întărit condiţiile verificate în setZile(), restrângând la cel mult două, cazurile în care un profesor are 7 ore pe zi. Avem acum trei condiţii şi cu siguranţă, timpul în care se va obţine o distribuţie care să le satisfacă va creşte sensibil (faţă de [1], unde aveam numai două condiţii); ordinea verificării lor contează şi probabil că ar fi fost mai bine să fi mutat la sfârşit, prima condiţie (care angajează pe matricea "mex" operaţii parcă mai complicate, decât în cazul celorlalte).
Merită lămurită posibilitatea adunării de matrice Xore + more; este clar că acestea au acelaşi număr de linii (câte una pentru fiecare zi); este necesar să aibă şi acelaşi număr de coloane. Matricea globală Xore (pe care în [1] o numisem "Mopr") are din start atâtea coloane câţi profesori sunt în total; dar matricea locală more reflectă (la prima vedere) numai acei profesori care au ore la clasa Q$cls[1] (unde Q – primit ca parametru de setZile() – conţine liniile din încadrarea FRM corespunzătoare unei aceleiaşi clase).
Totuşi, cele două matrice au acelaşi număr de coloane (şi la fel denumite) – fiindcă more a fost introdusă plecând de la table(), care producând tabelul de contingenţă între factorii prof şi zl, angajează în mod implicit toate nivelele acestora (deci şi toţi profesorii, nu numai pe cei care au ore la acea clasă).
Am văzut deja în [1], că apelul allock(vector_clase) sau produce o distribuţie a orelor claselor indicate, sau se încheie fără succes – în cazul când pentru clasa curentă, setZile() nu reuşeşte, prin re-apelare, să aloce orele acesteia încât să fie respectate condiţiile globale de distribuire a orelor: se ajunge la depăşirea capacităţii stivei de apeluri şi atunci programul este stopat.
Pentru a genera una după alta mai multe distribuţii (în ideea de a le compara şi a alege între ele), putem folosi lapply() – dar trebuie să evităm stoparea eventuală a programului, ceea ce putem asigura folosind tryCatch():
# gensetd.R (generează un set de distribuţii pseudo-omogene) source("schedule.R") lapply(1:100, function(i) tryCatch(allock(Cls), error=function(err) NULL)) %>% compact() %>% saveRDS(., file="Dis1.rds")
Prin acest program se produce o listă cu cel mult 100 de distribuţii (pentru toate cele 914 ore, corespunzătoare claselor din Cls); dacă la o anumită iteraţie i, allock() eşuează – atunci în locul respectiv din listă se înscrie NULL; în final, compact() elimină din listă obiectele NULL.
N-am prevăzut vreo modalitate de a măsura timpul de execuţie, preferând ceva foarte simplu: notez timpul la care startez programul şi-l compar la sfârşit, cu timpul ("Date Modified") înregistrării fişierului "Dis1.rds". Bineînţeles că iniţial am prevăzut numai 10 iteraţii (nu 100, ca în sursa redată mai sus), obţinând rezultatul cam în 5 minute (constând dintr-o listă cu numai 5 distribuţii); desigur, executând din nou programul – având grijă să schimbăm numele fişierului în care se scrie în final lista produsă – obţinem rezultatul într-un timp care oscilează cumva în jurul valorii de 5 minute, iar numărul de distribuţii din lista rezultată variază şi el.
După câteva experimente iniţiale (cu 10 iteraţii), am rulat gensetd.R redat mai sus – obţinând în 45 de minute, fişierul "Dis1.rds", conţinând o listă cu 46 de distribuţii. Am repetat apoi, în diverse momente, de încă 5 ori – obţinând (în timpi cuprinşi între 30 şi 47 de minute) liste conţinând între 46 şi 61 de distribuţii.
Următoarea secvenţă de comenzi concatenează listele din fişierele Dis{1-7}.rds, rezultând o listă cu 319 distribuţii, salvată apoi în fişierul lDis.rds (de aproape 563KiB):
> fd <- paste0("Dis", 1:7, ".rds") > lds <- lapply(fd, function(f) readRDS(f)) > lds <- do.call(c, lds) > print(length(lds)) [1] 319 > saveRDS(lds, file="lDis.rds")
Rămâne să comparăm cumva aceste distribuţii, reţinând mereu pe cele care par a fi mai promiţătoare – sperând că aceea aleasă în final să poată servi cel mai bine în etapele ulterioare de elaborare a unui orar propriu-zis.
Din cele desfăşurate anterior ştim că în fiecare distribuţie rezultată prin allock(), toate clasele au numărul cuvenit de ore pe zi (5-6, sau 6, sau 6-7, după cum numărul săptămânal de ore este mai mic, egal, respectiv mai mare ca 30); deci pentru compararea distribuţiilor trebuie să vizăm numai numărul de ore pe zi pentru profesori. Următoarea secvenţă de comenzi (în continuarea celei de mai sus) produce o listă conţinând exact matricele "Xore" care rezultau în programul schedule.R, pentru fiecare distribuţie dintre cele 319 existente; fiecare matrice redă numărul de ore pe zi alocat prin distribuţia respectivă fiecărui profesor:
> lZore <- lapply(lds, function(Q) as.matrix(table(Q[c('prof', 'zl')]))) > saveRDS(lZore, file="lZore.rds")
Înfiinţăm un nou program, în care vom încerca să investigăm comparativ diverse proprietăţi ale celor 319 distribuţii; vom avea de folosit nu numai lista matricelor lZore, dar şi lista distribuţiilor – fiindcă este de văzut şi reflectarea fiecăruia dintre cele două schimburi, în cadrul uneia şi alteia dintre distribuţii:
# statistics.R (investighează proprietăţile distribuţiilor) library(tidyverse) lDis <- readRDS("lDis.rds") # lista distribuţiilor pe zile (319) lZore <- readRDS("lZore.rds") # lista matricelor de alocare (ore pe zi de profesor)
Ştim din cele de mai sus că în fiecare dintre distribuţiile obţinute, 7 apare de cel mult două ori ca număr de ore pe zi; să vedem dacă în lDis există distribuţii în care 7 să apară o singură dată. Întâi obţinem un vector conţinând pentru fiecare matrice din lista lZore numărul de valori 7, apoi obţinem (prin which()) indicii în lZore – şi implicit, în lDis – ai valorilor din vectorul respectiv care sunt egale cu 1:
> n7 <- unlist(lapply(lZore, function(M) sum(M == 7))) > (Idx.u7 <- which(n7 == 1)) # which(n7 == 0) dă zero indici [1] 34 111 168 # lDis[[34]], lDis[[111]], lDis[[168]] (au câte un singur 7 ore pe zi)
Deci numai trei dintre cele 319 distribuţii, au proprietatea că există o singură zi în care un anumit profesor (unul singur) are 7 ore; am fi tentaţi să alegem între acestea trei – dar trebuie investigate şi alte proprietăţi, pentru care s-ar putea să găsim distribuţii mai avantajoase decât cele trei.
Pentru început, să considerăm cele trei distribuţii depistate mai sus; care ar fi mai bună, dacă ne gândim la prima condiţie din setZile(): pentru fiecare profesor, numărul de ore pe zi să nu difere de la o zi la cea următoare cu mai mult de 2. O distribuţie ca d1 <- (7 5 3 1 3) convine condiţiilor, dar ar fi de respins fiindcă diferenţa dintre cel mai mare (7) şi cel mai mic (1) număr de ore pe zi – adică diff(range(d1)) – este prea mare; o distribuţie omogenă pe acelaşi număr total de ore ca în d1, ar fi de exemplu d2 <- (4 4 4 4 3), pentru care diff(range(d2)) este 1.
Să producem tabelele de diferenţe, pentru distribuţiile indicate în Idx.u7:
lDst <- lapply(Idx.u7, function(id) table(apply(lZore[[id]], 1, function(ore) diff(range(ore))))) > lDst [[1]] # distribuţia lDis[[34]] 1 2 3 4 11 30 12 6 # 1×11 + 2×30 + 3×12 + 4×6 = 131 „diferenţe” (egale cu 1, 2, 3, sau 4) [[2]] # lDis[[111]] 1 2 3 4 5 9 31 15 3 1 # 133 „diferenţe” (1, 2, 3, 4 sau 5) [[3]] # lDis[[168]] 1 2 3 4 15 24 17 3 # 126 „diferenţe” (1, 2, 3, sau 4)
Am zice că lDis[[168]] este preferabilă celorlalte două, având cel mai multe distribuţii individuale omogene (cu diferenţa 1 între numărul de ore pe o zi şi alta) şi în total, cel mai mic număr de diferenţe. Numărul diferenţelor este dat de suma produselor dintre valorile diferenţei şi numărul corespunzător de cazuri – altfel spus, este produsul scalar D %*% K, unde D este vectorul diferenţelor şi K este vectorul cazurilor.
Este de observat că în aceste trei distribuţii, nu avem nici un caz cu diferenţa 0 (altfel spus, nu există nici un profesor care să aibă în fiecare zi un acelaşi număr de ore).
Să vedem acum pentru toate cele 319 distribuţii, ce valori are „numărul diferenţelor” şi câte distribuţii au un acelaşi număr de diferenţe:
lDst <- lapply(1:319, function(id) table(apply(lZore[[id]], 1, function(ore) diff(range(ore))))) lPS <- lapply(1:319, function(id) { mz <- lDst[[id]] # numărul de cazuri pe fiecare diferenţă df <- as.integer(unlist(attr(mz, "dimnames"))) # diferenţele drop(df %*% mz) # totalul diferenţelor (produsul scalar) }) > table(unlist(lPS)) # summary(unlist(lPS)) 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 1 1 5 2 2 3 3 9 7 18 15 6 16 24 17 23 27 21 22 21 132 133 134 135 136 137 138 139 140 141 142 143 22 15 12 8 7 3 3 1 2 1 1 1
Constatăm că numărul diferenţelor este cuprins între 112 şi 143 şi se poate spune că are o distribuţie normală: primele 9 şi ultimele 9 valori corespund unui număr mic de repartizări; pentru majoritatea repartizărilor dintre cele 319, numărul diferenţelor este cuprins în mijloc, între 121 şi 134; cel mai multe repartizări (anume, 27 dintre cele 319) au numărul de diferenţe egal cu 128 (cam la mijlocul intervalului [121, 134]).
Mai sus găsisem distribuţia lDis[[168]], care avea un singur „7 ore pe zi” şi avea 126 de diferenţe; acum vedem că există distribuţii cu numărul diferenţelor mai mic decât 126 (având însă doi de „7 ore pe zi”). Ne interesează distribuţiile din lista lDis cu cel mai mic număr de diferenţe (112 sau 113):
> which(lPS == 112) [1] 238 > lDst[[238]] # lDis[[238]] are cel mai mic număr de diferenţe (112) 0 1 2 3 4 3 14 30 10 2 # are 3 distribuţii individuale omogene > which(lPS == 113) [1] 35 > lDst[[35]] # lDis[[35]] are 113 diferenţe 0 1 2 3 4 1 17 31 6 4
Deci lDis[[238]] are cel mai mic număr de diferenţe (112); ar fi de preferat faţă de lDis[[35]] şi pentru că are 3 cazuri omogene (un acelaşi număr de ore în fiecare zi).
Ce avem de făcut mai departe?
Să observăm că matricea globală Xore nu ne serveşte la nimic: la terminarea programului gensetd.R, în Xore avem numărul de ore distribuite zilnic profesorilor numai pentru ultima repartiţie din setul rezultat (pentru celelalte, trebuie să producem direct matricea respectivă, ca mai sus în lista lZore).
Prin urmare, avem de reorganizat codul din programul schedule.R, localizând matricea Xore (ba chiar şi funcţia setZile()) în contextul funcţiei allock(); există şansa ca astfel, timpii de execuţie să se îmbunătăţească.
„Numărul diferenţelor” (introdus mai sus prin diff(range(ore))) este încă insuficient pentru a măsura omogenitatea distribuţiilor individuale; dintr-un set de distribuţii (mai mare totuşi, decât cel cu 319 distribuţii angajat mai sus) am alege pe aceea care să aibă cel mai mic număr de diferenţe – dar dacă sunt mai multe cu această proprietate, cum să alegem între acestea pe cea „mai omogenă”?
Prin urmare, avem de completat cumva măsurarea omogenităţii distribuţiilor individuale şi deasemenea, avem de obţinut o listă de distribuţii şi mai mare, decât cea considerată mai sus.
În sfârşit, avem şi un considerent „practic”, greu de gestionat şi mereu amânat: setul de distribuţii pe care l-am obţinut (şi urmează să-l extindem) vizează toate clasele, indiferent de schimbul (A.M. sau P.M.) de care ţin acestea; dar, mai devreme sau mai târziu, va trebui să excludem pe cât se poate, situaţia neplăcută în care un profesor are într-o zi, o singură oră într-un schimb şi „grosul” orelor în celălalt schimb.
vezi Cărţile mele (de programare)