momente şi schiţe de informatică şi matematică
To attain knowledge, write. To attain wisdom, rewrite.

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

CSV | limbajul R | orar şcolar
2021 feb

În [1] am extras din distribuţia pe zile a tuturor orelor unei şcoli, subsetul df12 – obiect "data.frame" pe care ulterior, l-am salvat ca fişier CSV "df12.csv"; prin /recast, am redistribuit pe zile orele din df12.csv – folosind operaţiile "SWAP", "Undo" şi "Verify" – obţinând prin "Export", următorul fişier "re_distr.csv":

prof,Lu,Ma,Mi,Jo,Vi
P56,6D 8D,10B 5B 6D 8D,10B 12B 5B,12B 5C,6D 5C
P59,6D 7D 8B,5E 7D 8B,5E 6D 7D,5D 5E,
P60,11C 12D 12E 9E,12D 12E,,11C 12D 12E,11C 9E
P61,10C 7A 7E,5E 7C 5A,5D 5C 7D 5B,,
P62,,12E 9C,10C 10D 9C,10A 10B 9D,10E 9D
P63,12A 11A 11B,12A 12C,12C 9A,11A 11B 9A,
P64,11D 9C,11D 11E,11E 9D,9C 9D,11E 11D
P65,6E 9A,5A 5B,,7E 7D,6C 8E 8C
P66,,5B 9E,9D 9E,11E 9D,9D 5A
P67,7E,7E 8C,7E 8C,7E 8C,
P68,5C 8C,12B 5C 8C,12B 5C,,
P69,9B 9D 5C,11C 5C 9C 11A,,,
P70,11A 9D 12A,,,,12B 9A 11B
P72,10A 10C,10D,,10E 10B 11E,
P73,11E 12C 12E 9E,12E 9E,,,
P74,10E,10C 10D,,,10E
P76,7B,,,,7B
P39,11A 12D 8F,7E 8C 8D,12E 8D 8E,7C 8E 8C 8F,11A 12A 12E 7D
P40,11D 8F 9A,11C 11D 8A 9A,8A 8B 11D,11D 8B 9C 11B,10E 8F 9C
P41,11E 12D 7E,12D 7E 8D 12A,12D 7A 8D 8E,7A 8E 9E,11A 12C 12D
P42,10B 7B 9B 9E,5B 9B 9E 7B,10B 5B 9B 9E,10B 9B,10B 7B 9E
P47,7E 8A 9B,12C 8A 8E,12C 8E 11A,7E 8A 8E,7E 8A 9B 11A
P48,6E 8C 8D 9E,6C 6D 8B 9B,6A 8A 10B,6B 8F 7B,7B 8E
P54,12E 6E 8F,12B 6E 8F,12B 8F,12B 12E 6E,12B 12E 6E 8F

Vom avea de integrat rezultatul în distribuţia tuturor orelor – deci apare necesitatea de a construi cu datele din "re_distr.csv", un obiect "data.frame" la fel structurat ca şi distribuţia globală. În distribuţia tuturor orelor (v. [1]–I), fiecare oră este reprezentată prin câte o linie, precizând profesorul, clasa şi ziua repartizată – în timp ce în fişierul CSV redat mai sus (ca şi în "df12.csv"), fiecare linie înregistrează un profesor împreună cu clasele (zero, una, sau mai multe) repartizate lui în fiecare zi.

Renormalizarea datelor

Prin read_csv(), din "re_distr.csv" obţinem obiectul "tibble" (cu 24 de linii):

   prof  Lu             Ma           Mi          Jo          Vi      
 1 P56   6D 8D          10B 5B 6D 8D 10B 12B 5B  12B 5C      6D 5C   
 2 P59   6D 7D 8B       5E 7D 8B     5E 6D 7D    5D 5E       NA      
 3 P60   11C 12D 12E 9E 12D 12E      NA          11C 12D 12E 11C 9E
 #### etc.

Începem „normalizarea” prin gather("zl", "cls", 2:6, na.rm=TRUE) (datele din coloanele 2:6 devin valori ale coloanei $cls, asociate respectiv zilelor înregistrate în coloana $zl):

