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

Chestiunea cuplajelor existente în orarul şcolar (IV)

R | orar şcolar
2021 nov

Cu daySchoolSchedule.R din [2], putem genera foarte rapid orarele zilnice (având repartiţia lecţiilor pe zile), dar fără să ţinem seama de semnificaţia profesorilor fictivi (introduşi în [1] pentru mascarea lecţiilor cuplate); pentru a corecta imediat poziţia cuplajelor, vom folosi deocamdată aplicaţia interactivă "dayRecast.html" (v. /dayRecast şi github). Apoi, vom completa programul "recast.R" din [3], astfel încât reducerea de ferestre din orarul rezultat să ţină seama şi de situaţiile de cuplare.

Generarea orarelor zilnice (ignorând cuplajele)

Cu prilejul acestei noi încercări, începem să reorganizăm lucrurile; întâi, eliminăm din fişierele "daySchoolSchedule.R" şi "recast.R", diversele funcţii utilitare comune (cnt_holes(), get_betweenness(), orarByProf() şi altele) – plasându-le pe toate într-un fişier separat, "stmt_utils.R" (în care am inclus şi library(tidyverse)).

Reformulăm programul din [2], restrângându-l la funcţia mount_hours(), prin care lecţiile prof|cls dintr-o aceeaşi zi vor fi etichetate cu orele 1..7 ale zilei (astfel încât să se evite suprapunerile şi profesorii să nu aibă mai mult de două ferestre):

# daySchoolSchedule.R
source("stmt_utils.R")  # cnt_holes(), get_betweenness(), orarByProf(), etc.

Pore <- readRDS("lstPerm47.RDS")  # lista matricelor de permutări 4..7 (ore)
nGaps <- 24  # maximum convenit pentru totalul ferestrelor

# etichetează cu .$ora, lecţiile prof|cls ale zilei, astfel încât
# fiecare profesor are zero, una sau cel mult două ferestre
mount_hours <- function(lessons) {
    btw_prof <- get_betweenness(lessons, 1) %>% sort()
    btw_cls <- get_betweenness(lessons, 2) %>% sort()  
    task <- lessons %>%
            mutate(prof = factor(prof, 
                   levels = names(btw_prof), ordered=TRUE)) %>%
            arrange(prof, cls)
    hBits <- rep(0L, nlevels(task$prof))  # alocările de ore (biţi) la profesori
    names(hBits) <- levels(task$prof)
    Z <- task %>% split(.$cls)  # desparte lecţiile după clasă
    lstCls <- names(Z)
    btw_cls <- btw_cls[lstCls]    

    mountHtoCls <- function(Q) {  # alocă pe 1..7, lecţiile unei clase
        mpr <- Pore[[nrow(Q)-3]]  # matricea de permutări corespunzătoare clasei
        bhp <- bith[Q$prof]  # biţii alocaţi anterior, profesorilor clasei
        for(i in 1:ncol(mpr)) { 
            po <- mpr[, i]
            bis <- bitwShiftL(1, po - 1)
            if(any(bitwAnd(bhp, bis) > 0)) 
                next  # caută o permutare care să evite biţi '1' alocaţi deja 
            # Dacă un profesor are 2 sau mai multe ore pe zi la aceeaşi clasă
            if(anyDuplicated(names(bhp)) > 0) {
                for(jn in 1:(nrow(Q)-1)) {
                    if(names(bhp)[jn] == names(bhp)[jn+1]) 
                        bis[jn] <- bis[jn+1] <- bis[jn] + bis[jn+1]
                }
            }  # (a comenta, dacă NU există profesor cu 2 ore la clasă) 
            blks <- bitwOr(bhp, bis)  # cumulează biţii vechilor şi noii alocări
            Cond1 <- unlist(lapply(blks, cnt_holes))
            if(any(Cond1 > 2)) next  # controlează numărul de ferestre
            bith[Q$prof] <<- blks
            return(Q %>% mutate(ora = po))  # înscrie orarul clasei curente
        }
        return(NULL)  # pentru clasa curentă NU s-a reuşit un orar "bun"
    } 

    odf <- vector("list", length(lstCls))  # va înregistra orarele claselor
    names(odf) <- lstCls
    while(TRUE) {
        succ <- TRUE
        bith <- hBits  # reiniţializează octeţii de alocare pe orele zilei
        lstCls <- sample(lstCls, prob = btw_cls)
        for(K in lstCls) {
            W <- mountHtoCls(Z[[K]])  # încearcă un orar pentru clasa curentă
            if(is.null(W)) {
                succ <- FALSE 
                break  # abandonează ('for') în caz de insucces
            }
            odf[[K]] <- W  # salvează orarul constituit clasei curente
        }
        if(succ) {
            NG <- sum(unlist(lapply(bith, cnt_holes)))
            cat(NG, " ")  # afişează totuşi, totalul ferestrelor 
            if(NG <= nGaps)
                break  # iese din 'while' (fiind cel mult 'nGaps' ferestre)
        }
    }
    bind_rows(odf)  # returnează orarul lecţiilor zilei (prof|cls|ora)
}

