momente şi schiţe de informatică şi matematică
To attain knowledge, write. To attain wisdom, rewrite.

Mofturile repartizării lecţiilor (III)

limbajul R | orar şcolar
2022 aug

[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?

Un fişier-text pentru încadrarea profesorilor

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].

Setul de bază al lecţiilor (obj | prof | cls)

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()LSS ocupă în memorie cam 121KiB.

Modelarea încadrării

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

Dicţionarul disciplinelor

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).

Codificarea profesorilor şi cuplajelor

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

Repartizarea ad-hoc a cuplajelor 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).

Specificarea disciplinelor secundare

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).

Dicţionarele necesare evitării suprapunerilor

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.

Externalizări

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".

Repartizarea lecţiilor pe zilele de lucru

[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.

Îmbunătăţirea funcţiei 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!).

Proprietăţile distribuţiei obţinute

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)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.

Omogenizarea interactivă a distribuţiilor individuale

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)

docerpro | Prev | Next