Un orar iniţial

Considerăm orarul unei şcoli cu un singur schimb, dintr-un document PDF pe care l-am transformat (v. [1], [2]) în fişier .xlsx; extragem datele din acest fişier şi le „normalizăm” într-un obiect tibble – separăm variabilele (profesor, clasă, zi, ora), eliminăm valorile nule, corectăm unele nume de clasă (înlocuim "11 F" cu "11F" şi "5" cu "5G", de exemplu) şi anonimizăm numele profesorilor (în variabila 'prof' de tip factor):

# orar_orig.R
library(tidyverse)

sheets2lst_tb <- function(xlsx="") { 
    require(readxl) 
    xlsx  %>%
    excel_sheets()  %>%
    set_names()  %>%
    map(read_excel, path = xlsx)  # listă de 'tibble' asociate tablelor Excel
}

ltb <- sheets2lst_tb("General_profesori.xlsx")
lmk <- rbind(ltb[[2]], ltb[[4]]) %>% 
       filter(!is.na(`...1`))  # omite antetul dublu, "Luni... /r/n 1 2 ... 7..."
Zile <- c('Lu','Ma','Mi','Jo','Vi')
antet <- lapply(Zile, function(z) paste0(z, 1:7))  # "Lu1", "Lu2", etc.
names(lmk) <- c("prof", unlist(antet))
    # print(slice_sample(lmk, n=2))
    # A tibble: 2 x 36
    #  prof   Lu1   Lu2   Lu3   Lu4   Lu5   Lu6   Lu7   Ma1   Ma2   Ma3   Ma4   Ma5  
    #  <chr>  <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
    #1 BUL…   11D   12A   10E   NA    11A   6     NA    10A   5     9C    11C   9B   
    #2 NEA…   NA    NA    NA    NA    NA    9E    9E    10D   9A    11 F  12B   NA   
    # … with 23 more variables: Ma6 <chr>, Ma7 <chr>, Mi1 <chr>, Mi2 <chr>, etc.

lmk[-1] <- lapply(lmk[-1], gsub, 
                  pattern=" ", replacement="", fixed=TRUE)  # corectează "11 F"
lmk <- lmk %>%
       pivot_longer(., cols=2:36, names_to="ZiOra", values_to="cls") %>%
       separate(ZiOra, c("zi", "ora"), sep=2) %>%
       filter(!is.na(cls)) %>%  # (elimină valorile nule)
       mutate(ora = as.integer(ora),
              cls = ifelse(nchar(cls)==1, 
                           paste0(cls, "G"), cls))  # "5" devine "5G"
# transformă 'prof' în "factor", cu nivelele "Pnn"
srt <- sort(table(lmk$prof), decreasing=TRUE)
lmk$prof <- factor(lmk$prof, levels=names(srt), ordered=TRUE)
numePr <- c(paste0("P0", (1:9)), paste0("P", (10:nlevels(lmk$prof))))  # "Pnn"
levels(lmk$prof) <- numePr 
    #> slice_sample(lmk, n=2)
    ## A tibble: 2 x 4
    #  prof  zi      ora cls  
    #  <ord> <chr> <int> <chr>
    #1 P25   Jo        2 8G   
    #2 P36   Mi        5 11A  
    #> nrow(lmk)
    # [1] 884  (numărul de ore)
saveRDS(lmk, file="orar_norm.RDS")  # păstrează orarul normalizat

Numărul total de ore ar fi 884 (fiecare linie din lmk înregistrează datele câte unei ore); de fapt, putem constata că există linii pe care diferă numai valoarea din coloana 'prof' – deci numărul de ore care se desfăşoară într-o săptămână este mai mic de 884…

Tocmai de cuplaje, începem aici să ne ocupăm; la unele obiecte (de exemplu, limbi străine), doi profesori partajează într-o aceeaşi oră o aceeaşi clasă (despărţind-o în grupe de elevi); cum să ţinem seama de această situaţie, în programele noastre de repartizare pe zile şi respectiv, pe orele zilei, a lecţiilor (v. [1], [2])?

Evidenţierea cuplajelor

În [1] aveam chipurile noroc: cuplajele erau explicitate cumva chiar în orar, prin linii precum "P_5 Mi 4 11C/11D/\r\n11E" – însemnând că în ora a 4-a din ziua "Mi", profesorul "P_5" partajează clasele indicate, cu alţi profesori (la care deasemenea găsim câte o astfel de linie). De data aceasta, valorile din celulele tablei Excel de la care am plecat sunt „curate” (cum şi trebuie să fie) – nu apar clase multiple (separate prin "/" sau "\r\n"); dar cum evidenţiem atunci, cuplajele existente?