Pentru a obţine orarele pentru lecţiile repartizate anterior pe zile în fişierele "dis_*.RDS" (unde '*' este "Lu", "Ma", etc.), putem formula acum următorul program:

# 5days.R
source("daySchoolSchedule.R")  # tidyverse; "stmt_utils.R"; mount_hours()
days <- c("Lu", "Ma", "Mi", "Jo", "Vi")
orar <- vector("list", 5)
names(orar) <- days
prnTime()  # din "stmt_utils.R"
for(zi in days) {
    lssn <- readRDS(paste0("dis_", zi, ".RDS")) %>%
            mutate(prof = tolower(sub('-','', prof)))
    orar[[zi]] <- mount_hours(lssn)
    prnTime()
}

Am ţinut cont aici (prin tolower() şi sub()) că în repartiţia pe zile preluată din [1] aveam notaţii ca "P25" şi "P08-P25", iar ulterior am adoptat notaţia "p08p25".

Orarele se obţin chiar foarte repede (în condiţiile asumate mai sus) – de exemplu:

 > source("5days.R")
    [1] 18:51:51
    30  26  27  26  30  29  32  30  29  27  34  31  28  24  [1] 18:51:55  # Lu
    26  22  [1] 18:51:56  # Ma  (cu 22 ferestre)
    30  26  32  30  27  27  27  30  27  25  24  [1] 18:52:02  # Mi
    19  [1] 18:52:05  # Jo  (cu 19 ferestre)
    29  37  24  [1] 18:52:07  # Vi  (24 ferestre)
 > saveRDS(orar, file="orar_lst5_7.RDS")

Pentru ziua "Lu" de exemplu, vedem că s-au generat 13 orare înainte de a ajunge (după :51:55-:51:51 = 4 secunde) la unul cu 24 de ferestre. Desigur, repetând o a doua oară execuţia programului "5days.R", va rezulta un alt set de orare zilnice, cu mai multe sau mai puţine generări de orare intermediare şi cu durate care oscilează între câteva secunde şi două-trei minute.

Ajustarea cuplajelor

Subliniem că în mount_hours() am ignorat lecţiile cuplate, încât orarele rezultate ascund anumite suprapuneri de ore… Considerăm orarul unei zile oarecare şi-l redăm într-o formă convenabilă pentru observarea defectelor privitoare la cuplaje:

source("stmt_utils.R")  # orarByProf(), orarByCls(), etc.
Z <- readRDS("orar_lst5_7.RDS")
lu <- Z[["Lu"]]
M <- as.matrix(orarByCls(lu))
print.table(M)
      cls 1      2      3      4   5   6      7  
 [1,] 10A p01p02 p36    p12    p14 p13 p21    p15
 [2,] 10B p32    p18    p09    p22 p05 p15       
 [3,] 10C p38    p07    p05    p25 p35 p16       
 [4,] 10D p31    p12    p16    p09 p21 p19       
 [5,] 10E p34p07 p28    p46    p39 p03 p27    p04
 [6,] 10F p03    p06p33 p45    p11 p20 p35       
 [7,] 11A p25    p01    p35    p40 p23 p20       
 [8,] 11B p28    p01p02 p13    p05 p02 p12       
 [9,] 11C p30    p31    p28    p17 p18           
