În [1] am obţinut direct (adică în cel mai rapid mod posibil) o repartizare pe zilele de lucru a TIP (tabelul încadrărilor profesorilor dintr-o şcoală), cu un algoritm realmente simplu: alocăm zilele repetând secvenţa (1:5) pe lista orelor – după disciplină şi profesor – pentru fiecare clasă. Astfel, orele cu aceeaşi clasă ale unui profesor oarecare vor fi plasate în zile diferite (dacă numărul acestor ore este cel mult 5); fiecare clasă va avea zilnic (n DIV 5) sau (n DIV 5 + 1) ore, unde n este numărul total de ore pe săptămână ale acelei clase.

Dar astfel, apar multe cazuri în care orele profesorului sunt distribuite neuniform pe zile (într-o zi 2 ore, în alta 7 de exemplu); iar pentru a îndrepta acest aspect, în [1] am prevăzut câteva funcţii pentru a ajusta interactiv repartizarea obţinută şi mai sugeram că acestea ar trebui îmbinate cumva, într-un program prin care să „automatizăm” retuşarea necesară.

Oarece retuşări vor fi cu siguranţă necesare mai devreme sau mai târziu, în cursul întregului proces de elaborare a orarului şcolar; dar până să ne gândim la retuşări, avem de observat că schimbând cumva ordinea liniilor pe care plasăm repetat secvenţa (1:5), putem genera mai multe repartiţii pentru orele respective şi vom putem alege dintre acestea, una care să aibă mai puţine cazuri de distribuire neuniformă (fiind mai uşor atunci, de retuşat interactiv).

Ar fi mai multe modalităţi de a forţa generarea unei noi repartiţii, dacă încă nu am obţinut una convenabilă; nu ştim deocamdată, care ar fi „cea mai bună”, dar cea mai simplă ar pleca de la această rescriere a funcţiei set_zile() din [1]:

# returnează un tabel de alocare a zilelor pentru orele unei clase
set_zile <- function(Q) {  # 'Q' conţine liniile din TIP cu o aceeaşi 'clasa'
    srt <- sort(table(Q$prof), decreasing=sample(c(TRUE, FALSE), 1))
    Q$prof <- factor(Q$prof, levels=names(srt))
    Q <- arrange(Q, prof)  # fie crescător, fie descrescător, după numărul de ore
    Q$zl <- gl(n=5, k=1, length = nrow(Q),  
               ordered=TRUE, labels = zile)  # alocă zile pentru ore
    as.data.frame(Q)
}

Faţă de [1], avem de fapt o singură modificare: factorul Q$prof este ordonat aleatoriu – fie crescător, fie descrescător – după numărul de ore la clasa respectivă ale profesorilor; în [1] aveam decreasing=TRUE, iar acum la fiecare moment al invocării funcţiei set_zile() se va alege – aleatoriu, prin sample() – când TRUE, când FALSE.

Dacă acum am invoca de câteva ori funcţia distr() din [1] (pe o aceeaşi listă de clase), vom obţine tot atâtea repartiţii distincte şi n-avem decât să vedem care ne convine mai mult în privinţa omogenităţii. Dar desigur că rescriem lucrurile, încât generarea unei noi repartiţii să se repete automat, până când cea obţinută curent este convenabilă (fiind atunci returnată ca rezultat).

Introducem întâi două variabile „globale” prin care să putem preciza diferenţa difH de admis între numerele de ore pe zi ale fiecărui profesor şi numărul maxim nrEx de cazuri de excepţie (de exemplu, distribuţia redată în [1] are exact 11 cazuri – iar de dorit ar fi cel mult nrEx=2 cazuri – în care diferenţa de ore într-o zi şi alta la un acelaşi profesor depăşeşte valoarea difH=3):

difH <- 3L  # diferenţa admisă între numerele de ore pe zi
nrEx <- 2L  # numărul de cazuri de excepţie        

Funcţia următoare primeşte ca argument subsetul din TIP corespunzător unor anumite clase (de exemplu, celor din schimbul doi), apelează set_zile() pentru fiecare clasă şi testează – procedând cam la fel ca în funcţia hoursPM() din [1] – dacă repartiţia rezultată convine condiţiilor implicate de difH şi nrEx, returnând-o în caz afirmativ, sau auto-apelându-se în caz contrar:

retake <- function(asTIP) {
    D <- map_df(asTIP, function(K) set_zile(K))
    hD <- addmargins(table(D[c('prof', 'zl')]), 2)  %>% 
          as.data.frame(.)  %>%  
          spread(., zl, Freq)
    omg <- apply(hD[, 2:6], 1, function(x) max(x)-min(x))
    som <- sum(omg > difH)  # ;  print(som)
    if(som <= nrEx) return(D)
    retake(asTIP)
}

Funcţia următoare primeşte un vector de clase (cele dintr-un acelaşi schimb, etc.) şi eventual, valori pentru cele două variabile de control; extrage din TIP liniile de date corespunzătoare claselor respective, separându-le după clasă şi apoi, pasează obiectul astfel constituit funcţiei recursive retake():

distrib <- function(vCl, diffh=NULL, nrex=NULL) {
    asT <- TIP  %>%  filter(clasa %in% vCl)  %>%  split(., .$clasa)
    if(!is.null(diffh))  difH <<- diffh
    if(!is.null(nrex)) nrEx <<- nrex
    return(retake(asT))
}      

Pentru schimbul doi (v. [1]) putem obţine acum, o repartiţie cu numai 2 cazuri (în [1] aveam 11 cazuri) în care diferenţa orelor zilnice ale profesorului este mai mare ca 3:

> PM <- distrib(clPM, 3L, 2L)   
> hPM <- hoursPM()
> hPM$omg <- apply(hPM[, 2:6], 1, function(x) max(x)-min(x))
> hPM[hPM$omg >= 3, ]  # redăm şi cazurile în care diferenţa este 3
   prof lu ma mi jo vi Sum omg
28  P22  2  4  5  4  4  19   3
36  P21  6  1  2  1  6  16   5
14  P20  5  2  2  3  3  15   3
24  P08  5  3  2  2  2  14   3
26  P17  1  3  3  4  2  13   3
31  P50  4  1  2  4  1  12   3
15  P15  3  3  0  1  3  10   3
46  P28  1  4  4  0  0   9   4
4   P32  1  0  2  3  1   7   3
21  P27  2  3  2  0  0   7   3
29  P31  0  1  3  1  1   6   3

Iar dacă repetăm secvenţa de mai sus, obţinem de fiecare dată o altă distribuţie a orelor respective, cu aceeaşi proprietate (cel mult două cazuri cu diferenţă mai mare ca 3). Funcţia retake() s-a reapelat de fiecare dată de cel mult câteva zeci de ori, încât timpul de obţinere a acestei repartiţii este rezonabil (sub 20 secunde).

Este interesant de observat că pentru clasele din primul schimb (v. [1]), putem obţine repartiţii cu 0 (zero) cazuri de diferenţă mai mare ca 3 – folosind de această dată distrib(clAM, 3L, 0L) – iar aceasta, cu timpi mult mai scurţi (retake() fiind re-apelată de mult mai puţine ori); ce poate însemna această constatare, altceva decât că (pe tabelul TIP pe care am experimentat) încadrarea pe schimbul "AM" este mai bună – permiţând o repartizare mai omogenă, a orelor respective – decât cea pentru schimbul "PM"?. Din acest motiv, repartizarea pe zile a orelor trebuie făcută pe fiecare schimb în parte şi nu deodată pe toate clasele existente…
Prin urmare, obţinerea unei distribuţii uniforme depinde sensibil de încadrarea iniţială; altfel spus, TIP este bună în măsura în care permite repartizarea cât mai uniformă pe zile, a orelor profesorilor.

O variantă a algoritmului de repartizare

Alocând zilele de lucru pe clase (şi profesori), am obţinut repartiţii omogene în privinţa numărului de ore pe zi ale claselor, dar neomogene în privinţa numărului de ore pe zi ale profesorilor. Este uşor de inversat rolurile, alocând zilele pe profesori (şi clase); vom obţine repartiţii omogene pentru profesori, dar neomogene pentru clase.

