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

Noul orar (partea întâia)

limbajul R | orar şcolar
2024 oct

În ~/24oct/orar_2.RDS am copiat orarul rezultat în [1] (unde prin Tesseract, extrăsesem textul —scris "de mână"— de pe imaginile PNG ale orarelor claselor unei anumite școli și organizasem apoi, datele astfel deduse):

> library(tidyverse)
> orr2 <- readRDS("orar_2.RDS")
> str(orr2)  # structura orarului curent
'data.frame':	838 obs. of  5 variables:
 $ cls : chr  "10A" "10A" "10A" "10A" ...
 $ prof: chr  "Camelia Alexandriuc" "BE/CA" "Lucian Lungu" ...
 $ zi  : Ord.factor w/ 5 levels "Lu"<"Ma"<"Mi"<..: 1 1 1 1 1 1 1 2 ...
 $ ora : num  1 2 3 4 5 6 7 1 2 3 ...
 $ obj : chr  "biologie" "engleza" "fizica" "matematica" ...

În fiecare zi | ora se desfășoară câte o lecție cls|prof|obj; în total avem 838 lecții, fiindcă între timp am dat și de cele 16 lecții pe care le reținusem separat de setul de date respectiv și le-am adăugat față de [1], prin asemenea secvențe:

for(zi in c("Mi", "Jo"))
  for(ora in 6:8)
    orr <- rbind(orr, list("9B", "Raluca Costineanu", zi, ora, "informatica"))

…Ne amintim că pe tabelele PDF inițiale, aceste 16 ore fuseseră înscrise în celule colapsate orizontal (câte două sau trei) și pentru a preîntâmpina bifurcările de program obligate de această situație particulară, le exclusesem din setul orr (și bineînțeles, am uitat un timp de ele).

Îngrijiri… (așezarea datelor în orar)

Dacă ne-ar interesa numele profesorilor, am folosi neapărat caracterele românești (scriind probabil "Amorăriței", nu "Amoraritei"). Dacă ne-ar interesa datele (să zicem, lista profesorilor), atunci trebuie preferată forma "nume prenume" (nu "Camelia Alexandriuc", ci "Alexandriuc Camelia"); numele "BE/CA" sugerează un cuplaj de lecții, dar probabil că "BE" și "CA" referă niște nume obișnuite, deductibile din context (și uneori, un același cuplaj apare în două forme: "CR/PA" și în alt loc, "PA/CR").

În principiu, numele de obiecte sunt bine alese (evitând jargonul "mate" și "info"); bineînțeles că trebuie înscris "religie" (sau mai bine, "Religie") și nu "Religia" — dar atunci, s-ar cuveni să înscriem "fizică" (mai bine "Fizică") și nu fizica, ș.a.m.d.

Iarăși… nu-i vreo grijă la repartizarea lecțiilor clasei; de exemplu clasa 9A are cele 5 ore de "engleza" în două zile (Lu cu 3 ore și Vi cu 2 ore). Clasele 9B și 9E au câte 36 ore, obligând o zi cu 8 ore. Unii profesori au într-o zi 2 ore și într-o alta, 7 ore (iar unii au câte o singură oră/săptămână !).

Aceste aspecte (nume incorecte, lipsa diacriticelor, dependența tacită de context, repartizarea dezechilibrată) caracterizează se pare, orarele școlilor noastre (v. [2], [3]) și compromit cumva anumite „principii” teoretice, clamate de obicei la baza așezării datelor într-un orar școlar. Reluăm aici ambiția de a constitui pe datele existente un nou orar, care să fie echilibrat; bineînțeles că ne angajăm la aceasta și (sau… mai ales) pentru a revedea minuțios logica și procedurile de lucru prezentate în [2].

Dar „ne angajăm”… fără grabă, abordând și aspecte care n-ar fi neapărat, necesare; mai întâi ne vom ocupa de obj, corectând oarecum denumirile inițiale și asociindu-le anumite abrevieri; apoi ne vom ocupa de profesori și de cuplaje, instituind o anumită codificare (benefică pentru programare) și stabilind dependențele temporale dintre lecțiile acestora. După aceasta, putem trece la realizarea orarului: întâi, speculând un algoritm aproape evident, repartizăm lecțiile, echilibrat, pe zilele de lucru; apoi, pentru fiecare zi, alocăm pe orele zilei lecțiile repartizate în acea zi (astfel încât fiecare profesor să nu aibă mai mult de 2 ferestre/zi); în sfârșit, ajustăm orarele zilnice rezultate astfel încât să micșorăm pe cât posibil, numărul total de ferestre. În final dacă vrem, ne gândim și la prezentarea decentă a orarului rezultat.

Precizăm că facem toate acestea folosind ecosistemul $\textbf{R}$ — limbajul $\textbf{R}$, consola interactivă $\textbf{R}$ și „dialectul” tidyverse; excludem RStudio care integrează toate cele, fiindcă în principiu… nu agreem să lucrăm în "IDE"-uri. Ne vom baza pe programele constituite în [2], dar folosind ultima versiune de $\mathbf{R}$ ne putem aștepta (credem sau nu), să fie necesare unele mici modificări.

Uneori vom avea și de editat, anumite date, așa că prin:
    sudo tee -a /usr/lib/R/etc/Rprofile.site
adăugăm în fișierul indicat, linia 'options(editor="gedit")' — urmarea fiind că o comandă viitoare edit(Obj, "ob.R") va lansa editorul gedit (în care lucrăm de obicei), în loc de editorul implicit vi; rezultatul editării va fi salvat în fișierul "*.R" indicat și va putea fi încărcat în sesiunea curentă de lucru prin funcția source().

Discipline școlare și abrevieri