[10,] 11D p27    p10    p04    p02 p58           
[11,] 11E p11p44 p26    p10    p03 p09           
[12,] 11F p09    p06    p25    p23 p26 p14       
[13,] 12A p01    p30    p01p02 p36 p17 p04       
[14,] 12B p22    p29    p30    p16 p24 p17       
[15,] 12C p29    p23    p42    p18 p19 p07       
[16,] 12D p49    p22    p08    p15 p27           
[17,] 12E p08p47 p08p25 p19    p21 p15 p08p11    
[18,] 12F p12    p20    p06    p04 p07 p26       
[19,] 5G  p06    p46    p17    p56 p04 p45       
[20,] 6G  p50    p42    p56    p08 p45 p24       
[21,] 7G  p62    p24    p21    p32 p40 p33       
[22,] 8G  p61    p14    p20    p13 p46 p56    p05
[23,] 9A  p36    p32    p02    p24 p14 p05       
[24,] 9B  p11    p03    p31    p10 p16 p22       
[25,] 9C  p06p33 p37    p11    p07 p10 p03       
[26,] 9D  p18    p33    p26    p19 p29 p39       
[27,] 9E  p34p09 p38    p03    p27 p39 p13       
[28,] 9F  p37    p08    p23    p45 p33 p10       

Bineînţeles că în fiecare coloană orară 1..7, fiecare dintre profesori apare cel mult o singură dată (nu există suprapuneri de ore); dar "p01p02" de exemplu, este un profesor fictiv – plasarea lui pe ora întâia la 10A însemnând că pentru desfăşurarea acestei ore, 10A este împărţită în două grupe, la care intră respectiv profesorii („reali”) p01 şi p02; desigur că pentru aceasta, atât p01 cât şi p02 trebuie să fie liberi în ora respectivă – ori vedem că p01 este deja fixat pe ora 1 la clasa 12A.
Pentru un alt exemplu, "p06p33" se suprapune în ora a doua (clasa 10F) şi cu p06 (care are oră la 11F) şi cu p33 (care are oră la 9D). La fel, "p34p07" se suprapune în ora întâia cu "p34p09" (la 10E şi respectiv, 9E).

N-ar fi greu de corectat direct, lucrurile; de exemplu, prin
M[13, c(2, 6)] <- M[13, c(6, 2)]
p01 şi p17 vor schimba între ei poziţiile de pe linia 13 (la clasa 12A) – disponibilizând p01 pentru a face ora I-a împreună cu p02, la 10A; de observat că iniţial, p17 nu apărea în coloana 2 şi deci, mutarea efectuată nu creează vreo nouă suprapunere.

Dar astfel de manipulări directe (probabil numeroase) sunt riscante, neavând pentru suprapuneri alt control decât cel vizual (prin proprii ochi); până vom pune la punct şi o procedură automată pentru ajustarea în orar a lecţiilor cuplate – preferăm să apelăm la aplicaţia interactivă "dayRecast.html" (şi pentru a nu proceda astfel pentru fiecare zi, va fi necesară o procedură „automată”).
Salvăm deocamdată orarul, în formatul CSV agreat de "dayRecast.html":

> write_csv(orarByProf(lu), file="orar_Lu.csv", na="-", col_names=TRUE)

Aranjarea liniilor orarului, pentru a evidenţia cuplajele

Avem de folosit "dayRecast.html" numai pentru a corecta suprapunerile de lecţii cuplate (fără a ne preocupa de ferestre); pentru a opera interactiv cât mai comod (şi rapid), rearanjăm întâi liniile din fişierul CSV rezultat mai sus, astfel încât să grupăm la început toate liniile corespunzătoare profesorilor cuplaţi.