Profesorii cuplaţi au nume diferite în coloana 'prof', dar au câte o aceeaşi valoare în celelalte trei coloane; prin split(list(<coloane>)) separăm liniile în obiecte tibble care conţin fiecare, linii cu aceleaşi valori în coloanele indicate; cuplajele vor corespunde acelora dintre obiectele listei obţinute, care au cel puţin două linii:

cpl <- lmk %>% split(list(.$zi, .$ora, .$cls))
cpl <- map(seq_along(cpl), 
           function(i) if(nrow(cpl[[i]]) > 1) cpl[[i]]) %>% 
       compact()  # elimină din listă valorile 'NULL'

map() a parcurs după indici lista returnată de split() şi a returnat o listă de aceeaşi lungime, înscriind NULL pentru obiectele excluse (cele cu un singur rând); prin compact() am eliminat în final, elementele nule. Avem, de exemplu:

> cpl[[1]]
# A tibble: 2 x 4
  prof  zi      ora cls  
  <ord> <chr> <int> <chr>
1 P06   Mi        2 10A  
2 P33   Mi        2 10A  

cu această semnificaţie: "P06" şi "P33" intră într-o aceeaşi zi şi oră la clasa "10A", lucrând (subînţelegem că în săli diferite) cu câte o grupă de elevi ai acestei clase.

Transformăm lista 'cpl' într-un tibble care conţine pe fiecare linie un vector de profesori (convertind prin as.character(), întregii asociaţi acestora prin factor-ul 'prof'), clasa şi numărul de ore pe care aceştia sunt cuplaţi:

cpl <- map_df(seq_along(cpl), function(i) 
             tibble(cup=paste(c(as.character(cpl[[i]]$prof)), collapse="-"),
                    cls=cpl[[i]]$cls[1])) %>%
       count(cup, cls)
#> cpl
## A tibble: 20 x 3
#   cup     cls       n                 #   cup     cls    n
#   <chr>   <chr> <int>
# 1 P01-P02 10A	    3		    #11 P06-P33 10F    1
# 2 P01-P02 11A	    3		    #12 P06-P33 9A     1
# 3 P01-P02 11B	    3		    #13 P06-P33 9B     1
# 4 P01-P02 12A	    3		    #14 P06-P33 9C     1
# 5 P01-P02 9A	    3		    #15 P08-P11 12E    1
# 6 P06-P33 10A	    1		    #16 P08-P25 12E    2
# 7 P06-P33 10B	    1		    #17 P08-P47 12E    5
# 8 P06-P33 10C	    1		    #18 P11-P44 11E    6
# 9 P06-P33 10D	    1		    #19 P34-P07 10E    5
#10 P06-P33 10E	    1		    #20 P34-P09 9E     5

Deci, în cazul de aici, avem 20 de cuplaje (care angajează 12 profesori), de cel mai simplu tip: doi profesori partajează o singură clasă. "P01" şi "P02" sunt cuplaţi pe câte 3 ore la fiecare dintre clasele 10A, 11A, 11B, 12A şi 9A; "P06" şi "P33" cuplează câte o oră la clasele a 10-a şi la 9ABC; la clasa 12E, "P08" cuplează cu "P11" pe o oră, cu "P25" pe două ore şi cu "P47" pe 5 ore; "P11" cuplează şi cu "P44", pe 6 ore, la clasa 11E; în sfârşit, "P34" cuplează cu "P07" pe 5 ore la 10E şi cu "P09" tot pe 5 ore, la 9E.

Ca idee, „profesorul” fictiv "P01-P02" va prelua orele partajate de "P01" şi "P02"…

Mascarea cuplajelor, prin profesori fictivi

Din orarul iniţial nu ne interesează decât datele referitoare la încadrarea profesorilor: câte ore are fiecare şi la care clase; plecând de la încadrarea respectivă, vrem să generăm (prin programele din [1], [2]) o repartizare cât mai omogenă a orelor pe zilele săptămânii şi apoi, orarele propriu-zise, corespunzătoare fiecărei zile.

Cuplajele prevăzute iniţial în încadrare contrazic din start, condiţia esenţială asumată într-un program de generare a unui orar: doi profesori nu pot intra simultan, la o aceeaşi clasă. Am avea două soluţii de conciliere: una practică – eliminăm pur şi simplu cuplajele, generăm orarul „de bază” şi ulterior, adăugăm interactiv şi cuplajele; şi o soluţie de investigat mai departe – mascăm cumva cuplajele, asociind fictiv orele respective unor noi profesori (sau unor noi clase).

Dacă am avea cuplaje mai complicate – în care doi (sau mai mulţi) profesori partajează nu o singură clasă, ci două sau mai multe – atunci probabil că ar trebui să optăm pentru înfiinţarea de noi clase; noi vizăm totuşi cazul cel mai obişnuit de cuplaje, pentru care ni se pare cel mai potrivit să înfiinţăm profesori fictivi.

