În orarNorm.rds avem orarul unei şcoli, în „formă normală” (v. [1] şi părţile anterioare). Dar nu ne mai interesează repartizarea existentă pe zile şi ore; vrem să folosim numai datele de încadrare, scopul nostru fiind generarea de distribuţii cât mai „omogene” pe zile (vezi părţile anterioare). Înainte de a „şterge” coloanele $zl şi $ora, profităm de $ora pentru a deduce care sunt clasele din fiecare schimb (primul schimb începe la ora 1 sau la ora 2 din zi; al doilea – încheie la ora 12 sau la ora 11 din zi):
library(tidyverse) orar <- readRDS("orarNorm.rds") schimb <- function(h) { with(orar, sort(unique(cls[ora==h]))) } Sch1 <- schimb(2) # clasele din primul schimb Sch2 <- schimb(11) # clasele din al doilea schimb orar %>% filter(!is.na(zl)) %>% # ignorăm cele 11 ore pe jumătăţi de clasă select(prof, obj, cls) %>% # „ştergem” coloanele 'zl' şi 'ora' saveRDS("frame.rds")
În orarul iniţial există 11 ore (dintre cele 925) fără alocare explicită pe zile (având NA în coloana $zl); aceste ore se desfăşoară cu câte doi profesori la o aceeaşi clasă, încât ziua s-a înregistrat numai la unul. Am decis să ignorăm „jumătăţile” de clasă – fiind mai simplu de tratat asemenea situaţii la sfârşit, după ce obţinem o repartizare promiţătoare a orelor propriu-zise.
În frame.rds avem acum încadrarea la clase pe care urmează să experimentăm:
> (fram <- readRDS("frame.rds")) # A tibble: 914 x 3 prof obj cls <ord> <chr> <chr> 1 P01 Foto.dig. 11D 2 P01 TIC 11C 3 P01 TI 11D 4 P01 TIC 11C 5 P01 Info 12B 6 P01 Info 12B 7 P01 TIC 12G 8 P01 Info 11A 9 P01 Info 12B 10 P01 Info 11A # … with 904 more rows
Bineînţeles că avem linii identice (de exemplu, liniile 5 şi 6, sau 2 şi 4) – diferenţa între ele era dată de cele două coloane eliminate prin programul redat mai sus.
Bineînţeles că m-am întrebat dacă nu cumva s-a strecurat vreo greşală de editare, la producerea orarului original: nu trebuia să fie "TIC" (disciplina denumită pompos "Tehnologia informaţiei şi a comunicaţiilor"), în loc de "TI" (v. linia 3)? Consultând însă documentul PDF original (cel care prezenta orarul-pe-clase, conţinând şi denumirile explicite ale obiectelor) am constatat că nu este nicio greşală: "TI" desemnează o nouă disciplină, "Tehnologii Internet".
Subliniem că cele 914 linii de date sunt ordonate după valorile din coloana $prof dar nu numai alfabetic, ci şi (vezi [1]) descrescător după numărul total de ore pe săptămână ale profesorilor respectivi; "P01" şi "P02" au cel mai mare număr (câte 28 de ore pe săptămână, ocupând liniile 1..28 şi respectiv 29..56 din fram), iar liniile finale corespund profesorilor cu cel mai puţine ore ("P57" are două, "P58" şi P59" chiar câte una).
De fapt… nu-i chiar aşa! Introdusesem factorul ordonat $prof înainte de a fi eliminat cele 11 ore nealocate iniţial pe zile (v. [1]); ori acum, după eliminarea acestora, la doi dintre profesori s-a diminuat puţin numărul de ore – încât ordinea menţionată trebuie totuşi corectată (presupunând că este într-adevăr, importantă):
Q <- readRDS("frame.rds") # după eliminarea celor 11 ore nealocate pe zile srt <- sort(table(Q$prof), decreasing=TRUE) Q$prof <- factor(Q$prof, levels=names(srt), ordered=TRUE) saveRDS(Q, "frame.rds")
Pentru verificare:
> addmargins(table(Q$prof)) P01 P02 P03 P04 P05 P06 P07 P08 P09 P10 P11 P12 P13 P14 P15 P16 P17 P18 P19 P20 28 28 28 27 26 26 25 24 23 23 23 22 22 22 21 21 21 20 20 20 P21 P22 P23 P24 P25 P26 P27 P28 P29 P30 P31 P32 P33 P34 P35 P36 P37 P38 P39 P40 20 19 19 19 19 18 18 18 18 18 18 18 17 16 16 16 16 16 16 13 P41 P42 P44 P45 P47 P48 P49 P50 P51 P46 P52 P53 P54 P55 P43 P56 P57 P58 P59 Sum 13 11 9 7 6 5 5 5 5 4 4 4 4 4 3 3 2 1 1 914
De observat această particularitate: câte o treime dintre profesori au între 20 şi 28, între 13 şi 20, respectiv sub 13 ore pe săptămână.
Problema noastră constă în repartizarea pe zile a celor 914 ore (pentru încadrarea concretă vizată aici), încât clasele să aibă zilnic numărul cuvenit de ore (5-6 ore, sau 6-7 ore) şi pe de altă parte, profesorii să aibă nu mai mult de 6-7 ore pe zi, fără diferenţe mari de la o zi la alta (pe scurt: am vrea o distribuţie cât mai „omogenă”, a orelor).
Experimentele din părţile [1] anterioare ne-au arătat că pretenţia de a obţine o distribuţie omogenă – diferenţa dintre numărul de ore pe o zi şi alta să fie cel mult 1, pentru fiecare profesor (şi clasă) – este nerealistă, fiind uşor de generat doar dacă neglijăm condiţia asupra numărului zilnic de ore pentru clase (acceptând ca unele clase să aibă de exemplu 3 ore într-o zi şi 8 ore într-o alta).
Următoarea idee este însă fezabilă: alocăm orele astfel încât numărul de ore pe zi să nu varieze cu mai mult de 1 de la o zi la alta pentru fiecare clasă, iar pentru profesori, să nu depăşească 7 şi să nu varieze cu mai mult de 2 ore de la o zi la cea următoare – cu precizarea că aceste două limite (7 şi 2) s-au dovedit potrivite pentru încadrarea de faţă (când o treime din totalul orelor corespunde profesorilor cu peste 20 de ore); dacă ar fi puţini profesorii cu peste 20 de ore, sau dacă am avea în vedere fiecare schimb în parte, limitele respective pot fi reduse (probabil) la 6 şi 1.
Programul corespunzător (redat „pas cu pas” mai jos) este scurt: funcţiile setZile() şi allock() au în total sub 20 de linii; la fiecare executare se produce (cel mai adesea, în timp foarte scurt) o nouă distribuţie (şansele de a reproduce una anterioară sunt aproape nule), respectând cele două condiţii specificate mai sus.
Mai întâi, recuperăm încadrarea din fişierul frame.rds, precum şi cele două schimburi de clase găsite deja (prin funcţia schimb()) mai sus:
# schedule.R (distribuie orele profesorilor şi claselor pe zile) library(tidyverse) FRM <- readRDS("frame.rds") # încadrarea (prof obj cls) Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi") Sch1 <- c("11A", "11B", "11C", "11D", "11E", "11F", "11G", "12A", "12B", "12C", "12D", "12E", "12F", "12G", "7", "8" ) Sch2 <- c("9A", "9B", "9C", "9D", "9E", "9F", "9G", "10A", "10B", "10C", "10D", "10E", "10F", "10G", "5", "6") Cls <- c(Sch1, Sch2)
Instituim o matrice „globală” în care vom menţine pentru fiecare profesor numărul curent al orelor alocate deja, în fiecare zi; intrările pe linii corespund celor 5 zile, iar cele pe coloane – profesorilor:
profs <- unique(FRM$prof) nrPr <- length(profs) Mopr <- matrix(data=rep(0L, 5*nrPr), nrow=5, ncol=nrPr, byrow=TRUE, dimnames=list(Zile, profs))
Am setat şi denumiri adecvate pentru liniile şi coloanele matricei; de exemplu, attr(Mopr, "dimnames")[[2]] va produce lista numelor profesorilor corespunzători coloanelor matricei.
Prin setZile(Q) se vor aloca pe zile orele unei aceleiaşi clase, transmise prin obiectul de tip "tibble" Q – procedând astfel: se ordonează aleatoriu (renunţând deci, la principiul ordonării după numărul de ore) liniile lui Q, dar astfel încât orele unui aceluiaşi profesor să fie pe linii consecutive; se adaugă coloana (de tip "factor") zl, constituită prin repetarea secvenţei zilelor – astfel, dacă profesorul are mai puţin de 6 ore la clasa respectivă, atunci acestea vor fi repartizate totdeauna în zile diferite.
Apoi, folosind as.matrix(table()), se constituie o matrice care (după transpunere prin t()) este de acelaşi tip cu matricea globală Mopr, reflectând însă numărul de ore plasate profesorilor pentru clasa curentă (în timp ce Mopr vizează toate clasele anterioare); dacă suma celor două matrice nu conţine valori mai mari ca 7 şi dacă diferenţele consecutive ale valorilor din fiecare coloană nu depăşesc (în valoare absolută) 2, atunci se actualizează matricea Mopr (adunându-i numerele de ore alocate pentru clasa curentă) şi se returnează repartizarea obţinută; altfel – în cazul când la un profesor ar apărea mai mult de 7 ore pe o zi, sau în cazul când diferenţa numerelor de ore alocate lui în zile consecutive ar depăşi 2 – se reia întregul proces (se re-ordonează aleatoriu liniile lui Q, se adaugă factorul zl, etc.), reapelând setZile(Q):
setZile <- function(Q) { # 'Q' conţine liniile din FRM cu o aceeaşi 'cls' S <- Q %>% arrange(match(prof, sample(unique(prof))), prof) %>% # aleatoriu mutate(zl = gl(n=5, k=1, length = nrow(.), ordered=TRUE, labels = Zile)) %>% # alocă zilele as.data.frame(.) more <- t(as.matrix(table(S[c('prof', 'zl')]))) mex <- Mopr + more if(all(abs(diff(mex)) <= 2) & !any(mex > 7)) { # condiţiile repartiţiei Mopr <<- Mopr + more # actualizează matricea globală 'Mopr' return(S) } # print(Q$cls[1]) return(setZile(Q)) # reia dacă nu-s îndeplinite condiţiile }
Funcţia allock() primeşte un vector de clase, extrage din încadrarea iniţială datele acestora, constituie o listă de obiecte "tibble" corespunzătoare fiecare câte unei clase şi apoi invocă setZile() pentru fiecare, reunind rezultatele într-un obiect "data.frame" returnat în final:
allock <- function(vCls) { Mopr <<- 0L # urmăreşte câte ore au fost deja alocate FRM %>% filter(cls %in% vCls) %>% split(., .$cls) %>% map_df(., function(K) setZile(K)) }
După ce lansăm R şi încărcăm programul (prin source("schedule.R")), putem invoca de exemplu allock(Sch1), obţinând o distribuţie pe zile pentru clasele din schimbul întâi; prin print(Mopr) putem afişa şi numărul de ore pe fiecare zi, pentru fiecare profesor de la clasele respective. Dacă vrem o altă distribuţie, n-avem decât să invocăm încă o dată, allock(Sch1); de observat că dacă în corpul funcţiei allock() am fi omis reiniţializarea matricei Mopr, atunci în setZile() s-ar fi folosit valorile rămase în această matrice de la precedentul apel allock() (şi repartizarea eşuează).
Nu totdeauna, allock() produce un rezultat; la un anumit moment, alocarea orelor clasei curente (apelând funcţia recursivă setZile()) poate să eşueze:
> allock(Cls) Error: C stack usage 7973060 is too close to the limit
Pentru clasa curentă, setZile(K) ordonează aleatoriu liniile lui K (dar păstrând împreună liniile unui aceluiaşi profesor), testează dacă alocarea pe zile în ordinea curentă a liniilor convine condiţiilor impuse prin matricea globală Mopr şi în caz negativ, se auto-apelează până când se nimereşte o ordine a liniilor pentru care alocarea zilelor respectă condiţiile respective. Dar practic, fiecare re-apelare necesită o anumită nouă zonă de memorie, iar numărul de auto-apelări este limitat de dimensiunea existentă pentru „stiva de apeluri”; depăşirea acesteia conduce la stoparea programului.
Însă – fiindcă ordonarea este aleatorie pentru fiecare clasă – este posibil ca reluând lucrurile de la capăt, printr-o nouă invocare allock(Cls), programul să nu mai fie stopat şi a doua oară, producând rezultatul aşteptat.
În fişierul "diffcons2.rds" am salvat o repartizare pe zile a celor 914 ore, obţinută (cam în 30 de secunde) prin allock(Cls); următorul program redă într-un format convenabil, numărul de ore alocat zilnic profesorilor:
library(tidyverse) Q <- readRDS("diffcons2.rds") mat <- as.matrix(addmargins(table(Q[c('prof', 'zl')]))) prof <- attr(mat, "dimnames")[[1]] ore <- data.frame(n1 = 1:20, c1 = 1:20, sep = rep(" ", 20), n2 = 1:20, c2 = 1:20, sep1 = rep(" ", 20), n3 = 1:20, c3 = 1:20) ore$c1 <- mat[1:20, ] ore$c2 <- mat[21:40, ] ore$c3 <- mat[41:60, ] ore$n1 <- prof[1:20] ore$n2 <- prof[21:40] ore$n3 <- prof[41:60] names(ore) <- NULL print(ore, row.names=FALSE, width=100) Lu Ma Mi Jo Vi Sum Lu Ma Mi Jo Vi Sum Lu Ma Mi Jo Vi Sum P01 4 6 5 7 6 28 P21 6 4 4 3 3 20 P41 1 3 3 4 2 13 P02 6 7 6 4 5 28 P22 4 5 4 2 4 19 P42 3 4 2 1 1 11 P03 6 6 4 6 6 28 P23 3 4 3 5 4 19 P44 0 2 4 2 1 9 P04 5 5 5 6 6 27 P24 3 5 3 4 4 19 P45 1 1 3 1 1 7 P05 5 4 6 5 6 26 P25 5 3 4 3 4 19 P47 1 1 2 1 1 6 P06 6 6 6 5 3 26 P26 2 3 5 5 3 18 P48 2 2 0 0 1 5 P07 6 6 5 5 3 25 P27 5 4 2 4 3 18 P49 0 0 1 2 2 5 P08 6 5 6 4 3 24 P28 3 4 5 4 2 18 P50 1 0 2 0 2 5 P09 4 6 5 4 4 23 P29 3 3 4 4 4 18 P51 0 1 0 2 2 5 P10 5 5 5 3 5 23 P30 6 5 3 2 2 18 P46 1 2 1 0 0 4 P11 6 4 5 5 3 23 P31 5 4 3 3 3 18 P52 3 1 0 0 0 4 P12 4 5 6 4 3 22 P32 2 4 3 5 4 18 P53 0 1 2 0 1 4 P13 5 4 4 4 5 22 P33 4 4 2 4 3 17 P54 2 0 1 0 1 4 P14 5 5 5 4 3 22 P34 4 3 4 3 2 16 P55 0 0 1 2 1 4 P15 4 5 5 4 3 21 P35 3 3 5 3 2 16 P43 2 0 0 0 1 3 P16 5 5 3 3 5 21 P36 3 4 4 2 3 16 P56 1 0 1 1 0 3 P17 5 5 5 3 3 21 P37 5 3 2 4 2 16 P57 0 0 0 1 1 2 P18 3 4 5 5 3 20 P38 3 3 2 4 4 16 P58 0 0 1 0 0 1 P19 5 3 4 5 3 20 P39 3 3 4 4 2 16 P59 0 0 1 0 0 1 P20 5 4 3 3 5 20 P40 4 2 2 2 3 13 Sum 194 191 191 176 162 914
Avem câte o zi cu 7 ore numai la doi profesori (P01 şi P02, care şi au multe ore); pentru fiecare profesor, numărul de ore variază de la o zi la cea următoare acesteia, cu cel mult 2. Cel mai multe ore (194) sunt alocate în ziua Lu şi cel mai puţine (162), în ultima zi Vi – fiindcă alocarea pe zile a orelor fiecărei clase a decurs în ordinea zilelor (şi cum majoritatea claselor au mai puţin de 30 de ore pe săptămână, zilele ultime nu mai ajung să fie alocate orelor respective).
Rămâne să vedem cum speculăm schedule.R, pentru a obţine un set de 100 (sau 200) de distribuţii pe zile ale încadrării date, urmând să le comparăm cumva pentru a depista una care să fie „promiţătoare”.
vezi Cărţile mele (de programare)