Distribuţia pe zile a orelor dintr-o şcoală cu un singur schimb
Am descărcat un fişier PDF conţinând orarul produs prin "ascTimetables" pentru o şcoală care funcţionează (spre deosebire de cazul din seria [1]) într-un singur schimb şi am apelat la iLovePDF pentru a obţine orarul respectiv ca fişier Excel, orarP
De la tabele vizuale, la structuri de date
Antetul original (pe foile Excel principale) are această formă (redăm primele coloane):
Este vorba ca de obicei de un antet informativ (pe primele două rânduri), aparent suficient pentru a înţelege datele propriu-zise, redate în tabel; prima coloană de date (identificată în Excel prin "A") nu este anunţată, dar imediat ce vedem valorile ei (înscrise începând cu a treia linie a tabelului) înţelegem că acestea reprezintă numele profesorilor; în celulele din celelalte coloane de date apare sau spaţiu (celulă „vidă”), sau numele unei clase, sau (cu un anumit separator între ele) numele a două–trei clase, iar „antetul” tabelului specifică pentru fiecare dintre aceste coloane, o zi (întinsă pe câte un grup de coloane), o oră şi câte un interval orar pentru fiecare oră. Disciplinele asociate profesorilor nu sunt menţionate.
Următorul program produce o listă de obiecte R tibble, câte unul pentru fiecare foaie Excel din fişierul iniţial orarP.xlsx:
library(tidyverse) library(readxl) # asigură importarea în R a fişierelor Excel xlsx <- "orarP.xlsx" lstDF <- xlsx %>% excel_sheets() %>% set_names() %>% map(read_excel, path = xlsx) # a vedea eventual, [1] > str(lstDF) # inspectează (în consola R) structura de date rezultată List of 5 $ Table 1: tibble [0 × 2] (S3: tbl_df/tbl/data.frame) ..$ (### Numele şi adresa şcolii ###): logi(0) ..$ Orarul general profesori : logi(0) $ Table 2: tibble [39 × 36] (S3: tbl_df/tbl/data.frame) ..$ ...1 : chr [1:39] NA "### Prof1 ###" "### Prof2 ###" ... ..$ Luni : chr [1:39] "1\r\n8:15\r\n9:05" "10B" "6D" NA ... ..$ ...3 : chr [1:39] "2\r\n9:15\r\n10:05" NA NA NA ... ### etc. ### ..$ ...8 : chr [1:39] "7\r\n14:15\r\n15:05" NA NA NA ... ..$ Marţi : chr [1:39] "1\r\n8:15\r\n9:05" "9B" "10A" NA ... ..$ ...10 : chr [1:39] "2\r\n9:15\r\n10:05" "9E" "10A" NA ... ### etc. ### ..$ Vineri : chr [1:39] "1\r\n8:15\r\n9:05" "9B" "11A" NA ... ..$ ...31 : chr [1:39] "2\r\n9:15\r\n10:05" "9B" "5C" NA ... ### etc. ### ..$ ...36 : chr [1:39] "7\r\n14:15\r\n15:05" NA NA NA ... $ Table 3: tibble [0 × 1] (S3: tbl_df/tbl/data.frame) ..$ (### Numele şi adresa şcolii ###): logi(0) $ Table 4: tibble [36 × 36] (S3: tbl_df/tbl/data.frame) ..$ ...1 : chr [1:36] NA "### Prof39 ###" "### Prof40 ###" ... ..$ Luni : chr [1:36] "1\r\n8:15\r\n9:05" NA "7B" NA ... ..$ ...3 : chr [1:36] "2\r\n9:15\r\n10:05" NA NA NA ... ### etc. ### ..$ ...36 : chr [1:36] "7\r\n14:15\r\n15:05" NA NA "8D" ... $ Table 5: tibble [0 × 3] (S3: tbl_df/tbl/data.frame) ..$ 10E: logi(0) ### etc. ###
Datele propriu-zise (dar incluzând şi „antetul” prezentat mai sus) sunt conţinute în "Table 2" şi "Table 4"; celulele vide din tabelul Excel sunt reprezentate prin valori NA ("Not Assigned" / "Not Available", sau „valoare lipsă”). Reunim (prin rbind()) liniile acestor două tabele şi pentru a scăpa de rândul pe care sunt specificate intervalele orare (rândul al doilea din fiecare „antet”) – „eliminăm” liniile care au NA în prima coloană:
orar <- rbind(lstDF[[2]], lstDF[[4]]) %>% filter(!is.na(`...1`)) # 72 linii de date x 36 coloane
Obiectul orar rezultat astfel (de tip "tibble", introdus prin „dialectul” tidyverse ca extensie a clasei standard "data.frame") are 72 de linii – dar ar fi trebuit să fie 73 (fiindcă tabelele reunite conţineau 39 şi 36 de linii şi intenţia a fost de a elimina cele două linii cu intervalele orare); deci mai exista o linie cu NA în coloana `...1` şi a fost eliminată şi aceasta: pe linia respectivă erau notate 3 clase, iar faptul că în loc de numele profesorului apărea NA, însemna cumva că aceste clase trebuie partajate în ziua şi ora indicate pe coloanele de care ţin, de către doi profesori (revenim mai jos asupra „partajelor”).
„Tabelul” orar are şi el, un „antet” – dar cu scop operaţional, nu informativ:
> names(orar) [1] "...1" "Luni" "...3" "...4" "...5" "...6" [7] "...7" "...8" "Marţi" "...10" "...11" "...12" [13] "...13" "...14" "...15" "Miercuri" "...17" "...18" [19] "...19" "...20" "...21" "...22" "Joi" "...24" [25] "...25" "...26" "...27" "...28" "...29" "Vineri" [31] "...31" "...32" "...33" "...34" "...35" "...36"
Astfel, orar["...1"] sau orar$"...1" va produce lista numelor profesorilor; pentru un exemplu mai interesant de folosire a numelor coloanelor, să producem orarul pe ziua de luni (aici evităm coloana numelor profesorilor şi redăm doar unele linii):
> orar[c("Luni", paste0("...", 3:8))] %>% print(n=Inf) # A tibble: 72 x 7 Luni ...3 ...4 ...5 ...6 ...7 ...8 1 "10B" NA 7B "5B" NA NA NA 2 "6D" NA 10A NA NA NA NA ### etc. ### 12 NA NA NA "6B" "6A" "11A\r\n11B" NA 13 "12D/\r\n12E" 5D NA "8B" "11C/11D\r\n11E" "5E" 7D 14 NA NA NA NA NA "7D" 8B ### etc. ### 71 "5E" 5A 5B NA "8F" "6B" 7B 72 "5C" 8E 6D NA NA NA NA
Să schimbăm „antetul”, în aşa fel încât să fie uşor mai târziu să „normalizăm” tabelul:
Zile <- c('Lu','Ma','Mi','Jo','Vi') antet <- lapply(Zile, function(z) paste0(z, 1:7)) names(orar) <- c("prof", unlist(antet)) saveRDS(orar, file = "orarP.rds")
Acum orar$prof selectează numele profesorilor; orar$Lu1, orar$Lu2, ..., orar$Lu7 selectează clasele (sau valorile NA) repartizate profesorilor, respectiv pentru orele 1..7 din ziua de luni (analog, pentru celelalte zile).
Deocamdată nu luăm seama la valorile care indică mai multe clase într-o aceeaşi oră – dar să observăm că uneori se foloseşte '/' (plus adesea, caractere de control "\r\n" – cum se vede mai sus pe linia 13, coloana 1) pentru a separa clasele, alteori nu (linia 12, coloana 7 – unde avem numai caractere de control a imprimării, drept separator).
Fişierul "orarP.rds" rezultat în final conţine imaginea de memorie (în format binar) a obiectului tibble orar (reprezentând în R, datele din fişierul Excel iniţial).
Normalizarea tabelului; evidenţierea partajelor
În tabelul Excel de la care am plecat avem pe fiecare rând, celule vide – în scopul alinierii vizuale pe coloane, a datelor propriu-zise; dar pentru orice prelucrare (nu doar afişare) interesează datele care sunt, nu cele care lipsesc. Să vedem câte valori NA (corespunzătoare celulelor vide din Excel) avem în „tabelul” orar obţinut mai sus:
> sum(is.na(orar[, ])) [1] 1318 # celule vide
orar are în total 72×36=2592 „celule”, deci datele propriu-zise sunt în număr de 2592-1318=1274, iar dintre acestea, 72 reprezintă numele profesorilor; deducem că în şcoala respectivă se desfăşoară săptămânal un număr de 1274-72=1202 ore.
Prin următorul program transformăm orar într-un obiect "tibble" cu 1202 linii (câte una pentru cele 1202 ore existente) şi 4 coloane, reprezentând pe fiecare linie profesorul, ziua, ora din zi şi clasa repartizată profesorului pentru acea zi şi oră:
library(tidyverse) orar <- readRDS("orarP.rds") orar_norm <- orar %>% # a vedea eventual, [1] gather("ziOra", "cls", 2:36) %>% separate(ziOra, c("zi", "ora"), sep=2) %>% filter(!is.na(cls)) %>% # ignoră celulele vide mutate(ora = as.integer(ora))
Vom elimina mai târziu, coloana $ora (fiindcă aici nu ne interesează orarul, ci doar încadrarea profesorilor pe clase) şi vom reseta valorile din coloana $zi; dar deocamdată, aceste două coloane ne arată cam cum stau lucrurile în privinţa orelor partajate între profesori pe „jumătăţi” de clasă:
sharing <- orar_norm %>% filter(grepl('[^[:alnum:]]', cls)) sharing$prof <- factor(sharing$prof) # a vedea eventual, [1] levels(sharing$prof) = paste0("P_", 1:length(unique(sharing$prof)))
Expresia regulată [^[:alnum:]] selectează caractere din afara celor „alfanumerice”, vizând astfel separatorii folosiţi între numele claselor ('/' sau/şi "\r\n"). Am anonimizat cumva numele profesorilor implicaţi şi se vede că avem 8 profesori care partajează într-o aceeaşi oră, unii câte două clase, alţii câte trei sau chiar patru clase:
> sharing %>% print(n=Inf) # inspectează din consola R # A tibble: 41 x 4 prof zi ora cls prof zi ora cls 1 P_5 Lu 1 "12D/\r\n12E" 21 P_5 Mi 4 "11C/11D/\r\n11E" 2 P_3 Lu 1 "12D/\r\n12E" 22 P_3 Mi 4 "11D/\r\n11E" 3 P_6 Lu 4 "10C\r\n10B" 23 P_4 Mi 5 "12E\r\n10D" 4 P_5 Lu 5 "11C/11D\r\n11E" 24 P_8 Mi 6 "10C/\r\n10D" 5 P_3 Lu 5 "11D/\r\n11E" 25 P_2 Mi 6 "10A/\r\n10C" 6 P_2 Lu 6 "11A\r\n11B" 26 P_5 Mi 6 "10D/\r\n10E" 7 P_3 Lu 6 "11A/\r\n11B" 27 P_3 Mi 6 "10C/10D/\r\n10E/10A" 8 P_7 Lu 6 "9C\r\n9D" 28 P_8 Jo 2 "12A/\r\n12C" 9 P_6 Lu 6 "9D\r\n9C" 29 P_1 Jo 2 "12A/\r\n12C" 10 P_8 Ma 1 "9D/9E" 30 P_5 Jo 3 "12D/\r\n12E" 11 P_2 Ma 1 "9A/9C" 31 P_3 Jo 3 "12D/\r\n12E" 12 P_1 Ma 1 "9A/9C" 32 P_2 Jo 4 "11A/\r\n11B" 13 P_3 Ma 1 "9D/9E" 33 P_3 Jo 4 "11A/\r\n11B" 14 P_8 Ma 2 "12A/\r\n12C" 34 P_2 Jo 5 "9A/9C" 15 P_1 Ma 2 "12A/\r\n12C" 35 P_1 Jo 5 "9A/9C" 16 P_8 Ma 3 "10C/\r\n10D" 36 P_8 Jo 6 "9D/9E" 17 P_2 Ma 3 "10A/\r\n10C" 37 P_3 Jo 6 "9D/9E" 18 P_5 Ma 3 "10D/\r\n10E" 38 P_5 Vi 5 "12D/\r\n12E" 19 P_3 Ma 3 "10C/10D/\r\n10E/10A" 39 P_3 Vi 5 "12D/\r\n12E" 20 P_6 Mi 1 "10A\r\n10E" 40 P_5 Vi 6 "11C/11D/\r\n11E" 41 P_3 Vi 6 "11D/\r\n11E"
Primele două linii de exemplu, spun că în ziua Lu, ora 1, o parte dintre elevii claselor 12D şi 12E are oră cu profesorul P_5, iar cealaltă parte cu profesorul P_3; analog, clasele 9D şi 9E sunt partajate Ma ora 1 de profesorii P_8 şi P_3 şi în acelaşi timp, clasele 9A şi 9C sunt partajate între profesorii P_2 şi P_1. Să observăm şi că avem o singură linie (linia 3) cu zi=Lu şi ora=4 şi în tot tabelul, avem o singură apariţie "10B" – aşa că nu putem stabili profesorul cu care P_6 partajează clasele 10C şi 10B…
Avem o sinteză poate mai utilă, înlocuind separatorii existenţi cu "/" şi considerând (prin table()) contingenţa valorilor de 'prof' şi 'cls' (transpunând apoi rezultatul, prin t()):
shrg <- sharing %>% mutate(cls = gsub("[^[:alnum:]]{1,}", "/", cls, perl=TRUE)) > t(table(shrg[c('prof', 'cls')])) prof cls P_1 P_2 P_3 P_4 P_5 P_6 P_7 P_8 10A/10C 0 2 0 0 0 0 0 0 10A/10E 0 0 0 0 0 1 0 0 10C/10B 0 0 0 0 0 1 0 0 10C/10D 0 0 0 0 0 0 0 2 10C/10D/10E/10A 0 0 2 0 0 0 0 0 10D/10E 0 0 0 0 2 0 0 0 11A/11B 0 2 2 0 0 0 0 0 11C/11D/11E 0 0 0 0 3 0 0 0 11D/11E 0 0 3 0 0 0 0 0 12A/12C 2 0 0 0 0 0 0 2 12D/12E 0 0 3 0 3 0 0 0 12E/10D 0 0 0 1 0 0 0 0 9A/9C 2 2 0 0 0 0 0 0 9C/9D 0 0 0 0 0 0 1 0 9D/9C 0 0 0 0 0 1 0 0 9D/9E 0 0 2 0 0 0 0 2
Însă metoda de generare a distribuţiei orelor pe zile pe care am introdus-o în [1] (şi intenţionăm acum să o reluăm) nu suportă „jumătăţile” de clasă şi de oră – încât vom ignora, sau vom transforma cumva, partajele evidenţiate mai sus.
Încadrarea de lucru
Se poate constata probabil (şi din cele de mai sus), că suntem mereu atenţi la aspectele reale (faţă de care avem adesea, critici argumentate); dar nu ne interesează neapărat, realitatea… Pentru experimentul de repartizare (omogenă) a orelor pe zile pe care ni l-am propus, avem nevoie de o încadrare a unor profesori pe clase; puteam foarte bine să producem una fictivă oarecare (plecând de la nişte „planuri-cadru” sau „curriculum”, existente la //edu.ro, sau fictive) – dar deocamdată am preferat să angajăm (cu unele adaptări) încadrări reale, deduse din diverse orare postate pe Internet.
Vom elimina cele 41 de ore partajate, evidenţiate în ultimul tabel redat mai sus – alocându-le însă, unor noi profesori (fictivi) – de exemplu, astfel:
outside <- tibble( prof = c(rep("Q1", 10), rep("Q2", 10), rep("Q3", 10), rep("Q4", 11)), cls = c("9C", "9C", "9D", "9D", "10A", "10B", "10C", "10D", "10E", "12E", "12A", "12A", "12C", "12C", "11A", "11A", "11B", "11B", "9A", "9A", "11D","11D","11D", "11E","11E","11E", "9C", "9C", "9D", "9D", "9E", "9E", "12D","12D","12D", "12E","12E","12E", "11C","11C","11C") )
Consultând documentul PDF care prezenta „orarul pe clase” (unde se precizează şi disciplinele), am încadrat profesorul "Q1" pe 10 ore de "Muz/Des" (cu câte 2 ore – una "Muz" şi una "Des" – la clasele 9C şi 9D şi câte una la următoarele 6 clase din lista de mai sus), iar profesorii "Q2", "Q3" şi "Q4" pe ore de limbi străine (câte două, sau câte trei pe clasă) – rezultând în total, cele 41 de ore „partajate” anterior.
Acum „eliminăm” din orar_norm coloanele $zi şi $ora şi înlocuim cele 41 de ore partajate, prin cele definite mai sus:
fram <- orar_norm %>% select('prof', 'cls') %>% # „elimină” coloanele 'zi', 'ora' filter(!grepl('[^[:alnum:]]', cls)) %>% # ignoră orele partajate rbind(., outside) # adaugă cele 41 de ore „fictive”
În final, redefinim coloana $prof ca factor ordonat, având ca nivele nişte nume convenţionale "P1", ..., "P76", a căror ordine coincide cu ordinea descrescătoare a numărului de ore pe săptămână pentru profesorii respectivi, ordonăm cele 1202 linii după $prof (şi $cls) şi salvăm obiectul tibble rezultat în fişierul "frame.rds":
srt <- sort(table(fram$prof), decreasing=TRUE) fram$prof <- factor(fram$prof, levels=names(srt), ordered=TRUE) numePr <- c(paste0("P0", (1:9)), paste0("P", (10:76))) # 76 profesori levels(fram$prof) <- numePr # descrescător după numărul de ore pe săptămână fram %>% arrange(prof, cls) %>% saveRDS(., "frame.rds") # 1202x2 <ord>prof <chr>cls
Subliniem că am ordonat liniile nu numai după profesori, dar – spre deosebire de [1] – şi după clase; aceasta ne permite să evidenţiem imediat, ideea de bază a distribuirii pe zile a orelor (împreună cu avantajele şi defectele acesteia).
Un algoritm „evident” de repartizare pe zile a orelor
Fiecărui profesor îi corespund în frame.rds, atâtea linii consecutive câte ore pe săptămână are acesta; clasele sale apar pe aceste linii în ordine alfabetică, deci pentru fiecare dintre aceste clase avem atâtea linii consecutive câte ore pe săptămână are acel profesor la clasa respectivă.
Pentru a ilustra algoritmul cel mai simplu de repartizare a orelor pe zilele de lucru, să considerăm liniile corespunzătoare primilor doi profesori:
library(tidyverse) fram <- readRDS("frame.rds") p12 <- fram %>% filter(prof %in% c("P01", "P02")) print(table(p12['prof'])[1:2]) #P01 P02 # 26 24 ## ore pe săptămână (în total, 50 de linii)
Pe cele 50 de linii rezultate în p12 înscriem repetat, de sus în jos, secvenţa zilelor de lucru – obţinând o distribuţie pe zile a celor 50 de ore:
Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi") p12 <- cbind(p12, zl = c(rep(Zile, 10))) # etichetează orele, cu zile prof cls zl prof cls zl # 1 P01 10A Lu P01 8D Lu 26 # 2 P01 10A Ma P02 11B Ma 27 # 3 P01 10B Mi P02 11C Mi 28 # 4 P01 10B Jo P02 11D Jo 29 # 5 P01 10C Vi P02 12E Vi 30 # 6 P01 10C Lu P02 12E Lu 31 # 7 P01 10D Ma P02 6C Ma 32 # 8 P01 10D Mi P02 6C Mi 33 # 9 P01 10E Jo P02 6D Jo 34 # 10 P01 11A Vi P02 6D Vi 35 # 11 P01 11E Lu P02 6E Lu 36 # 12 P01 11E Ma P02 6E Ma 37 # 13 P01 12A Mi P02 7A Mi 38 # 14 P01 12B Jo P02 7A Jo 39 # 15 P01 12C Vi P02 7C Vi 40 # 16 P01 12D Lu P02 7C Lu 41 # 17 P01 6A Ma P02 7D Ma 42 # 18 P01 6A Mi P02 7D Mi 43 # 19 P01 8A Jo P02 7E Jo 44 # 20 P01 8A Vi P02 7E Vi 45 # 21 P01 8B Lu P02 9A Lu 46 # 22 P01 8B Ma P02 9B Ma 47 # 23 P01 8C Mi P02 9C Mi 48 # 24 P01 8C Jo P02 9D Jo 49 # 25 P01 8D Vi P02 9E Vi 50
Din faptul că liniile profesorului sunt consecutive, rezultă că (prin etichetarea făcută) orele sale sunt distribuite uniform (cu diferenţă de cel mult o oră, între o zi şi alta):
print(table(p12[c('prof','zl')])[1:2, ]) # zl #prof Jo Lu Ma Mi Vi # P01 5 6 5 5 5 ## ore pe fiecare zi # P02 5 4 5 5 5
Din faptul că între liniile profesorului, cele corespunzătoare unei aceleiaşi clase sunt consecutive – rezultă că orele profesorului la o aceeaşi clasă (dacă nu-s mai multe decât 5) se vor desfăşura în zile diferite.
Bineînţeles că, fiind aşa de simplu, mecanismul exemplificat mai sus are un defect: clasele nu vor avea, în general, o distribuţie uniformă pe zile a orelor respective; continuând etichetarea cu 'Zile' pe liniile profesorilor P03, P04 etc. – vom avea la un moment dat situaţia în care o clasă cumulează 10 ore într-o zi şi doar 3 ore de exemplu, într-o altă zi.
Invers, dacă am eticheta cu 'Zile' nu după profesori şi clase ca mai sus – ci după clase şi profesori (ordonând liniile iniţiale după $cls şi apoi, după $prof), atunci clasele vor avea o distribuţie uniformă pe zile a orelor, dar în general, profesorii vor căpăta distribuţii ne-uniforme în privinţa numărului de ore pe zi (se păstrează totuşi, un avantaj: profesorul nu va face într-o aceeaşi zi, la o aceeaşi clasă, mai multe ore decât s-ar cuveni).
Program experimental de distribuire pe zile a orelor
Programul redat mai jos (formulat în R) are un caracter „experimental”: poate să producă rezultatul dorit, dar nu neapărat la prima lansare, iar timpul de execuţie nu poate fi estimat – poate fi 1-2 minute sau la o nouă lansare, 15-30 minute, sau poate fi ceva mai mult de o oră; dacă timpul de execuţie este scurt, aproape sigur se obţine o distribuţie a orelor – altfel, se poate şi ca lansarea curentă să nu producă rezultatul aşteptat; în plus, distribuţiile obţinute printr-un număr rezonabil de lansări succesive ale programului, diferă una de alta.
Lucrurile se petrec aşa pentru că orele de distribuit sunt „etichetate” cu Zile în ordinea claselor şi a profesorilor, dar dacă alocarea rezultată nu satisface anumite condiţii de echilibru, atunci se permută aleatoriu profesorii clasei curente (eventual şi clasele, mai târziu) şi se reia alocarea, în noua ordine – repetând până când sau se nimereşte o ordine de parcurgere care conduce la o alocare „echilibrată”, sau reapelarea devine imposibilă, depăşindu-se capacitatea stivei de apeluri.
Ne bazăm deci pe acest postulat: dacă echilibrarea vizată este una rezonabilă, atunci există o ordine de parcurgere a orelor pentru care etichetarea prin Zile conduce la o distribuţie „echilibrată” a orelor respective; impunând condiţii rezonabile (nu foarte restrictive), vor exista suficient de multe asemenea ordini de parcurgere a orelor – încât sunt mari şanse de a nimeri una, într-o serie suficient de lungă de încercări.
S-ar putea impune diverse condiţii (v. [1]); noi pretindem ca distribuţiile individuale să fie cvasi-omogene: la profesorii care au cel puţin 15 ore pe săptămână, numărul de ore pe zi să nu varieze cu mai mult de (să zicem) două ore, de la o zi la alta (cei care au puţine ore vor prefera să le facă în cât mai puţine zile).
Bineînţeles că redăm programul fără jenă, cu lux de comentarii; părţile principale sunt separate prin câte un rând alb.
Pentru a regiza reluările cum am evidenţiat mai sus (evitând pe cât se poate stoparea execuţiei, cauzată de limitarea existentă pentru stiva de apeluri), am folosit „tryCatch() imbricat” – un mecanism uşor de formulat, dar realmente greu de înţeles şi de lămurit dacă îl angrenezi ca aici, într-un context recursiv (cam peste tot, tryCatch() este legat de producerea unor mesaje explicative la apariţia în cursul execuţiei a unor anumite excepţii); n-am dat de vreun exemplu de folosire în context recursiv – cel de faţă ar fi primul, încât probabil că sunt încă de făcut anumite verificări şi eventual, reformulări.
# distribute.R rm(list = ls()) # elimină datele din sesiuni de lucru anterioare library(tidyverse) # încadrarea pe clase a profesorilor, în formă normală (format „lung”) FRM <- readRDS("frame.rds") # <prof> <cls> - pentru fiecare oră din săptămână # $prof este "factor ordonat" (descrescător după numărul de ore pe săptămână) nrPr <- length(levels(FRM$prof)) # 76 profesori; primii 55 au măcar 15 ore pe săptămână Cls <- unique(FRM$cls) # clasele şcolii (32 de clase, într-un singur schimb) # pentru a distribui numai orele anumitor clase: Cls <- c(<lista claselor>) Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi") FRM <- FRM %>% split(.$cls) # listă de „tabele”, câte unul de clasă # alocă orele pe zile, pentru fiecare clasă alloc_by_class <- function() { # controlul numărului de ore pe zi cumulat la profesori Zore <- matrix(data=rep(0L, 5*nrPr), nrow = 5, ncol = nrPr, byrow=TRUE) # Condiţiile impuse unei distribuţii a orelor CND <- function(More) { mex <- Zore[, 1:55] + More[, 1:55] # la profesorii cu măcar 15 ore/săpt. for(j in 1:ncol(mex)) { Pr <- mex[, j] # câte ore ar avea, în fiecare zi, profesorul for(oz in Pr) if(any(abs(Pr - oz) > 2)) return(FALSE) # refuză alocarea, dacă nu este "pseudo-omogenă" } return(TRUE) # acceptă alocarea: nr. ore/zi variază cu max. 2 (dacă suma >= 15) } # montează coloana zilelor alocate orelor unei clase labelsToClass <- function(Q) { # 'Q' conţine liniile din FRM cu o aceeaşi 'cls' S <- Q %>% mutate(zl = gl(n=5, k=1, length = nrow(.), ordered=TRUE, labels = Zile)) # %>% as.data.frame(.) # verifică dacă orele pe zi alocate profesorilor clasei respectă CND() more <- t(as.matrix(table(S[c('prof', 'zl')]))) if(CND(more)) { Zore <<- Zore + more # actualizează numărul de ore pe zi return(S) # o distribuţie care îndeplineşte condiţiile } # dacă nu-s îndeplinite CND(), permută profesorii clasei şi reia Q <- Q %>% arrange(match(prof, sample(unique(prof))), prof) return(labelsToClass(Q)) # Reia dacă nu-s îndeplinite condiţiile } # (programul va fi stopat dacă reapelarea nu mai este posibilă) tryCatch( # previne stoparea programului (v. [1]) { FRM %>% # etichetează liniile fiecăreia dintre clase map_df(., function(K) labelsToClass(K)) }, error = function(err) { # s-a depăşit capacitatea stivei de apeluri FRM <- FRM %>% sample(.) # permută grupurile de linii ale claselor tryCatch({ # cat("1") ## vizualizează cumva, reluările alloc_by_class() # reia, în noua ordine a claselor }, error = function(e) NULL # încercările făcute au eşuat ) } ) # Returnează distribuţia pe zile a orelor claselor indicate (sau, doar NULL) } # Exemplu: # Dis <- alloc_by_class() # saveRDS(Dis, file = "Dis1.rds")
Pentru a pune la punct programul (ajungând la forma finală redată mai sus), am experimentat întâi pe un număr redus de clase (definind Cls <- c(<listă_clase>)), scurtând astfel timpul de execuţie.
Bineînţeles că am rulat programul (considerând întregul set de clase) de suficient de multe ori, în diverse zile şi momente de timp, obţinând fişiere "Dis*.rds" ca în exemplul din comentariul final de mai sus – cu timpi de execuţie ca 1-2 minute (în două-trei cazuri din vreo 30), 7-50 minute (de cel mai multe ori), sau peste o oră (când uneori au rezultat distribuţiile căutate, alteori doar NULL).
Lista distribuţiilor; alegerea unei distribuţii
În [1] obţinusem (cu un program asemănător celui de aici) şi fişiere "Dis*.rds" conţinând câte o listă cu 100 de distribuţii – dar în [1] condiţiile CND() erau mai „slabe” ca aici şi încadrarea considerată avea cu vreo 300 de ore mai puţin; acum ne-am limitat să generăm cel mult două distribuţii într-un acelaşi fişier (fiindcă în urma întăririi condiţiilor şi a creşterii dimensiunii încadrării, generarea unei distribuţii va dura mai mult timp).
Bineînţeles că ne-am încurcat, imitând un timp metoda de obţinere a distribuţiilor din [1] (unde funcţia generate_distributions() producea o listă de distribuţii), iar în alt moment rulând direct programul de mai sus (vezi exemplul final din "distribute.R"): unele dintre fişierele obţinute conţin câte o listă (obiect R de clasă "list") care conţine fie unul, fie două obiecte tibble (reprezentând distribuţiile găsite de program), iar alte fişiere conţin direct câte un obiect tibble (neambalat într-un "list").
Faptul că avem şi liste de distribuţii şi direct câte o distribuţie (şi faptul că fişierele care le conţin sunt denumite ne-unitar), explică anumite complicaţii din programul următor, prin care vom reuni în lDis.rds distribuţiile din toate aceste fişiere, constituind deasemenea (v. [1]) şi fişierul lZore.rds, care asociază fiecărei distribuţii matricea distribuţiilor individuale (numărul de ore alocate pe profesor în fiecare zi):
# dis_and_mat.R library(tidyverse) # 13 fişiere cu câte o listă conţinând o singură distribuţie (obiect 'tibble') lstR1 <- c(paste0("Dis", c(1:9, 92:94), ".rds"), "Dist5.rds") # 3 fişiere cu câte o listă conţinând câte două distribuţii (obiecte 'tibble') lstR2 <- c(paste0("Dist", c(3,4,6), ".rds")) # 14 fişiere conţinând nu liste, ci câte un obiect 'tibble' lstR3 <- c("Dis91.rds", paste0("Dist", c(1,2,7,8,9,91), ".rds"), paste0("abc", 1:7, ".rds")) lD1 <- map(lstR1, function(f) {readRDS(f)[[1]]}) # listă cu 13 obiecte 'tibble' lD2 <- do.call(c, map(lstR2, readRDS)) # listă cu 6 obiecte 'tibble' lD3 <- map(lstR3, readRDS) # listă cu 14 obiecte 'tibble' lDis <- c(lD1, lD2, lD3) # lista finală a celor 33 obiecte 'tibble' (distribuţii) saveRDS(lDis, file="lDis.rds") lZore <- map(lDis, function(Q) as.matrix(table(Q[c("prof", "zl")]))) saveRDS(lZore, file="lZore.rds") # 33 matrici "Zore" (listă „paralelă” cu 'lDis')
În [1] am exagerat (cam inutil), generând peste 1000 de distribuţii; acum avem un număr rezonabil de distribuţii, iar scopul este acela de a alege una dintre acestea, ca bază pentru formularea ulterioară a orarului şcolar propriu-zis (având o distribuţie pe zile a tuturor orelor, rămâne de distribuit pe intervale orare orele dintr-o aceeaşi zi).
Pentru profesorii cu măcar 15 ore pe săptămână (care şi formează majoritatea), nu prea avem de distins între distribuţiile obţinute (era suficientă una singură!) – dat fiind că pentru aceştia, CND() asigură deja distribuţii individuale cvasi-omogene. Totuşi încă ar fi de ţinut seama de „coeficienţii de omogenitate” introduşi în [1] – de exemplu pentru a distinge între o distribuţie individuală „bună” ca (6 6 6 4 4) şi cea „perfectă” (6 5 5 5 5), dar mai ales pentru a distinge la profesorii cu mai puţin de 15 ore pe săptămână, între o distribuţie individuală „rea” ca (5 0 0 1 0) şi una (tot rea, mai ales din punctul de vedere al profesorului, dar cu un coeficient de omogenitate mai bun) ca (3 1 0 1 1), sau una ca (3 3 0 0 0), probabil cea „perfectă” pentru profesor.
Prin următorul program vom alege o distribuţie care să aibă cât mai multe distribuţii individuale cvasi-omogene (de coeficient cel mult 0.5) şi totodată, să aibă între distribuţiile individuale, cât mai puţine cazuri de zile cu câte o singură oră (astfel, pe cât se poate, desconsiderăm şi cazuri ca (5 0 0 1 0) şi cazuri ca (3 1 0 1 1), sau (2 1 1 1 1)):
# grope.R (investighează distribuţiile rezultate) library(tidyverse) lDis <- readRDS("lDis.rds") # lista distribuţiilor (33 'tibble') lZore <- readRDS("lZore.rds") # matricile orelor pe zile, pentru profesori cf_omg <- function(ore_zi) { # coeficient de omogenitate (v. [1]) ore <- ore_zi[ore_zi != 0] round(sd(ore)/mean(ore)*diff(range(ore)), 2) } lCfo <- lapply(1:length(lZore), function(id) { S <- apply(lZore[[id]], 1, cf_omg) length(which(S > 0.5)) }) print(table(unlist(lCfo))) # 15 17 18 19 21 22 23 24 26 ## câţi coeficienţi „răi” ( > 0.5) # 1 1 1 2 5 5 6 9 3 ## în câte distribuţii din cele 33 # câte cazuri de zile cu câte o singură oră există, în distribuţiile individuale? lH1 <- lapply(1:length(lZore), function(id) { sum(lZore[[id]] == 1) }) print(table(unlist(lH1))) # 27 28 29 30 32 33 34 35 36 37 38 39 40 43 ## câte valori '1' # 1 1 1 3 2 2 1 1 7 3 5 4 1 1 ## în câte distribuţii din cele 33
Din rezultatele anexate mai sus (sub semnul de comentariu, '#'), vedem că avem numărul minim 15 de coeficienţi „răi” într-o singură distribuţie şi avem numărul minim 27 de cazuri de zile cu câte o singură oră, deasemenea într-o singură distribuţie; investigând (prin which()) indecşii distribuţiilor, constatăm că avem ceva noroc – găsim una care satisface suficient, ambele criterii:
> which(lCfo %in% c(15, 17)) #[1] 1 10 ## which(lCfo == 15) dă 10, nu 1 > which(lH1 %in% c(27, 28)) #[1] 1 31 ## which(lH1 == 27) dă 1
Deducem de aici că distribuţia lDis[[1]] are 17 (cu numai 2 mai mult, ca minimul) distribuţii individuale de coeficient mai mare ca 0.5 şi are cel mai mic număr de zile cu câte o singură oră – prin urmare, aceasta ar fi distribuţia pe care o alegem.
Salvăm distribuţia aleasă lDis[[1]], într-un fişier ".rds"; urmează să vedem cum o putem îmbunătăţi (modificând convenabil unele distribuţii individuale).
vezi Cărţile mele (de programare)