# A tibble: 104 x 3
   prof  zl    cls
 1 P56   Lu    6D 8D         
 2 P59   Lu    6D 7D 8B      
 3 P60   Lu    11C 12D 12E 9E
 #### etc.

Sunt numai 104 linii şi nu 5×24=120, fiindcă valorile NA au fost eliminate.

Mai departe, folosim strsplit() pentru a transforma şiruri ca "6D 7D 8B" în liste de şiruri, ("6D", "7D", "8B") şi adăugăm coloana $ncl conţinând lungimile acestora:

   prof  zl    cls            ncl
 1 P56   Lu    6D 8D           2      
 2 P59   Lu    6D 7D 8B        3
 3 P60   Lu    11C 12D 12E 9E  4
 #### etc.

Apoi, folosim uncount() pentru a multiplica fiecare linie de atâtea ori cât este valoarea $ncl pe acea linie:

   prof  zl    cls            ncl
 1 P56   Lu    6D 8D           2      
 2 P56   Lu    6D 8D           2      
 3 P59   Lu    6D 7D 8B        3
 4 P59   Lu    6D 7D 8B        3
 5 P59   Lu    6D 7D 8B        3
 #### etc.

şi apoi împărţim liniile (prin split()) după valorile conţinute în $cls, obţinând o listă de obiecte "tibble" precum acest G (pentru valoarea $cls "6D 7D 8B"):

## G: tibble 3×4
   prof  zl    cls            ncl
 1 P59   Lu    6D 7D 8B        3
 2 P59   Lu    6D 7D 8B        3
 3 P59   Lu    6D 7D 8B        3

Pentru G obţinem acum „forma normală”, înlocuind coloana G$cls prin strsplit(G$cls) (cu o anumită adaptare, fiindcă strsplit() returnează o listă şi ne trebuie un vector):

## G: tibble 3×4
   prof  zl    cls      ncl
 1 P59   Lu    6D        3
 2 P59   Lu    7D        3
 3 P59   Lu    8B        3

Să observăm că dacă mai exista o zi cu aceleaşi clase, de exemplu P59 Jo "6D 7D 8B" – atunci $ncl ar fi 6, iar secvenţa înscrisă mai sus în coloana G$cls pentru ziua Lu, trebuie repetată (folosind rep()) a doua oară, pentru Jo.

Cu map_df() vom putea reuni într-un acelaşi obiect "data.frame", toate obiectele G astfel normalizate. În programul următor – în principal, în funcţia renormalize() – modelăm demersurile de normalizare descrise mai sus:

# renormal.R
library(tidyverse)
Dini <- read_csv("df12.csv")  # distribuţia iniţială a setului de ore
Drec <- read_csv("re_distr.csv")  # redistribuirea, din aplicaţia /recast

splt <- function(Txt)  unlist(strsplit(Txt, " "))

renormalize <- function(D) {
    D %>% gather("zl", "cls", 2:6, na.rm=TRUE) %>%
          mutate(ncl = unlist(lapply(.$cls, function(q) length(splt(q))))) %>%
          uncount(.$ncl) %>% split(., .$cls) %>%
          map_df(., function(G) {
                    q <- splt(G$cls[1])
                    G$cls <- rep(q, nrow(G) %/% length(q))
                    as.data.frame(G)
          })
}

Din <- renormalize(Dini) %>% select(-4)  # elimină coloana $ncl
Drc <- renormalize(Drec) %>% select(-4)

mDi <- as.matrix(addmargins(table(Din[c('cls','zl')])))
mDr <- as.matrix(addmargins(table(Drc[c('cls','zl')])))
if(identical(mDi, mDr)) {
    saveRDS(Drc, file="subset_recast.rds")
} else print("redistribuirea este eronată")

Am aplicat renormalize() şi pe tabelul rezultat din "df12.csv" şi pe cel provenit din "re_distr.csv", pentru a verifica prin table() că prin redistribuirea orelor nu am modificat cumva, numărul de ore pe zi la clase (este drept că ne puteam asigura asupra acestui fapt şi folosind operaţia Verify din aplicaţia de redistribuire /recast).
Aplicând identical() pe cele două matrici de ore pe zi la clase, constatăm că nu s-a întâmplat vreo asemenea modificare şi ne rezultă fişierul "subset_recast.rds", conţinând imaginea binară a obiectului data.frame corespunzător redistribuirii subsetului de ore, normalizat acum „la fel” cu distribuţia tuturor orelor.