Din [1], avem în "messing.RDS" listele Lx1 şi Lx2, care specifică – pentru întreaga săptămână – pentru fiecare profesor care intră într-un cuplaj şi respectiv, pentru fiecare profesor fictiv, acei profesori şi profesori fictivi de care depinde alocarea corectă (fără suprapuneri) a cuplajelor; mai precizăm că am mutat în "stmt_utils.R" şi funcţia utilitară introdusă în [1], select_cupl(), prin care selectăm din Lx1 şi Lx2 numai datele corespunzătoare zilei curente.

Următorul script produce rearanjarea dorită a liniilor orarului:

# update.R
source("stmt_utils.R")  # select_cupl(L, prof_day)
load("messing.RDS")  # Lx1, Lx2 (cuplajele din cadrul săptămânii)
X <- read_csv("orar_Lu.csv", col_types = "cccccccc")
prof_day <- unique(X$prof)  # profesorii (şi cei fictivi) pe ziua curentă
Lx1 <- select_cupl(Lx1, prof_day)  # ; print(Lx1)
Lx2 <- select_cupl(Lx2, prof_day)  # ; print(Lx2)
# de cine depinde un profesor cuplat sau un cuplu, la alocarea lecţiilor
nx1 <- names(Lx1);  nx2 <- names(Lx2)
dep1 <- unlist(map(seq_along(Lx1), 
                   function(i) c(nx1[i], Lx1[[i]])))
dep2 <- unlist(map(seq_along(Lx2), 
                   function(i) c(nx2[i], Lx2[[i]])))
# ordonează după cuplaje şi apoi, alfabetic (pentru lizibilitate)
dep <- unique(union(dep1, dep2))
lev <- c(dep, sort(unique(setdiff(X$prof, dep))))
X$prof <- factor(X$prof, levels = lev, ordered=TRUE)
X <- X %>% arrange(prof)
write_csv(X, file="orar_Lu_1.csv", col_names=TRUE)

Transferând fişierul obţinut "orar_Lu_1.csv" în locul cuvenit din fişierul "dayRecast.html" şi apoi operând în aplicaţia deschisă în browser – am obţinut cam în 3-4 minute (prin 15 operaţii "SWAP") următoarea variantă de plasare corectă a lecţiilor cuplate:

Prin link-ul "Export" am salvat orarul astfel modificat, în "orar_Lu_2.csv"

Să observăm că numărul de ferestre s-a mărit la 29; dar de fapt, acest număr nu mai este cel corect: de exemplu, p01 are o fereastră „ascunsă”, dat fiind că face primele 3 ore împreună cu p02 (orele puse profesorului fictiv "p01p02") şi apoi trebuie să stea o oră, pentru a ajunge la orele proprii (a 5-a la 12A şi a 6-a la 11A); iar lui p11 i s-a socotit o fereastră (având "- 9B - 10F 9C"), dar de fapt este o fereastră aparentă, fiindcă în ora a 3-a intră împreună cu p08 la clasa 12E.
p34 are chiar 3 ferestre (ascunse): intră ora I-a împreună cu p07 la 10E şi apoi tocmai ora a 5-a, împreună cu p09, la clasa 9E (şi consultând dedesubtul liniilor din imaginea parţială redată mai sus, constatăm că p34 nu are alte ore).
Vom vedea mai jos că numărul (corect) de ferestre (ascunse sau nu) din orarul obţinut mai sus este 37.

Reducerea ferestrelor, ţinând seama şi de cuplaje

Reluăm într-un nou fişier, programul recast.R din [3]; s-ar cuveni o anumită reorganizare a codului respectiv, dar deocamdată doar am mutat unele funcţii în "stmt_utils.R"; păstrăm deocamdată (şi nu le mai redăm aici) funcţiile move_cls(), cover_gaps(), choose_min(), recast() şi search_better().

