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

Noul orar (partea a treia)

limbajul R | orar şcolar
2024 oct

[1] Noul orar (partea întâia) (v. și "partea a doua")

[2] V.Bazon - De la seturi de date și limbajul R, la orare școlare (Google Books)

[3] V. Bazon - Orare școlare echilibrate și limbajul R (Google Books)

Montarea zilelor, pe lecțiile prof | cls

Pentru a obține o repartizare pe zile, aproape echilibrată, a lecțiilor cls|prof din orarul curent lăsat de [1], vom folosi programul by_days.R, adus din [2] (împreună cu matricea permutărilor de 1:5) în directorul curent:

## x7.R ##
library(tidyverse)
LSS <- readRDS("orar_8.RDS") %>%
       select(cls, prof)   # 826 lecții cls|prof (de tip 'chr')
load("Tw12.Rda")  # dependențele între lecții, Tw1 și Tw2
perm_zile <- readRDS("lstPerm47.RDS")[[2]]  # permutările de 1:5 (zile)
Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi")
source("by_days.R")  # mount_days_necup() și mount_days_cup()

prnTime <- function(S="")  # pentru a estima și afișa timpii de execuție
    cat(strftime(Sys.time(), format="%H:%M:%S"), S)
    
LS1 <- LSS %>% filter(! prof %in% c(names(Tw1), names(Tw2)))
    # nrow(LS1)  ## 658 linii (cei ne-angajați în cuplaje)
LS2 <- anti_join(LSS, LS1, by=c('cls', 'prof'))
    # nrow(LS2)  ## 168 linii (cei numiți în Tw1 și Tw2)
while(TRUE) {  # repartizează cvasi-omogen lecțiile necuplate
    prnTime()
    R1 <- mount_days_necup(LS1) # etichetează cu zile, pe clase
    prnTime("\n")
    s1 <- addmargins(table(R1[c('prof','zl')]))["Sum", 1:5] %>%
          as.vector()
    print(s1)
    if(diff(range(s1)) <= 2) break;
}
saveRDS(R1, "R1.RDS")  # [1] 132 131 132 132 131  (8 min.)

Am iterat mount_days_necup() până când în R1 avem o repartiție „echilibrată” pe zile, a lecțiilor celor care nu sunt membri în vreun cuplaj — ajungând în cazul de față chiar la o distribuție uniformă (cu 132 sau 131 ore/zi); am notat aici și timpul (8 min.), dar dacă repetăm execuția programului, timpul va fi poate mai mic sau poate mai mare, fiindcă alocarea pe zile asumă ordini aleatoare de parcurgere a claselor și profesorilor:

> source("x7.R")
07:36:53 *************************** 07:36:58 
[1] 134 129 131 130 134  # R1 cu diferență de 5 ore între două zile
07:36:58 *************************** 07:37:14 
[1] 131 133 132 130 132  # a doua repartiție R1, neomogenă
07:37:14 *************************** 07:37:19 
[1] 130 133 131 131 133  # a treia repartiție R1, neomogenă
# ș.a.m.d. (pe parcursul a vreo 8 minute)

Totdeauna (cum am arătat în [2] și [3]), R1 este o repartiție omogenă pe fiecare clasă în parte (la fiecare clasă, numărul de ore/zi diferă cu cel mult 1, de la o zi la alta) și este "cvasi-omogenă" pentru fiecare profesor neangajat în cuplaje (adică diferența de la o zi la alta a numărului de ore ale sale este de cel mult două ore). Dar este de așteptat ca aceste aspecte de omogenitate să se deterioreze într-o anumită măsură, după ce vom adăuga și o repartiție R2 a lecțiilor celor angajați în cuplaje:

while(TRUE) {  # repartizează lecțiile cuplajelor și membrilor acestora
    prnTime()
    R2 <- mount_days_cup(LS2) # etichetează cu zile, pe clase
    prnTime("\n")
    s2 <- addmargins(table(R2[c('prof','zl')]))["Sum", 1:5] %>%
          as.vector()
    print(s2)
    if(diff(range(s2)) <= 1) break;
}
saveRDS(R2, "R2.RDS")  # [1] 34 34 33 33 34  (35 sec.)

Am iterat mount_days_cup() până când în R2 avem o repartiție omogenă pe zile (cu 34 sau 33 ore/zi), a lecțiilor cuplajelor și membrilor acestora (timpul de execuție este mult mai mic decât în cazul R1, fiindcă pentru lecțiile celor din cuplaje alocarea pe zile decurge liniar).