Lucrăm în consola $\mathbf{R}$ (dar nu mai producem aici, pentru fiecare comandă, prompt-ul specific ">"); întâi aflăm denumirile unice obj și edităm vectorul respectiv:

> library(tidyverse)
orr2 <- readRDS("orar_2.RDS")
obj1 <- orr2$obj %>% unique() %>% sort()
edit(obj1, "obiecte.R")

Asociem vechile denumiri (aflate în câmpul obj pe liniile din orr2) cu cele tocmai convenite prin editare în vectorul din "obiecte.R":

obj2 <- source("obiecte.R")$value
Obj <- setNames(obj2, obj1)
> Obj  # (vector cu nume, sau "dicționar")
              ala      biologie           cds        chimie    consiliere 
       "edAntrep"    "Biologie"         "CDS"      "Chimie"  "Consiliere" 
         economie     ed fizica   ed muzicala    ed sociala    ed vizuala 
       "Economie"       "Sport"      "Muzică"   "edSocială"       "Desen" 
          engleza     filosofie        fizica      franceza     geografie 
        "Engleză"   "Filosofie"      "Fizică"    "Franceză"   "Geografie" 
          germana   informatica       istorie        latina        logica 
        "Germană" "Informatică"     "Istorie"      "Latină"      "Logică" 
       matematica    psihologie       religie        romana    sociologie 
     "Matematică"  "Psihologie"     "Religie"      "Română"  "Sociologie" 
         spaniola           tic       viz/muz 
       "Spaniolă"         "TIC"     "viz/muz" 

În general n-am făcut decât să înlocuim litera inițială din vechea denumire cu litera majusculă omonimă și să scriem corect "Română" în loc de "romana"; desigur, scriind "Română" (neprescurtat în vreun fel, fiindcă… "România" nu se desparte în silabe !), s-a cuvenit să scriem la fel (neprescurtat) și "Franceză", "Engleză", etc.
De observat modificarea "Sport" în loc de "ed fizica" ! Ar trebui făcut loc în programa școlară pentru un dram de cultură sportivă (ar fi potrivit domeniul tenisului, nu fotbalul); de unde să vadă cei care trebuie îndrumați să vadă, mai elocvente exemple de exigență față de sine, de ambiție și muncă nemiloasă (cu o echipă de antrenori) pentru perfecționarea anumitor calități individuale, de empatie și respect, dacă nu de la unii mari sportivi contemporani ? Fără un minimum de cultură, vom avea mereu "galerii" pline de sine și violente pe stadioane, sau campanii de denigrare ca aceea din gimnastica noastră; mai general, în necunoștință de cauză, lipsa de respect față de performeri (sau profesioniști) și față de valorile autentice, va persista…

Cum înscriem noile denumiri în locul celor vechi, de-a lungul coloanei obj ? Avem acest procedeu indirect, tipic pentru $\mathbf{R}$: întâi transformăm obj în factor, ceea ce înseamnă că se creează un vector (accesibil prin funcția levels()) care conține câte o singură dată denumirile existente (ordonate alfabetic) și acestea sunt înlocuite prin indecșii corespunzători lor în levels() (pentru analogie: $\mathbb{Z}_n$ este un factor, permițând clasificarea numerelor întregi după resturile împărțirii prin $n$); apoi, devine suficient să înscriem în levels() noile denumiri:

orr4 <- orr2 %>% mutate(obj=factor(obj))
lev <- levels(orr4$obj)  # vechile denumiri, în ordine alfabetică
levels(orr4$obj) <- Obj[lev]  # noile denumiri, după ordinea alfabetică veche
saveRDS(orr4, "orar_4.RDS")
saveRDS(Obj, "obiecte_4.RDS")

Intern, valorile obj sunt indecși numerici; dar la afișare, datorită prezenței tacite levels(), sunt produse (de obicei) denumirile asociate acestor indecși.

Bineînțeles că ne-am îngrijit să păstrăm „dicționarul” Obj (în "obiecte_4.RDS"), pentru eventualitatea că am vrea la un moment dat să comutăm între noile și vechile denumiri ale obiectelor. Dar să observăm că denumirile respective ne vor interesa doar când va fi să afișăm orarul final… Și de fapt, nici numele și prenumele profesorilor nu ne vor interesa, decât pentru a afișa orarul final.

Ceea ce ne interesează acum este faptul că mai mulți profesori au în încadrare câte un același obiect și faptul că unii profesori sunt încadrați pe mai multe obiecte. De exemplu, avem 6 profesori de "Română" și doi dintre aceștia au în încadrare și "CDS":

> pRo <- orr4 %>% filter(obj=="Română") %>% pull(prof) %>% unique()
> length(pRo)
[1] 6  # 6 profesori fac "Română"
> orr4 %>% filter(prof %in% pRo, obj=="CDS") %>% 
           pull(prof) %>% unique() %>% length()
[1] 2  # 2 profesori fac și "Română" și "CDS"

Abreviem disciplinele prin câte două litere, în ideea de a desemna profesorii prin codul corespunzător disciplinei principale a fiecăruia, împreună cu un număr de ordine în lista celor de pe o aceeași disciplină:

> abb <- abbreviate(levels(orr4$obj), minlength=2, strict=TRUE)
> abb["Română"] <- "Ro"  # în loc de "Râ"
> abb["viz/muz"] <"vm"  # în loc de "v/"
# Inversăm dicționarul: era disciplină -> cod și devine cod -> disciplină 
> abr <- names(abb) %>% setNames(as.vector(abb))
> abr  # (vector cu nume, sau "dicționar")
               eA            Bl            CD            Ch            Cn 
       "edAntrep"    "Biologie"         "CDS"      "Chimie"  "Consiliere" 
               Ec            Sp            Mz            eS            Ds 
       "Economie"       "Sport"      "Muzică"   "edSocială"       "Desen" 
               En            Fl            Fz            Fr            Gg 
        "Engleză"   "Filosofie"      "Fizică"    "Franceză"   "Geografie" 
               Gr            In            Is            Lt            Lg 
        "Germană" "Informatică"     "Istorie"      "Latină"      "Logică" 
               Mt            Ps            Rl            Ro            Sc 
     "Matematică"  "Psihologie"     "Religie"      "Română"  "Sociologie" 
               Sp            TI            vm 
       "Spaniolă"         "TIC"     "viz/muz" 