Ca idee, dacă Px şi Py sunt cuplaţi pe n ore la clasa Q, atunci depistăm liniile din setul lmk pe care în coloana $prof apare Px sau Py şi în coloana $cls apare Q, iar pe acele dintre aceste linii care au câte o aceeaşi valoare în câmpurile $zi şi $ora, înscriem ca „profesor” (fictiv) "Px-Py"; să observăm că astfel, vor fi afectate 2×n linii – deci mai trebuie să şi eliminăm n dintre acestea.

La implementarea acestei idei avem de ţinut seama de faptul că variabila lmk$prof este deja de tip factor ordonat (şi am avea de modificat nivelele deja stabilite ale acestuia); noi preferăm să folosim operaţii generale "_join()", care dacă este cazul, transformă în mod implicit tipurile de date (în loc de "factor" <ord> vom avea <chr>).

Pentru o linie indicată din cpl, următoarea funcţie produce un tabel tibble care conţine cele 2×n linii din lmk descrise mai sus (şi îi adăugăm o coloană de cuplare):

trace_cpl <- function(i) {
    pr <- unlist(strsplit(as.character(cpl[i, 1]), "-"))
    q <- cpl[i, 2]
    ls2 <- lmk %>% filter(cls %in% q & prof %in% pr) %>% 
           split(list(.$zi, .$ora))
    trc <- map_df(seq_along(ls2), function(j) 
                  if(nrow(ls2[[j]]) > 1) ls2[[j]])
    trc %>% mutate(cpl[i, 1])  # înscrie profesorul fictiv, pe o nouă coloană
}
print(trace_cpl(16))
## A tibble: 4 x 5
#  prof  zi      ora cls   cup    
#  <ord> <chr> <int> <chr> <chr>
#1 P08   Ma        2 12E   P08-P25
#2 P25   Ma        2 12E   P08-P25
#3 P08   Jo        3 12E   P08-P25
#4 P25   Jo        3 12E   P08-P25

Lui P08-P25 va trebui să-i punem 2 ore (nu 4) la clasa 12E.

Aplicăm trace_cpl() tuturor liniilor din cpl şi reunim prin map_df() tabelele rezultate, obţinând obiectul tibble del; prin anti_join(), eliminăm din lmk liniile aduse în del (ignorând câmpul final del$cup), apoi înlocuim valorile din del$prof cu acelea din del$cup şi eliminăm coloana del$cup; în final, prin full_join() adăugăm în lmk liniile din del şi prin distinct() eliminăm liniile duble (încât din fiecare 2×n linii care înregistrau orele cuplate în del, rămân n linii):

del <- map_df(1:nrow(cpl), trace_cpl)  # print(del)
lmk <- anti_join(lmk, del[-5])  # implicit, factorul $prof este degradat la <chr>
del$prof <- del$cup  # fixează profesorii fictivi pe orele cuplate
del$cup <- NULL
lmk <- full_join(lmk, del) %>% distinct()  # lmk %>% print(n=Inf)  ## 836 ore

Iniţial, lmk conţinea linii cu câte o aceeaşi valoare în câmpurile $zi, $ora şi $cls, corespunzătoare cuplajelor; acum, introducând profesori fictivi pe orele cuplate, acest defect a fost îndepărtat şi numărul de linii din lmk este exact numărul total de ore (836) din săptămână.

Eliminăm în sfârşit, câmpurile $zi şi $ora; apoi, convertim iarăşi $prof în factor ordonat (descrescător, după numărul de ore ale profesorilor, incluzând şi pe cei fictivi):

lmk <- lmk %>% select(prof, cls)
srt <- sort(table(lmk$prof), decreasing=TRUE)
lmk$prof <- factor(lmk$prof, levels=names(srt), ordered=TRUE)
lmk <- lmk %>% arrange(prof)
saveRDS(lmk, file="lmk.RDS") 

Ilustrăm lmk prin 5 linii alese aleatoriu:

> print(slice_sample(lmk, n=5))
# A tibble: 5 x 2
  prof    cls  
  <ord>   <chr>
1 P31     10A  
2 P12     10D  
3 P34-P07 10E  
4 P27     12D  
5 P32     7G  

Desigur – fie în mod interactiv, fie direct în programul de repartizare pe zile a orelor din "lmk.RDS" – va trebui să corelăm orele plasate unui profesor fictiv, cu acelea plasate în aceeaşi zi celor doi profesori pe care îi cuplează; analog ulterior, pentru programul de repartizare pe orele zilei, a orelor plasate într-o aceeaşi zi.

Repartizarea lecţiilor pe zilele săptămânii