# vrecast.R  reduce numărul de ferestre (reale sau aparente) din orarul zilei
source("stmt_utils.R")  # get_bin_patt(), cnt_holes(), prnTime()
load("messing.RDS")  # Lx1, Lx2 (cuplajele din cursul săptămânii)
# Preia orarul unei zile; asumăm că orele cuplate nu se suprapun.
X <- read_csv("orar_Lu_2.csv", col_types = "cccccccc")
prof_day <- unique(X$prof)  # profesorii (şi cei fictivi) pe ziua curentă
Lx1 <- select_cupl(Lx1, prof_day)
Lx2 <- select_cupl(Lx2, prof_day)
nx1 <- names(Lx1);  nx2 <- names(Lx2)
MXT <- as.matrix(X[, 2:ncol(X)])  # matricea orelor
row.names(MXT) <- X$prof
nHm <- ncol(MXT)  # nr. maxim de ore ale unei clase (7)

Am evidenţiat mai sus cazul profesorului p34, care în ziua "Lu" nu are ore proprii, dar este implicat în cuplajele "p34p07" şi "p34p09"; o distanţă mai mare ca 1 între orele alocate acestora înseamnă cel puţin o fereastră (ascunsă), pentru p34.
Următoarea funcţie produce un vector conţinând una după alta, câte o pereche de cuplaje care implică un profesor fără ore proprii în ziua respectivă:

# profesorii fără ore proprii, implicaţi în cel puţin două cuplaje
special_cases <- function() {
    spc <- map_df(nx2, function(cup) {
        cpl <- split_cuplu(cup)
        pr <- setdiff(cpl, nx1)
        if(length(pr) == 1) return(
            data.frame(prof = pr, cup = cup)
        )
    })
    onc <- spc[duplicated(spc$prof), ]$prof
    sort(spc[spc$prof %in% onc, ]$cup)
}
p_sp <- special_cases()  # [1] "p34p07" "p34p09"

Următoarele funcţii determină numărul de ferestre (incluzând acum şi pe cele ascunse) dintr-o matrice orară (precum cea iniţială, MXT), pe baza vectorului de şabloane binare asociat acelei matrici prin get_bin_patt():

cnt_all_gaps <- function(vsb) { # vectorul şabloanelor orare
    holes_cupl <- function() {
        ng <- 0
        for(p in nx1) {
            B <- vsb[p]
            for(pr in Lx1[[p]])
                B <- bitwOr(B, vsb[pr])
            ng <- ng + cnt_holes(B)
        }
        # adaugă eventual, diverse cazuri particulare:
        if(length(p_sp) >= 2) {
            for(i in seq(1, length(p_sp), by=2))
                ng <- ng + cnt_holes(bitwOr(vsb[p_sp[i]], vsb[p_sp[i+1]]))
        }
        ng 
    }
    sum(unlist(lapply(vsb, cnt_holes))) + holes_cupl()
}  # numărul ferestrelor din orar, ţinând cont şi de cuplaje
count_gaps <- function(morr)
    morr %>% get_bin_patt(.) %>% cnt_all_gaps(.)

Următoarea funcţie analizează şabloanele orare ale profesorilor fictivi (constituite până la momentul curent), pentru a vedea dacă nu cumva există lecţii cuplate care s-ar suprapune (având câte un bit '1' într-o aceeaşi poziţie din şabloanele binare respective):

# verifică suprapunerea lecţiilor profesorilor cuplaţi
vrf_over <- function(morr) {
    bith <- get_bin_patt(morr)
    for(prf in nx2) {
        B <- 0L
        for(pc in Lx2[[prf]])
            B <- bitwOr(B, bith[pc])
        if(bitwAnd(bith[prf], B) > 0)
            return(FALSE)
    }
    TRUE  # lecţiile cuplate de profesorii fictivi NU se suprapun
}

În final, invocând ca şi în [3] search_better(Niter=3000), obţinem în câteva minute, un orar cu 7 sau cu 6 ferestre – de exemplu:

[1] 37  (numărul iniţial de ferestre)
       1   2   3   4   5   6   7           1   2   3   4   5   6   7  