> saveRDS(abr, "dict_obj.RDS")
> levels(orr4$obj) <- names(abr)
> saveRDS(orr4, "orar_4.RDS")

Adoptând aceste abrevieri, cei 6 profesori de "Română" pot fi indicați prin "Ro1", Ro2, ..., Ro6; ca urmare, nu vom mai avea nevoie de coloana obj: disciplinele principale rezultă prin dicționarul dict_obj.RDS, din codurile asociate astfel profesorilor, iar pentru cele secundare putem constitui un set de date separat (de inclus în final, pentru afișarea orarului).

Verificarea profesorilor

Este obligatoriu ca înainte de orice, să verificăm dacă profesorii sunt bine definiți: nu cumva un același profesor apare o dată sub forma "prenume nume" și altă dată, sub forma inversă ? Cine sunt profesorii indicați prin "BE/CA", "PA/CR", etc. ?

Să ignorăm deocamdată cuplajele BE/CA etc., adică acele valori din coloana prof care conțin separatorul "/":

Prof <- orr4 %>% filter(! grepl("/", prof)) %>% 
        pull(prof) %>% unique() %>% sort()
> str(Prof)
 chr [1:59] "Adrian Cojocaru" "Adrian Frincu" "Adrian Petrisor" ...

Lista Prof este scurtă și este ordonată alfabetic, încât este ușor să o inspectăm direct; constatăm că avem totdeauna forma "prenume nume" (cu "prenume" de cel mult două cuvinte, separate prin spațiu sau "-") și fiecare figurează câte o singură dată.

Repetând comanda de mai sus pentru cuplaje (eliminând "!" din fața lui grepl()), obținem vectorul:

[1] "BE/CA"   "BE/MD"   "CR/PA"   "Frincu/Tablan"  "GS/MC"
[6] "MC/GS"   "MO/MD"   "PA/CR"   "SM/GS"

și observăm întâi că avem de identificat CR/PA cu PA/CR și GS/MC cu MC/GS și de înlocuit "Frincu/Tablan" cu "Adrian Frincu/Lucian Tablan":

replace_adhoc <- function(old, new)
    orr4$prof[orr4$prof == old] <<- new
replace_adhoc("PA/CR", "CR/PA")
replace_adhoc("MC/GS", "GS/MC")
replace_adhoc("Frincu/Tablan", "Adrian Frincu/Lucian Tablan")
saveRDS(orr4, "orar_4.RDS")

Să vedem acum pe care obiecte avem cuplaje de lecții:

> orr4 %>% filter(grepl("/", prof)) %>% pull(obj) %>% unique()
[1] En vm In Gr
27 Levels: eA Bl CD Ch Cn Ec Sp Mz eS Ds En Fl Fz Fr Gg Gr ... vm

De observat că rezultatul este un factor (s-au afișat etichetele asociate de levels(orr4$obj) indecșilor 11, 27, 17 și 16; dacă voiam să excludem celelalte niveluri — cum vom avea nevoie uneori — trebuia să intermediem prin droplevels()):

> str(.Last.value)  # pentru valoarea ultimei expresii evaluate
 Factor w/ 27 levels "eA","Bl","CD",..: 11 27 17 16

Pe vm (adică "viz/muz") cuplajul este deja clar: "Adrian Frincu/Lucian Tablan".
Să vedem care sunt cuplajele pe "En" (adică "Engleză"):

> orr4 %>% filter(grepl("/", prof), obj=="En") %>% 
           pull(prof) %>% unique()
[1] "BE/CA" "SM/GS" "BE/MD"

Pentru a deduce numele pentru "BE", "CA" etc., plecăm de la bănuiala plauzibilă că aceste câte două majuscule sunt inițiale de prenume și nume (sau poate nume și prenume) ale unora dintre profesorii încadrați pe "En"; listând de exemplu:

> orr4 %>% filter(obj=="En", grepl("C", prof), grepl("A", prof)) %>%
           arrange(zi, ora)
cls              prof zi ora obj    cls              prof zi ora obj
10A             BE/CA Lu   2  En    12E Alina Elena Cretu Jo   2  En
11B Alina Elena Cretu Lu   3  En     7A Alina Elena Cretu Jo   4  En
12A             BE/CA Lu   4  En    12B Alina Elena Cretu Jo   5  En
12D Alina Elena Cretu Lu   5  En    11B Alina Elena Cretu Jo   6  En
12B Alina Elena Cretu Lu   6  En    10A             BE/CA Jo   7  En   
10A             BE/CA Mi   3  En    12A             BE/CA Vi   2  En
12A             BE/CA Mi   4  En    12D Alina Elena Cretu Vi   3  En
12A             BE/CA Mi   5  En    12A             BE/CA Vi   4  En
10A             BE/CA Mi   6  En     7A Alina Elena Cretu Vi   5  En
12E Alina Elena Cretu Mi   7  En    10A             BE/CA Vi   6  En

constatăm că singurul profesor cu inițiale "C" și "A" care face "En" în zile și ore care nu se suprapun cu cele pentru cuplajul "BE/CA" este "Alina Elena Cretu".
Însă pentru "BE", lista produsă prin comanda analogă celeia de mai sus conține numai lecțiile cuplajului BE/CA — prin urmare, BE referă un profesor care singur (și nu în cuplaj), predă un alt obiect decât "En":

