momente şi schiţe de informatică şi matematică
anti point—and—click

Distribuţia pe zile a orelor dintr-o şcoală cu un singur schimb

R | orar şcolar
2021 feb

Am descărcat un fişier PDF conţinând orarul produs prin "ascTimetables" pentru o şcoală care funcţionează (spre deosebire de cazul din seria [1]) într-un singur schimb şi am apelat la iLovePDF pentru a obţine orarul respectiv ca fişier Excel, orarP.xlsx; ne interesează nu orarul propriu-zis, ci încadrarea profesorilor pe clase şi folosim R pentru a distribui cât mai omogen pe zilele de lucru, orele respective.

De la tabele vizuale, la structuri de date

Antetul original (pe foile Excel principale) are această formă (redăm primele coloane):

Este vorba ca de obicei de un antet informativ (pe primele două rânduri), aparent suficient pentru a înţelege datele propriu-zise, redate în tabel; prima coloană de date (identificată în Excel prin "A") nu este anunţată, dar imediat ce vedem valorile ei (înscrise începând cu a treia linie a tabelului) înţelegem că acestea reprezintă numele profesorilor; în celulele din celelalte coloane de date apare sau spaţiu (celulă „vidă”), sau numele unei clase, sau (cu un anumit separator între ele) numele a două–trei clase, iar „antetul” tabelului specifică pentru fiecare dintre aceste coloane, o zi (întinsă pe câte un grup de coloane), o oră şi câte un interval orar pentru fiecare oră. Disciplinele asociate profesorilor nu sunt menţionate.

Următorul program produce o listă de obiecte R tibble, câte unul pentru fiecare foaie Excel din fişierul iniţial orarP.xlsx:

library(tidyverse)
library(readxl)  # asigură importarea în R a fişierelor Excel

xlsx <- "orarP.xlsx" 
lstDF <- xlsx  %>%
         excel_sheets()  %>%
         set_names()  %>%
         map(read_excel, path = xlsx)  # a vedea eventual, [1]

