[1] De capul meu prin problema orarului şcolar (pe Google Play)
[2] Mofturile repartizării lecţiilor (I şi II)
În matricea de încadrare avem profesorii, clasele şi numerele de ore aferente – dar nu neapărat, şi disciplinele pe care sunt încadraţi profesorii…
Cum să cerem încadrarea – într-un format cât mai simplu – încât să impunem şi o specificare neexpeditivă a disciplinelor?
Folosim un editor de text – v. [Gedit] – şi creem un fişier-text, în care constituim câte o secţiune de linii pentru fiecare disciplină, separând prin câte un rând gol.
Pe prima linie a secţiunii curente înscriem numele cuvenit pentru disciplina respectivă; pe liniile următoare înscriem câte unul dintre profesorii încadraţi pe acea disciplină şi indicăm clasele (şi numărul de ore pe săptămână) la care este încadrat fiecare.
Folosim ':' pentru a separa numele de lista claselor şi '=' pentru a separa clasa de numărul orelor; de exemplu, Nume Prenume: 10A=3 9B=2 9D=2.
Folosim '/' pentru a separa numele profesorilor care sunt încadraţi „pe grupe”, la clasele respective (v. mai jos, "Informatică") şi deasemenea, pentru a separa disciplinele cu câte o oră la două săptămâni (v. mai jos "Educaţie muzicală/Educaţie vizuală").
Redăm un asemenea fişier de încadrare, "frame_fk.txt", în care numele şi prenumele profesorilor au fost generate aleatoriu – v. [Faker] – iar celelalte date de încadrare (discipline, clase, număr de ore) provin dintr-o anumită şcoală reală:
Biologie Bistriceanu Doriana: 10E=2 11B=1 12E=1 12I=1 5A=1 6A=2 6B=2 7A=2 8A=1 8B=1 9D=2 Diaconescu Ilinca: 10B=2 10F=2 10I=2 11C=1 11D=1 9I=2 Gacea Raluca: 10A=2 10D=2 11E=1 11I=1 12F=1 12G=1 12H=1 9A=2 9B=2 9C=2 9E=2 9F=2 9H=2 Stan Matei: 10C=2 10G=2 10H=2 11A=1 11F=1 11G=1 11H=1 12A=1 12B=1 12C=1 12D=1 9G=2 Chimie Albu Ghenadie: 10B=2 12A=1 7A=2 8B=2 9B=2 9C=2 9E=2 9F=2 Broască Laurian: 10A=2 10C=2 10F=2 10G=2 10H=2 11F=1 11G=1 11H=1 12F=1 12G=1 12H=1 Mazilescu Eleonora: 10D=2 10E=2 11B=1 11E=1 12D=1 12E=1 12I=1 8A=2 9D=2 Niță Izabela: 10I=2 11A=1 11C=1 11D=1 11I=1 12B=1 12C=1 9A=2 9G=2 9H=2 9I=2 Cultură civică Dinu Mina: 7A=1 8A=1 8B=1 Cultură germană Florescu Răzvan: 10A=1 Idriceanu Antim: 11A=1 12A=1 Tomescu Sorin: 9A=1 Dezbatere Nistor Xenia: 11D=1 11I=1 Dirigenţie Barbu Crenguța: 7A=1 Corbu Clementina: 6A=1 Diaconu Nicoleta: 8B=1 Florea Coralia: 6B=1 Socaciu Remus: 5A=1 Tabacu Dorin: 8A=1 Economie Mocanu Măriuca: 11A=1 11B=1 11C=1 11D=1 11E=1 11F=1 11G=1 11H=1 11I=1 Educaţie antreprenorială Mocanu Măriuca: 10A=1 10B=1 10C=1 10D=1 10E=1 10F=1 10G=1 10H=1 10I=1 Educaţie fizică Asavei Luiza: 10A=2 10F=2 10G=2 10I=2 Budăi Natașa: 10B=2 10C=2 10D=2 10E=2 11H=1 5A=2 6A=2 6B=2 8A=2 8B=2 9A=1 9B=1 9C=1 9E=1 9H=1 Dobre Blanduzia: 10H=2 11A=1 11B=1 11C=1 11E=1 12A=1 12B=1 12C=1 12D=1 12E=1 12F=1 12G=1 12H=1 12I=1 7A=2 9D=1 Hodorcea Astrid: 11D=1 11F=1 11G=1 11I=1 9F=1 9G=1 9I=1 Educaţie muzicală Dinu Mina: 5A=1 6A=1 6B=1 7A=1 8A=1 8B=1 Educaţie muzicală/Educaţie vizuală Dinu Mina/Aanei Severina: 10A=1 10B=1 10C=1 10D=1 10E=1 10F=1 10G=1 10H=1 10I=1 9A=1 9B=1 9C=1 9D=1 9E=1 9F=1 9G=1 9H=1 9I=1 Educaţie socială Cozmâncă Adrian: 5A=1 6A=1 6B=1 Educaţie tehnologică Iosifescu Daniel: 5A=1 6A=1 6B=1 7A=1 8A=1 8B=1 Educaţie vizuală Aanei Severina: 5A=1 6A=1 6B=1 7A=1 8A=1 8B=1 Filosofie Oprea Roxana: 12A=1 12B=1 12C=1 12D=1 12E=1 12F=1 12G=1 12H=1 12I=1 Fizică Căldare Zeno: 10C=3 11C=3 11H=3 12A=3 12B=3 9G=3 Damian Gheorghe: 11I=3 8B=2 Dima Marilena: 11E=3 12I=3 9A=3 9B=3 Eftimie Fiona: 11D=3 11F=3 11G=3 12F=3 12G=3 12H=3 Ionescu Leana: 10A=3 10E=3 12C=3 12E=3 6A=2 9C=3 Pușcașu Bogdana: 10B=3 10F=3 10I=3 9E=3 9F=3 9H=3 9I=3 Suciu Demetra: 10D=3 10H=3 11B=3 12D=3 6B=2 7A=2 8A=2 9D=3 Tudor Teodora: 10G=3 11A=3 Geografie Nemeș Janeta: 10C=1 10H=1 10I=1 11B=1 11C=1 11E=1 11G=1 11I=1 12C=1 12I=1 8B=2 9A=1 9B=1 9C=1 9D=1 9E=1 9G=1 9H=1 9I=1 Tabacu Dorin: 10A=1 10B=1 10D=1 10E=1 10F=1 10G=1 11A=1 11D=1 11F=1 11H=1 12A=1 12B=1 12D=1 12E=1 12F=1 12G=1 12H=1 5A=1 6A=1 6B=1 7A=1 8A=2 9F=1 Informatică Ardelean Sandu: 10F=1 12B=4 9F=1 Ardelean Sandu/Bască Relu: 11H=3 Ardelean Sandu/Dochioiu Jean: 10F=3 9F=3 Barbu Crenguța: 11F=4 11H=4 5A=2 7A=2 8A=1 8B=1 9D=1 Barbu Crenguța/Stancu Lorena: 11C=3 12D=3 9D=3 Bască Relu: 10B=1 10H=1 11I=4 9E=1 9H=1 Bască Relu/Păduraru Julieta: 11I=3 9E=3 9H=3 Bască Relu/Stancu Lorena: 10H=3 Dochioiu Jean: 10G=1 12H=4 Dochioiu Jean/Pop Sabrina: 12E=3 12H=3 Dumitrescu Voichița: 10C=1 10D=1 12F=4 Dumitrescu Voichița/Enescu Melania: 12F=3 9I=3 Dumitrescu Voichița/Taşcă Crin: 10D=3 Enescu Melania: 9I=2 Marin Dida: 10E=1 11A=4 Marin Dida/Popa Edmond: 11G=3 Marin Dida/Stoica Simi: 10E=3 Marin Dida/Taşcă Crin: 11D=3 Marin Dida/Vartolomei Francisc: 9C=3 Pop Sabrina/Prisecaru Ilie: 11F=3 Pop Sabrina/Taşcă Crin: 12C=3 Popa Edmond: 11G=4 12E=4 Preda Ica: 11E=4 Preda Ica/Pop Sabrina: 11E=3 Preda Ica/Prisecaru Ilie: 10G=3 Preda Ica/Stănescu Zenovia: 12G=3 Preda Ica/Taşcă Crin: 12I=3 Prisecaru Ilie/Taşcă Crin: 10I=3 Stancu Lorena: 11C=4 Stănescu Zenovia: 12G=4 9A=1 9G=1 Stănescu Zenovia/Pop Sabrina: 9G=3 Stoica Simi: 6A=2 6B=2 Stoica Simi/Vartolomei Francisc: 11B=3 9B=3 Taşcă Crin: 10I=1 11D=4 12C=4 12D=4 12I=4 Vartolomei Francisc: 10A=1 11B=4 12A=4 9B=1 9C=1 Istorie Busuioc Viorel: 10A=1 10B=1 10C=1 10D=1 10E=1 10F=1 10G=1 10H=1 10I=1 11E=1 12A=1 12I=1 5A=2 6A=1 6B=1 Cristea Maia: 11A=1 11D=1 11F=1 11G=1 11H=1 11I=1 12B=1 12D=1 12E=1 12F=1 12G=1 9A=1 9B=1 9C=1 9D=1 9E=1 9F=1 9G=1 9H=1 9I=1 Sofrone Lazăr: 11B=1 11C=1 12C=1 12H=1 7A=1 8A=2 8B=2 Limba engleză Ciucă Dacian: 10A=2 10C=2 11H=2 11I=2 12C=2 12E=2 12F=2 12G=2 12H=2 9E=2 9F=2 9H=2 Diaconu Nicoleta: 10E=2 11A=2 11C=2 12A=2 7A=2 8B=2 9D=2 Diaconu Nicoleta/Socaciu Remus: 10B=4 12B=4 Popescu Sabina: 10D=2 10H=2 10I=2 11D=2 11E=2 11F=2 11G=2 12D=2 9G=2 Socaciu Remus: 10F=2 11B=2 12I=2 5A=3 6A=2 6B=3 8A=2 9C=2 9I=2 Zamfirescu Lucian: 10G=2 9A=2 9B=2 Limba franceză Bostan Lăcrămioara: 10C=2 10D=2 11I=2 12H=2 7A=2 9I=2 Chimir Mirela: 10H=2 10I=2 11F=2 12B=2 Georgescu Stelian: 10E=2 10G=2 11B=2 11E=2 12C=2 12D=2 12E=2 5A=2 8B=2 9B=2 Paşcu Ionela: 10B=2 11C=2 11G=2 12G=2 6A=2 6B=2 9C=2 9D=2 9F=2 Poamă Bucur: 10F=2 11D=2 11H=2 12F=2 12I=2 9E=2 9G=2 9H=2 Limba germană Florescu Răzvan/Idriceanu Antim: 10A=5 Idriceanu Antim: 8A=2 Toma Ilinca/Idriceanu Antim: 12A=5 Tomescu Sorin/Idriceanu Antim: 11A=5 9A=5 Limba latină Chimir Mirela: 7A=1 Limba română Ababei Agripina: 9I=4 Corbu Clementina: 12E=3 6A=4 8A=5 9F=4 Ene Norbert: 12B=3 9G=4 Florea Coralia: 10B=3 10C=3 10D=3 10F=3 11I=3 6B=4 Gomez Carla: 12I=3 5A=4 7A=4 8B=5 9A=4 Manole Atena: 11A=3 11H=3 12H=3 Marincea Anca: 10G=3 10I=3 9B=4 9E=4 9H=4 Stepan Iurie: 10E=3 11B=3 11C=3 11E=3 12D=4 9C=4 9D=4 Voicu Evanghelina: 10H=3 11D=3 12A=3 Voinea Georgia: 10A=3 11F=3 11G=3 12C=3 12F=3 12G=3 Logică Oprea Roxana: 9A=1 9B=1 9C=1 9D=1 9E=1 9F=1 9G=1 9H=1 9I=1 Matematică Arcan Iosif: 11A=4 11C=5 12B=4 12E=5 Bosânceanu Remus: 10G=4 11D=4 11H=5 12H=1 9G=4 Gheorghiu Alistar: 10I=4 11I=4 12H=4 9H=4 9I=4 Ghimbu Alma: 10A=4 10C=4 11E=1 12A=4 12B=1 9B=4 Ioniță Nicoară: 10E=4 12C=5 6A=5 7A=5 Picincu Nicoleta: 5A=5 6B=5 9A=4 9F=4 Săvescu Minodora: 10B=4 11G=5 12G=5 9E=4 Stroe Georgel: 10F=4 11B=1 11F=5 12F=5 12I=1 Todiraşcu Emilia: 10D=4 11B=4 12I=4 9C=4 Tudose Andreea: 8A=5 8B=5 Vrânceanu Bianca: 10H=4 11E=4 12D=4 9D=4 Psihologie Cozmâncă Adrian: 10F=1 10G=1 Nistor Xenia: 10A=1 10B=1 10C=1 10D=1 10E=1 10H=1 10I=1 Religie Garcea Sebastian: 11A=1 11B=1 11C=1 11D=1 11E=1 11F=1 11G=1 11H=1 11I=1 12A=1 12B=1 12C=1 12D=1 12E=1 12F=1 12G=1 12H=1 12I=1 5A=1 6A=1 6B=1 7A=1 8A=1 8B=1 Hriscu Anemona: 10A=1 10B=1 10C=1 10D=1 10E=1 10F=1 10G=1 10H=1 10I=1 9A=1 9B=1 9C=1 9D=1 9E=1 9F=1 9G=1 9H=1 9I=1 TIC Bască Relu: 10B=1 10H=1 9E=2 9H=2 Dochioiu Jean: 10F=1 10G=1 9F=2 Dominte Alexandru: 10D=1 10I=1 9C=2 9D=2 Dumitrescu Voichița: 10C=1 Enescu Melania: 9I=1 Marin Dida: 10E=1 9B=2 Stănescu Zenovia: 9A=2 9G=2 Vartolomei Francisc: 10A=1
Intenţionăm să producem din încadrarea "frame_fk.txt", un orar echilibrat – folosind (şi îmbunătăţind uneori) funcţiile de modelare a încadrării şi de repartizare echilibrată a lecţiilor pe zile şi pe orele zilei, din [1].
Ideea de bază din [1] este de a constitui un set al tuturor lecţiilor prof | cls care trebuie să se desfăşoare într-o săptămână şi a-l completa cu un factor zl care să aloce fiecărei lecţii câte o zi şi apoi, cu un factor ora care să aloce lecţiile dintr-o aceeaşi zi, pe orele 1..7 ale zilei (ajungând la un orar prof|cls|zl|ora).
În următorul program, întâi constituim un „dicţionar” (de fapt, o listă R) având drept chei – prin names() – numele disciplinelor şi drept valori, câte un vector care conţine liniile din frame_fk.txt aferente disciplinei:
# frame_lessons.R (fişierul de încadrare ==> setul lecţiilor obj|prof|cls) library(tidyverse) Lines <- readLines("frame_fk.txt") fct <- cumsum(Lines == '') # asociază fiecărei linii, rangul secţiunii (disciplinei) SL <- split(Lines, fct) # partiţionează liniile după discipline for(i in seq_along(SL)) { li <- SL[[i]] # liniile aferente unei aceleiaşi discipline n <- if(li[1] == "") 2 else 1 names(SL)[i] <- li[n] # numele disciplinei SL[[i]] <- li[-c(1:n)] # vectorul încadrărilor pe disciplina curentă }
Prin cumsum() am creat un „factor” tacit fct, pentru liniile citite din fişier: se asociază fiecărei linii (începând însă cu rândul gol "" care separă o secţiune de cea precedentă) rangul secţiunii din fişier care o conţine. Cu split(), am separat liniile după factorul fct – obţinând o listă a secţiunilor, listă pe care am numit-o apoi după discipline, asociind fiecăreia vectorul încadrărilor din secţiunea respectivă.
Redăm un eşantion, evidenţiind aspecte privitoare la discipline „principale” şi eventual „secundare”, precum şi aspecte privitoare la cuplajele de profesori:
> print(SL[21:23]) $`Limba franceză ` [1] "Bostan Lăcrămioara: 10C=2 10D=2 11I=2 12H=2 7A=2 9I=2 " [2] "Chimir Mirela: 10H=2 10I=2 11F=2 12B=2 " # încadrarea principală [3] "Georgescu Stelian: 10E=2 10G=2 11B=2 11E=2 12C=2 12D=2 12E=2 5A=2 8B=2 9B=2 " [4] "Paşcu Ionela: 10B=2 11C=2 11G=2 12G=2 6A=2 6B=2 9C=2 9D=2 9F=2 " [5] "Poamă Bucur: 10F=2 11D=2 11H=2 12F=2 12I=2 9E=2 9G=2 9H=2 " $`Limba germană ` [1] "Florescu Răzvan/Idriceanu Antim: 10A=5 " # cuplaj de profesori (lecţii "pe grupe") [2] "Idriceanu Antim: 8A=2 " [3] "Toma Ilinca/Idriceanu Antim: 12A=5 " [4] "Tomescu Sorin/Idriceanu Antim: 11A=5 9A=5 " $`Limba latină ` [1] "Chimir Mirela: 7A=1 " # încadrare secundară
Avem profesori care sunt încadraţi la mai multe discipline (am marcat mai sus Chimir); aceea la care are cel mai multe ore este cea „principală” – celelalte dacă există, sunt ”secundare”. În [1] nu am făcut asemenea distincţii, dar acum ne vom îngriji să constituim un subset de date corespunzător încadrărilor secundare (necesar mai târziu, la formularea corectă a orarelor claselor).
Avem şi cuplaje; subliniem convenţia de a separa numele respective prin '/', fără vreun spaţiu (Tomescu Sorin/Idriceanu Antim).
Acum, folosim strsplit() pentru a separa (la ':') profesorul sau cuplul, de secvenţa claselor şi apoi pentru a separa clasele (la ' ' – cu sublinierea că avem câte un singur spaţiu separator) şi prin map_dfr() vom obţine un „tabel” (data.frame) de forma:
obj prof cls_n
1 Biologie Bistriceanu Doriana 10E=2
2 Biologie Bistriceanu Doriana 11B=1
3 Biologie Bistriceanu Doriana 12E=1
Folosim apoi separate() pentru a separa (la '=') în două coloane, valorile din coloana 'cls_n'; în final, uncount() multiplică fiecare linie după valorile din coloana 'n' (pe care o elimină) – şi rezultă setul tuturor lecţiilor prof|obj|cls:
LSS <- map_dfr(seq_along(SL), function(i) { map_dfr(seq_along(SL[[i]]), function(j) { spl <- strsplit(SL[[i]][j], ":")[[1]] qs <- strsplit(str_trim(spl[2], side="both"), ' ')[[1]] data.frame(obj = names(SL)[i], prof = spl[1], cls_n = qs) }) }) %>% separate(col="cls_n", into=c("cls", "n"), sep="=", convert=TRUE) %>% uncount(n) # structura obiectului rezultat, LSS: 'data.frame': 1260 obs. of 3 variables: $ obj : chr "Biologie " "Biologie " "Biologie " "Biologie " ... $ prof: chr "Bistriceanu Doriana" "Bistriceanu Doriana" ... $ cls : chr "10E" "10E" "11B" "12E" ...
Obs. Ca de obicei, căutăm să lămurim mersul sau logica lucrurilor; descrierea exactă a ceea ce face una sau alta dintre funcţiile R+tidyverse pe care le angajăm, se poate vedea în consola R, prin comanda help() (de exemplu, help(cumsum), sau help(uncount), etc.).
Încheiem programul frame_lessons.R salvând bineînţeles, setul LSS:
saveRDS(LSS, "fk_lessons.RDS") # 1260 lecţii obj|prof|cls
saveRDS() serializează şi comprimă, obiectul indicat; fişierul rezultat măsoară cam 6.7KiB, dar putem constata prin object.size() că LSS ocupă în memorie cam 121KiB.
Numele profesorilor sau disciplinelor nu joacă niciun rol, în programele de repartizare pe zile şi pe orele zilei – încât este firesc să le înlocuim prin nişte coduri scurte (urmând să le reconstituim în final); mai mult – este uşor să imaginăm o codificare a profesorilor care să indice şi disciplina principală a fiecăruia, încât vom putea elimina variabila obj (reţinând însă, cazurile de profesor încadrat şi pe discipline secundare). Vom vedea mai jos că prin aceste simplificări fireşti, necesarul de memorie se reduce cam de trei ori, ceea ce va uşura sensibil, derularea ulterioară a programelor de repartizare.
Pe de altă parte, avem de constituit nişte „dicţionare” auxiliare, care să precizeze dependenţele dintre profesori în privinţa alocării pe zile şi ore; de exemplu, pentru un cuplaj – alocarea lecţiilor va trebui să ţină seama de alocările pentru membrii săi şi de alocările altor cuplaje în care sunt angajaţi aceştia.
Demarăm un program prin care să simplificăm setul lecţiilor şi să creem structurile de date necesare mai târziu, alocării lecţiilor pe zile şi ore:
# model_frame.R (codificări; dicţionare necesare alocării lecţiilor) library(tidyverse) LSS <- readRDS("fk_lessons.RDS") # 1260 lecţii obj|prof|cls
Să ne ocupăm întâi de disciplinele şcolare; de obicei, pe orarele claselor fiecare lecţie din ziua curentă este identificată prin numele disciplinei.
Dar sunt de făcut nişte simplificări fireşti: n-o să folosim denumirile oficiale, care de obicei sunt prea lungi (încât orarul clasei ar căpăta o formă prea sinuoasă); de exemplu, în loc de "Limba şi literatura română" este de preferat "Română".
Pe de altă parte, vrând să codificăm profesorii după discipline, trebuie şi să abreviem la cel mult două caractere, numele interne ale disciplinelor.
Înlocuim denumirile iniţiale din LSS$obj, cu abrevierile dorite, prin următorul procedeu tipic: transformăm $obj în factor ordonat şi modificăm cum credem – inclusiv, apelând la abbreviate() – nivelele acestuia, folosindu-ne bilateral de levels():
LSS <- LSS %>% mutate(obj = factor(str_trim(obj), ordered=TRUE)) Obj <- levels(LSS$obj) # disciplinele din "frame_fk.txt", ordonate alfabetic ## Modificări: Obj[11] <- "Ed. muzicală/vizuală" # în loc de "Educaţie muzicală/vizuală" Obj[20] <- "Engleză" # în loc de "Limba engleză" # şi altele ## Abrevieri, cu modificări: Obj <- abbreviate(Obj, minlength=2, strict=TRUE, use.classes=FALSE) Obj[c("Informatică", "Matematică", "Română")] <- c("N", "M", "R") Obj["Ed. muzicală/vizuală"] <- "mv" # etc. levels(LSS$obj) <- as.vector(Obj) # adoptă abrevierile disciplinelor, în LSS$obj ## Structura actuală a setului lecţiilor: 'data.frame': 1260 obs. of 3 variables: $ obj : Ord.factor w/ 29 levels "Bi"<"Ch"<"Cc"<..: 1 1 1 1 1 1 1 1 1 1 ... $ prof: chr "Bistriceanu Doriana" "Bistriceanu Doriana" "Bistriceanu Doriana" ... $ cls : chr "10E" "10E" "11B" "12E" ...
În loc de "Biologie" avem acum "Bi", ş.a.m.d. Dar când va fi să redăm orarul clasei, va trebui să înscriem nu abrevieri ca "Bi", ci chiar numele convenit pentru fiecare disciplină ("Biologie", etc.); deci vom avea nevoie de dicţionarul invers, care să asocieze fiecărei abrevieri din vectorul levels(obj), numele disciplinei:
OBJ <- names(Obj) # inversează dicţionarul disciplinelor names(OBJ) <- levels(LSS$obj) > print(OBJ) Bi Ch Cc "Biologie" "Chimie" "Cultură civică" Cg De Di "Cultură germană" "Dezbatere" "Dirigenţie" Ec Ea Ef "Economie" "Ed. antreprenorială" "Educaţie fizică" Em mv Es "Educaţie muzicală" "Ed. muzicală/vizuală" "Educaţie socială" Et Ev Fs "Ed. tehnologică" "Educaţie vizuală" "Filosofie" Fi Gg N "Fizică" "Geografie" "Informatică" Is En Fr "Istorie" "Engleză" "Franceză" Ge La R "Germană" "Latină" "Română" Lo M Ps "Logică" "Matematică" "Psihologie" Re TI "Religie" "TIC"
Mai departe, ideea este de a nota profesorii după disciplină; de exemplu, cei de "Biologie" vor fi desemnaţi prin "Bi1", "Bi2", "Bi3" şi "Bi4". Am abreviat prin câte o singură literă, disciplinele cu mai mult de 9 profesori – vizând pentru aceştia notaţii de genul "N01", ..., "N09", "N10", etc. (astfel, codurile profesorilor vor fi toate, de lungime 3).
Să separăm lecţiile în două părţi – cele „cu întreaga clasă”, respectiv cele care decurg „pe grupe” (pentru care în câmpul prof apare '/'):
Sep <- LSS %>% split(grepl("/", .$prof)) Pr1 <- Sep[[1]] %>% pull(prof) %>% unique() %>% sort() # profesorii care au ore proprii ("cu clasa întreagă") Pr2 <- Sep[[2]] %>% filter(obj != "mv") %>% pull(prof) %>% unique() %>% strsplit(., "/") %>% unlist() %>% sort() # profesorii angajaţi în cuplaje ("pe grupe")
grepl() produce valori logice, iar FALSE < TRUE – deci Sep[[1]] conţine lecţiile celor care au (şi) ore proprii (la care intră singuri), iar Sep[[2]] conţine lecţiile „pe grupe”.
Lecţiile de "mv" (v. mai sus, dicţionarul OBJ) nu decurg „pe grupe” (ci pe cupluri de clase, de care ne vom ocupa mai încolo), încât le-am exclus din Sep[[2]].
De observat că vectorii Pr1 şi Pr2 sunt ordonaţi alfabetic, prin sort()-ul final de mai sus; de fapt, n-ar fi fost necesar să mai folosim sort(), dacă aveam grijă de la bun început, să ordonăm după câmpul $prof (transformat eventual în factor) lecţiile din LSS.
Vom avea nevoie de o funcţie care să producă disciplinele pe care este încadrat un profesor (din Pr1, sau din Pr2), în ordinea descrescătoare a numărului de ore:
prof_objs <- function(P, lss) lss %>% filter(grepl(P, prof)) %>% count(obj, sort=TRUE) ## Exemplificări: > prof_objs("Idriceanu Antim", Sep[[1]]) obj n 1 Cg 2 ## Cultură germană 2 Ge 2 ## Germană > prof_objs("Idriceanu Antim", Sep[[2]]) obj n 1 Ge 20 ## Germană
Din exemplificarea aleasă mai sus, se vede că dacă profesorul apare şi în Pr1 şi în Pr2, atunci numai comparând încadrarea pe ore proprii cu aceea „pe grupe”, putem decide asupra disciplinei „principale” ("Idriceanu Antim" are ca disciplină principală Ge (la care are cel mai multe ore) şi ca disciplină „secundară” Cg).
Putem obţine acum o listă care asociază fiecărei discipline principale, setul profesorilor încadraţi pe acea disciplină – care au şi ore proprii (indiferent de disciplina acestora) – ordonaţi descrescător după numărul de ore:
Pob <- map_dfr(Pr1, function(P) { OB <- prof_objs(P, Sep[[1]])[1, ] if(P %in% Pr2) { # decide asupra disciplinei principale OB2 <- prof_objs(P, Sep[[2]])[1, ] if(OB2$n > OB$n) OB <- OB2 } data.frame(prof = P, obj = OB$obj, no = OB$n) }) %>% droplevels() %>% # ignoră disciplinele secundare (şi "mv") arrange(desc(no)) %>% split(.$obj) # Exemplificare: (List of 21) $ Ge:'data.frame': 3 obs. of 3 variables: ..$ prof: chr [1:3] "Idriceanu Antim" "Tomescu Sorin" "Florescu Răzvan" ..$ obj : Ord.factor w/ 21 levels "Bi"<"Ch"<"Ec"<..: 16 16 16 ..$ no : int [1:3] 20 10 5
Subliniem că prof_objs() păstrează calitatea de factor a câmpului $obj (implicit, toate cele 29 de nivele ale acestuia); folosind mai sus droplevels(), s-au păstrat numai cele 21 de nivele corespunzătoare disciplinelor principale.
Profesorii exemplificaţi mai sus vor fi notaţi prin Ge1, Ge2 şi respectiv Ge3. Consultând "frame_fk.txt", vedem că pe "Germană" avem un al 4-lea profesor, "Toma Ilinca", dar acesta nu are ore proprii, ci numai într-un cuplaj – fiind deci dintre profesorii „externi” (pe care îi vom codifica separat, acuşi).
În sfârşit – putem formula un „tabel” care asociază numelor din Pr1 coduri de câte 3 caractere, formate din codul disciplinei principale şi un sufix care indică numărul de ordine după numărul descrescător al orelor fiecăruia:
Pcd <- map_dfr(seq_along(Pob), function(i) { N <- nrow(Pob[[i]]) # numărul de profesori pe disciplina curentă ob <- Pob[[i]]$obj[1] obn <- if(N < 10) paste0(ob, 1:N) else c(paste0(ob, "0", 1:9), paste0(ob, 10:N)) data.frame(prof = Pob[[i]]$prof, cod = obn) })
Dar bineînţeles că în loc de „tabel”, va fi mai convenabil să lucrăm cu dicţionare:
prof_cod <- Pcd$cod names(prof_cod) <- Pcd$prof CPR <- setNames(names(prof_cod), prof_cod) # dicţionarul invers #Exemplificări: > sample(prof_cod, 4) Stan Matei Taşcă Crin Nistor Xenia Damian Gheorghe "Bi3" "N01" "Ps1" "Fi8" > sample(CPR, 3) N08 Ps1 Re2 "Vartolomei Francisc" "Nistor Xenia" "Hriscu Anemona"
După extindere (pentru a viza şi cuplajele), vectorul „cu nume” CPR va fi folosit când va fi cazul de a consemna pe orar numele reale, în loc de codurile profesorilor (iar din acestea, prin OBJ vom regăsi şi disciplinele).
Profesorii externi sunt aceia care apar în cuplaje, dar nu au ore proprii – deci apar în Pr2, dar nu şi în Pr1; le asociem coduri cu prefixul "X0" şi extindem vectorul prof_cod:
CEX <- setdiff(Pr2, Pr1) names(CEX) <- paste0("X0", 1:length(CEX)) # X01 X02 X03 X04 # "Păduraru Julieta" "Pop Sabrina" "Prisecaru Ilie" "Toma Ilinca" prof_cod <- c(prof_cod, setNames(names(CEX), CEX))
Folosind vectorul astfel extins prof_cod, putem codifica acum cuplajele – alipind codurile celor doi membri (şi anume, în ordine alfabetică):
tws <- Sep[[2]] %>% filter(obj != "mv") %>% pull(prof) %>% unique() %>% sort() # cuplajele de profesori (pe grupe) cup_cod <- vector("character", length(tws)) for(i in seq_along(tws)) { tw <- strsplit(tws[i], "/")[[1]] kod <- as.vector(prof_cod[tw]) # codurile membrilor if(kod[1] > kod[2]) # vrem codurile în ordine alfabetică kod[1:2] <- kod[2:1] cup_cod[i] <- paste0(kod[1], kod[2]) # alipeşte codurile membrilor } cup_cod <- setNames(cup_cod, tws) # Exemplificare: > sample(cup_cod, 2) Prisecaru Ilie/Taşcă Crin Diaconu Nicoleta/Socaciu Remus "N01X03" "En2En4"
Extindem iarăşi prof_cod, adăugând şi codurile cuplajelor de profesori:
prof_cod <- c(prof_cod, cup_cod)
Prin vectorul prof_cod putem codifica acum, toate numele din LSS$prof – cu excepţia acelora care corespund unor cuplaje de clase…
Pe disciplina mv avem un „cuplaj de clase” (v. fişierul de încadrare "frame_fk.txt"). Cele 18 ore la clasele a 9-a şi a 10-a trebuie efectuate „cu întreaga clasă” (şi nu „pe grupe”), alternând săptămânal cele două discipline; de exemplu, 9A face "Educaţie muzicală" (cu Em1) în săptămânile impare şi face "Educaţie vizuală" (cu Ev1) în cele pare.
Putem regiza alternanţa săptămânală a disciplinelor – mărind şi şansele de a evita ferestrele, celor doi profesori – prin împerecherea claselor în câte o aceeaşi zi şi oră; de exemplu, alocând într-un acelaşi timp, 9A lui Em1 şi 10A lui Ev1 – creem posibilitatea ca în săptămâna curentă Em1 să intre la 9A în timp ce Ev1 intră la 10A, iar în săptămâna următoare Em1 să intre la 10A în timp ce Ev1 intră la 9A.
Prevedem deocamdată zilele (nu şi orele zilei), în care să alocăm fiecare pereche de clase, pentru lecţiile de "mv":
CUP <- LSS %>% filter(obj == "mv") %>% select(prof, cls) %>% # exclude câmpul (constant) $obj mutate(prof = ifelse(grepl("9", cls), "Em1", "Ev1")) %>% arrange(cls) %>% mutate(zl = rep(c(1:5, 1:4), 2)) # alocarea pe zile a lecţiilor de "mv" # Exemplificare: prof cls zl prof cls zl 1 Ev1 10A 1 10 Em1 9A 1 2 Ev1 10B 2 11 Em1 9B 2 3 Ev1 10C 3 12 Em1 9C 3 4 Ev1 10D 4 13 Em1 9D 4 5 Ev1 10E 5 14 Em1 9E 5 6 Ev1 10F 1 15 Em1 9F 1 7 Ev1 10G 2 16 Em1 9G 2 8 Ev1 10H 3 17 Em1 9H 3 9 Ev1 10I 4 18 Em1 9I 4
În funcţie de paritatea săptămânii curente, cei doi profesori intră în fiecare zi la câte două clase (sau numai una, în ziua 5) de-a 10-a şi respectiv, de-a 9-a; rămâne să nu uităm că la aceste clase, cei doi vor face disciplina "mv"… (am exclus din CUP, coloana „constantă” $obj).
Acum, ignorând cele 18 lecţii deja repartizate pe zile, putem înregistra în LSS$prof codurile stabilite mai sus în vectorul prof_cod:
LSS <- LSS %>% filter(obj != "mv") %>% droplevels() %>% mutate(prof = as.vector(prof_cod[prof])) # structura actuală a setului lecţiilor de repartizat pe zile şi ore 'data.frame': 1242 obs. of 3 variables: $ obj : Ord.factor w/ 28 levels "Bi"<"Ch"<"Cc"<..: 1 1 1 1 1 1 1 1 1 1 ... $ prof: chr "Bi2" "Bi2" "Bi2" "Bi2" ... $ cls : chr "10E" "10E" "11B" "12E" ... # Exemplificare: > slice_sample(LSS, n=4) obj prof cls 1 Fi Fi2 10D 2 Ch Ch1 10F 3 N N01N06 12I 4 Cg Ge2 9A
Ne-au rămas de repartizat pe zile 1242 de lecţii obj|prof|cls; împreună cu CUP, acestea ocupă în memorie nu mai mult de o treime, din cât ocupa setul iniţial LSS:
> print(object.size(c(LSS, CUP)), units="auto") 39.2 Kb # iniţial, LSS ocupa cam 121 Kb
Dar să observăm că $obj este deja inutil: disciplina poate fi dedusă imediat din codul existent în $prof – exceptând totuşi, cazurile când este vorba de o disciplină „secundară” (cum se vede pe linia 4, în exemplificarea de mai sus).
Fiecare lecţie este reprezentată pe câte o linie din LSS; pe linia respectivă, codul din câmpul prof induce pe cel din câmpul obj numai în cazul disciplinelor „principale” – deci comparând pe fiecare linie, valorile prof şi obj, vom putea depista liniile corespunzătoare disciplinelor secundare. În mod implicit, operaţiile pe un obiect data.frame decurg „pe coloane”; dar funcţia dplyr::rowwise() asigură şi posibilitatea de a opera „pe linii”, cum am avea nevoie acum:
scd <- LSS %>% rowwise() %>% filter(! grepl(obj, prof)) # liniile pe care apar discipline "secundare" lSC <- scd %>% split(.$prof) OSE <- map_dfr(seq_along(lSC), function(i) { sec <- lSC[[i]] data.frame(prof = sec$prof[1], obj = sec$obj[1], # cel mult câte o singură disciplină secundară cls = paste(sec$cls, collapse = " ")) }) # Exemplificare: prof obj cls 1 Ec1 Ea 10A 10B 10C 10D 10E 10F 10G 10H 10I 2 Em1 Cc 7A 8A 8B 3 En2 Di 5A 4 En4 Di 8B 5 Es1 Ps 10F 10G 6 Fr5 La 7A 7 Fs1 Lo 9A 9B 9C 9D 9E 9F 9G 9H 9I 8 Ge1 Cg 11A 12A 9 Ge2 Cg 9A 10 Ge3 Cg 10A 11 Gg1 Di 8A 12 N02 Di 7A 13 N03 TI 10B 10H 9E 9E 9H 9H 14 N04 TI 10F 10G 9F 9F 15 N05 TI 10E 9B 9B 16 N08 TI 10A 17 N10 TI 10C 18 N13 TI 9I 19 N14 TI 9A 9A 9G 9G 20 Ps1 De 11D 11I 21 R03 Di 6B 22 R06 Di 6A 23 X02X03 N 11F 11F 11F
Subliniem că am avut în vedere numai situaţia pe care o putem considera ca obişnuită: un profesor are cel mult o singură disciplină secundară.
De observat că pentru X02X03 (care reprezintă doi profesori „externi”), "N" apare ca disciplină secundară (deşi este de fapt, cea principală) – fiindcă pentru profesorii externi nu am legat codul profesorului de codul vreunei discipline (ei apar numai în cuplaje, de regulă cu câte o valoare $prof care deja conţine codul disciplinei).
Subsetul OSE ne va folosi pentru a scrie corect orarele claselor; de exemplu, va trebui ca una dintre orele lui R06 la clasa 6A să fie nu "R" (Română), ci "Di" (Dirigenţie).
Subliniem că nu vom folosi OSE în procedura de repartizare pe zile a lecţiilor (decât poate, în cursul unor corecţii interactive ulterioare) – vrând să urmăm principiul de alocare „câte una pe zi” a orelor la o aceeaşi clasă, ale profesorului respectiv.
Acum putem şi elimina din LSS, câmpul obj:
LSS <- LSS %>% select(prof, cls)
Când va fi necesar, disciplinele vor putea fi reconstituite plecând de la codurile din $prof, consultând eventual şi subsetul OSE (şi folosind desigur, dicţionarul OBJ pentru a trece de la codurile disciplinelor la denumirile „corecte” ale acestora).
Alocarea pe zile şi ore a lecţiilor cuplajelor şi profesorilor care sunt angajaţi în cuplaje, depinde mereu de alocările făcute celor cu care sunt astfel conexaţi; vom constitui nişte „dicţionare” care să evidenţieze aceste dependenţe.
Împărţim lecţiile în două părţi, după lungimea codului (3 sau 6) din câmpul $prof:
S36 <- LSS %>% split(nchar(.$prof)) K3 <- S36[[1]] %>% pull(prof) %>% unique() %>% sort() K6 <- S36[[2]] %>% pull(prof) %>% unique() %>% sort()
Vectorii K3 şi K6 reprezintă (analog cu Pr1 şi Pr2 folosiţi mai înainte) profesorii propriu-zişi care au ore proprii, respectiv cuplajele de profesori (sau „profesorii fictivi”).
Următorul dicţionar are drept chei profesorii care intră măcar într-un cuplaj
și care au şi ore proprii, iar drept valori – vectorii care conţin profesorii de care
depind aceştia, la alocarea pe zile şi ore:
Tw1 <- map(K3, function(P) K6[grepl(P, K6)]) %>% setNames(K3) %>% compact() # Exemplificare: $En2 "En2En4" $En4 "En2En4" $Ge1 "Ge1Ge2" "Ge1Ge3" "Ge1X04" $Ge2 "Ge1Ge2" $Ge3 "Ge1Ge3" $N01 "N01N05" "N01N06" "N01N10" "N01X02" "N01X03" $N02 "N02N07" $N03 "N03N07" "N03N09" "N03X01" $N04 "N04N09" "N04X02" $N05 "N01N05" "N05N08" "N05N11" "N05N12" $N06 "N01N06" "N06N14" "N06X02" "N06X03" $N07 "N02N07" "N03N07" $N08 "N05N08" "N08N11" $N09 "N03N09" "N04N09" $N10 "N01N10" "N10N13" $N11 "N05N11" "N08N11" $N12 "N05N12" $N13 "N10N13" $N14 "N06N14" "N14X02"
Dacă P este una dintre cheile lui Tw1, ora din zi pe care o alocăm uneia dintre lecţiile lui P trebuie să nu coincidă cu vreuna dintre orele alocate deja cuplajelor din Tw1[[P]].
Constituim şi un dicţionar cumva invers, în care cheile sunt cuplajele existente, iar valorile sunt vectori care conţin profesorii – fictivi sau propriu-zişi – de care depinde alocarea orelor cheii respective:
Tw2 <- map(K6, function(PP) { P1 <- substr(PP, 1, 3) P2 <- substr(PP, 4, 6) setdiff(c(P1, P2, union(Tw1[[P1]], Tw1[[P2]])), union(PP, paste0("X0", 1:4))) %>% unique() }) %>% setNames(K6) %>% compact() Q <- K6[K6 != "X02X03"] # pentru cuplajul de profesori externi Tw2[["X02X03"]] <- union(Q[grepl("X02", Q)], Q[grepl("X03", Q)]) %>% unique() # Exemplificare: $En2En4 "En2" "En4" $Ge1Ge2 "Ge1" "Ge2" "Ge1Ge3" "Ge1X04" $Ge1Ge3 "Ge1" "Ge3" "Ge1Ge2" "Ge1X04" $Ge1X04 "Ge1" "Ge1Ge2" "Ge1Ge3" $N01N05 "N01" "N05" "N01N06" "N01N10" "N01X02" "N01X03" "N05N08" "N05N11" "N05N12" $N01N06 "N01" "N06" "N01N05" "N01N10" "N01X02" "N01X03" "N06N14" "N06X02" "N06X03" $N01N10 "N01" "N10" "N01N05" "N01N06" "N01X02" "N01X03" "N10N13" $N01X02 "N01" "N01N05" "N01N06" "N01N10" "N01X03" $N01X03 "N01" "N01N05" "N01N06" "N01N10" "N01X02" $N02N07 "N02" "N07" "N03N07" $N03N07 "N03" "N07" "N03N09" "N03X01" "N02N07" $N03N09 "N03" "N09" "N03N07" "N03X01" "N04N09" $N03X01 "N03" "N03N07" "N03N09" $N04N09 "N04" "N09" "N04X02" "N03N09" $N04X02 "N04" "N04N09" $N05N08 "N05" "N08" "N01N05" "N05N11" "N05N12" "N08N11" $N05N11 "N05" "N11" "N01N05" "N05N08" "N05N12" "N08N11" $N05N12 "N05" "N12" "N01N05" "N05N08" "N05N11" $N06N14 "N06" "N14" "N01N06" "N06X02" "N06X03" "N14X02" $N06X02 "N06" "N01N06" "N06N14" "N06X03" $N06X03 "N06" "N01N06" "N06N14" "N06X02" $N08N11 "N08" "N11" "N05N08" "N05N11" $N10N13 "N10" "N13" "N01N10" $N14X02 "N14" "N06N14" $X02X03 "N01X02" "N04X02" "N06X02" "N14X02" "N01X03" "N06X03"
La alocarea lecţiilor unui cuplaj P (cheie din Tw2), va trebui să ţinem seama de alocările făcute deja profesorilor şi cuplajelor din vectorul Tw2[[P]] (urmărind să evităm suprapunerile de ore).
Bineînţeles că profesorii „externi” X01..X04, neavând ore proprii, vor intra în acele zile şi ore care sunt alocate profesorilor fictivi care îi implică; în [1], prin dicţionarul suplimentar Twx, am avut în vedere numai situaţia în care profesorul extern respectiv intră în măcar două cuplaje – alocările acestora depind evident, una de alta.
De fapt, dacă intră într-un singur cuplaj dar acesta are în ziua curentă măcar două ore, atunci avem cam aceeaşi situaţie ca şi când ar intra în „măcar două cuplaje” – încât introducerea dicţionarului suplimentar Twx nu prea are sens şi doar, creează premizele unor greşeli ulterioare: în [1] am socotit ferestrele mizând pe Twx – deci omiţând ferestrele posibile ale unui profesor extern care este angajat într-un singur cuplaj, dar pe măcar două ore.
Pentru repartizarea lecţiilor pe zile şi apoi, pe orele zilei, vom avea nevoie de CUP (care conţine repartiţia pe zile convenită pentru lecţiile desfăşurate pe cupluri de clase) şi de dicţionarele Tw1 şi Tw2; le salvăm împreună, într-un acelaşi fişier .Rda (să observăm totuşi că de CUP avem nevoie numai pentru repartizarea pe zile).
Pentru formularea finală a orarelor vom avea nevoie de CPR şi OBJ (pentru a reconstitui numele profesorilor şi disciplinelor, din codurile acestora), precum şi de OSE (pentru a înregistra disciplinele secundare, în locul celor deduse din codurile existente pe lecţiile prof|cls, când este cazul) – deci constituim cu acestea un nou fişier .Rda.
Bineînţeles, salvăm şi structura actuală a lecţiilor LSS, într-un fişier .RDS:
saveRDS(LSS, "lessons.RDS") # 1242 lecţii prof|cls, de repartizat pe zile save(CUP, Tw1, Tw2, file="CUP_Tw.Rda") save(CPR, OBJ, OSE, file="CPR_OBJ_OSE.Rda")
Cu aceasta, putem încheia programul "model_frame.R".
[1] este o carte de programare, încât este firesc (şi chiar, de dorit) să putem îmbunătăţi uneori, programele respective… Avem acum ceva îmbunătăţiri şi pentru programul de repartizare a lecţiilor pe zilele săptămânii, by_days.R – conducând la o anumită reducere a timpului mediu necesar generării unei distribuţii.
mount_hours()În funcţia labelsToClass() (v. [1]) alocam zile pe lecţiile clasei curente, verificând ca la momentul abordării acesteia, profesorii clasei care au suficient de multe ore în încadrare, să aibă alocări zilnice „cvasi-omogene” şi apoi, verificând „alte condiţii”: profesorii numiţi în Tw1 să nu cumuleze, împreună cu cei de care depind aceştia (din cauza cuplajelor), mai mult de 7 ore pe zi. Dar (şi este aproape evident) nu este necesar să verificăm aceste condiţii pentru toate numele din Tw1 – ar fi suficient să verificăm numai pentru acelea care apar la clasa curentă!
Rescriem deci by_days.R astfel:
# by_days.R (repartizează pe zile, un set de lecţii) perm_zile <- readRDS("lstPerm47.RDS")[[2]] # int [1:5, 1:120] 1 2 3 4 5 ... load("CUP_Tw.Rda") # [1] "Tw1" "Tw2" "CUP" Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi") mount_days <- function(LSS, many_hours = 14, h_twin = 7, max_try = 100) { ## - v. [1] ... # montează coloana zilelor alocate lecţiilor unei aceleiaşi clase labelsToClass <- function(Q) { lpr <- cls_mh[[Q$cls[1]]] Ptw <- intersect(names(Tw1), Q$prof) # reduce CND2 (îmbunătăţire faţă de [1]) for(h in 1:max_try) { # încercări de alocare (schimbând ordini) Q <- Q %>% # max. 100 reordonări de profesori arrange(match(prof, sample(unique(prof))), prof) flag <- FALSE for(j in sample(120)) { # pentru toate ordonările de zile S <- Q %>% mutate(zl = rep_len(perm_zile[, j], nrow(.))) ## - v. [1] ... } if(flag) { # verifică alte condiţii CND2 <- map_lgl(Ptw, function(pr) { sdp <- apply(Zore[, c(pr, Tw1[[pr]])], 1, sum) any(sdp > h_twin) }) if(all(CND2 == FALSE)) return(S) } } return(NULL) # cele (cel mult) 12000 de încercări au eşuat } # aplică aleatoriu labelsToClass(), până "trec" toate clasele Lds <- vector("list", length(lstCls)) # va stoca distribuţia pe zile names(Lds) <- lstCls while(TRUE) { ## - v. [1] ... } bind_rows(Lds) %>% # returnează distribuţia (prof|cls|zl) full_join(., CUP, by=c("prof", "cls", "zl")) %>% mutate(zl = factor(zl, labels = Zile), prof = factor(prof, levels = levZ)) }
Am zis bine "ar fi suficient…", mai sus; nu este suficient: dacă la clasa curentă apare şi "N02" şi "N02N07" de exemplu, atunci în funcţie de ordinea în care sunt abordaţi profesorii (şi clasele), se vor contoriza orele plasate lui N02 şi ale celor plasate până la momentul respectiv celor din Tw1[[P02]] – dar nu şi ora plasată clasei curente lui "N02N07" (care ar mări, eventual la 8, orele cumulate zilnic de N02); probabil, corect era ca pe lângă Ptw să fi considerat şi "Ptw2", care să vizeze cheile din Tw2 existente în câmpul $prof al clasei curente – ceea ce ar fi complicat totuşi prea tare lucrurile…
Am făcut până la urmă un compromis, acceptând deocamdată ca unii dintre profesorii angajaţi în cuplaje să cumuleze 8 ore pe o zi sau alta, depăşind valoarea maximă specificată iniţial în parametrul h_twin (şi rămâne de văzut, ce se întâmplă în acest caz, cu numărul de ore al claselor implicate…).
Reformulăm şi programul "test1.R", prin care în [1] obţineam într-un anumit subdirector, un set de mai multe distribuţii pe zile:
# test1.R library(tidyverse) source("by_days.R") # mount_days() prnTime <- function() cat(strftime(Sys.time(), format="%H:%M:%S"), "\n") LSS <- readRDS("lessons.RDS") %>% # 1242 lecţii prof|cls (108 prof, 42 cls) mutate(prof = factor(prof, ordered=TRUE)) prnTime() for(i in 1:9) { Dis <- mount_days(LSS) saveRDS(Dis, file = paste0("byDays/D", i, ".RDS")) cat("\n") } prnTime()
De observat că faţă de [1], am renunţat (deocamdată) să mai implicăm fişierul "stmt_utils.R"; am specificat direct, vectorul Zile (în "by_days.R") şi funcţia prnTime().
Rulând "test1.R" de câteva ori, am obţinut seturi de câte 9 distribuţii pe zile, în timpi care variază de la 15 minute, la 30 minute – însemnând în medie 2-3 minute, pentru a genera o singură distribuţie; în [1] aveam în medie doar 30 secunde, dar comparaţia este delicată: în [1] aveam 73 de profesori şi 33 de clase, ori acum avem 108 profesori (incluzând cuplajele, în ambele cazuri) şi 42 de clase…
Rulând pentru LSS-ul de aici, "test1.R" cu mount_days() din [1] şi respectiv, cu mount_days() „îmbunătăţită” mai sus – am obţinut seturi de câte 9 distribuţii cam în 40-50 de minute, respectiv în numai 15-30 de minute (deci, mult mai bine!).
Bineînţeles că dintre distribuţiile obţinute, am ales una care să aibă cât mai puţine situaţii în care un profesor angajat în cuplaje cumulează mai mult de 6 ore pe zi şi care să fie cât mai echilibrată faţă de totalul orelor pe fiecare zi:
# tst1.R evidenţiază proprietăţi ale distribuţiei pe zile library(tidyverse) RC <- readRDS("byDays/C8.RDS") # structura distribuţiei RC: 'data.frame': 1260 obs. of 3 variables: $ prof: Factor w/ 108 levels "Bi1","Bi2","Bi3",..: 84 84 53 53 53 53 106 5 5 28 ... $ cls : chr "10A" "10A" "10A" "10A" ... $ zl : Factor w/ 5 levels "Lu","Ma","Mi",..: 3 5 1 4 2 3 5 1 4 2 ... Z <- t(as.matrix(table(RC[c('prof', 'zl')]))) print(apply(Z, 1, sum)) # totalul orelor pe fiecare zi: Lu Ma Mi Jo Vi 253 252 252 251 252 # între zile, diferenţa de ore este cel mult 2 Ntw <- names(Tw1) Htw <- map(Ntw, function(P) apply(Z[, c(P, Tw1[[P]])], 1, sum)) %>% setNames(Ntw) %>% as.data.frame() print(Htw) # alocarea pe zile pentru cei din cuplaje: En2 En4 Ge1 Ge2 Ge3 N01 N02 N03 N04 N05 N06 N07 N08 N09 N10 N11 N12 N13 N14 Lu 6 4 5 3 1 7 6 6 4 3 2 4 6 2 4 2 1 3 2 Ma 6 5 4 2 1 5 6 6 5 5 3 4 4 5 3 4 3 2 4 Mi 6 4 6 2 1 7 4 5 2 4 4 3 3 3 1 3 3 0 4 Jo 5 5 5 2 2 6 5 6 4 3 3 2 3 2 4 2 3 2 3 Vi 6 5 4 2 1 7 4 6 6 5 4 3 5 3 4 2 1 2 3
N01 (şi numai el) depăşeşte în trei zile, 6 ore pe zi; dat fiind că este încadrat pe 32 de ore, am fi vrut să aibă numai două zile cu 7 ore (şi câte 6 ore, în celelalte trei zile).
Conform parametrului many_hours din funcţia mount_hours(), profesorii încadraţi pe măcar 15 ore – dar subliniem faţă de [1], că este vorba de ore proprii, nu în cuplaje – capătă alocări cvasi-omogene (cu cel mult 2 ore diferenţă, de la o zi la alta); pentru a verifica, putem folosi iarăşi, table(RC[c('prof', 'zl')]).
Fiindcă acum (spre deosebire de [1]) avem multe cuplaje – putem sesiza încă o idee (logică) de „îmbunătăţire”… Să observăm că "N08" de exemplu, are în total (cu tot cu orele din cuplajele care îl angajează) 21 de ore (distribuite neomogen: (6 4 3 3 5)); putem constata uşor (filtrând pe LSS) că N08 are numai 12 ore proprii – astfel că mount_hours() nu îi asigură o alocare (cvasi-)omogenă (analog avem pentru N04, de exemplu).
Dacă prin many_hours am fi vizat nu numai orele proprii, ci – după cum ar fi logic – toate orele profesorului (incluzând şi lecţiile „pe grupe”), atunci mount_hours() ar fi respins alocarea neomogenă rezultată mai sus în coloana "N08" şi ar fi căutat o altă alocare a celor 21 de ore ale sale, care să fie cvasi-omogenă.
Dar această corecţie de logică implică o creştere sensibilă a timpilor de execuţie şi mai bine renunţăm să o implementăm – cu atât mai mult cu cât avem totuşi de corectat (interactiv) unele dintre distribuţiile individuale rezultate.
Constituim într-un fişier separat, funcţii (sau comenzi) prin care să investigăm sau să modificăm distribuţia curentă, plecând de la distribuţia pe zile iniţială:
# interact.R funcţii de investigare/modificare interactivă a distribuţiei curente library(tidyverse) load("CUP_Tw.Rda") # [1] "Tw1" "Tw2" "CUP" Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi") RC <- readRDS("byDays/J8.RDS") # distribuţia pe zile iniţială twin_allocations <- function() { Z <- t(as.matrix(table(RC[c('prof', 'zl')]))) # pe distribuţia curentă RC ntw <- names(Tw1) map(ntw, function(P) apply(Z[, c(P, Tw1[[P]])], 1, sum)) %>% setNames(ntw) %>% as.data.frame() } # alocările pe zile pentru cei cu ore proprii, agajaţi şi în cuplaje individual_allocations <- function() addmargins(table(RC[c('prof', 'zl')])) %>% # pe distribuţia curentă RC as.data.frame(.) %>% pivot_wider(names_from = zl, values_from = Freq) %>% .[order(-.$Sum), ] # distribuţiile individuale pe zile (cu totaluri) # alocă o lecţie într-o altă zi (modificând distribuţia curentă RC) change_zl <- function(P, Q, Z, new_zl) RC[with(RC, prof==P & cls==Q & zl==Z), "zl"] <<- new_zl cls_hours <- function(cls_name) { RC %>% filter(cls == cls_name) %>% count(zl) %>% pull(n) } # alocarea pe zile a orelor clasei joint_allocations <- function(P) { Tw <- if(nchar(P)==3) Tw1 else Tw2 J <- RC %>% filter(prof %in% c(P, Tw[[P]])) %>% mutate(prof = as.character(prof)) %>% split(.$zl) map(Zile, function(z) { L <- J[[z]] %>% split(.$prof) map_dfr(seq_along(L), function(i) data.frame(prof = L[[i]]$prof[1], cls = paste(L[[i]]$cls, collapse=" "))) }) %>% setNames(Zile) } # reuneşte alocările pe zile pentru P şi fie Tw1[[P]], fie Tw2[[P]]
Obs. Nu-i cazul de a „clarifica” mai mult decât am făcut-o prin comentariile (şi sublinierile) din program… Am mai folosit anterior, toate elementele implicate; de exemplu, definiţia funcţiei twin_allocations() imită definiţia lui Htw din programul anterior "tst1.R".
De exemplu, să vedem (în consola R) alocările pe ziua "Lu" care îl implică pe N01:
> source("interact.R") > print(joint_allocations("N01")["Lu"]) $Lu prof cls 1 N01 11D 12C 12I 2 N01N06 12I 3 N01N10 10D 4 N01X02 12C 5 N01X03 10I
Deci N01 are Lu 7 ore, dintre care două la 12C (o dată singur şi o dată împreună cu X02) şi două la 12I (singur, respectiv împreună cu N06). Dacă vrem, putem să mutăm într-o altă zi (folosind change_zl()) una dintre orele la 12C, de exemplu – verificând apoi alocarea rezultată astfel, pentru clasa 12C şi pentru profesorul extern X02 (şi eventual, corectând mai departe alocările).
Dar pentru ca N01 să-şi poată face aceste 7 ore din ziua Lu, ar trebui ca măcar una dintre clasele implicate să aibă în ziua respectivă, 7 ore; să verificăm, înainte de a trece mai departe, cum stau lucrurile:
> Jn1 <- joint_allocations("N01") > qls <- Jn1[["Lu"]]$cls %>% paste(., collapse=" ") %>% strsplit(" ") %>% unlist() %>% unique() [1] "11D" "12D" "12I" "10D" "10I" > map(qls, cls_hours) %>% setNames(qls) $`11D` 6 5 6 6 6 $`12D` 5 6 6 6 6 $`12I` 6 6 6 5 6 $`10D` 6 6 6 7 6 $`10I` 6 6 6 7 6
Se vede că niciuna dintre clasele implicate, nu are 7 ore pe Lu; va trebui deci să folosim change_zl(), pentru a muta de exemplu, o oră la clasa 10I (sau la 10D) din ziua Jo (când are 7 ore) în ziua Lu.
Dar de data aceasta, în loc să ne apucăm de echilibrarea interactivă necesară (cum am făcut în [2])… mai bine stăm puţin pe gânduri. Oricum am face (dar fără a depăşi timpii de execuţie obişnuiţi mai sus) – tot nu vom scăpa de intervenţii interactive ulterioare; dar atunci, de ce să chinuim mount_days() pentru a avea în vedere toate corelaţiile privitoare la cuplaje? N-ar fi fost mai bine să fi separat, lucrurile?
Printr-un "mount_days_1()" distribuim lecţiile celor neangajaţi în cuplaje (probabil s-ar executa în doar câteva secunde); printr-un "mount_days_2()" distribuim lecţiile celor vizaţi de Tw1 şi Tw2 (iarăşi, câteva secunde); în final reunim „cât mai convenabil” cele două distribuţii pe zile (şi probabil, mai corectăm şi interactiv, rezultatul)
Se conturează astfel, o rescriere (sau o nouă ediţie) pentru [1]…
vezi Cărţile mele (de programare)