> orr4 %>% filter(grepl("B", prof), grepl("E", prof), 
                  zi %in% c("Mi","Vi")) %>% arrange(zi, ora)
    cls                       prof zi ora obj
    10A                      BE/CA Mi   3  En
    12A                      BE/CA Mi   4  En
    12A                      BE/CA Mi   5  En
    10A                      BE/CA Mi   6  En
    10A Elisabeta Mracica Bucaciuc Mi   7  CD
    12A                      BE/CA Vi   2  En
     9A                      BE/MD Vi   3  En
    12A                      BE/CA Vi   4  En
    10A Elisabeta Mracica Bucaciuc Vi   5  Cn
    10A                      BE/CA Vi   6  En
     9A                      BE/MD Vi   7  En

Constatăm că "Elisabeta Mracica Bucaciuc" are (la clasa 10A) lecții de CD și Cn, în zile și ore compatibile cu cele în care BE/CA face "En".
Deducem astfel înlocuirea:

> replace_adhoc("BE/CA", 
                "Elisabeta Mracica Bucaciuc/Alina Elena Cretu")

Procedând analog, găsim de făcut și aceste înlocuiri:

> replace_adhoc("BE/MD", "Elisabeta Mracica Bucaciuc/Daria Marginean")
> replace_adhoc("SM/GS", "Mariana Savin Giosan/Sabina Grapini")

Mai departe, filtrând pentru 'prof=="GS/MD"', vedem că obiectul corespunzător acestui cuplaj este "Gr" (adică "Germană"); filtrând pentru inițialele "G" și "S" și obiectele "En" și "Gr", vedem liniile:

    11D           GS/MC Lu   4  Gr
     9E  Sabina Grapini Lu   4  En

și fiindcă aceste două lecții se desfășoară în aceeași zi și oră, deducem că "GS" nu este "Sabina Grapini" (identificată mai sus pentru "En" și… numită tot "GS").
Listând apoi pentru obj=="Gr" și inițialele "G" și "S" (respectiv "M" și "C") și asigurându-ne de compatibilitatea temporală a lecțiilor, identificăm și cuplajul pe "Germană":

> replace_adhoc("GS/MC", "Sofia Grigonreanu/Camelia Maftei")

Ne-au rămas cuplajele pe "In" (adică "Informatică") și procedând ca mai sus, avem:

> replace_adhoc("CR/PA", "Raluca Costineanu/Adrian Petrisor")
> replace_adhoc("MO/MD", "Ovidiu Marian Marcu/Daniela Marcu")

Bineînțeles că în final, salvăm setul de date astfel modificat:

> saveRDS(orr4, "orar_6.RDS")

dar păstrând și vechiul "orar_4.RDS", pentru eventualitatea (puțin probabilă, totuși) că vom fi greșit pe undeva și va trebui poate, s-o luăm de la capăt…

Investigațiile de mai sus arată implicit că toți profesorii care fac parte dintr-un cuplaj au și lecții proprii (la care intră singuri); altfel spus, în cazul de față nu există profesori "externi" (care să aibă ore numai în cuplaje) — încât mai departe putem și simplifica, față de situații redate în [2] și [3].

Profesori și discipline

Următoarea funcție produce (pentru orarul curent) disciplinele pe care este încadrat un profesor, în ordinea descrescătoare a numărului de ore:

orr6 <- readRDS("orar_6.RDS")
prof_objs <- function(P)
    orr6 %>% filter(grepl(P, prof)) %>% count(obj, sort=TRUE)

De exemplu, pentru "Elisabeta Mracica Bucaciuc" (care este și membru în cuplajele "BE/CA" și "BE/MD", cum am văzut mai sus) avem:

> prof_objs("Bucaciuc")  # nu-i  necesar numele complet (am folosit grepl())
      obj  n
    1  En 15  # obiectul principal
    2  CD  1
    3  Cn  1

Putem codifica profesorii după disciplina principală a fiecăruia; de exemplu pentru cazul redat mai sus, En2 — unde sufixul "2" (să zicem) ar fi numărul de ordine în lista celor cu disciplina principală "En". Firește, pentru cuplaje vom alipi codurile membrilor.

Ignorăm deocamdată cuplajele și formulăm o listă care asociază fiecărei discipline principale, setul profesorilor încadrați pe acea disciplină, ordonați descrescător după numărul de ore:

Pr1 <- orr6 %>% filter(! grepl("/", prof)) %>%  # fără cuplaje
       pull(prof) %>% unique()
Lob <- map(Pr1, function(P) {
    OB <- prof_objs(P)[1, ]  # reține numai obiectul principal
    data.frame(prof = P, obj = OB$obj, n = OB$n)
}) %>% list_rbind() %>% droplevels() %>% 
       arrange(desc(n)) %>% split(.$obj)

În [2] și [3] foloseam funcția elegantă map_dfr(), dar ultima versiune de $\mathbf{R}$ recomandă în loc, map() și list_rbind() (reducând complexitatea bifurcărilor interne, precum și dependența de alte pachete).

Prin map() (și prof_objs()), fiecărui profesor (dar nu și cuplajelor) i s-a asociat un data.frame conținând o singură linie prof|obj|n, unde obj este obiectul cu cel mai mare număr n de ore (adică este obiectul "principal" din încadrarea profesorului); bineînțeles că în aceste obiecte data.frame, câmpul obj moștenește calitatea de factor și păstrează toate nivelurile inițiale (inclusiv, cele care reprezintă discipline "secundare").
Apoi, prin list_rbind, toate obiectele data.frame de câte o singură linie care au rezultat, sunt reunite într-un singur obiect data.frame și acum este momentul pentru a restrânge (folosind droplevels()) nivelurile factorului obj la cele pentru disciplinele principale. Apoi, prin arrange() am ordonat liniile descrescător după valorile din coloana n și în final, le-am împărțit după obj — rezultând lista-"dicționar" desemnată prin Lob.

