Fişierul "Lessons.RDS" specifică toate lecţiile prof | obj | cls, de făcut în cursul săptămânii într-o anumită şcoală:

library(tidyverse)
LSS <- readRDS("Lessons.RDS") # 1260 lecţii prof|obj|cls
'data.frame':	1260 obs. of  3 variables:
 $ prof: chr  "Ionela Stan-Cristache" "Alina Teac" "Iulia Salajanu" "Raluca Mangra" ...
 $ obj : chr  "Educatie fizica" "Educatie muzicala" "Limba engleza" "Matematica" ...
 $ cls : Factor w/ 42 levels "10A","10B","10C",..: 28 28 28 28 28 28 28 28 28 28 ...

O lecţie angajează fie un singur profesor, fie (dar mult mai rar) un cuplu de profesori – cum se vede pe acest eşantion de lecţii:

> slice_sample(LSS, n = 3)
                               prof            obj  cls
1                    Daniel Crocnan         Fizica  12H
2 Sorin Giurumescu/Valentina Morman  Limba germana  10A
3                   Maria Ardeleanu        Religie  12E

Numele celor doi profesori care au de partajat într-un acelaşi timp o anumită clasă (lucrând cu câte o grupă a acesteia) sunt separate în coloana prof prin caracterul '/' (ca în linia 2 din eşantionul redat mai sus); spre deosebire de [2], nu asumăm vreo anumită ordine a numelor respective (în general de fapt, demersul de acum este mai „aşezat”).

Investigând disciplinele şcolare din coloana obj, descoperim o compunere de două discipline (separate prin '/'):

> (obj_sep <- unique(LSS$obj) %>% grep("/", ., fixed=TRUE, value=TRUE))
[1] "Educatie muzicala/Educatie vizuala"

Investigând lecţiile pe această disciplină „compusă”, vedem că ele angajează un acelaşi cuplu de profesori, la clasele a 9-a şi a 10-a; extragem aici un eşantion:

> LSS %>% filter(obj == obj_sep) %>% slice_sample(., n=2)
                        prof                                 obj  cls
1 Alina Teac/Gratiela Stoian  Educatie muzicala/Educatie vizuala   9D
2 Alina Teac/Gratiela Stoian  Educatie muzicala/Educatie vizuala  10B

Dar de data aceasta, nu mai este vorba de un cuplaj de profesori obişnuit (pe grupe ale unei aceleiaşi clase), dat fiind că "Educatie muzicala" şi "Educatie vizuala" sunt prevăzute la clasele a 9-a şi a 10-a cu numai câte o jumătate de oră pe săptămână – sau „echivalent”, cu câte o oră la două săptămâni.
Este vorba de clase cuplate într-un acelaşi timp, alternând săptămânal cele două discipline; de exemplu, în săptămânile impare 9D face "Educatie muzicala" şi în acelaşi timp, 10B face "Educatie vizuală", iar în săptămânile pare 9D face "Educatie vizuala" şi în acelaşi timp, 10B face "Educatie muzicala".

Pentru a asigura – prin programele de repartizare pe zile şi ore din [1] – o asemenea alternanţă săptămânală, decupăm din LSS lecţiile pe obiectul compus (deci rămân mai puţine lecţii de repartizat) şi le alocăm anticipat pe zile (anticipând acum şi specificaţia la care vom ajunge mai jos, pentru discipline şi profesori), astfel încât în fiecare zi cei doi profesori implicaţi să poată intra la o clasă a 9-a, respectiv la una de-a 10-a:

cls_cup <- LSS %>% filter(obj == "Educatie muzicala/Educatie vizuala")
LSS <- LSS %>% 
       anti_join(., cls_cup, by=c("prof", "obj", "cls"))  # rămân 1242 lecţii
cls_cup <- cls_cup %>%
           mutate(prof = ifelse(grepl("9", cls), "Em1", "Ev1")) %>%
           mutate(obj = ifelse(grepl("9", cls), "Em", "Ev")) %>%
           arrange(cls) %>%
           mutate(zl = rep(c(1:5, 1:4), 2))