În mount_days_cup() ne-am putut asigura doar că numărul total de ore/zi la fiecare clasă este cuprins între 5 și 8 — rezultând și distribuții neomogene (precum la clasa 10D: 6 8 5 8 5 ore/zi); în plus (fiindcă s-a procedat "liniar", fără condiții asupra distribuțiilor individuale) unii dintre membrii cuplajelor au căpătat distribuții neomogene:

     En5  # membru în cuplajul En5En1 (cu 5 ore "pe grupe", la clasa 11A)               
[1,] "11A 11A 10B 9F 9F"  # Lu: 5 ore
[2,] "11A 10B 8A"       
[3,] "10F 11A"            # Mi: 2 ore
[4,] "11A 10F 8A"       
[5,] "11A 10F 11A 9F"   

Precizăm că atunci când (v. [3]) am conceput "liniar" mount_days_cup(), mizam pe „reparații” interactive; de exemplu, la En5 putem transfera o lecție a clasei 9F din ziua Lu în ziua Mi — rezultând o distribuție uniformă: 4 3 3 3 4 ore/zi și îndreptând în plus, distribuția celor trei ore cu 9F (inițial erau două Lu și una Vi, iar acum sunt câte una pe zi).

Având repartizate pe zile (relativ "echilibrat") toate cele 826 de lecții din setul LSS — să ne amintim că avem și un set de tuplaje, constituit în [1] pentru lecțiile de "Muzică" și "Desen"; reunim în R12 cele trei repartizări:

source("orar_partial.R")  # v. [1]
VM <- orar_partial_vm() %>% rename(zl = zi)  # tuplajele (Ds1, Mz1), pe zile
R12 <- R1 %>% rbind(R2) %>% rbind(VM)  # 836 linii
saveRDS(R12, "R12.RDS")

De observat că a trebuit să redenumim "zi" cum lăsase orar_partial_vm(), prin "zl" cum avem în by_days.R (mai potrivit: "zi lucrătoare").
Acum, adăugând și lecțiile din VM, se poate ca unele dintre clasele implicate în tuplaje să cumuleze 9 ore/zi.

Putem verifica imediat, distribuția pe zile pentru R1, R2, VM și respectiv R12:

addmargins(table(R1$zl) %>%
           rbind(table(R2$zl)) %>% rbind(table(VM$zl))) %>% print()
         Lu  Ma  Mi  Jo  Vi Sum
    .   132 131 132 132 131 658
         34  34  33  33  34 168
          2   2   2   2   2  10
    Sum 168 167 167 167 167 836

Putem lăsa lucrurile așa, trecând direct la alocarea pe ore a lecțiilor fiecărei zile; dar… în R1 au rămas distribuții individuale cvasi-omogene, iar în R2 au rămas unele distribuții (ca aceea redată mai sus pentru En5) ne-omogene; în plus, avem clase care într-o zi au 8 ore (poate, în urma cumulării, chiar 9) și în alta au 5 ore.
Vom repara interactiv aceste defecte (folosind consola $\mathbf{R}$); instrumentul de bază va fi o funcție prin care să putem muta o lecție dintr-o zi în alta. În principiu, vom muta numai lecții care nu aparțin cuplajelor (nici tuplajelor), iar scopul mutării este acela de a uniformiza diverse distribuții individuale, sau distribuții ale lecțiilor unei clase; de regulă, vom muta între două zile și într-un sens și în celălalt — încât să menținem uniformitatea de repartizare pe zile, existentă din start în R12.
De observat că diversele mutări vor schimba compoziția seturilor R1 și R2; dar dacă ar fi cazul, putem abandona toate mutările efectuate deja și… putem s-o luăm de la capăt, reconstituind setul inițial R12 din fișierele "R1.RDS" și "R2.RDS".

Ajustarea interactivă a repartizării pe zile

Înființăm un nou program, în care preluăm de prin [2] (cu unele adaptări) o serie de funcții care ne vor ușura ajustarea interactivă a distribuțiilor de lecții din R12:

## x8.R ##
rm(list=ls())  # elimină variabilele păstrate din sesiunea anterioară
library(tidyverse)
Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi")
load("Tw12.Rda")  # dicționarele Tw1 și Tw2
twins <- c(names(Tw1), names(Tw2), "Ds1", "Mz1")

R1 <- readRDS("R1.RDS")
Profs <- setdiff(unique(R1$prof), twins) # neangajați în cuplaje/tuplaje
rm(R1)  # de-acum nu mai avem nevoie de R1 și R2