Lob asociază obiectelor principale câte un "tabel" (obiect data.frame) care conține profesorii încadrați pe obiectul respectiv, în ordinea descrescătoare a numărului total de ore din încadrarea fiecăruia; de exemplu, pentru obiectul principal "Istorie":

> Lob$Is
                      prof obj  n
    13 Mihai Bogdan Dranca  Is 19    # Is1 (codul de asociat)
    34     Didina Petrisor  Is 13    # Is2
    54     Daniel Hrenciuc  Is  4    # Is3

(indecșii afișați 13, 34, 54 indică liniile pe care se află profesorii respectivi în cadrul data.frame din care a provenit  —prin clasificare după obj— lista Lob)

Am simplificat lucrurile față de [2] și [3] (unde le separam, lucrând cu o funcție prof_objs(P, Lst) întâi pe lista celor care nu apar în cuplaje și apoi pe lista membrilor cuplajelor) — dar aceasta iată că are totuși un preț: cei doi profesori din cuplajul pe "viz/muz" apar ca având obiectul principal "vm" și nu cum ar trebui, Ds și respectiv Mz (fiecare având având mai puține ore proprii, decât în cuplaj):

> Lob$vm
                prof obj  n
    38 Adrian Frincu  vm 10    # trebuia Ds
    39 Lucian Tablan  vm 10    # trebuia Mz

Să nu amânăm „reparația”… Adăugăm "Ds" și "Mz" ca niveluri ale câmpului obj (fuseseră excluse, după droplevels()), schimbăm valorile "vm" pe cele două linii redate mai sus, apoi înființăm în lista Lob cheile $Ds și $Mz asociindu-le respectiv prima și a doua dintre cele două linii astfel modificate, iar în final eliminăm Lob$vm:

> levels(Lob$vm[, 2]) <- c(levels(Lob$vm[, 2]), "Ds", "Mz")
> Lob$vm[1, 2] <- "Ds";  Lob$vm[2, 2] <- "Mz"
> Lob$Ds <- Lob$vm[1, ];  Lob$Mz <- Lob$vm[2, ]
> Lob$vm <- NULL

Acum, folosind Lob, putem formula un „tabel” care asociază profesorilor 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(seq_along(Lob), function(i) {
    N <- nrow(Lob[[i]])  # câți profesori, pe disciplina curentă (< 10)
    ob <- Lob[[i]]$obj[1]  # obiectul principal
    obn <- paste0(ob, 1:N)  # alipește numerele de ordine
    data.frame(prof = Lob[[i]]$prof, cod = obn)
}) %>% list_rbind()

De exemplu, pentru cei de "Istorie" exemplificați și mai sus, avem:

> Pcd[grepl("Is", Pcd$cod), ]
                      prof cod
    36 Mihai Bogdan Dranca Is1
    37     Didina Petrisor Is2
    38     Daniel Hrenciuc Is3

Un dicționar {prof -> cod} ar fi mai convenabil decât tabelul Pcd, pentru a înlocui prin aceste coduri valorile din coloana prof a setului orr6:

prof_cod <- Pcd$cod
names(prof_cod) <- Pcd$prof

Folosind dicționarul prof_cod, putem codifica acum și cuplajele — alipind codurile membrilor; în final, reunim toate codurile:

tws <- orr6 %>% filter(grepl("/", prof)) %>% pull(prof) %>% unique() 
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
    cup_cod[i] <- paste0(kod[], collapse="") # alipește codurile
}
cup_cod <- setNames(cup_cod, tws)
prof_cod <- c(prof_cod, cup_cod) # dicționar profesor sau cuplaj -> COD
saveRDS(prof_cod, "dict_prof.RDS") 

Dicționarul prof_cod va fi util (dacă-l vom inversa) când va fi să recuperăm numele reale, pentru a prezenta orarul final (de aceea, l-am salvat pe disc).
Acum putem înregistra codurile din vectorul prof_cod, pe toate liniile din setul orr6:

orr6 <- orr6 %>% mutate(prof = as.vector(prof_cod[prof]))
> slice_sample(orr6, n=5) # un eșantion ilustrativ:
      cls   prof zi ora obj
    1 10A En4En2 Mi   6  En
    2 11D    Sp1 Vi   4  Sp
    3 12A En4En2 Mi   4  En
    4  9A    In3 Jo   2  TI  # "TI" este obiect secundar, pentru "In3"
    5 10C    Ro5 Mi   3  Ro

Am repetat de câteva ori comanda slice_sample(), până am obținut eșantionul redat mai sus — din care se vede că obj este încă importantă: pentru disciplinele principale, valoarea obj se deduce într-adevăr, din codul profesorului; însă (cum se vede pe linia 4) fără a avea coloana obj n-am ști disciplinele secundare.

Pentru a vedea dacă lecția de pe linia curentă din orr6 implică o disciplină secundară, n-avem decât să comparăm valorile prof și obj. Reținând cumva lecțiile pe disciplinele secundare, vom putea elimina totuși, coloana obj.
În mod implicit, pe un obiect data.frame se operează „pe coloane”; însă acum, avem de comparat valori prof și obj aflate pe câte o aceeași linie. Funcția dplyr::rowwise() ne asigură și posibilitatea de a opera „pe linii”, cum avem nevoie acum:

scd <- orr6 %>% rowwise(prof, obj, cls) %>%
       filter(! grepl(obj, prof)) # liniile cu discipline "secundare"