> cls_cup
   prof obj  cls  zl             prof obj  cls  zl
1   Ev1  Ev  10A   1          10  Em1  Em   9A   1
2   Ev1  Ev  10B   2          11  Em1  Em   9B   2
3   Ev1  Ev  10C   3          12  Em1  Em   9C   3
4   Ev1  Ev  10D   4          13  Em1  Em   9D   4
5   Ev1  Ev  10E   5          14  Em1  Em   9E   5
6   Ev1  Ev  10F   1          15  Em1  Em   9F   1
7   Ev1  Ev  10G   2          16  Em1  Em   9G   2
8   Ev1  Ev  10H   3          17  Em1  Em   9H   3
9   Ev1  Ev  10I   4          18  Em1  Em   9I   4

Am preferat să împerechem clasele după litere; de exemplu, clasele 9A şi 10A fac în ziua 1 fie Em şi respectiv Ev, fie invers – după cum săptămâna în curs este de rang par sau impar.
Desigur, ulterior va trebui să asigurăm câte o aceeaşi oră a zilei, pentru ca profesorii Em1 şi Ev1 să intre în paralel (într-un acelaşi timp) la clasele astfel împerecheate pe zile.

Dacă este cazul, putem extinde cls_cup – fixând anumite zile şi pentru alţi vreo doi-trei profesori (şi excluzând lecţiile respective, din LSS)…

Pentru programele de repartizare pe zile şi pe orele zilei a lecţiilor este necesar să constituim anumite seturi de date – precum cls_cup – şi anumite dicţionare prealabile (eventual şi anumite funcţii de conversie); de aceea, se cuvine să vorbim de modelarea încadrării şi nu doar (ca anterior, pe aici) de „matricea de încadrare”.

Dicţionarele inverse unul celuilalt obj_abb.RDS şi abb_obj.RDS vor servi pentru a nota uniform profesorii, după disciplina principală a fiecăruia – permiţând eliminarea câmpului LSS$obj (fără vreo pierdere, dacă vom constitui şi un dicţionar pentru profesorii care au în încadrare şi o disciplină secundară):

> dObj <- readRDS("obj_abb.RDS")
                        dObj                            dObj
Biologie                  Bi              Fizica          Fz
Chimie                    Ch              Geografie       Ge
Cultura civica            Cv              Informatica     N
Cultură germană           Cg              Istorie         Is
Dezbatere                 Dz              Limba engleza   Le
Dirigentie                Dr              Limba franceza  Lf
Economie                  Ec              Limba germana   Lg
Educatie antreprenoriala  Ea              Limba latina    Ll
Educatie fizica           Ef              Limba romana    R
Educatie muzicala         Em              Logica          Lo
Educatie sociala          Es              Matematica      M
Educatie tehnologica      Et              Psihologie      Ps
Educatie vizuala          Ev              Religie         Re
Filosofie                 Fs              TIC             Ti

Am redat aici dicţionarul „direct”, conţinând abrevierile convenite pentru discipline (prin câte două caractere, dacă numărul de profesori de pe disciplina respectivă este mai mic ca 10 şi printr-unul singur, în caz contrar). Subliniem că dObj este de fapt un "vector cu nume", dar l-am redat prin as.data.frame(dObj) (cheile s-au păstrat ca "nume de linii", iar valorile au fost înscrise în singura coloană "dObj" a tabelului).
Dicţionarul „invers” abb_obj.RDS ne va permite să explicităm (când ar fi cazul) disciplina corespunzătoare unui profesor, pe baza „numelui” acestuia; de exemplu, lecţia Em1 | 10A va fi una de "Educatie muzicala", iar Bi2 | 10A de "Biologie".

Vom folosi următoarea funcţie (foarte simplă), pentru a stabili care discipline sunt ”principale” şi care „secundare” şi pentru a introduce apoi notaţia după disciplina principală (sugerată mai sus) pentru profesori:

obj_main_sec <- function(P)
    LSS %>% filter(grepl(P, prof, fixed=TRUE)) %>% count(obj, sort=TRUE)
# Exemplificare:
> print(obj_main_sec("Sorin Giurumescu"))
              obj  n
1   Limba germana  5  # principală
2 Cultură germană  1  # secundară

Profesorul exemplificat aici are disciplina de bază "Limba germana" şi disciplina secundară (cu număr mai mic de ore) "Cultură germană" – încât vom alege ca „nume” al său LgN (şi nu "CgN", cum ne-a rezultat în [2]) unde N ar fi numărul de ordine în lista profesorilor pe "Limba germana", ordonată descrescător după numărul de ore.

Pentru a desemna lecţiile care trebuie să decurgă „pe grupe”, vom compune (prin alipire) numele stabilite pentru cei doi profesori implicaţi (ajungând deci la ceea ce am denumit anterior pe aici, „profesori fictivi”). Deci ne interesează în primul rând, profesorii implicaţi în lecţii care nu decurg pe grupe (altfel spus – cei care au şi ore proprii, la care intră singuri şi nu în vreun cuplaj):

prof_main <- LSS %>% filter(! grepl("/", prof, fixed=TRUE)) %>% 
             pull(prof) %>% unique()  # profesorii care au şi ore proprii
lpm <- map(prof_main, obj_main_sec)
names(lpm) <- prof_main

Aplicând funcţia obj_main_sec() pe vectorul profesorilor cu ore proprii, am obţinut lista lpm care indică pentru fiecare dintre aceştia, disciplina principală şi (când este cazul) pe cea secundară. Să constituim acum un „tabel” (data.frame) care să conţină profesorii cu ore proprii (din vectorul prof_main) împreună cu obiectele principale asociate lor prin lista lpm:

DF_main <- map_df(prof_main, function(P) 
                  data.frame(prof = P, obj = lpm[[P]]$obj[1]))

Numărând pentru fiecare profesor din DF_main, pe câte linii apare în LSS – obţinem numărul de ore ale acestuia şi-l putem integra într-o nouă coloană, pe linia corespunzătoare lui în DF_main; dar coloanele $prof sunt deocamdată de tip character (şi nu factor ordonat după vreun anumit criteriu), deci count(prof) va furniza frecvenţele respective în ordinea alfabetică a numelor.
Prin urmare, întâi aranjăm liniile din DF_main în ordinea alfabetică a numelor din coloana $prof, apoi adăugăm coloana $nh în care înscriem numărul de ore obţinut din LSS prin count(prof), reordonăm liniile descrescător după frecvenţele respective şi în final, transformăm prin split() într-o listă conţinând subseturile de profesori ai câte unei aceleiaşi discipline principale:

DF_main <- DF_main %>% 
           arrange(prof) %>%  # aceeaşi ordine ca după count(prof)
           mutate(nh = LSS %>% 
                       filter(prof %in% DF_main$prof) %>% 
                       count(prof) %>%  # implicit, ordine alfabetică
                       pull(n) # numărul de ore pentru fiecare
           ) %>% arrange(desc(nh)) %>%
           split(.$obj)
# Exemplificare:
 $ Istorie             :'data.frame':	3 obs. of  3 variables:
  ..$ prof: chr [1:3] "Dan Ciuperca" "Veta Grecu" "Vasilica Donciu"
  ..$ obj : chr [1:3] "Istorie" "Istorie" "Istorie"
  ..$ nh  : int [1:3] 20 16 9

Pe Istorie de exemplu, apar 3 profesori, în ordinea descrescătoare a numărului de ore şi urmează să-i notăm respectiv prin Is1, Is2 şi Is3.
Pentru a ajunge la notaţia respectivă (pentru toţi profesorii care au ore proprii), folosim dicţionarul obj_abb.RDS şi pentru profesorii fiecăruia dintre subseturile pe discipline din lista DF_main, alipim abrevierea disciplinei respective cu 1:N unde N este numărul de profesori pe acea disciplină (iar dacă N > 9, intercalăm şi un '0' – încât codurile rezultate să aibă toate, câte 3 caractere). În final, prin map_dfr() obţinem un tabel (data.frame) care asociază numele reale (cele iniţiale, din LSS) ale profesorilor care au ore proprii şi codurile de câte 3 caractere, atribuite lor:

abb <- readRDS("obj_abb.RDS")
DFpc <- map_dfr(1:length(DF_main), function(i) {
            N <- nrow(DF_main[[i]])
            mc <- abb[DF_main[[i]]$obj][[1]]
            obn <- if(N < 10) paste0(mc, 1:N)
                   else c(paste0(mc, "0", 1:9), paste0(mc, 10:N))
            data.frame(prof = DF_main[[i]]$prof, cod = obn)
})
# pentru exemplificare:
> str(DFpc)
'data.frame':	83 obs. of  2 variables:
 $ prof: chr  "Mirela Marinescu" "Doriana Stoica" "Simona Vasilescu" "Felix Lupulescu" ...
 $ cod : chr  "Bi1" "Bi2" "Bi3" "Bi4" ...

Dar este mai simplu să tratăm DFpc nu ca data.frame, ci ca dicţionar (uşor de extins şi – valorile DFpc$cod fiind distincte între ele – de inversat):

prof_cod <- DFpc$cod
names(prof_cod) <- DFpc$prof
cod_prof <- setNames(names(prof_cod), prof_cod)  # dicţionarul invers
## Exemplificare:
> sample(prof_cod, 3)
  Oana Lupascu Alexandra Puiu   Alina Moraru   # chei
         "N14"          "N10"          "Lf2"   # valori (distincte)
> sample(cod_prof, 3)
                 Ec1                   Re2                  N02  # chei
   "Cristina Vasile"  "Veronica Cosacenco"         "Alina Boca"  # valori

"N02" de exemplu, indică (după dicţionarul abb_obj.RDS) un profesor de "Informatica" (al 2-lea, în ordinea descrescătoare a numărului de ore) care are şi ore proprii.
Dar unii profesori care au ore proprii, fac şi o a doua disciplină; să ne amintim că aceasta este indicată pe al doilea loc în vectorul $obj asociat profesorului în lista lpm.
Să constituim un dicţionar prof_sec pentru profesorii cu disciplină secundară:

pr2 <- sapply(lpm, nrow)  # profesor ==> număr discipline
pr2 <- names(pr2[pr2 == 2])  # profesorii cu o disciplină secundară
prof_sec <- sapply(pr2, function(P) lpm[[P]]$obj[2])  # profesor ==> disciplina_2
names(prof_sec) <- prof_cod[names(prof_sec)]
# Exemplificare:
> sample(prof_sec, 3)
              Ge1            Es1                 Lg1 
     "Dirigentie"   "Psihologie"   "Cultură germană"

N-am folosit abrevierile din obj_abb.RDS, fiindcă de disciplinele secundare ar fi nevoie numai la redarea finală a orarelor claselor.
Avem nevoie desigur, de o funcţie care să dea clasele unde profesorul (indicat prin codul său) are şi disciplină secundară:

sec_to_cls <- function(codP, disp)
    LSS %>% filter(prof %in% cod_prof[codP], obj %in% disp) %>%
    pull(cls) %>% 
    as.vector() %>% unique()
# Exemplificare:
> sec_to_cls("Lg1", "Cultură germană")
[1] "11A" "12A"

Folosind '%in%' şi nu '==', ne-am asigurat că putem invoca şi cu argumente de lungime mai mare ca 1; să aplicăm sec_to_cls() pe dicţionarul prof_sec (al profesorilor cu discipline secundare):

cls_sec <- sapply(names(prof_sec), sec_to_cls, prof_sec) 
# Exemplificare: 
> str(cls_sec)
List of 22
 $ Em1: chr [1:3] "7A" "8A" "8B"
 $ Le2: chr "5A"
 $ Ge1: chr "8A"
# etc.