R12 <- readRDS("R12.RDS")  %>% mutate(prof = as.character(prof))
> str(R12)
    'data.frame':	836 obs. of  3 variables:
     $ cls : chr  "10A" "10A" "10A" "10A" ...
     $ prof: chr  "Gr3" "Gr3" "Gg1" "Ch2" ...
     $ zl  : Factor w/ 5 levels "Lu","Ma","Mi",..: 3 2 1 4 5 3 2 1 4 5 ...

În mod tacit, "by_days.R" transformase prof în factor; pentru necesitățile de acum, am revenit la tipul de bază "chr".

Prin următoarea funcție vom realoca o lecție aflată în R12, din ziua inițială într-o altă zi:

change_zl <- function(P, Q, Z, new_zl) {
    wh <- which(with(R12, prof==P & cls==Q & zl==Z) == TRUE)
    if(length(wh) > 1) wh <- wh[1] # mută numai una dintre orele existente
    R12[wh, "zl"] <<- new_zl
}

Am avut grijă ca în cazul când în ziua respectivă, P are mai multe ore la clasa Q (cum avem în cazul redat mai sus: En5 are două ore la 9F în ziua Lu), să mutăm una singură dintre acestea; bineînțeles că, R12 fiind în exteriorul funcției, am folosit în final operatorul "<<-" (de „atribuire globală”).

Am văzut mai sus că mutând o lecție 9F | En5 din ziua Lu în ziua Mi, rezolvăm două aspecte: distribuția lecțiilor lui En5 devine omogenă; iar cele 3 ore la 9F ale lui En5 ajung în zile diferite, câte una pe zi. Numai că trebuie să căutăm și o mutare „inversă”, din ziua Mi în ziua Lu — pentru a păstra omogenitatea globală a distribuției pe zile.
Investigând (prin funcția see_cls() de mai jos) distribuțiile membrilor cuplajelor, găsim și distribuția neomogenă:

     TI1  # membru în cuplajul In1TI1 (cu 3 ore "pe grupe", la clasa 11B)               
[1,] "10C 11D 12F"        
[2,] "11B 10D 11B 12F"    
[3,] "11B 11B 10C 10E 11F"
[4,] "10D 10E 11D"        
[5,] "10C 10E 11F"        

și observăm că dacă mutăm 10E din ziua Mi în ziua Lu, distribuția lui TI1 devine și ea, omogenă (4 4 4 3 3). Prin urmare, efectuăm schimbările respective:

> change_zl("En5", "9F", "Lu","Mi")
> change_zl("TI1", "10E", "Mi","Lu")

Următoarea funcție redă distribuțiile acelor clase pentru care diferența dintre cel mai mare și cel mai mic număr de ore/zi are valoarea indicată ca argument:

cls_diff_hours <- function(d)
    table(R12[c('cls','zl')]) %>%
        apply(., 1, function(row) if(diff(range(row)) == d) row) %>%
        compact() %>% list2DF() %>% as.matrix() %>%
        t() %>% `colnames<-`(Zile)

Desigur, am vrea ca diferența menționată să fie 0 sau 1 (adică, să fie omogenă) și vom avea de ajustat, în cazurile când este 2 sau 3:

do.call(rbind, lapply(3:2, cls_diff_hours)) %>% print()
        Lu Ma Mi Jo Vi        Lu Ma Mi Jo Vi
    10A  8  7  7  5  6    11C  6  5  6  6  7
    10B  7  6  5  7  8    11D  6  7  6  5  6
    10D  6  8  5  8  5    11F  5  5  6  7  7
    12E  5  5  6  8  6    12A  5  7  5  7  5
    8A   5  8  7  6  7    12B  7  6  6  5  6
    9A   7  5  8  6  7    12C  5  6  7  6  6
    9E   9  7  7  6  6    12D  7  6  7  5  5
    10C  6  7  6  5  6    12F  6  7  5  6  6
    10E  6  5  7  7  5    6A   6  7  5  6  6
    10F  5  6  6  7  6    7A   7  6  6  8  6
    11A  7  5  5  6  7    9D   7  6  5  6  7
    11B  5  7  7  5  6    9F   7  5  7  5  6

Pentru a omogeniza distribuția la o clasă, avem de mutat lecții dintr-o zi în alta; de exemplu, pentru clasa 9E (singura la care s-au cumulat din R1, R2 și VM, 9 ore într-o zi), ar fi de mutat două lecții din ziua Lu în zilele Jo și Vi (rezultând câte 7 ore/zi). Dar dacă lecția pe care o mutăm există și în ziua-destinație, atunci mai bine renunțăm la mutarea respectivă (am încălca principiul „o singură oră/zi, pe un același obiect”).

Avem deci nevoie de o funcție care să indice profesorii clasei care au ore într-o zi, dar nu și în cealaltă:

diff_prof <- function(Cls, z1, z2) { # Zile, nu indecși numerici
    Q <- R12 %>% filter(cls == Cls & zl %in% c(z1, z2)) %>%
         droplevels() %>% split(.$zl)
    Pr <- setdiff(Q[[z1]]$prof, Q[[z2]]$prof)
    NH <- table(R12[c('prof', 'zl')])[Pr, ]
    if(length(Pr) == 1) { # evită 'array' unidimensional
        dim(NH) <- c(1, 5)
        dimnames(NH) <- list(Pr, Zile)
    }
    NH  # distribuțiile celor cu ore la clasa Cls în ziua z1, dar NU și în z2
}

droplevels() a fost necesar fiindcă altfel, split() ar fi asociat seturi (vide) și valorilor ignorate ale factorului $zl; ar fi fost incorect să referim prin indecși numerici, Q[[1]] în loc de Q[[z1]]: dacă z1="Ma" și z2="Lu", atunci Q[[1]] ar viza Lu și nu Ma !

Pentru ajustarea distribuției pe zile a lecțiilor unei clase, afișăm distribuția curentă a acesteia (dată de funcția locală distr_cls()) și așteptăm ca utilizatorul să indice ziua Z1 din care ar vrea să mute una dintre lecții și ziua-destinație Z2; apoi afișăm matricea returnată de diff_prof(), a profesorilor cu lecții la clasa respectivă în Z1 dar nu și în Z2 și așteptăm ca utilizatorul să aleagă și să indice pe cel căruia să-i realocăm lecția (evidențiem pe ecran unele indicații, folosind funcții din pachetul cli):

recast12 <- function(K) { # ajustează distribuția pe zile a clasei
    distr_cls <- function(Cls)
        R12 %>% filter(cls == Cls) %>% count(zl) %>% pull(n)
    H <- distr_cls(K) # afișează clasa și distribuția curentă a ei
    cat(cli::style_bold(K), paste0(H, collapse=" "), "\n")
    cat(cli::col_blue("index Z1 și index Z2: "))
    Z <- readLines("stdin", n=1) # așteaptă indecșii z1 și z2
    Z <- strsplit(Z, " ") %>% unlist() %>% as.integer()
    z1 <- Zile[Z[1]]; z2 <- Zile[Z[2]]
    cat(cli::col_blue(z1), "-->", cli::col_blue(z2))
    NH <- diff_prof(K, z1, z2)
    print(NH) # distribuțiile celor cu ore la K în z1, dar nu și în z2
    cat(cli::col_blue("index-prof, de mutat "), "(0 = Cancel): ")
    id <- readLines("stdin", n=1) |> as.integer()
    if(!is.na(id) & id > 0 & id <= nrow(NH)) {
        change_zl(row.names(NH)[id], K, z1, z2)
        cat('\t', distr_cls(K), '\n\n') # confirmă ajustarea
    }
}

De exemplu, instrumentarea omogenizării distribuției la clasa 9E decurge astfel:

> source("x8.R")
> recast12("9E")
9E 9 7 7 6 6  # distribuția inițială (în setul R12 curent)
index Z1 și index Z2: 1 4
Lu --> Jo     zl      # distribuțiile celor care la 9E au ore Lu, dar nu și Jo
prof  Lu Ma Mi Jo Vi
  Ro2  3  4  3  4  4
  Lg1  3  2  1  1  2
  Fz1  5  4  3  4  5
  Sp1  5  4  3  4  4
  En1  3  3  4  3  3
  Mz1  2  3  2  2  1
index-prof, de mutat (0 = Cancel): 2
	 8 7 7 7 6   # după mutarea lecției Lg1|Lu în ziua Jo
> recast12("9E")
9E 8 7 7 7 6 
index Z1 și index Z2: 1 5
Lu --> Vi     zl
prof  Lu Ma Mi Jo Vi
  Sp1  5  4  3  4  4
  En1  3  3  4  3  3
  Mz1  2  3  2  2  1
index-prof, de mutat (0 = Cancel): 1
	 7 7 7 7 7   # după mutarea lecției Sp1|Lu în ziua Vi

Dar e bine ce am făcut astfel ? Nu chiar — distribuția globală a devenit neomogenă: a scăzut cu două ore în ziua Lu și a crescut cu câte o oră pe Jo și Vi, devenind 166 167 167 168 168. Pentru îndreptare, ar fi suficient să mutăm o lecție din Jo sau din Vi, în ziua Lu; căutăm în lista afișată mai sus, a claselor la care avem de omogenizat distribuția, o clasă care ar fi potrivită pentru o asemenea mutare:

> recast12("12A")
12A 5 7 5 7 5 
index Z1 și index Z2: 4 1
Jo --> Lu        zl
prof     Lu Ma Mi Jo Vi
  Ro5     3  3  4  4  2
  Sp2     3  3  3  3  5
  En4En2  1  3  2  3  1
  Gr2     0  1  0  1  0
index-prof, de mutat (0 = Cancel): 0

Pentru 12A nu este convenabilă vreo mutare Jo-->Lu (ignorăm pe cât putem, membrii cuplajelor — deci ultimele două linii; iar distribuțiile de pe primele două linii nu s-ar îmbunătăți, prin mutarea respectivă). Căutăm o altă clasă:

> recast12("11F")
11F 5 5 6 7 7 
index Z1 și index Z2: 4 1
Jo --> Lu     zl
prof  Lu Ma Mi Jo Vi
  Mt2  4  6  4  6  5
  Gg2  2  2  2  3  2
  En3  3  3  3  3  4
index-prof, de mutat (0 = Cancel): 1
	 6 5 6 6 7 

Mutând la 11F o lecție Mt2|Jo în ziua Lu, se îmbunătățește și distribuția clasei și aceea a profesorului, iar distribuția globală devine din nou, uniformă.

Desigur, ne ia ceva timp, procedând ca mai sus, pentru a omogeniza distribuțiile tuturor claselor (păstrând omogenitatea pentru distribuția globală); inerent, se vor îmbunătăți (sau chiar, se vor uniformiza) și unele distribuții individuale. Dacă vrem, putem fragmenta operațiile între mai multe sesiuni de lucru interactiv — salvând din când în când rezultatele schimbărilor de lecții (prin saveRDS(R12, "R12.RDS")).

Lucrând fără grabă, având poate și ceva inspirație pentru alegerea clasei la fiecare pas — ne-a luat cam o oră (în două sesiuni de lucru) pentru a pune la punct distribuțiile tuturor claselor. Spre final, prin cls_diff_hours() mai aveam de omogenizat distribuția unei singure clase și abia acum, a devenit necesară și ceva ingeniozitate: distribuția respectivă era 5 7 7 5 6 și am găsit mutări convenabile de lecții "Ma-->Lu" și "Mi-->Jo" — dar… cum să păstrăm și acum, omogenitatea globală ?
Am căutat o clasă printre cele cu distribuții omogene care să aibă Lu 7 ore și Ma 6 ore, pentru care am putut face o mutare "Lu-->Ma" (inversă primeia de mai sus); apoi, am procedat analog și pentru o schimbare "Jo-->Mi". Distribuția globală s-a schimbat, dar a rămas omogenă.

Mai rămân de omogenizat unele distribuții individuale; următoarea funcție tabelează distribuțiile individuale cu un total mai mare de 6 ore (pentru cei cu puține ore, cel mult 6, ar fi de dorit distribuții neomogene) și care la momentul curent sunt neomogene, pentru profesorii care nu fac parte din vreun cuplaj:

see_bad_distrib <- function() {
    tpz <- table(R12[c('prof', 'zl')])
    NU <- apply(tpz, 1, function(H) 
              if(sum(H) > 6 & diff(range(H)) >= 2) H)
    NU <- NU %>% compact() %>% list2DF()
    Prof <- setdiff(names(NU), twins) # care au numai ore proprii
    NU %>% select(all_of(Prof))
}
> see_bad_distrib()  # distribuții individuale rămase de omogenizat
  Ec1 Fz1 Fz2 Gg1 Is1 Mt1 Mt3 Mt4 Ro1 Ro2 Ro4 Ro5 Sp1
1   5   5   3   5   4   4   4   4   5   3   4   4   4
2   3   4   4   5   4   6   4   5   4   5   3   2   4
3   3   3   4   3   5   5   6   4   3   3   5   4   3
4   3   4   4   5   3   5   4   5   5   4   5   3   4
5   4   5   5   4   4   5   5   3   5   3   4   3   5

Pentru unele dintre distribuțiile afișate există câte o primă mutare de încercat, în vederea omogenizării; de exemplu, la Sp1 am vedea întâi mutarea Vi-->Mi, care dacă este convenabilă, conduce la o distribuție cu câte 4 ore/zi — dar apare bineînțeles, problema de a găsi la unul sau altul, convenabil, o mutare inversă Mi-->Vi (pentru a păstra omogenitatea globală).