lSC <- scd %>% split(.$prof)  # profesor -> {liniile cu discipline secundare}
OSE <- map_dfr(seq_along(lSC), function(i) {
    sec <- lSC[[i]] %>% # pe profesorul curent
           split(.$obj, drop=TRUE) # desparte pe discipline
    map_dfr(seq_along(sec), function(j) {
        Cls <- sec[[j]] %>% pull(cls)
        data.frame(
            prof = sec[[j]]$prof[1], # profesorul
            obj = names(sec)[j], # disciplina secundară
            cls = paste(Cls, collapse = " ")) # la care clase
    })
})
saveRDS(OSE, "obj_sec.RDS") # prof|obj|cls pe obiecte secundare

(mai sus evitam să folosim map_dfr(), adoptând recomandarea curentă map() și list_rbind(), care între altele „ocolește” pachetul dplyr; dar rowwise() implică deja dplyr, încât ni s-a părut firesc să folosim direct map_dfr() (încă neabandonată))

De exemplu, profesorul Ds1 (cu disciplina principală "Ds") are următoarea situație pe clase a disciplinelor secundare ale sale:

> OSE %>% filter(grepl("Ds", prof))
        prof obj                                 cls
    1    Ds1  CD                               5A 7A
    2    Ds1  Cn                                 10F
    3 Ds1Mz1  vm 10A 10B 10C 10D 10E 10F 9A 9B 9D 9E

"vm" apare ca disciplină secundară, pentru cuplajul Ds1Mz1. Se știe că la noi, "Muzică" și "Desen" au alocate câte o jumătate de oră/săptămână; lecțiile "vm" se desfășoară „pe grupe” care alternează săptămânal și la fiecare clasă, grupa-1 face "Ds" și grupa-2 face "Mz" (rezultând astfel, câte o oră "DS" și o oră "Mz" la fiecare două săptămâni consecutive, pentru fiecare grupă în parte).
Dar fiindcă în cazul de față, "vm" vizează exact 10 clase, apare o idee care evită împărțirea clasei în grupe: repartizăm câte două clase pe zi, de exemplu în prima zi clasele 10A și 10B și convenim ca Ds1 să intre la 10A și Mz1 la 10B în săptămânile de rang par și invers, în cele de rang impar.
Putem face un orar parțial pentru cele 10 lecții "vm" (câte două pe zi), pe care să-l adăugăm în final orarului generat pentru celelalte $838-10=828$ lecții…

Putem elimina acum, coloana obj:

> orr6$obj <- NULL
> saveRDS(orr6, "orar_6.RDS")

Disciplinele principale vor rezulta când va fi nevoie, din codurile de câte 3 caractere ale profesorilor, iar pentru cele secundare vom consulta liniile din setul "obj_sec.RDS" (și apoi vom folosi "dict_obj.RDS", pentru a regăsi denumirile complete); iar numele profesorilor vor putea fi restabilite prin "dict_prof.RDS".

Dependențele temporale

Ca și în multe alte orare școlare, avem cuplaje — situații în care doi profesori partajează într-un același timp, o aceeași clasă; de exemplu, linia 10F|Ds1Mz1|Jo|2 spune că în ora a doua din ziua Jo, clasa 10F este despărțită în două grupe, la care intră profesorii Ds1 și respectiv Mz1 (sau invers, în săptămâna următoare).
Dar întâlnim adesea și tuplaje (v. [2]); un "tuplaj" este o pereche de clase (sau chiar un triplet de clase) care sunt plasate într-o aceeași zi și oră, acelorași doi (respectiv, trei) profesori. De exemplu, o "linie" ca 10AB|Gr1Gr2|Lu|3 ar spune că în ora a treia din ziua Lu, cu elevii reuniți ai claselor 10A și 10B se formează două noi clase, la care intră (în fiecare săptămână) respectiv Gr1 și Gr2 (pentru câte o lecție de „germană-începători” și respectiv „germană-avansați”, să zicem).

S-ar cuveni întâi, să vedem dacă în cazul de față avem sau nu, tuplaje. Pentru aceasta, ne uităm dacă există cazuri în care pentru un același prof, aceeași zi și aceeași ora, găsim în orr6 mai mult de o singură linie:

> orr6 %>% group_by(prof, zi, ora) %>%
           count() %>% filter(n > 1)
# Groups:   prof, zi, ora [1]
      prof  zi      ora     n
    1 Rl1   Ma        7     2  # Două linii care diferă numai prin "cls"
> orr6 %>% filter(prof=="Rl1", zi=="Ma", ora==7)
      cls prof zi ora
    1  9D  Rl1 Ma   7
    2  9E  Rl1 Ma   7

Avem deci un singur caz și acesta aduce doar, a "tuplaj"; de fapt, nu este decât o situație "imposibilă": profesorul Rl1 intră într-un același timp la două clase (contabilul nu te poate plăti pentru două ore, dacă faci de fapt una singură ! Pe de altă parte, "clasă" este o entitate reglementată ca număr de elevi și nici într-un caz, nici pentru "Religie", nu poate cuprinde cât două clase).
Cum s-ar explica totuși, această situație care oficial (și pentru contabilitate și față de normativele în vigoare) este imposibilă ?

Din dicționarele formulate mai sus vedem că Rl1 este profesor de "Religie"; această disciplină școlară este (oficial) "opțională": numai o parte a elevilor clasei 9D și numai o parte a elevilor clasei 9E au optat pentru "religie", iar din cele două părți s-a putut constitui o nouă clasă, pentru care s-a căutat o zi și oră în care să fie disponibili elevii de la ambele clase — deci ora a 7-a, dintr-o anumită zi (în care ambele clase aveau 6 ore și numai cei care au optat pentru "Religie", rămân și pentru ora a 7-a).