Funcţia următoare primeşte un vector de clase, extrage datele acestora din TIP, le ordonează după $prof şi $clasa şi apoi adaugă coloana $zl (ca factor ordonat) prin care se alocă zilele pe orele respective:

# alocă Zile după Prof şi Clasa (NU după Clasa şi Prof)
byProfCl <- function(vCl) {  # preia un vector de clase
    TIP %>% filter(clasa %in% vCl) %>%
            arrange(., prof, clasa) %>%
            mutate(zl = gl(n=5, k=1, length = nrow(.), 
                           ordered=TRUE, labels = zile))
}

Constatăm că repartizarea zilnică a orelor pe clase este neomogenă; de exemplu, pentru vectorul care conţine clasele a 9-a rezultă:

> byProfCl(clPM[1:7]) -> byPC9
> table(byPC9[c('zl', 'clasa')])
    clasa
zl   9A 9B 9C 9D 9E 9F 9G
  lu  6  7  9  5  6  2  7
  ma  7  8  6  5  4  7  5
  mi  6  6  4  6  7  8  5
  jo  7  3  4  6  7  9  5
  vi  5  5  5  8  6  4  8

În acest caz, cea mai neomogenă repartiţie ar fi aceea de la clasa 9F, având 3 zile cu mai mult de 6 ore (şi o zi cu numai 2 ore).

Următoarea funcţie – care de fapt, rescrie hoursPM() din [1] – ne va permite să vedem şi distribuţia orelor pe profesori:

byPChours <- function(byPC) {
    addmargins(table(byPC[c('prof', 'zl')]), 2)  %>% 
    as.data.frame(.)  %>%  
    spread(., zl, Freq)  %>%  
    .[order(-.$Sum), ]
}

Constatăm că orele fiecărui profesor au o distribuţie omogenă: în fiecare zi sunt sau Sum/5, sau Sum/5 + 1 ore. De exemplu, pentru cazul de mai sus, byPC9:

> head(byPChours(byPC9))
   prof lu ma mi jo vi Sum
19  P22  2  2  2  3  2  11
10  P11  2  2  2  2  2  10
17  P20  1  2  2  2  2   9
24  P28  1  2  2  2  2   9
3   P03  2  2  2  1  1   8
6   P06  1  1  2  2  2   8

Următorul mic raţionament justifică faptul că orele fiecărui profesor sunt distribuite omogen: în byProfCl(), prin arrange(), liniile au fost ordonate alfabetic după numele profesorilor şi numele claselor; astfel, liniile corespunzătoare lui "P22" urmează după toate cele asociate lui "P21" şi corespund celor Sum=11 ore din încadrarea la clasele a 9-a a profesorului "P22", în ordinea alfabetică a acestor clase. Prin coloana $zl, aceste linii au fost etichetate cu valori din secvenţa repetată (1:5), rezultând distribuţia zilnică de ore (2 2 2 3 2); fiindcă 3 apare în ziua "jo" (a 4-a), rezultă că secvenţa celor 11 etichete este "4 5 1 2 3 4 5 1 2 3 4" – cu 3 apariţii pentru "jo" şi cu câte două pentru celelalte zile. Putem deduce şi că ultima linie dintre cele pentru "P21" are eticheta de alocare "mi" (iar dacă ar fi fost nu "mi", ci "vi" – atunci pentru "P22" rezulta distribuţia (3 2 2 2 2)).

Să observăm că în byProfCl() n-am luat nicio măsură care să sprijine cumva, o repartizare mai uniformă în privinţa numărului zilnic de ore ale claselor; ordinea de alocare pe linii a zilelor a fost cea alfabetică, fără nicio legătură cu numărul de ore. Dar lucrurile nu se schimbă suficient nici dacă am transforma din start TIP$prof în factor ordonat după numărul total de ore pe profesor (încât apoi, arrange() ar ordona după aceste numere şi nu alfabetic); trebuie căutată altă idee, sau de văzut dacă n-ar fi prea complicat de retuşat interactiv (uniformizând pe clase numărul zilnic de ore, dar păstrând pe cât se poate, omogenitatea distribuţiei zilnice pe profesori).