[1] De capul meu prin problema orarului şcolar (pe Google Play)
În [1] (şi adesea, pe aici), am „abstractizat” cumva, profesorii implicaţi pe orarele şcolare pe care le-am abordat – dar şi cu alte gânduri, decât acela obişnuit, de a proteja „drepturile personale”…
Ultimul exemplu îl avem în [2], unde profesorii „de bază” au fost desemnaţi prin p01, p02, ..., p83 (în ordinea descrescătoare a numărului de ore); rezultă astfel formulări concise pentru matricea de încadrare şi pentru orare – iar pe de altă parte, devine firească modelarea cuplajelor de profesori (v. [1]): dacă de exemplu, p55 şi p71 trebuie să partajeze anumite clase (în câte o aceeaşi zi şi oră), atunci înfiinţăm „profesorul” fictiv "p55p71" căruia îi atribuim orele „pe grupe” ale celor doi profesori.
Totuşi, notaţia amintită mai sus este chiar săracă: "p" este o literă oarecare (putea fi "t" de la "teacher", sau "y" de la "учитель", etc.), iar "55" ar spune doar că p55 are mai multe ore decât p71 (şi mai puţine decât p25); parcă şi „notaţia” vulgară "profu' de mate" este mai consistentă…
Îmbunătăţirea de făcut este străvezie, dar realizarea acesteia este chiar instructivă (reflectând într-un context real, o seamă de aspecte specifice programării în limbajul R).
Considerăm setul de lecţii constituit la început în [2], plecând de la fişierul PDF care prezenta orarul final al unei anumite şcoli:
library(tidyverse) LSS <- readRDS("TV-org.RDS") # 1260 lecţii prof|obj|zi|ora|cls
Subliniem că nu prea ne interesează părţile zi|ora (din care deducem totuşi, cuplajele de profesori), având intenţia de a genera – prin programele R din [1] – orare echilibrate corespunzătoare matricei de încadrare deduse din orarul iniţial.
În $prof avem numele reale, separate prin '/' în cazul în care lecţia respectivă angajează „pe grupe” ale clasei, cei doi profesori – ca în acest eşantion de lecţii:
> slice_sample(LSS, n = 5) prof obj zi ora cls 1 Rica Zamfir Matematica Vi 2 12f 2 Claudia Anghel Chimie Jo 8 9d 3 Marcel Homorodean/Simona Ionescu Informatica Lu 12 10i 4 Maria Ardeleanu Religie Lu 1 11g 5 Ovidiu Sontea Matematica Vi 7 10h
Ne propunem să „abstractizăm” numele profesorilor indicând cumva disciplina şi un număr de ordine între ceilalţi angajaţi pe disciplina respectivă.
Bineînţeles că întâi, ne procurăm – folosind abbreviate(), cu unele ajustări manuale – un set de abrevieri convenabile pentru discipline (numele unice din LSS$obj):
abb <- readRDS("abb_obj.RDS") Biologie Chimie Cultura civica Cultură germană Economie "Bi" "Ch" "Cv" "Cg" "Ec" Dezbatere Dirigentie Educatie antreprenoriala Educatie fizica "Dz" "Dr" "Ea" "Ef" Educatie muzicala Educatie sociala Educatie tehnologica Educatie vizuala "Em" "Es" "Et" "Ev" Filosofie Fizica Geografie Informatica Istorie "Fs" "Fz" "Ge" "N" "Is" Limba engleza Limba franceza Limba germana Limba latina Limba romana "Le" "Lf" "Lg" "Ll" "R" Logica Matematica Psihologie Religie TIC "Lo" "M" "Ps" "Re" "Ti"
Dacă avem trei profesori de "Biologie", ei vor fi desemnaţi prin "Bi1", "Bi2" şi "Bi3"; având mai mult de 9 profesori de "Matematica", îi vom desemna prin "M01", ..., "M09", "M10", etc. Indecşii 1, 2, etc. reflectă ordinea descrescătoare a numărului de ore ale profesorilor de pe disciplina respectivă.
abb este un vector cu nume, sau cum se zice parcă mai firesc, în alte limbaje – un dicţionar, având drept "chei" denumirile obişnuite ale disciplinelor şcolare şi drept "valori", abrevierile convenite pentru acestea ("Biologie" ⇒ "Bi", etc.).
Cheile trebuie să fie (şi sunt) distincte între ele; în cazul de faţă şi valorile asociate cheilor, sunt distincte între ele – încât ne putem gândi şi la dicţionarul "invers":
iabb <- names(abb) # cheile din 'abb' devin valorile lui 'iabb' names(iabb) <- as.vector(abb) # valorile din 'abb' devin cheile lui 'iabb' > head(iabb, 4) # exemplificare Bi Ch Cv Cg "Biologie" "Chimie" "Cultura civica" "Cultură germană"
Obs. Avem totuşi această diferenţă între "dicţionar" (ca în Python) şi "vector cu nume" (specific lui R): selectarea unui element dintr-un vector cu nume – de exemplu, prin iabb["Bi"], sau prin iabb[1] – ne dă şi cheia şi valoarea (… tot un "vector cu nume"), pe când selectarea dintr-un dicţionar ne dă numai valoarea asociată cheii indicate.
Prin iabb vom putea explicita discipline, plecând de la numele profesorilor:
show_obj <- function(Prof) gsub("[\\d]", "", Prof, perl=TRUE) %>% # fără cifre, rămâne o cheie din 'iabb' iabb[.] %>% # selectează cheia şi valoarea as.vector(.) # păstrează numai valoarea (şi o returnează) # exemplificări: > show_obj("Bi2") [1] "Biologie" > show_obj(c("M12", "Bi2", "N09")) # aplicare pe o coloană de profesori [1] "Matematica" "Biologie" "Informatica"
Dacă avem un obiect data.frame conţinând orarul „pe profesori” al unei clase (indicând profesorii care intră la clasă în fiecare oră), atunci aplicând pe coloanele sale funcţia show_obj(), am obţine imediat (fără vreo altă investigare) orarul obişnuit, „pe discipline”.
Păstrăm din LSS numai datele de încadrare, $prof, $obj şi $cls; renunţăm deocamdată la liniile pe care avem '/' în câmpul $prof, sau în $obj (acestea reprezintă o lecţie care se desfăşoară „pe grupe” – v. [2]). Împărţim apoi pe discipline:
lso <- LSS %>% select(prof, obj, cls) %>% filter(! (grepl("/", prof, fixed=TRUE) | grepl("/", obj, fixed=TRUE))) %>% split(.$obj) # seturile de lecţii pe câte o aceeaşi disciplină
De exemplu, pe "Geografie" avem 44 de lecţii şi putem constata prin count() că acestea sunt repartizate pe doi profesori, cu câte 24 şi 20 de ore:
> str(lso$Geografie) 'data.frame': 44 obs. of 3 variables: $ prof: chr "Diana Petculescu" "Florentin Rotea" "Florentin Rotea" ... $ obj : chr "Geografie" "Geografie" "Geografie" ... $ cls : chr "5" "9d" "9e" ... # Câte ore are fiecare: > lso$Geografie %>% count(prof, sort=TRUE) prof n 1 Diana Petculescu 24 2 Florentin Rotea 20
Pentru fiecare set de lecţii pe o aceeaşi disciplină, contorizăm apariţiile câte unui aceluiaşi profesor – obţinând de fapt, numărul de ore ale acestuia – şi producem vectorul profesorilor respectivi, în ordinea descrescătoare a numărului de ore:
LO <- map(1:length(lso), function(i) lso[[i]] %>% count(prof, sort=TRUE) %>% pull(prof)) names(LO) <- names(lso) #Exemplificare: > LO[16] $Geografie [1] "Diana Petculescu" "Florentin Rotea"
Folosind acum abrevierile din abb, urmează să desemnăm profesorii de "Geografie" prin "Ge1" (cel cu mai multe ore) şi "Ge2".
Să observăm că puteam scurta puţin lucrurile: names(LO) <- abb[names(lso)] (atunci, nu mai aveam "Geografie" de exemplu, ci direct "Ge").
Pentru fiecare set de lecţii (pe o aceeaşi disciplină) dintre cele 28 din lista LO, constituim câte un obiect data.frame conţinând profesorii din acel set şi codificarea rezultată pentru aceştia prin alipirea numelui abreviat al obiectului, cu indexul profesorului în cadrul setului respectiv – având grijă să folosim "01", "02" etc. în loc de 1, 2 etc., dacă numărul profesorilor pe obiectul respectiv este mai mare ca 9.
În final „reunim” obiectele data.frame constituite astfel, folosind map_dfr():
LOP <- map_dfr(1:length(LO), function(i) { n <- length(LO[[i]]) obj <- if(n < 10) paste0(abb[[i]], 1:n) else c(paste0(abb[[i]], "0", 1:9), paste0(abb[[i]], 10:n)) data.frame(prof = LO[[i]], obp = obj) }) > str(LOP) 'data.frame': 103 obs. of 2 variables: $ prof: chr "Mirela Marinescu" "Doriana Stoica" "Simona Vasilescu" ... $ obp : chr "Bi1" "Bi2" "Bi3" ...
Am obţinut codificările prin câte 3 caractere – indicând disciplina şi cumva, numărul de ore – pentru 103 profesori; de exemplu, la întâmplare:
> slice_sample(LOP, n = 5) prof obp 1 Sena Azis M11 2 Mirela Marcu Ch2 3 Monica Dumitrache M06 4 Raluca Mangra M07 5 Livia Magureanu N13
"M11" (evidenţiat în selecţia redată mai sus) este al 11-lea profesor, în ordinea descrescătoare a numărului de ore, pe disciplina "Matematica".
Dar să observăm că avem acum 103 „profesori”, în loc de 83 câţi erau „de bază” în notaţia anterioară ("p01"..."p83"); aceasta înseamnă că avem cazuri când un acelaşi profesor apare la mai multe discipline (şi i s-au asociat codificări distincte):
po2 <- LOP %>% group_by(prof) %>% filter(n() > 1) %>% # cei cu mai multe codificări arrange(prof) > str(po2) tibble [40 × 2] (S3: grouped_df/tbl_df/tbl/data.frame) $ prof: chr [1:40] "Alina Boca" "Alina Boca" "Alina Teac" "Alina Teac" ... $ obp : chr [1:40] "Dr1" "N02" "Cv1" "Em1" ...
po2 având 40 de linii, deducem că avem (cel mai probabil – dar se verifică, listând po2) 20 de profesori încadraţi pe câte două discipline; de exemplu, profesorul Em1 (de "Educatie muzicala") are şi "Cultura civica", fiind codificat şi prin Cv1. Dintre cele două codificări vom alege (fireşte) pe aceea care asociază mai multe ore (ţinând cont cumva şi de cealaltă, atunci când va fi să formulăm în final, orarele „pe discipline”, ale claselor).
Reducerea de la cei 103 la cei 103-20=83 „de bază”, ar putea decurge astfel:
N2 <- map_dbl(1:nrow(po2), function(i) LSS %>% filter(prof == po2$prof[i] & obj == show_obj(po2$obp[i])) %>% nrow(.) ) # num [1:40] 1 15 3 6 8 6 1 14 6 1 ... idx <- map_dbl(seq(1, nrow(po2), by=2), function(i) if(N2[i] > N2[i+1]) i else i+1) # num [1:20] 2 4 5 8 9 12 14 15 17 20 ... LOP <- LOP %>% anti_join(po2) %>% full_join(po2[idx, ])
Vectorul N2 a înregistrat numărul de ore pe fiecare dintre cele două discipline ale profesorilor din po2 (de exemplu, vedem că Cv1 are 3 ore, iar Em1 are 6 ore); dintre cele câte două linii corespunzătoare în po2 unui aceluiaşi profesor, am înscris în vectorul idx indexul aceleia pe care numărul de ore este mai mare (de exemplu, pentru Em1 am păstrat linia 4). În final, prin anti_join() am exclus din LOP cele 40 de linii existente în po2 şi apoi prin full_join(), am inclus cele 20 de linii de pe rangurile idx, ale lui po2.
Acum cei 83 profesori „de bază” sunt:
> LOP$obp %>% sort() [1] "Bi1" "Bi2" "Bi3" "Bi4" "Cg2" "Cg3" "Ch1" "Ch2" "Ch3" "Ch4" "Ea1" "Ef1" [13] "Ef2" "Ef3" "Ef4" "Em1" "Es1" "Et1" "Ev1" "Fz1" "Fz2" "Fz3" "Fz4" "Fz5" [25] "Fz6" "Fz7" "Fz8" "Ge1" "Ge2" "Is1" "Is2" "Is3" "Le1" "Le2" "Le3" "Le4" [37] "Le5" "Lf1" "Lf2" "Lf3" "Lf4" "Lf5" "Lg1" "Lo1" "M01" "M02" "M03" "M04" [49] "M05" "M06" "M07" "M08" "M09" "M10" "M11" "N01" "N02" "N03" "N04" "N05" [61] "N06" "N07" "N08" "N09" "N10" "N11" "N12" "N13" "N14" "Ps1" "R01" "R02" [73] "R03" "R04" "R05" "R06" "R07" "R08" "R09" "R10" "Re1" "Re2" "Ti2"
Prin funcţia show_obj() putem stabili direct, disciplina principală a fiecăruia; dacă profesorul are şi o disciplină secundară, atunci aceasta (cu număr de ore mai mic) a fost indicată în po2 fie în faţa, fie după cea principală – deci o putem regăsi astfel:
sec_obj <- function(Prof) { # un singur 'Prof' (NU o coloană!) id <- match(Prof, po2$obp, 0) if(id == 0) return(NULL) # NU are disciplină secundară id <- if(id %% 2 == 0) id - 1 else id + 1 show_obj(po2$obp[id]) } # exemplificare: > sec_obj("Em1") [1] "Cultura civica"
Subliniem că if() evaluează o singură valoare (nu este o funcţie „vectorizată”), încât sec_obj() trebuie folosită pentru câte un singur profesor (nu şi pentru o coloană de profesori, ca în cazul funcţiei show_obj()).
Vom avea de înlocuit numele reale din LSS prin codificările asociate acestora în LOP (după ce vom fi extins LOP, cuprinzând şi notaţia „scurtă” pentru cuplaje); în [2] am procedat în maniera tipică, transformând coloanele $prof în factori la fel ordonaţi şi folosind levels(). Dar putem proceda şi direct (scăpând de ordonări): transformăm „tabelul” LOP în vector cu nume şi prevedem o funcţie care să dea codul scurt asociat numelui, dacă există:
Dpc <- LOP$obp names(Dpc) <- LOP$prof short_name <- function(Prof) as.vector(ifelse(is.na(Dpc[Prof]), Prof, Dpc[Prof])) # Exemplificare: > short_name(c("Marcel Homorodean", "Simona Ionescu")) [1] "Marcel Homorodean" "N01"
Fiindcă am formulat cu ifelse() (nu cu if()) – funcţia short_name() poate fi apelată şi pentru o coloană de profesori, cum am şi exemplificat mai sus.
Următoarea funcţie primeşte un cuplaj cum avem în LSS (de exemplu "Marcel Homorodean/Simona Ionescu") şi angajează short_name() pe vectorul celor două nume, returnând prin alipire un prim cod scurt al cuplajului (păstrând separatorul '/'), sau dacă unul dintre nume nu este găsit în Dpc – însuşi numele respectiv, separat de celălalt (eventual „scurtat”) iarăşi prin '/' (dar astfel încât codul scurt, dacă există unul, să fie înainte de '/'):
st2name <- function(P2) { s2 <- short_name(strsplit(P2, "/", fixed=TRUE)[[1]]) if(nchar(s2[1]) > 3) s2 <- rev(s2) # codul scurt să fie înainte de '/' paste0(s2, collapse="/") } # Exemplificare: > st2name("Isabela Coman/Victor Manz") [1] "N10/N03" > st2name("Marcel Homorodean/Simona Ionescu") [1] "N01/Marcel Homorodean"
Acum culegem într-un „tabel” DFcup, cuplajele din LSS (liniile care în $prof conţin '/') şi-i montăm o coloană $obp pe care înscriem valorile date de st2name() (eliminând separatorul '/' din codurile deja scurte – cele de câte 7 caractere):
DFcup <- LSS %>% select(prof, obj, cls) %>% filter(grepl("/", prof)) %>% count(prof, sort=TRUE) %>% mutate(obp = "") for(i in 1:nrow(DFcup)) { cup <- st2name(DFcup$prof[i]) DFcup$obp[i] <- if(nchar(cup)==7) sub("/", "", cup) else cup } DFcup$n <- NULL # nu avem nevoie de numărul de ore (introdus de count()) # Exemplificare > str(DFcup) 'data.frame': 26 obs. of 2 variables: $ prof: chr "Alina Teac/Gratiela Stoian" "Alexandra Tudor/Valentina Morman" "Alina Boca/Corina Vint" "Anca Leuciuc/Irina Iosupescu" ... $ obp : chr "Em1Ev1" "Cg2Lg1" "N02N12" "N04/Irina Iosupescu" ...
Numele din DFcup$obp care mai conţin '/' corespund cuplajelor cu profesori „externi” (neaflaţi printre cei 83 „de bază”); pentru aceştia – doar câţiva – prevedem (după ce excludem partea din faţa separatorului '/') codurile "e01", "e02" etc.:
C3 <- DFcup$obp cpx <- C3[grepl("/", C3)] # reţine cuplajele cu profesor extern Pex <- unique(gsub(".*/", "", cpx)) # profesorii externi dct_x <- paste0("e0", 1:length(Pex)) names(dct_x) <- Pex # dicţionar {Prof_extern ==> e0N}
Folosind dicţionarul dct_x, definitivăm codurile de câte 6 caractere şi pentru cuplajele cu profesori externi, din DFcup$obp:
for(i in 1:nrow(DFcup)) { if(nchar(DFcup$obp[i]) == 6) next vct <- strsplit(DFcup$obp[i], "/", fixed=TRUE)[[1]] p1 <- vct[1] if(nchar(p1) > 3) p1 <- dct_x[p1] p2 <- dct_x[vct[2]] DFcup$obp[i] <- paste0(p1, p2) }
Acum putem finaliza lucrurile: reunim LOP (unde avem codurile scurte pentru profesorii „de bază”) şi DFcup (unde avem codurile cuplajelor) şi transformăm iarăşi în "vector cu nume", pe care îl folosim pentru a converti numele reale din LSS$prof:
DFn <- LOP %>% full_join(DFcup, by=c("prof", "obp")) Dpc <- DFn$obp names(Dpc) <- DFn$prof LSS <- LSS %>% select(prof, cls) %>% mutate(prof = as.vector(Dpc[prof])) # Exemplificare > str(LSS) 'data.frame': 1260 obs. of 2 variables: $ prof: chr "Ef1" "Em1" "Le2" "M07" ... $ cls : Factor w/ 42 levels "10A","10B","10C",..: 28 28 28 28 ...
(desigur, între timp am ajustat ca în [2], notaţia claselor din LSS$cls)
Dacă foloseam mutate(prof=Dcp[prof]) (fără as.vector()), atunci s-ar fi păstrat cumva şi numele reale (accesibile prin construcţii incomode, ca attr(LSS$prof[10], "names")):
$ prof: Named chr "Ef1" "Em1" "Le2" "M07" ... # vector cu nume ..- attr(*, "names")= chr [1:1260] "Ionela Stan-Cristache" "Alina Teac" ...
ceea ce ar fi însă inutil (dacă ar fi cazul de a regăsi numele reale, putem accesa dicţionarul Dpc) şi s-ar putea să ne şi încurce ulterior, când ar fi să aplicăm programele din [1] pentru a repartiza lecţiile prof | cls pe zile şi pe orele zilei.
Dacă vrem, putem formula (tipări) şi matricea de încadrare, ca în [2]; dar acum putem evidenţia imediat (fără investigări suplimentare) şi matricele de încadrare pe discipline:
emv <- LSS %>% filter(grepl("Em|Ev", prof)) frem <- addmargins(table(emv[c('prof', 'cls')]), 2) frem <- frem[, -(10:27)] # exclude clasele 11 şi 12 frem[frem == 0] <- '.' > frem cls 10________________ 5 6__ 7 8__ 9________________ prof A B C D E F G H I A A B A A B A B C D E F G H I + Em1 . . . . . . . . . 1 1 1 2 2 2 . . . . . . . . . 9 Em1Ev1 1 1 1 1 1 1 1 1 1 . . . . . . 1 1 1 1 1 1 1 1 1 18 # jumătăţi de oră Ev1 . . . . . . . . . 1 1 1 1 1 1 . . . . . . . . . 6
Am redat încadrarea pe "Educatie muzicala" şi "Educatie vizuala"; fiindcă Em1 apare şi în dicţionarul po2 al profesorilor care au şi discipline secundare – deducem că una din cele câte două ore ale sale de la clasele a 7-a şi a 8-a este de "Educatie civica".
Cele 18 ore alocate fictiv lui Em1Ev1 angajează cei doi profesori „pe grupe”, la clasele respective şi se pot desfăşura fie ca atare (18 ore cu câte o jumătate de clasă), fie cuplând câte o grupă de la două clase (pe 9 ore, cu clase „întregi”).
Bineînţeles că putem „abstractiza”, inventând o funcţie frame_obj(), care să producă matricea de încadrare pe disciplinele primite ca argument; de exemplu, tabelul redat mai sus s-ar obţine prin frame_obj(c("Em", "Ev")).
vezi Cărţile mele (de programare)