Pentru a preveni problemele care apar din necesitatea de a împerechea o mutare într-un sens cu mutarea inversă, imaginăm un interschimb de lecții între doi profesori: în principiu, pentru a retușa distribuția curentă a unui profesor oarecare P (dar nu unul „fictiv”), îi mutăm o clasă Cls aflată într-o zi z1 în care are mai multe ore, într-o zi z2 în care are mai puține ore (dar nu și la clasa Cls); totodată îndreptăm invers clasa respectivă, din ziua z2 în ziua z1, la unul dintre profesorii din afara vectorului twins, care are în ziua z1 cel puțin tot atâtea ore (dar nu și la Cls) ca în ziua z2.

Avem nevoie întâi de o funcție care să afișeze pe zile, clasele repartizate lui P:

see_cls <- function(P)
    R12 %>% filter(prof %in% P) %>% split(.$zl) %>%
    map(function(Oz) paste(Oz$cls, collapse=" ")) %>%
    list2DF() %>% t() %>% `colnames<-`(P[1]) %>% `rownames<-`(NULL)

(am folosit deja această funcție, când am redat mai sus, distribuția pe zile a lecțiilor lui TI1)

Următoarea funcție mapează see_cls() pe lista acelor profesori P1 din afara vectorului twins, cu care P ar putea schimba o clasă și o zi, fără ca prin aceasta distribuția lui P1 să fie „degradată” (să devină neomogenă):

see_swaps <- function(P, z1, z2) {
    LS <- R12[R12$prof == P, ] %>% as.data.frame()
    C1 <- LS[LS$zl==z1, 2] # clasele lui P în z1
    C2 <- LS[LS$zl==z2, 2] # clasele lui P în z2
    map(setdiff(Profs, P), function(P1) {
        DS <- R12[R12$prof == P1, ] %>% as.data.frame()
        K2 <- DS[DS$zl==z2, 2] # clasele lui P1 în z2
        K1 <- DS[DS$zl==z1, 2] # clasele lui P1 în z1
        if(length(K2) < length(K1)) return(NULL)
        if(! length(intersect(setdiff(C1, C2), setdiff(K2, K1))))
            return(NULL)
        return(see_cls(P1)) # distribuția claselor lui P1
    }) %>% compact()
}

Angajând aceste două funcții, putem instrumenta interschimbarea interactivă între lecții din două distribuții individuale (în scopul omogenizării distribuției claselor unui profesor dat) astfel:

recast_by_swap <- function(P) { # interschimb între distribuții individuale
    Dp <- see_cls(P)
    print(Dp, quote=FALSE) # distribuția "verticală" a lui P
    cat(cli::col_blue("Mutăm o clasă - din care Z1 în care Z2: "))
    Z <- readLines("stdin", n=1) # așteaptă indecșii z1 și z2
    Z <- strsplit(Z, " ") %>% unlist() %>% as.integer()
    cls_ds <- setdiff(strsplit(Dp[Z[1]], " ")[[1]],
                      strsplit(Dp[Z[2]], " ")[[1]]) # evită 2 ore/zi/cls
    z1 <- Zile[Z[1]]; z2 <- Zile[Z[2]]
    cat(cli::col_blue(" Interschimbăm cu unul dintre profesorii:\n"))
    W <- see_swaps(P, z1, z2)
    stopifnot("nu există candidați"= length(W) > 0)
    for(j in seq_along(W)) {
        cat(cli::style_bold(j), ": ",
            cli::col_blue(attr(W[[j]], "dimnames")[[2]]), sep="")
        rw <- unlist(W[[j]])
        for(i in 1:5) cat("\n", rw[i]) # distribuțiile pentru Pj
        cat("\n")
    }
    cat("\n", cli::col_blue("Mutăm una dintre clasele "), cls_ds,
        cli::col_blue(" din "), z2, cli::col_blue(" în "), z1, "\n",
        cli::col_blue(" la al câtelea profesor (0 to Cancel): "))
    ip <- readLines("stdin", n=1) |> as.integer()
    if(!is.na(ip) && ip %in% 1:length(W)) {
        Pj <- attr(W[[ip]], "dimnames")[[2]]
        cat(cli::col_blue("Clasa de interschimbat între ", P,
            " și ", Pj, ": "))
        Cls <- readLines("stdin", n=1) |> as.character()
        stopifnot("trebuia ales dintre clasele indicate"=
                    Cls %in% cls_ds)
        change_zl(P, Cls, z1, z2)
        change_zl(Pj, Cls, z2, z1)
        cat(cli::col_blue("După interschimbare:\n"))
        res <- table(R12[c('prof', 'zl')])
        print(res[c(P, Pj), ])
    }
}

Iată cum ar decurge omogenizarea prin interschimbare a distribuției lecțiilor lui Sp1:

> recast_by_swap("Sp1")
     Sp1  # distribuția curentă: 4 4 3 4 5 ore/zi             
[1,] 10A 11E 6A 9F   
[2,] 10C 11B 5A 8A   
[3,] 10C 11D 7A      
[4,] 10A 12F 6A 8A   
[5,] 12C 12E 5A 7A 9E
Mutăm o clasă - din care Z1 în care Z2: 5 3
 Interschimbăm cu unul dintre profesorii:
1: Mt4                    2: Fr1                  3: Ro4
 10B 11C 11D 12E          10C 10E 11C 12E 9E      12C 12E 5A 8A
 10B 11C 11D 11E 12E      10C 11C 12C 9E          12E 5A 8A
 10B 11C 11E 12E          10C 12C 9E 9E           11C 12C 12E 5A 8A
 10B 11C 11D 11E 12E      10E 11E 9E 9E           11C 12C 12E 5A 8A
 11C 11D 11E              11E 12E 9E 9E           11C 12C 12E 8A
4: In4                    5: Is3
 11C 11E 12C 9F
 11C 12C 7A 9E            12B
 11C 12C 12C 5A 9E        12E
 11C 12C 5A 7A 9E         12C 12D
 11C 11E 12C 9F
 Mutăm una dintre clasele  12C 12E 5A 9E  din  Mi  în  Vi 
  la al câtelea profesor (0 to Cancel): 4
Clasa de interschimbat între Sp1 și In4: 9E
După interschimbare:
prof  Lu Ma Mi Jo Vi
  Sp1  4  4  4  4  4
  In4  4  4  4  5  5

După ce, aplicând recast_by_swap() fiecăruia din lista afișată din timp în timp de see_bad_distrib(), reușim să omogenizăm toate distribuțiile individuale cu mai mult de 6 ore — să ne gândim și la cei din afara cuplajelor care au puține ore (cel mult 6); obținem lista acestora printr-o copie a funcției see_bad_distrib() în care doar reducem condiția de sub apply() la if(sum(H) <= 6):

  CD1 CD2 eS1 Fl1 Fz4 Fz5 Gg3 Is3 Mt6 Mt7 Rl2 Ro6 Sp4 TI2
1   2   0   1   1   0   2   2   0   1   1   0   1   0   0
2   1   0   0   2   2   0   0   2   1   1   2   2   2   0
3   0   1   1   0   2   2   2   0   1   1   2   1   0   0
4   2   0   1   1   0   2   2   2   1   1   0   1   0   1
5   0   0   1   2   2   0   0   0   1   1   2   1   0   0

Cine are puține ore, preferă de obicei să și le facă în cât mai puține zile (și nu câte una pe zi); dar… trebuie să ne gândim și la clase. Mt6 are numai 5 ore, dar toate la o aceeași clasă (la fel, Mt7); dacă le-am repartiza în mai puțin de 5 zile, clasa respectivă ar avea într-o zi cel puțin două ore de "Matematică", ceea ce ar excepta de la principiile de echilibrare pe care le-am asumat.

Ro6 are numai 6 ore și acestea ar putea fi grupate în două sau trei zile; prin recast_by_swap("Ro6") vedem distribuția pe zile și clase: "9F | 10F 12B | 12B | 12B | 12B"; fiindcă 4 dintre cele 6 ore sunt la o aceeași clasă (12B), nu putem accepta o repartizare cu mai puțin de 4 zile; găsim totuși un profesor cu care Ro6 poate interschimba clasa 12B din ziua Vi în ziua Lu, încât Ro6 capătă o distribuție mai bună 2 2 1 1 0.
Am mai putut reduce numărul de zile la Fl1; pentru Es1 n-am găsit o interschimbare acceptabilă, iar pentru ceilalți, câte 2 ore/zi, în cel mult 3 zile este deja acceptabil.

Ar mai fi de verificat distribuțiile cumulate de membrii cuplajelor:

for(P in names(Tw1))
    see_cls(c(P, Tw1[[P]])) %>% print()

Găsim distribuție neomogenă la unul singur dintre membrii cuplajelor:

     En4             
[1,] "10A 9A 10A"    
[2,] "10A 12A 12A 9A"
[3,] "10A 12A 9A 10A"
[4,] "10A 12A 12A 9A"
[5,] "10A 9A"        

En4 intră la 12A în cuplaj cu En2; mutând En4En2|12A | Jo-->Vi distribuția la En4 se omogenizează, iar la En2 se menține omogenă. Listând lecțiile pe Vi la 12A, găsim că putem muta invers "Vi-->Jo" (păstrând omogenitatea), lecția lui Ch2. Prin urmare, putem omogeniza și distribuția lui En4, direct:

> change_zl("En4En2", "12A", "Jo", "Vi")
> change_zl("Ch2", "12A", "Vi", "Jo")

De observat excepția rămasă: 12A face într-o aceeași zi două ore cu En4En2 (inițial în 2 zile, dar după omogenizarea efectuată mai sus, într-o singură zi); probabil că am putea „corecta”, mutând En4En2|12A | Ma-->Lu, dar… să acceptăm și noi o excepție.

Subliniem că membrii cuplajelor au câte cel mult 6 ore/zi, încât nu-i cazul să ne gândim și la situația (v. [3]): cumulând orele proprii cu cele din cuplaje, are într-o zi 7 ore, dar niciuna dintre clasele respective nu ajunge în acea zi la ora a 7-a…

În final, avem în R12.RDS o repartiție pe zile a lecțiilor prof|cls care este omogenă cam din toate punctele de vedere: și pe zile, și pe clase și pe fiecare profesor cu mai mult de 6 ore; iar cei cu cel mult 6 ore au lecțiile grupate într-un număr restrâns de zile, după caz.

Dar, fiindcă am avut în vedere numai criteriul omogenității (fără a căuta și vreo corelație mai subtilă între profesori, sau între clase) – este posibil ca orarul care va rezulta după repartizarea pe ore pentru fiecare zi, a lecțiilor respective, să nu fie „cel mai bun” (obligând poate, apariția unui număr de ferestre care nu mai poate fi redus la o limită acceptabilă, fără a mai modifica repartiția pe zile existentă).

Sintetizarea repartizării pe zile

Folosind (cum am întâlnit și mai sus) table() (și addmargins()), putem verifica dacă distribuțiile pe profesori și respectiv pe clase, sunt într-adevăr omogene; dar poate vrem să vedem mai mult decât numărul de ore/zi…

Următoarea funcție „vizualizează” într-un tabel clasele repartizate profesorilor (sau unui subset al acestora) în fiecare zi (într-un format "Tab Separated Values"):

tidy_as_tsv <- function(D) { # pe un set de lecții
    D <- D %>% mutate(prof = factor(prof)) %>% arrange(prof)
    Dz <- D %>% split(.$zl)
    Z <- map(Zile, function(z) {
             map_dfr(Dz[[z]] %>% split(.$prof), function(L)
                  data.frame(prof = L$prof[1],
                             cls = paste(L$cls, collapse=" "))
             )
         }) %>% setNames(Zile)
    data.frame(prof = levels(D$prof), 
               Lu = Z$Lu$cls, Ma = Z$Ma$cls, Mi = Z$Mi$cls, 
               Jo = Z$Jo$cls, Vi = Z$Vi$cls)
}

De exemplu, să vedem repartizarea pe zile a lecțiilor de "Română":

Ro <- tidy_as_tsv(R12 %>% filter(grepl("Ro", prof)))
sink("Ro.txt")
    print(Ro, row.names=FALSE, print.gap = 2, width = 120)
sink()
prof                 Lu             Ma              Mi                 Jo                 Vi
 Ro1  10B 11B 11E 6A 7A  11D 11E 7A 7A   10B 11E 6A 7A      11B 11D 6A 7A  10B 11B 11D 6A 7A
 Ro2     10E 10F 11F 9E  10F 11F 9E 9F       10E 9E 9F     10E 10F 11F 9F          10F 9E 9F
 Ro3          12F 9A 9B     11A 12F 9A   10A 12F 9A 9B      10A 11A 9A 9B     10A 11A 12F 9B
 Ro4      12C 12E 5A 8A  11C 12E 5A 8A   12C 12E 5A 8A  11C 12C 12E 5A 8A     11C 12C 12E 8A
 Ro5         10C 10D 9D     12A 12D 9D  10C 12A 12D 9D         10C 10D 9D        10D 12A 12D
 Ro6             12B 9F        10F 12B             12B                12B                   

Am scris într-un fișier (prin sink()), fiindcă lungimea rândului de date este totuși prea mare (aproape 120 caractere) pentru consolă; alternativa era să scriem Ro[, 1:4] și dedesubt, Ro[, c(1,5,6)] — neconvenabilă însă, dacă în loc de Ro am viza tot setul R12.

Subliniem că pentru fiecare prof și zi, clasele repartizate sunt afișate în ordine alfabetică (nicidecum, în ordinea orelor zilei…), cu aliniere la dreapta.

vezi Cărţile mele (de programare)

docerpro | Prev |