Pentru repartizarea pe zile a lecţiilor (la care rămăsesem „pe gânduri” în [2]), putem separa lucrurile, operând (spre deosebire de [1]) în două etape distincte: ne ocupăm întâi de lecţiile necuplate (majoritatea lecţiilor existente, cu câte un singur profesor la clasă) şi apoi, de cele cuplate (în care doi profesori partajează „pe grupe” o aceeaşi clasă); iar în final, îmbinăm rezultatele.

Lucrăm desigur într-un subdirector nou, încât putem păstra eventual, denumirile anterioare pentru funcţiile (şi fişierele) pe care le modificăm.

Repartizarea pe zile a lecţiilor necuplate

Simplificăm funcţia mount_days() (din programul "by_days.R" – v. [1] sau [2]), vizând acum numai profesorii neimplicaţi în cuplaje.
În principal, excludem Tw1, Tw2 şi secvenţa "alte condiţii", prin care limitam anterior numărul de ore pe zi cumulat la cei angajaţi în cuplaje.

Altfel, modificările faţă de versiunea din [1] sunt totuşi minore.
Am redus argumentele funcţiei mount_days() la trei: LSS (lecţiile prof|cls ale profesorilor ne-implicaţi în cuplaje), many_hours cu valoarea implicită 5 – încât funcţia CND() să pretindă alocări cvasi-omogene pentru majoritatea profesorilor din LSS şi nu doar pentru cei cu „suficient de multe” ore – şi max_try (pentru a limita încercările de alocare, echilibrată şi fără conflicte cu alocările făcute deja la alte clase, a lecţiilor clasei curente).
Am eliminat înregistrarea în matricea de alocare locală ZH, a alocărilor convenite în prealabil prin setul CUP (v. [2]) – fiindcă lecţiile din CUP (pentru clase cuplate) vor putea fi adăugate în orice moment ulterior (cel mai bine, tocmai la sfârşit).

Avem de menţionat această reformulare simplă şi elegantă, pentru funcţia CND():

CND <- function(More, lpr) {  # verifică omogenitatea alocării pe zile
        mex <- Zore[, lpr] + More[, lpr]  # (cu peste 'many_hours', ai clasei curente)
        # caută alocarea cu diferenţe ≤ 2, la numerele de ore pe zi
        for(j in 1:ncol(mex)) {
            oz <- mex[, j]  # o alocare pe zile, posibilă pentru profesorul curent   
            if(any(sapply(oz, '-', oz) > 2)) return(FALSE)
        }
        return(TRUE)  # acceptă alocarea: este cvasi-omogenă
    }  

sapply(oz, '-', oz) aplică funcţia "-"() pe oricare două valori din coloana curentă 'oz'; apoi, se testează dacă vreuna dintre diferenţele respective este mai mare ca 2 – caz în care alocarea propusă este refuzată: nu este „cvasi-omogenă”, fiindcă există două zile în care numărul de ore alocate unui profesor al clasei diferă cu mai mult de 2 ore.

În programul următor separăm setul iniţial al lecţiilor în cele două subseturi (lecţiile necuplate, respectiv cele „pe grupe”) şi deocamdată, exploatăm mount_days():

# test1.R
library(tidyverse)
source("by_days.R")  # mount_days() (cu modificările indicate mai sus)
load("CUP_Tw.Rda")  # [1] "Tw1", "Tw2", "CUP" (neutilizate în 'by_days.R')
    
LSS <- readRDS("lessons.RDS")  # print(str(LSS))
LS1 <- LSS %>% filter(! prof %in% union(names(Tw1), names(Tw2)))
LS2 <- anti_join(LSS, LS1, by=c('prof', 'cls'))

R1 <- mount_days(LS1)  # for(i in 1:10) R1 <- mount_days(LS1)

Rulând, cu intercalarea afişării structurii datelor şi a intervalului de timp în care mount_hours() îşi produce rezultatul – avem de exemplu, această imagine a execuţiei:

> rm(list=ls())  # elimină variabilele existente în sesiunea de lucru curentă
> source("test1.R")
# LSS  (toate lecţiile, exceptând pe cele din CUP)
'data.frame':	1242 obs. of  2 variables:
 $ prof: chr  "Bi2" "Bi2" "Bi2" "Bi2" ...
 $ cls : chr  "10E" "10E" "11B" "12E" ...
# LS1  (lecţiile necuplate)
'data.frame':	963 obs. of  2 variables:
 $ prof: chr  "Bi2" "Bi2" "Bi2" "Bi2" ...
 $ cls : chr  "10E" "10E" "11B" "12E" ...
# LS2  (lecţiile cuplate, "pe grupe")
'data.frame':	279 obs. of  2 variables:
 $ prof: chr  "Ge3" "Ge1" "Ge1" "Ge2" ...
 $ cls : chr  "10A" "11A" "12A" "9A" ...
 
# execută mount_days(), pe LS1:
11:01:30******************************************11:01:48
# R1 (o distribuţie pe zile a lecţiilor necuplate)
'data.frame':	963 obs. of  3 variables: 
 $ prof: Ord.factor w/ 64 levels "Bi1"<"Bi2"<"Bi3"<..: 38 44 44 44 44 12 ...
 $ cls : chr [1:963] "10A" "10A" "10A" "10A" ...
 $ zl  : Factor w/ 5 levels "Lu","Ma","Mi",..: 3 1 4 2 5 3 1 4 2 5 ...

Rulând "test1.R" de mai multe ori, rezultă alte distribuţii pe zile, iar execuţia lui mount_days() diferă ca timp şi eventual, ca mod de lucru intern – de exemplu:

> source("test1.R")
# execută 'mount_days()' pe LS1:
11:05:25***************************************/ ******************************************11:06:50

caz în care mount_days() a consumat 85 de secunde şi a necesitat o reluare a procesului de alocare: la prima abordare a listei claselor, alocarea lecţiilor clasei curente – semnalată pe ecran prin "*" – a eşuat (şi pe ecran s-a marcat "/", în loc de "*"); ca urmare, procesul curent este abandonat, lista claselor este reordonată (aleatoriu) şi procesul de alocare este reluat de la capăt.
Iterând execuţia lui mount_days() de vreo 10 ori (v. mai sus, comentariul final din "text1.R"), constatăm că reluarea procesului de alocare este foarte rară (un caz sau două, din 10), iar execuţia durează cel mai adesea câte mai puţin de 20 secunde.

Repartizarea pe zile a cuplajelor

Evocăm din [1] ideea de bază a funcţiei mount_days().
Împărțim setul tuturor lecțiilor prof|cls, după clasă; etichetăm succesiv lecțiile unei clase (pentru fiecare clasă, pe rând), astfel: fixăm temporar o ordine oarecare a zilelor de lucru și înscriem secvența respectivă primelor 5 lecții, apoi următoarelor 5, ș.a.m.d.
De observat că astfel, clasa va avea în fiecare zi cam același număr de ore, iar orele unui aceluiași profesor la clasa respectivă vor fi plasate în zile diferite (lecţiile clasei fiind ordonate după profesor); lecţiile fiecărei clase sunt distribuite omogen pe zile, dar în general, profesorii care au ore la mai multe clase vor căpăta alocări ne-omogene (o zi cu 2 ore, una cu 5 ore de exemplu) – pe care le putem refuza (prin funcţia de validare CND()), căutând apoi o altă alocare (măcar „cvasi-omogenă”).