> str(lstDF)  # inspectează (în consola R) structura de date rezultată
    List of 5
     $ Table 1: tibble [0 × 2] (S3: tbl_df/tbl/data.frame)
      ..$ (### Numele şi adresa şcolii ###): logi(0) 
      ..$ Orarul general profesori         : logi(0) 
     $ Table 2: tibble [39 × 36] (S3: tbl_df/tbl/data.frame)
      ..$ ...1    : chr [1:39] NA "### Prof1 ###" "### Prof2 ###" ...
      ..$ Luni    : chr [1:39] "1\r\n8:15\r\n9:05" "10B" "6D" NA ...
      ..$ ...3    : chr [1:39] "2\r\n9:15\r\n10:05" NA NA NA ...
        ### etc. ###
      ..$ ...8    : chr [1:39] "7\r\n14:15\r\n15:05" NA NA NA ...
      ..$ Marţi   : chr [1:39] "1\r\n8:15\r\n9:05" "9B" "10A" NA ...
      ..$ ...10   : chr [1:39] "2\r\n9:15\r\n10:05" "9E" "10A" NA ...
        ### etc. ###
      ..$ Vineri  : chr [1:39] "1\r\n8:15\r\n9:05" "9B" "11A" NA ...
      ..$ ...31   : chr [1:39] "2\r\n9:15\r\n10:05" "9B" "5C" NA ...
        ### etc. ###
      ..$ ...36   : chr [1:39] "7\r\n14:15\r\n15:05" NA NA NA ...
     $ Table 3: tibble [0 × 1] (S3: tbl_df/tbl/data.frame)
      ..$ (### Numele şi adresa şcolii ###): logi(0) 
     $ Table 4: tibble [36 × 36] (S3: tbl_df/tbl/data.frame)
      ..$ ...1    : chr [1:36] NA "### Prof39 ###" "### Prof40 ###" ...
      ..$ Luni    : chr [1:36] "1\r\n8:15\r\n9:05" NA "7B" NA ...
      ..$ ...3    : chr [1:36] "2\r\n9:15\r\n10:05" NA NA NA ...
        ### etc. ###
      ..$ ...36   : chr [1:36] "7\r\n14:15\r\n15:05" NA NA "8D" ...
     $ Table 5: tibble [0 × 3] (S3: tbl_df/tbl/data.frame)
      ..$ 10E: logi(0)  ### etc. ###

Datele propriu-zise (dar incluzând şi „antetul” prezentat mai sus) sunt conţinute în "Table 2" şi "Table 4"; celulele vide din tabelul Excel sunt reprezentate prin valori NA ("Not Assigned" / "Not Available", sau „valoare lipsă”). Reunim (prin rbind()) liniile acestor două tabele şi pentru a scăpa de rândul pe care sunt specificate intervalele orare (rândul al doilea din fiecare „antet”) – „eliminăm” liniile care au NA în prima coloană:

orar <- rbind(lstDF[[2]], lstDF[[4]]) %>%
        filter(!is.na(`...1`))  # 72 linii de date x 36 coloane

Obiectul orar rezultat astfel (de tip "tibble", introdus prin „dialectul” tidyverse ca extensie a clasei standard "data.frame") are 72 de linii – dar ar fi trebuit să fie 73 (fiindcă tabelele reunite conţineau 39 şi 36 de linii şi intenţia a fost de a elimina cele două linii cu intervalele orare); deci mai exista o linie cu NA în coloana `...1` şi a fost eliminată şi aceasta: pe linia respectivă erau notate 3 clase, iar faptul că în loc de numele profesorului apărea NA, însemna cumva că aceste clase trebuie partajate în ziua şi ora indicate pe coloanele de care ţin, de către doi profesori (revenim mai jos asupra „partajelor”).

„Tabelul” orar are şi el, un „antet” – dar cu scop operaţional, nu informativ:

> names(orar)
 [1] "...1"     "Luni"     "...3"     "...4"     "...5"     "...6"    
 [7] "...7"     "...8"     "Marţi"    "...10"    "...11"    "...12"   
[13] "...13"    "...14"    "...15"    "Miercuri" "...17"    "...18"   
[19] "...19"    "...20"    "...21"    "...22"    "Joi"      "...24"   
[25] "...25"    "...26"    "...27"    "...28"    "...29"    "Vineri"  
[31] "...31"    "...32"    "...33"    "...34"    "...35"    "...36"   

Astfel, orar["...1"] sau orar$"...1" va produce lista numelor profesorilor; pentru un exemplu mai interesant de folosire a numelor coloanelor, să producem orarul pe ziua de luni (aici evităm coloana numelor profesorilor şi redăm doar unele linii):

> orar[c("Luni", paste0("...", 3:8))] %>% print(n=Inf)
# A tibble: 72 x 7
   Luni          ...3  ...4  ...5         ...6             ...7          ...8 
 1 "10B"         NA    7B    "5B"          NA               NA           NA   
 2 "6D"          NA    10A    NA           NA               NA           NA   
### etc. ###
12  NA           NA    NA    "6B"         "6A"             "11A\r\n11B"  NA   
13 "12D/\r\n12E" 5D    NA    "8B"         "11C/11D\r\n11E" "5E"          7D   
14  NA           NA    NA     NA           NA              "7D"          8B   
### etc. ###
71 "5E"          5A    5B     NA          "8F"             "6B"          7B   
72 "5C"          8E    6D     NA           NA               NA           NA   

Să schimbăm „antetul”, în aşa fel încât să fie uşor mai târziu să „normalizăm” tabelul:

Zile <- c('Lu','Ma','Mi','Jo','Vi')
antet <- lapply(Zile, function(z) paste0(z, 1:7))
names(orar) <- c("prof", unlist(antet))
saveRDS(orar, file = "orarP.rds")

Acum orar$prof selectează numele profesorilor; orar$Lu1, orar$Lu2, ..., orar$Lu7 selectează clasele (sau valorile NA) repartizate profesorilor, respectiv pentru orele 1..7 din ziua de luni (analog, pentru celelalte zile).

Deocamdată nu luăm seama la valorile care indică mai multe clase într-o aceeaşi oră – dar să observăm că uneori se foloseşte '/' (plus adesea, caractere de control "\r\n" – cum se vede mai sus pe linia 13, coloana 1) pentru a separa clasele, alteori nu (linia 12, coloana 7 – unde avem numai caractere de control a imprimării, drept separator).

Fişierul "orarP.rds" rezultat în final conţine imaginea de memorie (în format binar) a obiectului tibble orar (reprezentând în R, datele din fişierul Excel iniţial).

Normalizarea tabelului; evidenţierea partajelor

În tabelul Excel de la care am plecat avem pe fiecare rând, celule vide – în scopul alinierii vizuale pe coloane, a datelor propriu-zise; dar pentru orice prelucrare (nu doar afişare) interesează datele care sunt, nu cele care lipsesc. Să vedem câte valori NA (corespunzătoare celulelor vide din Excel) avem în „tabelul” orar obţinut mai sus:

> sum(is.na(orar[, ]))
[1] 1318  # celule vide

orar are în total 72×36=2592 „celule”, deci datele propriu-zise sunt în număr de 2592-1318=1274, iar dintre acestea, 72 reprezintă numele profesorilor; deducem că în şcoala respectivă se desfăşoară săptămânal un număr de 1274-72=1202 ore.

Prin următorul program transformăm orar într-un obiect "tibble" cu 1202 linii (câte una pentru cele 1202 ore existente) şi 4 coloane, reprezentând pe fiecare linie profesorul, ziua, ora din zi şi clasa repartizată profesorului pentru acea zi şi oră:

library(tidyverse)
orar <- readRDS("orarP.rds")
orar_norm <- orar %>%  # a vedea eventual, [1]
             gather("ziOra", "cls", 2:36) %>%
             separate(ziOra, c("zi", "ora"), sep=2) %>%
             filter(!is.na(cls)) %>%  # ignoră celulele vide
             mutate(ora = as.integer(ora))

Vom elimina mai târziu, coloana $ora (fiindcă aici nu ne interesează orarul, ci doar încadrarea profesorilor pe clase) şi vom reseta valorile din coloana $zi; dar deocamdată, aceste două coloane ne arată cam cum stau lucrurile în privinţa orelor partajate între profesori pe „jumătăţi” de clasă:

sharing <- orar_norm %>% 
           filter(grepl('[^[:alnum:]]', cls))
sharing$prof <- factor(sharing$prof)  # a vedea eventual, [1]
levels(sharing$prof) = paste0("P_", 1:length(unique(sharing$prof)))

Expresia regulată [^[:alnum:]] selectează caractere din afara celor „alfanumerice”, vizând astfel separatorii folosiţi între numele claselor ('/' sau/şi "\r\n"). Am anonimizat cumva numele profesorilor implicaţi şi se vede că avem 8 profesori care partajează într-o aceeaşi oră, unii câte două clase, alţii câte trei sau chiar patru clase:

> sharing %>% print(n=Inf)  # inspectează din consola R
# A tibble: 41 x 4
   prof  zi  ora  cls                        prof  zi  ora  cls
 1 P_5   Lu    1  "12D/\r\n12E"           21 P_5   Mi    4  "11C/11D/\r\n11E"
 2 P_3   Lu    1  "12D/\r\n12E"           22 P_3   Mi    4  "11D/\r\n11E"
 3 P_6   Lu    4  "10C\r\n10B"            23 P_4   Mi    5  "12E\r\n10D"
 4 P_5   Lu    5  "11C/11D\r\n11E"        24 P_8   Mi    6  "10C/\r\n10D"
 5 P_3   Lu    5  "11D/\r\n11E"           25 P_2   Mi    6  "10A/\r\n10C"
 6 P_2   Lu    6  "11A\r\n11B"            26 P_5   Mi    6  "10D/\r\n10E"
 7 P_3   Lu    6  "11A/\r\n11B"           27 P_3   Mi    6  "10C/10D/\r\n10E/10A"
 8 P_7   Lu    6  "9C\r\n9D"              28 P_8   Jo    2  "12A/\r\n12C" 
 9 P_6   Lu    6  "9D\r\n9C"              29 P_1   Jo    2  "12A/\r\n12C" 
10 P_8   Ma    1  "9D/9E"                 30 P_5   Jo    3  "12D/\r\n12E"
11 P_2   Ma    1  "9A/9C"                 31 P_3   Jo    3  "12D/\r\n12E"
12 P_1   Ma    1  "9A/9C"                 32 P_2   Jo    4  "11A/\r\n11B"
13 P_3   Ma    1  "9D/9E"                 33 P_3   Jo    4  "11A/\r\n11B" 
14 P_8   Ma    2  "12A/\r\n12C"           34 P_2   Jo    5  "9A/9C"
15 P_1   Ma    2  "12A/\r\n12C"           35 P_1   Jo    5  "9A/9C" 
16 P_8   Ma    3  "10C/\r\n10D"           36 P_8   Jo    6  "9D/9E"
17 P_2   Ma    3  "10A/\r\n10C"           37 P_3   Jo    6  "9D/9E"
18 P_5   Ma    3  "10D/\r\n10E"           38 P_5   Vi    5  "12D/\r\n12E"
19 P_3   Ma    3  "10C/10D/\r\n10E/10A"   39 P_3   Vi    5  "12D/\r\n12E"
20 P_6   Mi    1  "10A\r\n10E"            40 P_5   Vi    6  "11C/11D/\r\n11E"
                                          41 P_3   Vi    6  "11D/\r\n11E"

Primele două linii de exemplu, spun că în ziua Lu, ora 1, o parte dintre elevii claselor 12D şi 12E are oră cu profesorul P_5, iar cealaltă parte cu profesorul P_3; analog, clasele 9D şi 9E sunt partajate Ma ora 1 de profesorii P_8 şi P_3 şi în acelaşi timp, clasele 9A şi 9C sunt partajate între profesorii P_2 şi P_1. Să observăm şi că avem o singură linie (linia 3) cu zi=Lu şi ora=4 şi în tot tabelul, avem o singură apariţie "10B" – aşa că nu putem stabili profesorul cu care P_6 partajează clasele 10C şi 10B

Avem o sinteză poate mai utilă, înlocuind separatorii existenţi cu "/" şi considerând (prin table()) contingenţa valorilor de 'prof' şi 'cls' (transpunând apoi rezultatul, prin t()):

shrg <- sharing %>% mutate(cls = gsub("[^[:alnum:]]{1,}", "/", cls, perl=TRUE))       
> t(table(shrg[c('prof', 'cls')]))  
                 prof
cls               P_1 P_2 P_3 P_4 P_5 P_6 P_7 P_8
  10A/10C           0   2   0   0   0   0   0   0
  10A/10E           0   0   0   0   0   1   0   0
  10C/10B           0   0   0   0   0   1   0   0
  10C/10D           0   0   0   0   0   0   0   2
  10C/10D/10E/10A   0   0   2   0   0   0   0   0
  10D/10E           0   0   0   0   2   0   0   0
  11A/11B           0   2   2   0   0   0   0   0
  11C/11D/11E       0   0   0   0   3   0   0   0
  11D/11E           0   0   3   0   0   0   0   0
  12A/12C           2   0   0   0   0   0   0   2
  12D/12E           0   0   3   0   3   0   0   0
  12E/10D           0   0   0   1   0   0   0   0
  9A/9C             2   2   0   0   0   0   0   0
  9C/9D             0   0   0   0   0   0   1   0
  9D/9C             0   0   0   0   0   1   0   0
  9D/9E             0   0   2   0   0   0   0   2

Însă metoda de generare a distribuţiei orelor pe zile pe care am introdus-o în [1] (şi intenţionăm acum să o reluăm) nu suportă „jumătăţile” de clasă şi de oră – încât vom ignora, sau vom transforma cumva, partajele evidenţiate mai sus.

Încadrarea de lucru

Se poate constata probabil (şi din cele de mai sus), că suntem mereu atenţi la aspectele reale (faţă de care avem adesea, critici argumentate); dar nu ne interesează neapărat, realitatea… Pentru experimentul de repartizare (omogenă) a orelor pe zile pe care ni l-am propus, avem nevoie de o încadrare a unor profesori pe clase; puteam foarte bine să producem una fictivă oarecare (plecând de la nişte „planuri-cadru” sau „curriculum”, existente la //edu.ro, sau fictive) – dar deocamdată am preferat să angajăm (cu unele adaptări) încadrări reale, deduse din diverse orare postate pe Internet.

Vom elimina cele 41 de ore partajate, evidenţiate în ultimul tabel redat mai sus – alocându-le însă, unor noi profesori (fictivi) – de exemplu, astfel:

outside <- tibble(
    prof = c(rep("Q1", 10), rep("Q2", 10), rep("Q3", 10), rep("Q4", 11)),
    cls = c("9C", "9C", "9D", "9D", "10A", "10B", "10C", "10D", "10E", "12E",
            "12A", "12A", "12C", "12C", "11A", "11A", "11B", "11B", "9A", "9A",   
            "11D","11D","11D", "11E","11E","11E", "9C", "9C", "9D", "9D",
            "9E", "9E", "12D","12D","12D", "12E","12E","12E", "11C","11C","11C")
)

Consultând documentul PDF care prezenta „orarul pe clase” (unde se precizează şi disciplinele), am încadrat profesorul "Q1" pe 10 ore de "Muz/Des" (cu câte 2 ore – una "Muz" şi una "Des" – la clasele 9C şi 9D şi câte una la următoarele 6 clase din lista de mai sus), iar profesorii "Q2", "Q3" şi "Q4" pe ore de limbi străine (câte două, sau câte trei pe clasă) – rezultând în total, cele 41 de ore „partajate” anterior.

Acum „eliminăm” din orar_norm coloanele $zi şi $ora şi înlocuim cele 41 de ore partajate, prin cele definite mai sus:

fram <- orar_norm  %>%
        select('prof', 'cls')  %>%  # „elimină” coloanele 'zi', 'ora'
        filter(!grepl('[^[:alnum:]]', cls))  %>%  # ignoră orele partajate
        rbind(., outside)  # adaugă cele 41 de ore „fictive”

În final, redefinim coloana $prof ca factor ordonat, având ca nivele nişte nume convenţionale "P1", ..., "P76", a căror ordine coincide cu ordinea descrescătoare a numărului de ore pe săptămână pentru profesorii respectivi, ordonăm cele 1202 linii după $prof (şi $cls) şi salvăm obiectul tibble rezultat în fişierul "frame.rds":

srt <- sort(table(fram$prof), decreasing=TRUE)
fram$prof <- factor(fram$prof, levels=names(srt), ordered=TRUE)
numePr <- c(paste0("P0", (1:9)), paste0("P", (10:76)))  # 76 profesori
levels(fram$prof) <- numePr  # descrescător după numărul de ore pe săptămână
fram  %>%  arrange(prof, cls)  %>%
      saveRDS(., "frame.rds")  # 1202x2  <ord>prof  <chr>cls 

Subliniem că am ordonat liniile nu numai după profesori, dar – spre deosebire de [1] – şi după clase; aceasta ne permite să evidenţiem imediat, ideea de bază a distribuirii pe zile a orelor (împreună cu avantajele şi defectele acesteia).

Un algoritm „evident” de repartizare pe zile a orelor

Fiecărui profesor îi corespund în frame.rds, atâtea linii consecutive câte ore pe săptămână are acesta; clasele sale apar pe aceste linii în ordine alfabetică, deci pentru fiecare dintre aceste clase avem atâtea linii consecutive câte ore pe săptămână are acel profesor la clasa respectivă.

Pentru a ilustra algoritmul cel mai simplu de repartizare a orelor pe zilele de lucru, să considerăm liniile corespunzătoare primilor doi profesori:

library(tidyverse)
fram <- readRDS("frame.rds")
p12 <- fram %>% filter(prof %in% c("P01", "P02"))
print(table(p12['prof'])[1:2])
    #P01 P02 
    # 26  24  ## ore pe săptămână (în total, 50 de linii)

Pe cele 50 de linii rezultate în p12 înscriem repetat, de sus în jos, secvenţa zilelor de lucru – obţinând o distribuţie pe zile a celor 50 de ore:

Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi")
p12 <- cbind(p12, zl = c(rep(Zile, 10)))  # etichetează orele, cu zile
       prof cls   zl    prof cls   zl
#    1  P01 10A   Lu     P01  8D   Lu 26
#    2  P01 10A   Ma     P02 11B   Ma 27
#    3  P01 10B   Mi     P02 11C   Mi 28
#    4  P01 10B   Jo     P02 11D   Jo 29
#    5  P01 10C   Vi     P02 12E   Vi 30
#    6  P01 10C   Lu     P02 12E   Lu 31
#    7  P01 10D   Ma     P02  6C   Ma 32
#    8  P01 10D   Mi     P02  6C   Mi 33
#    9  P01 10E   Jo     P02  6D   Jo 34
#    10 P01 11A   Vi     P02  6D   Vi 35
#    11 P01 11E   Lu     P02  6E   Lu 36
#    12 P01 11E   Ma     P02  6E   Ma 37
#    13 P01 12A   Mi     P02  7A   Mi 38
#    14 P01 12B   Jo     P02  7A   Jo 39
#    15 P01 12C   Vi     P02  7C   Vi 40
#    16 P01 12D   Lu     P02  7C   Lu 41
#    17 P01  6A   Ma     P02  7D   Ma 42
#    18 P01  6A   Mi     P02  7D   Mi 43
#    19 P01  8A   Jo     P02  7E   Jo 44
#    20 P01  8A   Vi     P02  7E   Vi 45
#    21 P01  8B   Lu     P02  9A   Lu 46
#    22 P01  8B   Ma     P02  9B   Ma 47
#    23 P01  8C   Mi     P02  9C   Mi 48
#    24 P01  8C   Jo     P02  9D   Jo 49
#    25 P01  8D   Vi     P02  9E   Vi 50

Din faptul că liniile profesorului sunt consecutive, rezultă că (prin etichetarea făcută) orele sale sunt distribuite uniform (cu diferenţă de cel mult o oră, între o zi şi alta):

print(table(p12[c('prof','zl')])[1:2, ])
    #     zl
    #prof  Jo Lu Ma Mi Vi
    #  P01  5  6  5  5  5  ## ore pe fiecare zi
    #  P02  5  4  5  5  5

Din faptul că între liniile profesorului, cele corespunzătoare unei aceleiaşi clase sunt consecutive – rezultă că orele profesorului la o aceeaşi clasă (dacă nu-s mai multe decât 5) se vor desfăşura în zile diferite.

Bineînţeles că, fiind aşa de simplu, mecanismul exemplificat mai sus are un defect: clasele nu vor avea, în general, o distribuţie uniformă pe zile a orelor respective; continuând etichetarea cu 'Zile' pe liniile profesorilor P03, P04 etc. – vom avea la un moment dat situaţia în care o clasă cumulează 10 ore într-o zi şi doar 3 ore de exemplu, într-o altă zi.

Invers, dacă am eticheta cu 'Zile' nu după profesori şi clase ca mai sus – ci după clase şi profesori (ordonând liniile iniţiale după $cls şi apoi, după $prof), atunci clasele vor avea o distribuţie uniformă pe zile a orelor, dar în general, profesorii vor căpăta distribuţii ne-uniforme în privinţa numărului de ore pe zi (se păstrează totuşi, un avantaj: profesorul nu va face într-o aceeaşi zi, la o aceeaşi clasă, mai multe ore decât s-ar cuveni).

Program experimental de distribuire pe zile a orelor

Programul redat mai jos (formulat în R) are un caracter „experimental”: poate să producă rezultatul dorit, dar nu neapărat la prima lansare, iar timpul de execuţie nu poate fi estimat – poate fi 1-2 minute sau la o nouă lansare, 15-30 minute, sau poate fi ceva mai mult de o oră; dacă timpul de execuţie este scurt, aproape sigur se obţine o distribuţie a orelor – altfel, se poate şi ca lansarea curentă să nu producă rezultatul aşteptat; în plus, distribuţiile obţinute printr-un număr rezonabil de lansări succesive ale programului, diferă una de alta.

Lucrurile se petrec aşa pentru că orele de distribuit sunt „etichetate” cu Zile în ordinea claselor şi a profesorilor, dar dacă alocarea rezultată nu satisface anumite condiţii de echilibru, atunci se permută aleatoriu profesorii clasei curente (eventual şi clasele, mai târziu) şi se reia alocarea, în noua ordine – repetând până când sau se nimereşte o ordine de parcurgere care conduce la o alocare „echilibrată”, sau reapelarea devine imposibilă, depăşindu-se capacitatea stivei de apeluri.

Ne bazăm deci pe acest postulat: dacă echilibrarea vizată este una rezonabilă, atunci există o ordine de parcurgere a orelor pentru care etichetarea prin Zile conduce la o distribuţie „echilibrată” a orelor respective; impunând condiţii rezonabile (nu foarte restrictive), vor exista suficient de multe asemenea ordini de parcurgere a orelor – încât sunt mari şanse de a nimeri una, într-o serie suficient de lungă de încercări.

S-ar putea impune diverse condiţii (v. [1]); noi pretindem ca distribuţiile individuale să fie cvasi-omogene: la profesorii care au cel puţin 15 ore pe săptămână, numărul de ore pe zi să nu varieze cu mai mult de (să zicem) două ore, de la o zi la alta (cei care au puţine ore vor prefera să le facă în cât mai puţine zile).

Bineînţeles că redăm programul fără jenă, cu lux de comentarii; părţile principale sunt separate prin câte un rând alb.
Pentru a regiza reluările cum am evidenţiat mai sus (evitând pe cât se poate stoparea execuţiei, cauzată de limitarea existentă pentru stiva de apeluri), am folosit „tryCatch() imbricat” – un mecanism uşor de formulat, dar realmente greu de înţeles şi de lămurit dacă îl angrenezi ca aici, într-un context recursiv (cam peste tot, tryCatch() este legat de producerea unor mesaje explicative la apariţia în cursul execuţiei a unor anumite excepţii); n-am dat de vreun exemplu de folosire în context recursiv – cel de faţă ar fi primul, încât probabil că sunt încă de făcut anumite verificări şi eventual, reformulări.

# distribute.R
rm(list = ls())  # elimină datele din sesiuni de lucru anterioare
library(tidyverse)

# încadrarea pe clase a profesorilor, în formă normală (format „lung”)
FRM <- readRDS("frame.rds")  # <prof> <cls> - pentru fiecare oră din săptămână
# $prof este "factor ordonat" (descrescător după numărul de ore pe săptămână)
nrPr <- length(levels(FRM$prof))  # 76 profesori; primii 55 au măcar 15 ore pe săptămână
Cls <- unique(FRM$cls)  # clasele şcolii (32 de clase, într-un singur schimb)
    # pentru a distribui numai orele anumitor clase: Cls <- c(<lista claselor>)
Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi")
FRM <- FRM %>%
       split(.$cls)  # listă de „tabele”, câte unul de clasă

# alocă orele pe zile, pentru fiecare clasă
alloc_by_class <- function() {
    # controlul numărului de ore pe zi cumulat la profesori 
    Zore <- matrix(data=rep(0L, 5*nrPr), nrow = 5, ncol = nrPr, byrow=TRUE)
                        
    # Condiţiile impuse unei distribuţii a orelor
    CND <- function(More) {
        mex <- Zore[, 1:55] + More[, 1:55]  # la profesorii cu măcar 15 ore/săpt.
        for(j in 1:ncol(mex)) {
            Pr <- mex[, j]  # câte ore ar avea, în fiecare zi, profesorul
            for(oz in Pr) 
                if(any(abs(Pr - oz) > 2)) 
                    return(FALSE)  # refuză alocarea, dacă nu este "pseudo-omogenă"
        }
        return(TRUE)  # acceptă alocarea: nr. ore/zi variază cu max. 2 (dacă suma >= 15)
    }  

    # montează coloana zilelor alocate orelor unei clase 
    labelsToClass <- function(Q) {  # 'Q' conţine liniile din FRM cu o aceeaşi 'cls'
        S <- Q %>% 
             mutate(zl = gl(n=5, k=1, length = nrow(.),  
                            ordered=TRUE, labels = Zile)) # %>%  as.data.frame(.) 
        # verifică dacă orele pe zi alocate profesorilor clasei respectă CND()
        more <- t(as.matrix(table(S[c('prof', 'zl')])))
        if(CND(more)) {
            Zore <<- Zore + more  # actualizează numărul de ore pe zi
            return(S)  # o distribuţie care îndeplineşte condiţiile
        }
        # dacă nu-s îndeplinite CND(), permută profesorii clasei şi reia
        Q <- Q %>% arrange(match(prof, sample(unique(prof))), prof)
        return(labelsToClass(Q))  # Reia dacă nu-s îndeplinite condiţiile
    }       # (programul va fi stopat dacă reapelarea nu mai este posibilă)

    tryCatch(  # previne stoparea programului (v. [1])
        { FRM %>%  # etichetează liniile fiecăreia dintre clase
              map_df(., function(K) labelsToClass(K))
        }, 
        error = function(err) {  # s-a depăşit capacitatea stivei de apeluri
                    FRM <- FRM %>% 
                           sample(.)  # permută grupurile de linii ale claselor
                    tryCatch({
                               # cat("1")  ## vizualizează cumva, reluările 
                               alloc_by_class()  # reia, în noua ordine a claselor
                             }, 
                             error = function(e) NULL  # încercările făcute au eşuat
                    )
                }
    )  # Returnează distribuţia pe zile a orelor claselor indicate (sau, doar NULL)
}
# Exemplu:
    # Dis <- alloc_by_class()
    # saveRDS(Dis, file = "Dis1.rds")

Pentru a pune la punct programul (ajungând la forma finală redată mai sus), am experimentat întâi pe un număr redus de clase (definind Cls <- c(<listă_clase>)), scurtând astfel timpul de execuţie.

Bineînţeles că am rulat programul (considerând întregul set de clase) de suficient de multe ori, în diverse zile şi momente de timp, obţinând fişiere "Dis*.rds" ca în exemplul din comentariul final de mai sus – cu timpi de execuţie ca 1-2 minute (în două-trei cazuri din vreo 30), 7-50 minute (de cel mai multe ori), sau peste o oră (când uneori au rezultat distribuţiile căutate, alteori doar NULL).

Lista distribuţiilor; alegerea unei distribuţii

În [1] obţinusem (cu un program asemănător celui de aici) şi fişiere "Dis*.rds" conţinând câte o listă cu 100 de distribuţii – dar în [1] condiţiile CND() erau mai „slabe” ca aici şi încadrarea considerată avea cu vreo 300 de ore mai puţin; acum ne-am limitat să generăm cel mult două distribuţii într-un acelaşi fişier (fiindcă în urma întăririi condiţiilor şi a creşterii dimensiunii încadrării, generarea unei distribuţii va dura mai mult timp).

Bineînţeles că ne-am încurcat, imitând un timp metoda de obţinere a distribuţiilor din [1] (unde funcţia generate_distributions() producea o listă de distribuţii), iar în alt moment rulând direct programul de mai sus (vezi exemplul final din "distribute.R"): unele dintre fişierele obţinute conţin câte o listă (obiect R de clasă "list") care conţine fie unul, fie două obiecte tibble (reprezentând distribuţiile găsite de program), iar alte fişiere conţin direct câte un obiect tibble (neambalat într-un "list").

Faptul că avem şi liste de distribuţii şi direct câte o distribuţie (şi faptul că fişierele care le conţin sunt denumite ne-unitar), explică anumite complicaţii din programul următor, prin care vom reuni în lDis.rds distribuţiile din toate aceste fişiere, constituind deasemenea (v. [1]) şi fişierul lZore.rds, care asociază fiecărei distribuţii matricea distribuţiilor individuale (numărul de ore alocate pe profesor în fiecare zi):

# dis_and_mat.R
library(tidyverse)

# 13 fişiere cu câte o listă conţinând o singură distribuţie (obiect 'tibble')
lstR1 <- c(paste0("Dis", c(1:9, 92:94), ".rds"), "Dist5.rds")
# 3 fişiere cu câte o listă conţinând câte două distribuţii (obiecte 'tibble')
lstR2 <- c(paste0("Dist", c(3,4,6), ".rds"))
# 14 fişiere conţinând nu liste, ci câte un obiect 'tibble'  
lstR3 <- c("Dis91.rds", paste0("Dist", c(1,2,7,8,9,91), ".rds"), 
           paste0("abc", 1:7, ".rds"))

lD1 <- map(lstR1, function(f) {readRDS(f)[[1]]})  # listă cu 13 obiecte 'tibble'
lD2 <- do.call(c, map(lstR2, readRDS))  # listă cu 6 obiecte 'tibble'
lD3 <- map(lstR3, readRDS)  # listă cu 14 obiecte 'tibble'

lDis <- c(lD1, lD2, lD3)  # lista finală a celor 33 obiecte 'tibble' (distribuţii)
saveRDS(lDis, file="lDis.rds")

lZore <- map(lDis, function(Q) as.matrix(table(Q[c("prof", "zl")])))
saveRDS(lZore, file="lZore.rds")  # 33 matrici "Zore" (listă „paralelă” cu 'lDis')

În [1] am exagerat (cam inutil), generând peste 1000 de distribuţii; acum avem un număr rezonabil de distribuţii, iar scopul este acela de a alege una dintre acestea, ca bază pentru formularea ulterioară a orarului şcolar propriu-zis (având o distribuţie pe zile a tuturor orelor, rămâne de distribuit pe intervale orare orele dintr-o aceeaşi zi).

Pentru profesorii cu măcar 15 ore pe săptămână (care şi formează majoritatea), nu prea avem de distins între distribuţiile obţinute (era suficientă una singură!) – dat fiind că pentru aceştia, CND() asigură deja distribuţii individuale cvasi-omogene. Totuşi încă ar fi de ţinut seama de „coeficienţii de omogenitate” introduşi în [1] – de exemplu pentru a distinge între o distribuţie individuală „bună” ca (6 6 6 4 4) şi cea „perfectă” (6 5 5 5 5), dar mai ales pentru a distinge la profesorii cu mai puţin de 15 ore pe săptămână, între o distribuţie individuală „rea” ca (5 0 0 1 0) şi una (tot rea, mai ales din punctul de vedere al profesorului, dar cu un coeficient de omogenitate mai bun) ca (3 1 0 1 1), sau una ca (3 3 0 0 0), probabil cea „perfectă” pentru profesor.

Prin următorul program vom alege o distribuţie care să aibă cât mai multe distribuţii individuale cvasi-omogene (de coeficient cel mult 0.5) şi totodată, să aibă între distribuţiile individuale, cât mai puţine cazuri de zile cu câte o singură oră (astfel, pe cât se poate, desconsiderăm şi cazuri ca (5 0 0 1 0) şi cazuri ca (3 1 0 1 1), sau (2 1 1 1 1)):

# grope.R (investighează distribuţiile rezultate)
library(tidyverse)

lDis <- readRDS("lDis.rds")  # lista distribuţiilor (33 'tibble')
lZore <- readRDS("lZore.rds")  # matricile orelor pe zile, pentru profesori

cf_omg <- function(ore_zi) {  # coeficient de omogenitate (v. [1])
    ore <- ore_zi[ore_zi != 0]
    round(sd(ore)/mean(ore)*diff(range(ore)), 2)
}

lCfo <- lapply(1:length(lZore), function(id) {
               S <- apply(lZore[[id]], 1, cf_omg)
               length(which(S > 0.5))
})
print(table(unlist(lCfo)))
# 15 17 18 19 21 22 23 24 26  ## câţi coeficienţi „răi” ( > 0.5)
#  1  1  1  2  5  5  6  9  3  ## în câte distribuţii din cele 33 

# câte cazuri de zile cu câte o singură oră există, în distribuţiile individuale?
lH1 <- lapply(1:length(lZore), function(id) {
            sum(lZore[[id]] == 1)
})
print(table(unlist(lH1)))
# 27 28 29 30 32 33 34 35 36 37 38 39 40 43  ## câte valori '1'
#  1  1  1  3  2  2  1  1  7  3  5  4  1  1  ## în câte distribuţii din cele 33

Din rezultatele anexate mai sus (sub semnul de comentariu, '#'), vedem că avem numărul minim 15 de coeficienţi „răi” într-o singură distribuţie şi avem numărul minim 27 de cazuri de zile cu câte o singură oră, deasemenea într-o singură distribuţie; investigând (prin which()) indecşii distribuţiilor, constatăm că avem ceva noroc – găsim una care satisface suficient, ambele criterii:

> which(lCfo %in% c(15, 17))
#[1]  1 10  ## which(lCfo == 15) dă 10, nu 1
> which(lH1 %in% c(27, 28))
#[1]  1 31  ## which(lH1 == 27) dă 1

Deducem de aici că distribuţia lDis[[1]] are 17 (cu numai 2 mai mult, ca minimul) distribuţii individuale de coeficient mai mare ca 0.5 şi are cel mai mic număr de zile cu câte o singură oră – prin urmare, aceasta ar fi distribuţia pe care o alegem.

Salvăm distribuţia aleasă lDis[[1]], într-un fişier ".rds"; urmează să vedem cum o putem îmbunătăţi (modificând convenabil unele distribuţii individuale).

vezi Cărţile mele (de programare)

docerpro | Prev | Next