p01    -   -   -   12A 11A -   -    p19	   -   -   9D  12C 12E 10D -
p01p02 12A 11B 10A -   -   -   -    p20	   12F 11A 10F 8G  -   -   -
p02    -   -   -   11D 9A  11B -    p21	   10A 10D 7G  12E -   -   -
p06    -   -   -   5G  12F 11F -    p22	   -   -   12B 9B  12D 10B -
p06p33 -   10F 9C  -   -   -   -    p23	   -   -   11F 9F  12C 11A -
p33    -   -   -   9D  7G  9F  -    p24	   -   9A  -   7G  6G  12B -
p08    -   -   -   12D 9F  6G  -    p26	   11F 12F -   -   11E 9D  -
p08p11 -   12E -   -   -   -   -    p27	   9E  12D 11D 10E -   -   -
p08p25 -   -   12E -   -   -   -    p28	   10E 11C 11B -   -   -   -
p08p47 12E -   -   -   -   -   -    p29	   12B 9D  12C -   -   -   -
p11    -   -   -   10F 9B  9C  -    p30	   11C 12B 12A -   -   -   -
p11p44 11E -   -   -   -   -   -    p31	   10D 9B  11C -   -   -   -
p25    -   -   -   11A 11F 10C -    p32	   7G  10B 9A  -   -   -   -
p07    -   12C 12F 9C  10C -   -    p35	   10F 10C 11A -   -   -   -
p34p07 -   -   -   -   -   10E -    p36	   -   -   -   9A  12A 10A -
p09    10B 11F 11E 10D -   -   -    p37	   9F  9C  -   -   -   -   -
p34p09 -   -   -   -   9E  -   -    p38	   10C 9E  -   -   -   -   -
p03    9C  11E 9B  9E  10E 10F -    p39	   9D  10E 9E  -   -   -   -
p04    -   12A 10E 12F 11D 5G  -    p40	   11A 7G  -   -   -   -   -
p05    11B 8G  10C -   10B 9A  -    p42	   12C 6G  -   -   -   -   -
p10    9B  11D 9F  11E 9C  -   -    p45	   5G  9F  -   6G  10F -   -
p12    -   -   -   11B 10D 12F 10A  p46	   -   -   -   -   5G  8G  10E
p13    -   -   -   10A 11B 9E  8G   p49	   12D -   -   -   -   -   -
p14    9A  10A 8G  11F -   -   -    p50	   6G  -   -   -   -   -   -
p15    -   -   12D 10B 10A 12E -    p56	   8G  5G  6G  -   -   -   -
p16    -   -   10D 10C 12B 9B  -    p58	   11D -   -   -   -   -   -
p17    -   -   5G  12B 11C 12A -    p61	   -   -   -   -   8G  -   -
p18    -   -   10B 11C 9D  12C -    p62	   -   -   -   -   -   7G  -
[1] 6  (numărul final de ferestre)

Cele 37 de ferestre din orarul iniţial au fost reduse la 6: una ascunsă, la p11 (intră la prima oră împreună cu p44 la clasa 11E, a doua oră cu p08 la 12E şi de la a 4-a oră îşi face orele proprii), trei ferestre de câte o oră (la p05, p24 şi p45) şi o fereastră de două ore consecutive (la p26). Exceptând p11, profesorii care intră în cuplaje nu au ferestre; de exemplu, p06 şi p33 fac împreună ora a 2-a şi a 3-a (la 10F şi 9C), apoi continuă fiecare cu cele câte trei ore proprii; să mai observăm că p34 (care nu are ore proprii, dar intră în două cuplaje) nu are fereastră.

Repetând search_better(), obţinem orare cu alte repartizări a celor 6 ferestre, în timpi care oscilează între câteva minute şi circa 30 de minute (în funcţie şi de valoarea aleasă pentru Niter); ar fi de văzut dacă extinzând cumva gama de „reparaţii” constituită de cover_gaps() (vizând explicit şi ferestrele „ascunse”), am obţine şi orare cu mai puţin de 6 ferestre…

vezi Cărţile mele (de programare)

docerpro | Prev | Next