Așa stând lucrurile, decidem să eliminăm din setul orr6 cele două linii, notând undeva că în final va trebui să adăugăm o oră a 7-a la clasele 9D și 9E, profesorului Rl1:

excl <- orr6 %>% filter(prof=="Rl1", zi=="Ma", ora==7)
orr6 <- anti_join(orr6, excl)
saveRDS(orr6, "orar_6.RDS")

Astfel, orr6 rămâne cu 836 de linii cls|prof|zi|ora (și… nu mai avem imposibilități).

Tuplarea lecțiilor de "Muzică/Desen"

Cum am văzut mai sus, cuplajul Ds1Mz1 are 10 lecții, "pe grupe" ale câte unei clase. Poate că și pentru elevi și pentru profesori este mai convenabil de lucrat "pe grupe", cu mai puțini elevi în oră, decât cu întreaga clasă… Totuși, în loc să faci de două ori "aceeași" lecție (cu fiecare grupă în parte), parcă este mai firesc să o faci o singură dată, cu întreaga clasă (că nici nu este vorba de a antrena aptitudini individuale, pentru care ar trebui multe ore de lucru, ci doar de a prezenta în puține ore, elemente de bază și cunoștințe generale); mai mult, numai așa (cu întreaga clasă, nu cu jumătăți) ar fi just: lucrând "pe grupe", profesorul face efectiv două ore — câte una pe fiecare grupă — dar este plătit numai pentru o oră ! (ceea ce este fără doar și poate, nedrept).

Noi vom transforma cele 10 lecții "pe grupe" ale cuplajului Ds1Mz1, în 5 tuplaje — perechi de clase întregi, la care intră cu alternare săptămânală, Ds1 și respectiv Mz1, conform unui orar parțial prestabilit (desigur, profităm aici de faptul că numărul de lecții "pe grupe" este par…).

Pentru flexibilitate, nu constituim un "orar-parțial" definitiv, ci formulăm o funcție (pe care o vom putea apela oricând, câtă vreme păstrăm fișierul "orar_6.RDS") pentru a instanția câte un asemenea orar parțial (alegând poate, pe cel mai convenabil situației curente):

orar_partial_vm <- function(smp = FALSE) {
    orr6 <- readRDS("orar_6.RDS") # 836 lecții cls|prof|zi|ora
    cls_vm <- orr6 %>% filter(prof=="Ds1Mz1") %>% pull(cls)
    if(smp) cls_vm <- sample(cls_vm)
    Zile <- orr6$zi %>% unique() %>% as.factor()
    data.frame(
        prof = rep(c("Ds1", "Mz1"), times=5),
        cls = cls_vm,  
        zi = rep(sample(Zile), each=2))
}
> orar_partial_vm()  # (Exemplificare)
           prof cls zi
        1   Ds1 10A Lu  # tuplaj (10A 10B)|(Ds1 Mz1)|Lu
        2   Mz1 10B Lu
        3   Ds1 10C Jo  # tuplaj (10C 10D)|(Ds1 Mz1)|Jo
        4   Mz1 10D Jo
        5   Ds1 10E Mi  # (10E 10F)|(Ds1 Mz1)|Mi
        6   Mz1 10F Mi
        7   Ds1  9A Ma  # (9A 9B)|(Ds1 Mz1)|Ma
        8   Mz1  9B Ma
        9   Ds1  9D Vi  # (9D 9E)|(Ds1 Mz1)|Vi
        10  Mz1  9E Vi

În orar_partial_vm() am extras din orr6 clasele cuplajului Ds1Mz1, în vectorul cls_vm; dacă la apelare s-a sesizat TRUE în loc de FALSE, pentru argumentul "smp" al funcției, atunci permutăm aleatoriu cls_vm, folosind sample(). Apoi, am „extras” din orr6 factorul ordonat Zile (desigur… puteam să-l definim și direct); în final, am constituit valoarea de returnat: un "tabel" în care în coloana prof alternează de 5 ori Ds1 și Mz1, în coloana cls apar cele 10 clase din cls_vm, iar în coloana zi apar de câte două ori consecutiv, elementele dintr-o permutare aleatorie a vectorului Zile.

În exemplificarea de mai sus, clasele apar în ordine alfabetică (dacă invocam orar_partial_vm(TRUE), atunci clasele apăreau într-o ordine aleatoarie); lecțiile de "vm" la clasele 10A și 10B au fost alocate în ziua Lu, cele de la clasele 10C și 10D au fost alocate în ziua Jo ș.a.m.d. Este de subânțeles această convenție: în ziua Lu a săptămânii curente, Ds1 intră la 10A și Mz1 intră la 10B — și invers, în săptămâna următoare (analog, pentru celelalte zile).
Când ne vom ocupa (dar… mult mai încolo) de alocarea pe ore a lecțiilor din ziua curentă, vom avea grijă ca lecțiile astfel împerecheate pe zile, ale lui Ds1 și Mz1, să cadă într-o aceeași oră a zilei respective.

Obs. Mai sus apare un algoritm elementar pentru repartizarea echilibrată pe zile a unui set de lecții: se listează lecțiile și apoi se etichetează de sus în jos, repetând vectorul zilelor; rezultă un același număr de lecții/zi, dacă numărul de lecții este multiplu de numărul zilelor.

Acum, având aceste 5 tuplaje (și posibilitatea de a le aloca echilibrat pe zile, prin orar_partial_vm()), putem exclude din orr6 lecțiile cuplajului Ds1Mz1:

> orr6 <- orr6 %>% filter(prof != "Ds1Mz1")
> saveRDS(orr6, "orar_8.RDS")  # 826 lecții cls|prof|zi|ora

Subliniem că încă nu am eliminat câmpurile zi|ora, gândindu-ne la eventualitatea de a organiza ca tuplaje și lecțiile "pe grupe" la alte obiecte decât "Muzică" și "Desen"…