Reintegrarea sub-distribuţiei

De fapt, subset_recast.rds nu este chiar „la fel” cu distribuţia tuturor orelor! Amintindu-ne (v. [1]) că salvasem această „distribuţia tuturor orelor” în "chosen_distr.rds", putem compara cele două structuri:

Dgl <- readRDS("chosen_distr.rds")  # distribuţia globală (a tuturor orelor)
> str(Dgl)
tibble [1,202 × 3] (S3: tbl_df/tbl/data.frame)  # cele 1202 ore ale şcolii
 $ prof: Ord.factor w/ 76 levels "P01"<"P02"<"P03"<..: 26 26 14 14 5 8 8 8 16 16 ...
 $ cls : chr [1:1202] "10A" "10A" "10A" "10A" ...
 $ zl  : Ord.factor w/ 5 levels "Lu"<"Ma"<"Mi"<..: 1 2 3 4 5 1 2 3 4 5 ...

Drc <- readRDS("subset_recast.rds")  # "recast" pentru un subgrup de ore
> str(Drc)
'data.frame':	252 obs. of  3 variables:  # 252 ore, redistribuite pe zile prin /recast
 $ prof: chr  "P62" "P62" "P62" "P72" ...
 $ zl  : chr  "Jo" "Jo" "Jo" "Lu" ...
 $ cls : chr  "10A" "10B" "9D" "10A" ...

Cele două structuri diferă, în primul rând prin faptul că în Dgl (nu şi în Drc) variabilele $prof şi $zl sunt de tip factor ordonat.

Dar nu este necesar să convertim variabilele la un acelaşi tip, fiindcă beneficiem de „conversii implicite”. Liniile din Dgl care trebuie înlocuite prin cele din Drc sunt acelea care în coloana Dgl$prof au ca valori pe cele existente în coloana Drc$prof – prin urmare, reintegrarea în Dgl a subsetului de ore redistribuit prin /recast, constă în:

Dgl <- readRDS("chosen_distr.rds") %>%
       filter(! prof %in% Drc$prof) %>%  # reţine liniile neaflate în 'Drc'
       rbind(., Drc)  # adaugă liniile din 'Drc'
saveRDS(Dgl, "distr_final.RDS")

În "distr_final.rds" avem acum distribuţia finală pe zilele de lucru, a celor 1202 ore ale şcolii. Să tabelăm distribuţiile individuale (numărul de ore pe zi, pentru fiecare profesor), cum am mai făcut anterior în [1]:

Dgl <- readRDS("distr_final.RDS")

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

Z <- bind_omg(as.matrix(table(Dgl[c('prof', 'zl')])))
Z <- cbind(Z, rowSums(Z[, 1:5]))  # nr. ore pe săpt. ale profesorilor
Z <- Z[order(-Z[, 7]), ]
    Lu Ma Mi Jo Vi                  Lu Ma Mi Jo Vi          