Acum să inversăm rolurile!
Împărțim setul tuturor lecțiilor prof|cls, după profesor; etichetăm succesiv lecțiile unui profesor (pentru fiecare profesor, într-o anumită ordine), astfel: fixăm temporar o ordine oarecare a zilelor de lucru și înscriem secvența respectivă primelor 5 lecții, apoi următoarelor 5, ș.a.m.d. (în funcţie de câte ore are în total, profesorul respectiv).
Vor rezulta distribuţii omogene pentru lecţiile profesorului, dar în general – ne-omogene, pentru lecţiile unei aceleiaşi clase (o zi cu 2 ore, una cu 7 ore de exemplu).

Iar acum să observăm că această a doua variantă de lucru este cea potrivită pentru repartizarea pe zile a lecţiilor cuplate, dat fiind numărul mic al acestora; LS2 conţine 279 de lecţii, deci pe fiecare clasă (dintre cele 42) am avea un număr mic de ore – încât este de aşteptat ca variaţia de la o zi la alta a numărului de ore ale aceleiaşi clase să fie suficient de mică (şi va fi uşor de făcut corecţii ulterioare). Ar rămâne ca avantaj, faptul că lecţiile fiecărui cuplaj vor fi distribuite omogen, pe zile.

Pentru a modela această manieră de repartizare pe zile a lecţiilor cuplate, am putea să imităm mount_days() (inversând rolurile, între profesori şi clase); dar avem o soluţie directă, poate mai ingenioasă, dar mult mai scurtă.

Pentru fiecare profesor P numit în Tw1, considerăm lecţiile acestuia împreună cu lecţiile celor din Tw1[[P]] (cuplajele în care apare P); ordonăm subsetul respectiv după câmpul $cls şi apoi îi montăm coloana $zl pe care etichetăm lecţiile, aplicând o aceeaşi permutare de 1..5 pe primele 5 lecţii, apoi pe următoarele 5, ş.a.m.d. Subliniem că nu este necesar să vizăm şi Tw2, fiindcă numele din Tw2 apar sub o cheie sau alta, în Tw1 (exceptând doar cuplajul extern X02X03).
Următorul experiment – instrumentat în consolă – ilustrează procedeul şi ne permite să sesizăm singurul lucru de care trebuie să ţinem seama:

> LS2 %>% filter(prof %in% c("Ge2", Tw1[["Ge2"]])) %>% 
+         arrange(desc(cls) %>%  
+         mutate(zl = rep_len(1:5, nrow(.)))
     prof cls zl
1     Ge2  9A  1
2  Ge1Ge2  9A  2
3  Ge1Ge2  9A  3
4  Ge1Ge2  9A  4
5  Ge1Ge2  9A  5
6  Ge1Ge2  9A  1
7  Ge1Ge2 11A  2
8  Ge1Ge2 11A  3
9  Ge1Ge2 11A  4
10 Ge1Ge2 11A  5
11 Ge1Ge2 11A  1

Va trebui să ţinem seama de următorul lucru: Ge1Ge2 apare şi în Tw1[["Ge1"]], deci dacă nu-l îndepărtăm fie din Tw1[["Ge1"]], fie din Tw1[["Ge2"]] – orele lui Ge1Ge2 vor fi etichetate de câte două ori.

Următoarea secvenţă (pe care o înscriem deocamdată chiar în "test1.R") constituie lista W în care copiază cheile şi respectiv, valorile din Tw1 – dar astfel încât fiecare dintre valori să apară câte o singură dată:

W <- Tw1
W[["X02X03"]] <- ""  # adaugă pe ultimul loc, cuplajul din Tw2 neexistent în Tw1
n <- length(W)
for(i in 1:n) {
    Pcr <- c(names(W)[i], W[[i]])
    j <- i+1
    while(j < n) {
        tw <- W[[j]]
        tw <- tw[! tw %in% Pcr]  # ignoră cuplajele întâlnite anterior
        W[[j]] <- tw
        j <- j + 1
    }
}

Angajând lista W (şi matricea de permutări 1..5 perm_zile, din "by_days.R"), următoarea secvenţă realizează procedura descrisă mai sus pentru repartizare pe zile a lecţiilor cuplate (din LS2):

assign_zl_twins <- function(P)
    LS2 %>% filter(prof %in% c(P, W[[P]])) %>%
    arrange(cls) %>%
    mutate(zl = rep_len(perm_zile[, sample(120)], nrow(.)))

R2 <- map_dfr(names(W), assign_zl_twins) %>%
      mutate(zl = factor(zl, labels = Zile))  # o distribuţie a lecţiilor cuplate

Rulând "test1.R" după introducerea celor două secvenţe de mai sus, obţinem R2 în doar o fracţiune de secundă; dacă repetăm, obţinem o altă distribuţie R2, diferită (în general) de precedenta – fiindcă în assign_zl_twins() am folosit sample(), asigurând o alocare aleatorie a zilelor pe lecţiile profesorului curent.
Totuşi nu am implicat sample() cu scopul de a obţine diverse distribuţii R2 – una singură (oricare) ne este suficientă. Dacă nu foloseam sample() şi prevedeam mereu, pentru toţi profesorii, alocarea 1..5 – atunci lecţiile ar fi fost alocate cu precădere în primele zile, rezultând o distribuţie descrescătoare după zile, a celor 279 de ore, precum (64 60 58 51 46); folosind sample(), avem distribuţii destul de echilibrate, precum (58 57 52 56 56) (şi desigur, dacă rulăm de suficient de multe ori, putem nimeri şi o distribuţie R2 care să fie chiar omogenă – cu 56 de ore în 4 zile şi 55 în ziua rămasă).

Putem încheia "test1.R" salvând împreună, cele două distribuţii:

save(R1, R2, file="R1R2.Rda")

Să mai observăm cum sunt distribuite pe zile lecţiile din R1, respectiv din R2; putem folosi de exemplu R1 %>% group_by(zl) %>% count(zl) şi (pentru R1) găsim (191 196 194 195 187), cu diferenţa maximă de 9 ore (între zilele 2 şi 5); analog, pentru R2 avem distribuţia (55 56 56 57 55) – care desigur că este cvasi-omogenă, având în vedere modul în care am generat R2.

Corelarea distribuţiilor pe zile

Trebuie să urmărim pentru fiecare clasă, ca numărul de ore plasate acesteia într-o aceeaşi zi, în R1 şi respectiv în R2, să nu însumeze mai mult de 6 sau 7 ore; probabil că vom reuşi odată, să automatizăm (parţial) această „urmărire” – dar acum, vom proceda interactiv, folosind consola R (şi eventual, aplicaţia "Recast.html" referită în [1] sau în alte locuri pe aici). Ne vom baza pe trei funcţii, modelate după cele disparate în programul "interact.R" constituit mai înainte în [2]; primele două sunt preluate din [2], cu deosebirea că acum au ca parametru şi distribuţia pe care operează:

# interact.R  investigare/modificare interactivă a distribuţiilor
library(tidyverse)
load("CUP_Tw.Rda")  # [1] "Tw1"  "Tw2"  "CUP"
Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi")
load("R1R2.Rda")  # importă distribuţiile R1 (lecţiile necuplate) şi R2 (cuplate)

cls_hours <- function(cls_name, RC) {
    RC %>% filter(cls == cls_name) %>% 
    count(zl) %>% pull(n)
} # alocarea pe zile a orelor clasei (în distribuţia indicată)

change_zl <- function(P, Q, Z, new_zl, RC) {
    RC[with(RC, prof==P & cls==Q & zl==Z), "zl"] <- new_zl
    RC
} # alocă o lecţie într-o altă zi, returnând distribuţia modificată

A treia funcţie dezvoltă cls_allocations() din [2] şi… pare complicată, sau este mai complicată decât pare:

prof_zl_nh <- function(Cls, Vzl, RC) {
    D <- RC %>% filter(cls == Cls & zl %in% Vzl) %>% 
         mutate(prof = as.character(prof)) %>% arrange(zl)
    Vpr <- D %>% pull(prof) %>% unique()
    NH <- table(RC[c('prof', 'zl')])[Vpr, ]
    D %>% mutate(zl = as.character(zl)) %>%
          rowwise() %>%
          mutate(nh = paste(NH[prof, Vzl], collapse=" "))
}

Având indicate o clasă Cls, un subvector Vzl din Zile şi o distribuţie RC (fie R1, fie R2) – funcţia prof_zl_nh() procedează astfel: constituie subsetul D al lecţiilor clasei, pe zilele indicate; reţine în vectorul Vpr, profesorii implicaţi în D (ceea ce a necesitat trecerea de la factor la character, a variabilei $prof); determină în matricea NH (prin table() şi '[') numărul total de ore în zilele respective, ale acestor profesori; în final, ataşează lui D – văzut pe linii, prin rowwise() – coloana $nh, în care înscrie pe fiecare linie câte un vector de tip character care conţine valorile din NH corespunzătoare profesorului de pe acea linie şi zilelor din Vzl (ceea ce a necesitat ca şi $zl să fie character, în loc de factor).

Ca exemplu, să corelăm R1 şi R2 pentru clasa 9A.
Mai întâi, evidenţiem numărul de ore pe fiecare zi la 9A, în cele două distribuţii:

> rm(list=ls())
> source("interact.R")
> for(RC in list(R1, R2)) print(cls_hours("9A", RC))
[1] 4 4 5 5 4
[1] 1 2 1 3 2

Deci 9A are 8 ore (5 în R1 şi 3 în R2) în ziua 4 şi are 5 ore în ziua 1, iar în celelalte zile are câte 6 ore. Pentru a echilibra această distribuţie, va trebui să mutăm – fie în R1, fie în R2 – o oră din ziua 4 în ziua 1 (rezultând distribuţia omogenă (6 6 6 7 6)); în principiu, mutăm în R1 (unde avem distribuţii individuale cvasi-omogene şi mutând ore, avem şansa de a le omogeniza) şi nu în R2 (unde cuplajele au fost distribuite omogen, cel puţin pentru profesorii numiţi în Tw1).

Să vedem lecţiile din R1, la 9A pe zilele 1 şi 4, împreună cu numerele totale de ore în aceste zile, ale profesorilor implicaţi:

> prof_zl_nh("9A", c("Lu", "Jo"), R1)
  prof  cls   zl    nh
1 R02   9A    Lu    4 3  
2 M06   9A    Lu    4 4  
3 En5   9A    Lu    2 0  
4 Bi1   9A    Lu    5 4  
5 Gg2   9A    Jo    4 4  
6 M06   9A    Jo    4 4  
7 Ch2   9A    Jo    2 4
8 Fi6   9A    Jo    2 2  
9 Fs1   9A    Jo    4 4 

Ch2 are Lu 2 ore (dar nu şi la 9A) şi are Jo 4 ore, din care una la 9A; ceilalţi profesori care au ore Jo la 9A au în cele două zile, distribuţii omogene (fie (4 4), fie (2 2)).
Prin urmare, alegerea de făcut este certă: mutăm ora lui Ch2 din ziua 4, în ziua 1 (cu avantajul că rezultă o distribuţie omogenă, (3 3) şi pentru Ch2):

> R1 <- change_zl("Ch2", "9A", "Jo", "Lu", R1)

Mai dăm un exemplu, în care avem de făcut două mutări, dar alegerea acestora este iarăşi uşor de făcut.
Să corelăm R1 şi R2 pentru clasa 12A:

> for(RC in list(R1, R2)) print(cls_hours("12A", RC))
[1] 3 4 3 4 3
[1] 2 4 3 1 2
        # De mutat 2 ore din ziua 2, în două dintre zilele 1, 4, 5
> prof_zl_nh("12A", Zile[-3], R1)     
   prof  cls   zl    nh 
 1 Bi3   12A   Lu    3 4 4 2
 2 M05   12A   Lu    3 4 4 3
 3 Ch3   12A   Lu    3 3 3 3
 4 Fs1   12A   Ma    4 4 4 3
 5 Is2   12A   Ma    4 4 2 3
 6 Ef2   12A   Ma    3 4 3 4
 7 Gg1   12A   Ma    5 6 5 4
 8 R08   12A   Jo    1 2 1 2
 9 M05   12A   Jo    3 4 4 3
10 Fi3   12A   Jo    3 4 4 4
11 Re1   12A   Jo    4 5 4 6
12 R08   12A   Vi    1 2 1 2
13 M05   12A   Vi    3 4 4 3
14 Fi3   12A   Vi    3 4 4 4

Reunind distribuţiile R1 şi R2, am avea pentru 12A distribuţia iniţială (5 8 6 5 5); mutând două ore din ziua 2, în două zile dintre cele cu 5 ore – ar rezulta o distribuţie omogenă. Din tabelul afişat de prof_zl_nh() pentru R1, deducem uşor la cine să mutăm câte o oră: la Is2 – care Ma are 4 ore, iar Jo are numai 2 ore (niciuna la 12A) – şi la Gg1, care Ma are în total 6 ore, iar Vi are numai 4 ore (niciuna, la 12A):

> R1 <- change_zl("Is2", "12A", "Ma", "Jo", R1)
> R1 <- change_zl("Gg1", "12A", "Ma", "Vi", R1)

De observat iarăşi, că pe lângă omogenizarea distribuţiei clasei, am omogenizat prin mutările respective şi distribuţiile individuale ale profesorilor implicaţi (şi am avut grijă ca, în principiu, un profesor să nu aibă într-o zi, două ore la o aceeaşi clasă).

Faptul că putem proceda la fel (angajând cele 3 funcţii de mai sus) pentru toate clasele, trebuie să ne conducă până la urmă la o procedură care să decurgă automat, măcar pentru acele clase la care alegerea mutării este (precum în cele două exemple de mai sus) uşor de făcut…

Să presupunem acum că am terminat de corelat R1 şi R2: lecţiile fiecărei clase sunt distribuite uniform pe zile (iar lecţiile fiecărui profesor sunt distribuite omogen, sau măcar cvasi-omogen, pe zile). Rămâne atunci să reunim cele două distribuţii:

R12 <- R1 %>% mutate(prof = as.character(prof)) %>% 
       full_join(R2, by=c('prof','cls','zl'))

Bineînţeles că înainte de a salva rezultatul, trebuie să alipim şi setul CUP:

CUP <- CUP %>% mutate(zl = factor(zl))
levels(CUP$zl) <- Zile
R12 <- R12 %>% full_join(CUP)
saveRDS(R12, "R12.RDS")

Amintim că în CUP avem din [2], setul lecţiilor pe disciplina "mv" (Educaţie muzicală/vizuală) la clasele a 9-a si a 10-a, repartizate din start pe zile (în aşa fel încât Em1 şi Ev1 să intre alternativ – după rangul săptămânii curente – la câte o clasă de-a 9-a şi una de-a 10-a).
Să observăm totuşi că ne-am amintit cam târziu de CUP… În primul exemplu de mai sus, am obţinut pentru 9A distribuţia omogenă (6 6 6 7 6) – dar fără ora de "mv", specificată în CUP; avem totuşi noroc:

> cls_hours("9A", R12)
[1] 7 6 6 7 6

În CUP clasa 9A are alocat "mv" în ziua Lu – astfel că distribuţia finală din R12 rămâne omogenă, (7 6 6 7 6) – spre deosebire de cazul când "mv" ar fi fost alocată în ziua 4, când ar fi rezultat (6 6 6 8 6), necesitând încă o mutare de oră.