Programul "distribute_by_days.R" (redat şi reluat anterior de mai multe ori), prin funcţia principală alloc_by_class(), asigură distribuirea lecţiilor prof|cls pe zilele de lucru, angajând o singură condiţie: distribuţiile individuale, pentru profesorii cu măcar 10 ore, să fie „cvasi-omogene” (pentru fiecare, numărul de ore pe zi nu diferă de la o zi la alta, cu mai mult de 2 ore); punând această singură condiţie, obţinem o distribuţie pe zile într-un timp foarte scurt (în general, 2-5 minute). Rămâne celui care face orarul şcolii, să regleze interactiv distribuţia obţinută, pentru a ţine seama de diversele condiţii concrete, specifice fiecărei şcoli (profesorul cutare vine numai în cutare zile; cutare trebuie să aibă liber în cutare zile; etc., etc.).

În cazul cuplajelor, am avea această condiţie: în oricare zi, numărul de ore alocate cuplului şi oricăruia dintre parteneri să nu depăşească 6 ore (sau 7 ore, la unele clase); considerăm că şi această condiţie trebuie lăsată în seama reglării interactive ulterioare – pentru a lăsa celui care face orarul libertatea de a decide în funcţie de condiţiile concrete existente, cum să plaseze orele cuplate (de exemplu, poate că orele de „laborator” trebuie comasate în câte o anumită zi, la fiecare clasă).

Pentru încadrarea din "lmk.RDS", după ce am obţinut prin alloc_by_class() o distribuţie (cvasi-omogenă) pe zile a lecţiilor respective, am folosit aplicaţia interactivă /Recast (v. şi github), obţinând (în cam 30-40 minute) o distribuţie omogenă acceptabilă:

Pentru această distribuţie am respectat o serie de principii general valabile.
Cele 836 de lecţii sunt repartizate uniform pe zile: (167 167 167 168 167); pentru profesorii cu măcar 10 ore, distribuţiile individuale sunt omogene (cu două excepţii, la P36 şi P39) – de exemplu, pentru 16 ore avem distribuţii ca (4 3 3 3 3).
Bineînţeles că pentru fiecare clasă, distribuţia orelor pe zile este uniformă (numărul de ore pe zi diferă cu cel mult 1, de la o zi la alta).

Exceptând P01 şi P02 (care sunt cuplaţi pe câte 3 ore la 5 clase) şi poate, alte cupluri ("P11-P44", care la clasa 11E are 6 ore) – toţi profesorii intră câte o singură dată pe zi, la fiecare dintre clasele respective; în măsura în care această cerinţă nu este încălcată, profesorii care au puţine ore au câte un anumit număr de zile libere (P50 are numai 5 ore, dar toate la aceeaşi clasă – deci nu are zi liberă; P55 are numai 3 ore, dar 2 ore sunt la o aceeaşi clasă – deci distribuim cele 3 ore în două zile, nu într-una singură; P56 are 3 ore, la clase diferite – încât le-am putut plasa într-o singură zi).

Desigur că în realitate, plecând nu de la „principii”, ci de la „în ce zile puteţi veni” – distribuţia redată mai sus este de neacceptat; probabil că P50 va zice aşa: „am numai 5 ore, deci trebuie să mi le puneţi în 2 zile, anume cutare şi cutare” (încât P50 ar trebui să facă la clasa 6G, 2 ore într-o cutare zi şi 3 ore într-o altă cutare zi).
Şi acceptând o excepţie de la „principii”, va trebui apoi să înghesuim orele profesorilor, încât aceştia să şi le facă în cât mai puţine zile – fără a mai lua în seamă şi interesele fireşti ale elevilor, privitoare la distribuţia echilibrată a obiectelor pe parcursul săptămânii.

Repartizarea lecţiilor dintr-o aceeaşi zi, pe orele zilei

Programul anterior daySchoolSchedule.R preia din repartiţia pe zile obţinută mai sus, lecţiile repartizate într-o aceeaşi zi şi produce orarul propriu-zis al acelei zile – dar angajează iarăşi, o singură condiţie, privitoare la numărul de ferestre; însă în acest caz, s-ar cuveni probabil, ca instrumentarea cuplajelor existente să fie făcută chiar în program (în loc de a o lăsa iarăşi, în seama unei intervenţii interactive ulterioare).

Cele două programe de repartizare vizate mai sus, angajând câte o singură condiţie (aceea care şi este esenţială: omogenitatea distribuţiilor individuale şi respectiv, limitarea numărului de ferestre), îşi produc rezultatele foarte rapid; noi susţinem în continuare, că diversele condiţii particulare (inclusiv, cele privitoare la cuplaje) trebuie lăsate în seama unor intervenţii interactive ulterioare.

Totuşi, merită sau nu – vom încerca mai departe să modificăm daySchoolSchedule.R, încât să ţinem seama şi de cuplajele existente pe ziua respectivă.