P01  6  5  6  5  4   26 0.32    P39  3  3  3  4  4   17 0.16
P02  5  4  5  5  5   24 0.09    P40  3  4  3  4  3   17 0.16
P03  5  6  5  4  4   24 0.35    P41  3  4  4  3  3   17 0.16
P04  4  5  5  5  4   23 0.12    P42  4  4  4  2  3   17 0.53
P05  5  5  3  5  5   23 0.39    P43  4  3  4  3  3   17 0.16
P06  4  5  6  4  4   23 0.39    P44  4  3  4  3  3   17 0.16
P07  6  4  5  4  4   23 0.39    P45  4  4  3  3  3   17 0.16
P08  5  4  5  4  4   22 0.12    P46  3  4  3  3  3   16 0.14
P09  4  5  5  5  3   22 0.41    P47  3  3  3  3  4   16 0.14
P10  5  4  4  4  4   21 0.11    P48  4  4  3  3  2   16 0.52
P11  4  5  4  4  4   21 0.11    P49  3  3  4  3  3   16 0.14
P12  3  3  5  4  5   20 0.50    P50  3  2  4  3  3   15 0.47
P13  4  4  4  5  3   20 0.35    P51  2  3  4  3  3   15 0.47
P14  4  5  5  3  3   20 0.50    P52  4  3  3  3  2   15 0.47
P15  5  3  4  4  4   20 0.35    P53  3  2  3  3  4   15 0.47
P16  4  4  5  4  3   20 0.35    P54  3  3  2  3  4   15 0.47
P17  4  4  4  3  5   20 0.35    P55  3  3  3  3  3   15 0.00
P18  4  4  4  4  4   20 0.00    P56  2  4  3  2  2   13 0.69
P19  4  3  4  4  4   19 0.12    P57  3  3  3  3  0   12 0.00
P20  4  5  3  3  4   19 0.44    P58  2  3  3  2  2   12 0.23
P21  3  4  5  3  4   19 0.44    P59  3  3  3  2  0   11 0.18
P22  5  3  3  4  4   19 0.44    P60  4  2  0  3  2   11 0.70
P23  4  4  4  4  3   19 0.12    P61  3  3  4  0  0   10 0.17
P24  4  4  4  3  4   19 0.12    P62  0  2  3  3  2   10 0.23
P25  5  4  4  3  3   19 0.44    P63  3  2  2  3  0   10 0.23
P26  5  3  4  3  4   19 0.44    P64  2  2  2  2  2   10 0.00
P27  3  3  4  4  4   18 0.15    P65  2  2  0  2  3    9 0.22
P28  4  3  3  5  3   18 0.50    P66  0  2  2  2  2    8 0.00
P29  4  4  3  3  4   18 0.15    P67  1  2  2  2  0    7 0.29
P30  4  3  4  3  4   18 0.15    P68  2  3  2  0  0    7 0.25
P31  4  3  3  4  4   18 0.15    P69  3  4  0  0  0    7 0.20
P32  4  4  4  4  2   18 0.50    P70  3  0  0  0  3    6 0.00
P33  4  5  3  3  3   18 0.50    P71  0  0  2  2  2    6 0.00
P34  4  4  3  3  4   18 0.15    P72  2  1  0  3  0    6 1.00
P35  4  3  3  4  4   18 0.15    P73  4  2  0  0  0    6 0.94
P36  3  4  3  5  3   18 0.50    P74  1  2  0  0  1    4 0.43
P37  3  4  3  3  4   17 0.16    P75  2  2  0  0  0    4 0.00
P38  3  4  3  3  4   17 0.16    P76  1  0  0  0  1    2 0.00

Distribuţia dinaintea modificării prin /recast avea 17 distribuţii individuale de coeficient mai mare ca 0.5 şi avea 27 de cazuri de „o singură oră pe zi” (v. [1]); acum, în distribuţia finală, avem numai 4 coeficienţi mai mari ca 0.5 (dar la P60 şi P73, care au puţine ore, distribuţiile respective pot fi considerate ca fiind foarte bune) şi doar 6 cazuri de „o singură oră pe zi” (dintre care, unele sunt motivate: de exemplu, P76 are ambele ore la aceeaşi clasă, deci orele trebuie puse în două zile şi nu într-una singură).

Prin urmare, distribuţia finală pe care o avem acum în "distr_final.RDS" poate fi considerată ca fiind suficient de bună: orele fiecărui profesor sunt repartizate cvasi-omogen pe zilele de lucru (exceptând pe cei care au puţine ore, pentru care am evitat pe cât s-a putut situaţia neconvenabilă de „o singură oră pe zi”). Desigur, dacă ar mai fi de modificat repartizarea unui anumit subgrup de ore – putem folosi iarăşi /recast, urmând să reintegrăm rezultatul, cum am procedat mai sus.

Acum putem să ne gândim şi la orarul propriu-zis, al şcolii; pentru a obţine orarul unei zile, trebuie să extragem din Dgl orele repartizate acelei zile şi să vedem cum le putem marca cu intervale orare, încât să evităm situaţia în care doi profesori ar trebui să intre simutan la o aceeaşi clasă şi situaţia în care un profesor ar intra în acelaşi timp, la două clase (şi am avea această cerinţă analogă omogenităţii din etapa repartizării pe zile: profesorii să aibă cât mai puţine ferestre)…

vezi Cărţile mele (de programare)

docerpro | Prev | Next