„Flexibilitatea” de care pomeneam mai sus, constă în faptul că fiecare nouă invocare orar_partial() (sau eventual orar_partial(TRUE)) produce de regulă (fiindcă am implicat sample()) o altă repartizare pe zile a celor 10 lecții; va trebui să alegem una care, ca împerechere de clase și repartizare pe zile se potrivește cât mai bine cu repartizarea pe zile făcută mai încolo celorlalte lecții, lăsate acum în "orar_8.RDS".

Dependențele alocării lecțiilor

Alocarea pe zile și ore a lecțiilor cuplajelor și profesorilor care sunt angajați în cuplaje, va depinde mereu de alocările făcute celor cu care sunt astfel conexați. Vom constitui niște dicționare (numite cu "Tw", de la "twins") care să indice pentru fiecare profesor implicat în cuplaje (și invers, pentru fiecare cuplaj), de care profesori și cuplaje depinde alocarea pe zile și pe ore a lecțiilor acestuia.

Împărțim lecțiile după lungimea codului din câmpul prof (3 sau 6, în cazul nostru) și degajăm profesorii din fiecare parte:

orr8 <- readRDS("orar_8.RDS") # 826 lecții cls|prof|zi|ora
S3 <- orr8 %>% split(nchar(.$prof)) %>%
      map(function(S)
          S %>% pull(prof) %>% unique() %>% sort())
P1 <- S3[[1]] # care au (și) ore proprii
P2 <- S3[[2]] # cuplaje cu 2 profesori

Următorul dicționar are drept chei profesorii din vectorul P1 care intră măcar într-un cuplaj (având și ore proprii), iar drept valori — vectorii care conțin profesorii de care depind aceștia, la alocarea pe zile și ore:

Tw1 <- map(P1, function(P) P2[grepl(P, P2)]) %>%
       setNames(P1) %>% compact()

compact() a eliminat pe cei care nu intră în cuplaje; dacă P este una dintre cheile lui Tw1, ora din zi care poate fi alocată pe o lecție a lui P trebuie să nu coincidă cu vreuna dintre orele alocate deja cuplajelor din vectorul Tw1[[P]]:

    P     Tw1[[P]]
    $En1  "En5En1"
    $En2  "En4En2"
    $En3  "En4En3"
    $En4  "En4En2" "En4En3"
    $En5  "En5En1"
    $Gr1  "Gr2Gr1"
    $Gr2  "Gr2Gr1"
    $In1  "In1TI1"
    $In2  "In3In2"
    $In3  "In3In2"
    $TI1  "In1TI1"

Constituim și un dicționar cumva invers, în care cheile sunt cuplajele existente, iar valorile sunt vectori care conțin profesorii (propriu-ziși, sau „fictivi” adică în cuplaje) de care depinde alocarea orelor cheii respective:

Tw2 <- map(P2, function(PP) {
    p1 <- substr(PP, 1, 3)
    p2 <- substr(PP, 4, 6)
    setdiff(c(p1, p2, Tw1[[p1]], Tw1[[p2]]), PP) %>% unique()
}) %>% setNames(P2) %>% compact()

La alocarea lecțiilor unui cuplaj PP (cheie din Tw2), va trebui să ținem seama de alocările făcute deja profesorilor și cuplajelor din vectorul Tw2[[PP]]:

    PP       Tw2[[PP]]
    $En4En2  "En4" "En2" "En4En3"
    $En4En3  "En4" "En3" "En4En2"
    $En5En1  "En5" "En1"
    $Gr2Gr1  "Gr2" "Gr1"
    $In1TI1  "In1" "TI1"
    $In3In2  "In3" "In2"

De exemplu, En4En2 nu se va putea afla într-o aceeași oră a zilei ca și vreunul dintre cei 3 profesori (sau cuplaje) din vectorul Tw2$"En2En4".

Repartizarea pe zile și pe orele zilei a lecțiilor prof|cls, precum și reducerea ferestrelor din orarele obținute (deasemenea, calculul numărului de ferestre dintr-un orar final dat), se bazează pe dicționarele de dependențe constituite mai sus; le salvăm împreună:

save(Tw1, Tw2, file="Tw12.Rda")

Analizând repartizarea lecțiilor care se desfășoară "pe grupe" (la obiectele En, Gr, In și TI), constatăm că în nici unul dintre cazuri, nu putem să le transformăm în "tuplaje" — din cauza faptului că ar trebui împerecheate clase de pe niveluri diferite; de exemplu:

orr8 %>% filter(prof %in% names(Tw2)) %>% count(prof,cls) %>% head(4)
        prof cls n
    1 En4En2 10A 5
    2 En4En2 12A 5
    3 En4En3  9A 5
    4 En5En1 11A 5

En4 și En2 partajează "pe grupe" clasa 10A și deasemenea, clasa 12A; am putea constitui tuplajul (10A 12A) | (En4 En2), dacă s-ar permite să îmbinăm în câte o nouă clasă grupele pe care lucrează En4 la clasele 10A și 12A și respectiv, cele ale lui En2 la aceste clase — însă o asemenea îmbinare de grupe este admisibilă doar pentru clase de pe un același nivel (puteam forma un tuplaj dacă în loc de "12A" ar fi fost de exemplu "10B").

N.B. …

În "partea a doua" ne vom referi la forma normală a lecțiilor prof|cls, pe care (între altele) putem aplica un algoritm elementar de repartizare echilibrată pe zile (vizat deja mai sus, în cea mai simplă formă) și de matricea orară a lecțiilor unei zile, pe care între altele, putem socoti și vizual, ferestrele existente în acea zi.

vezi Cărţile mele (de programare)

docerpro | Prev | Next