Probabil că s-ar cuveni să strângem într-un singur loc (un obiect data.frame), toate informaţiile (profesorul, disciplina secundară, clasele) obţinute mai sus în vectorul cu nume prof_sec şi în lista cls_sec:

TB_sec <- tibble(prof = names(prof_sec), 
                 disp = as.vector(prof_sec), 
                 cls = as.vector(cls_sec)) %>%
          as.data.frame()
# Exemplificare:
> TB_sec %>% slice_sample(n=4)
  prof            disp          cls
1  Em1  Cultura civica   7A, 8A, 8B
2  Es1      Psihologie     10F, 10G
3  N06             TIC 9F, 10F, 10G
4  Lg2 Cultură germană           9A

Am cam terminat, cu profesorii care au şi ore proprii; din codurile de câte 3 caractere pe care le-am asociat acestora, avem imediat – folosind şi dicţionarul abb_obj.RDS – disciplina principală a fiecăruia; în setul de date TB_sec avem aceia dintre profesori care la anumite clase (indicate şi acestea, în TB_sec), fac şi o disciplină secundară.
De exemplu, cum vedem mai sus, N06 face "Informatica", iar la clasele 9F, 10F şi 10G face (şi) "TIC"; forma indexului, '06', ne spune că avem cel puţin 10 profesori pe "Informatica" (dintre care 5 au tot atâtea sau mai multe ore, decât N06). Rămâne de văzut când va fi cazul, dacă N06 face ambele obiecte la câte o aceeaşi clasă.

Am terminat să zicem, şi cu clasele cuplate – pentru care am rezervat repartizarea pe zile din tabelul cls_cup. A rămas să ne ocupăm de cuplajele de profesori.

Mai întâi, extragem din LSS subsetul lecţiilor care se desfăşoară „pe grupe”:

LSS2 <- LSS %>% filter(grepl("/", prof, fixed=TRUE))
    'data.frame':	115 obs. of  3 variables:
     $ prof: chr  "Alina Boca/Corina Vint" "Alina Boca/Corina Vint" ...
     $ obj : chr  "Informatica" "Informatica" "Informatica" "Informatica" ...
     $ cls : Factor w/ 42 levels "10A","10B","10C",..: 37 37 37 38 38 38 39 ...
> unique(LSS2$obj)
    [1] "Informatica"   "Limba germana" "Limba engleza"

Cele 115 lecţii „pe grupe” (la trei discipline, evidenţiate şi acestea mai sus) angajează câte doi profesori şi pentru aceştia putem avea trei cazuri: fie ambii au şi ore proprii, deci apar ambii în dicţionarul prof_cod (şi n-avem decât să alipim codurile existente aici); fie numai unul dintre ei apare în prof_cod, fie niciunul.

Să determinăm profesorii „externi” – cei care nu apar în prof_cod. Pentru aceasta, obţinem întâi numele unice, dintre cele 115 perechi de nume din LSS2$prof; apoi, din vectorul rezultat reţinem acele nume care nu apar în prof_cod şi prin setNames(), le asociem coduri de forma "ex1", "ex2", etc.:

in_tw <- LSS2 %>% pull(prof) %>%  
         strsplit(.,'/',fixed=TRUE) %>% 
         unlist() %>% unique()
#
> str(in_tw)
 chr [1:23] "Alina Boca" "Corina Vint" "Anca Leuciuc" "Irina Iosupescu" ...
#
pr_ext <- in_tw[! in_tw %in% names(prof_cod)]
pr_ext <- setNames(paste0("ex", 1:length(pr_ext)), pr_ext)
# 
> pr_ext  # profesorii "externi"
  Irina Iosupescu      Elena Dragan Marcel Homorodean      Cezar Mandle 
            "ex1"             "ex2"             "ex3"             "ex4" 

Acum formulăm un dicţionar tw_cod care să asocieze numelor unice din LSS2$prof – aşa cum apar acestea, separate prin '/' – codurile rezultate prin funcţia set_cod() de mai jos, alipind valori din prof_cod sau pr_ext, după caz:

set_cod <- function(P) {
    kd <- if(! is.na(prof_cod[P])) prof_cod[P] else pr_ext[P]
    as.vector(kd) 
}
twins <- LSS2 %>% pull(prof) %>% unique() %>% sort()
tw_cod <- vector("character", length(twins))
for(i in 1:length(twins)) {
    tw <- strsplit(twins[i], "/", fixed=TRUE)[[1]]
    tw_cod[i] <- paste0(set_cod(tw[1]), set_cod(tw[2]))
}
tw_cod <- setNames(tw_cod, twins)
#
> sample(tw_cod, 4)
Elena Dragan/Marcel Homorodean Andreea Dumitru/Iulia Salajanu 
                      "ex2ex3>"                       "Le4Le2" 
   Livia Magureanu/Victor Manz    Cristina Olaru/Elena Dragan 
                      "N13N04"                       "N05ex2" 

Combinând prof_cod (notaţia celor cu ore proprii) şi tw_cod (notaţia cuplajelor) – obţinem codificarea după discipline a tuturor numelor unice de profesori din LSS:

PC <- c(prof_cod, tw_cod)  # profesor (sau cuplu) ==> cod scurt
#
> sample(PC, 4)
   Elena Dragan/Simona Ionescu               Daniel Georgescu 
                      "ex2N01"                          "R10" 
Andreea Dumitru/Iulia Salajanu                  Gina Cojocaru 
                      "Le4Le2"                          "Le5" 

Putem reformula acum LSS, înlocuind numele reale prin cele asociate în dicţionarele PC (pentru profesori şi cuplaje) şi abb (pentru discipline):

LSS <- LSS %>% mutate(prof = as.vector(PC[prof]), 
                      obj = as.vector(abb[obj]))
#
> str(LSS)
'data.frame':	1242 obs. of  3 variables:
 $ prof: chr  "Ef1" "Em1" "Le2" "M07" ...
 $ obj : chr  "Ef" "Em" "Le" "M" ...
 $ cls : Factor w/ 42 levels "10A","10B","10C",..: 28 28 28 28 28 28 ...
#
saveRDS(LSS, file="lessons.RDS")

Am avut grijă să folosim as.vector(), pentru a culege din dicţionarele respective numai valorile (nu şi numele – caz în care LSS ar fi fost de două-trei ori mai voluminos, iar exploatarea ulterioară devenea mai înceată); pentru discipline avem deja obj_abb.RDS şi n-avem decât să salvăm undeva şi PC – pentru a reconstitui ulterior, când ar fi cazul, numele reale.

Mai este de salvat cls_cup, în care avem repartizarea pe zile convenită la început pentru clasele cuplate (eventual şi pentru unii profesori cu ore puţine). Iar pentru a încheia modelarea încadrării – în vederea folosirii acesteia în programele de repartizare pe zile şi ore a lecţiilor, din [1] – rămâne să formulăm încă două-trei „dicţionare” (sau liste) care să evidenţieze de care alţi profesori depinde alocarea pe zile şi ore a lecţiilor unui profesor care este angajat în unul sau mai multe cuplaje; dar listele respective se obţin de-acum exact ca în [1] (Tw1, Tw2 şi Twx) şi aici nu mai avem nimic de adăugat.

Poate doar am avea de subliniat: codificarea pe discipline a profesorilor (introdusă mai sus) este superioară din orice punct de vedere, celeia banale p01...p83, pe care o adoptasem în [1] şi în alte locuri pe aici.
Desigur… apare o întrebare: cum de n-am avut-o în vedere de la bun început (în loc de cea banală)? Explicaţia „păcălelii” este simplă (dar ţine de gusturi şi obiceiuri): orarele de şcoală pe care le-am folosit pentru a dezvolta [1] vizau aşa de prost disciplinele şcolare (spre deosebire de orarul pe care l-am abordat aici, în care notaţiile sunt corecte şi coerente), încât de la bun început, am ignorat –mea culpa– câmpul obj (în [1] de exemplu, lecţie însemna de la bun început prof | cls, unde prof nu viza în vreun fel, disciplina).