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

Revenire asupra șabloanelor orare cu ferestre (II)

graf | limbajul R | orar şcolar
2025 jan

Setul complet de mutări corectoare

Setul SBC constituit în [3] este incomplet; de exemplu, SBC[["114"]] conține doar "reparații" care ignoră prima oră:

    114 -*--***   # 4 lecții cu 2 ferestre
        h1 h2   șablon  # mută '*' din locul h1 în locul h2
    	 2  3  --*-*** 
    	 2  4  ---****  # s-ar elimina ambele ferestre inițiale
    	 5  3  -**--** 
    	 6  3  -**-*-* 
    	 7  3  -**-**- 
    	 5  4  -*-*-** 
    	 6  4  -*-**-* 
    	 7  4  -*-***- 

Dintre aceste 8 mutări, una singură elimină ambele ferestre, trei elimină câte o singură fereastră, iar celelalte păstrează câte două ferestre; nu luasem în seamă și o mutare ca (7 1), fiindcă aceasta nu acoperă o fereastră propriu-zisă, ci un loc liber — totuși… ar rezulta "**--**-", similar mutării (5 3).
Trebuie avute în vedere toate mutările care acoperă un loc liber (nu neapărat "fereastră"); urmărim să reducem numărul total de ferestre și nu pe cel corespunzător unui anumit profesor.

Reluăm programul din [3] și formulăm toate mutările "*" --> "-", pe fiecare șablon:

HG <- HG[HG > 0]  # 99 șabloane binare cu ferestre
SBC <- map(HG, function(S) {
    L <-  bitwAnd(S, h2bin) 
    ik <- which(L > 0)  # clase "*"
    il <- which(L == 0)  # liber "-"
    H1 <- H2 <- vector("integer")  # pentru move_cls() din H1 în H2
    for(i in ik) 
        for(j in il) {
            H1 <- c(H1, i)
            H2 <- c(H2, j)
        }
    list(h1 = H1, h2 = H2)
}) %>% setNames(HG)

Pentru fiecare șablon dintre cele 99 posibile, numărul de mutări este dat de produsul dintre numărul de "*" (lecții) și cel de locuri "-":

> SBC[["114"]]$h1; SBC[["114"]]$h2  # toate mutările (h1 h2) pentru '-*--***'
 [1] 2 2 2 5 5 5 6 6 6 7 7 7
 [1] 1 3 4 1 3 4 1 3 4 1 3 4
> SBC |> unlist() |> length()
[1] 2184  # totalul mutărilor care acoperă ferestre

"corectoare" —cum numisem mutările (h1 h2)— este acum mai puțin potrivit: pe șablonul exemplificat mai sus, mutarea (2 1) nu corectează, ci chiar mărește numărul de ferestre; acceptăm de-acum și asemenea mutări, fiindcă nu-i exclus ca tocmai așa, numărul total de ferestre să devină mai mic.

Setul mutărilor corectoare pentru orarul curent

Pentru o matrice-orar dată Mop, funcția bin_patt() (v. [2]) șablonează toate orarele individuale; depistăm șabloanele cu ferestre și (dar numai pentru ceva investigații) formulăm un tabel data.frame al mutărilor din SBC corespunzătoare acestora:

> bin_patt  # produce șabloanele binare ale orarelor individuale
function(matPr) 
    apply(matPr, 1, function(Row) sum(h2bin[which(! Row %in% "-")]))

register_holes <- function(Mop) {
    Vsb <- bin_patt(Mop)
    B <- which(unlist(lapply(Vsb, cnt_holes), use.names=FALSE) > 0)
    map_dfr(B, function(id) {
        H12 <- SBC[[as.character(Vsb[id])]] %>% as.data.frame() %>%
               rowwise() %>% filter(max(h1,h2) <= ncol(Mop))
        vsb <- Vsb[id] %>% as.vector()  # de eliminat
        data.frame(h1 = H12$h1, h2 = H12$h2, ql = Mop[id, H12$h1], 
                   sb = vsb, SB = byte_line(vsb))  # de eliminat 'sb', 'SB'
    })
}

Precizăm că funcția cover_gaps() din [2] producea deasemenea (dar pe o cale iterativă rudimentară) setul h1|h2|ql, din care alegea (însă numai la întâmplare) mutarea de returnat funcției choose_next() din care fusese apelată; funcția recast() apelează repetat choose_next(), până când orarul rezultat prin efectuarea mutării primite are mai puține ferestre decât orarul inițial. Procesul descris este reluat pe un anumit număr de iterații (v. search_better()), până când ferestrele nu mai pot fi reduse astfel.
Experimentele etalate pe aici în ultimii vreo trei ani arată că acest mecanism, bazat numai pe întâmplare, este suficient pentru a reduce numărul de ferestre pe la 4-5% față de totalul lecțiilor; excepție ar fi ultimul caz, evocat în [3], când aveam o încadrare foarte densă (cu câte măcar 16 ore/săptămână pentru fiecare profesor) și acest procent n-a putut fi coborât astfel, sub 7%.

Însă acum, SBC oferă mult mai multe "mutări corectoare" — de fapt, cam toate posibilitățile de modificare a orarelor individuale — și este de văzut dacă ne mai putem baza numai pe întâmplare, pentru a reduce ferestrele într-un timp rezonabil…

Obs. Considerând de-acum toate posibilitățile de ocupare a unui loc liber, putem elimina funcția gen_rand_tmt(), prin care anterior (pentru a compensa faptul că vizam numai ocuparea de ferestre) mutam o clasă oarecare într-o altă coloană (și abia apoi, declanșam recast(), pe lista de mutări corectoare a orarului rezultat astfel).

Investigații…

Am adăugat cele două linii comentate mai sus cu "de eliminat", numai de dragul examinării setului de mutări; dacă excludem "vsb" și câmpurile informative "sb" și "SB" și dacă returnăm în final o linie oarecare (la întâmplare) h1|h2|ql, atunci register_holes() ar avea aceeași funcționalitate ca și cover_gaps() — fiind însă, ca formulare, mult mai concisă și elegantă… Însă înlocuind cover_gaps() (care are o formulare iterativă directă, dintre cele mai obișnuite) prin register_holes() astfel modificat, durata de execuție a funcției search_better() devine cam de două-trei ori mai mare.

Deocamdată vrem doar să vizualizăm informații privitoare la mutările corectoare corespunzătoare unui orar dat. Pe câmpul SB avem deja, șabloanele (în format literal) pe care operează mutările (h1 h2); pentru a înregistra și șabloanele rezultate în urma acestor mutări, plecăm de la următoarea funcție (în șablonul binar primit, anulăm bitul de rang (h1-1) și setăm bitul de rang (h2-1) — rezultând astfel, șablonul binar corespunzător efectuării mutării (h1 h2)):

new_SB <- function(sb, h1, h2)
    bitwShiftL(1, h1-1) |> bitwNot() |> bitwAnd(sb) |> 
    bitwOr(bitwShiftL(1, h2-1))

Pentru exemplificare să considerăm o matrice-orar dintre cele evocate în [3]:

ORR <- readRDS("Orar1.RDS")
mORR <- map(ORR, hourly_matrix)
MC <- mORR[["Lu"]] %>% register_holes() %>% 
      rowwise() %>% mutate(sb1 = new_SB(sb, h1, h2)) %>%
      mutate(SB1 = byte_line(sb1)) %>% ungroup()

str(MC) ne arată că avem 618 "mutări corectoare"; iată un eșantion arbitrar, scurt:

> slice_sample(MC, n = 5)
         h1  h2  ql       sb SB        sb1 SB1
    1     2   7  10F      23 ***-*--    85 *-*-*-*
    2     2   4  12D      23 ***-*--    29 *-***--
    3     4   5  9F       45 *-**-*-    53 *-*-**-
    4     1   6  5H       27 **-**--    58 -*-***-
    5     6   2  12C      61 *-****-    31 *****--

Interpretăm astfel o linie de date, de exemplu prima: profesorul cu lecție la clasa 10F în ora h1=2, are orarul cu șablonul SBC[['23']]="***-*--"; mutând 10F din coloana 2 în coloana h2=7, rezultă SBC[['85']]="*-*-*-*" — un orar "dințat" foarte nedorit, dar… nu-i exclus ca schimbările necesare între cele două coloane orare (pentru a păstra unicitatea clasei pe coloană), să diminueze numărul total de ferestre.

Una sau alta dintre cele 618 mutări poate conduce momentan, la un orar cu mai puține ferestre — dar nu putem anticipa că pe orarul rezultat (și apoi pe următorul rezultat, ș.a.m.d.) vom putea găsi iarăși vreo mutare, care să continue reducerea de ferestre…

Nu prea este de luat în seamă prioritizarea mutărilor prin (cam prima idee de încercat) raportul față de numărul de lecții din șablon, al diferenței numărului de ferestre înainte și după mutare; ar fi (în funcție de densitatea orarului) prea multe "cazuri egale".
Dacă e să alegem o mutare, nu doar la întâmplare, atunci trebuie să ținem seama cumva, de anumite caracteristici globale (și nu doar de șabloanele individuale).

Prioritizarea rezonabilă a mutărilor

S-ar cuveni să ținem seama cumva, de clasele implicate în mutările corectoare — favorizând mutările acelei clase care are cât mai multe "legături" cu alte clase, cu speranța plauzibilă că (mai frecvent, decât dacă nu distingem între clase) vreuna dintre aceste mutări ar putea reduce "deodată" mai multe ferestre…
Anterior (v. [2]) am stabilit ca "legături" între clase, numărul de profesori comuni la câte două clase și am constituit dicționarul BTW_cls care asociază fiecărei zile, vectorul coeficienților "betweenness" pentru acea zi, ai claselor (amintim că ne-am bazat pe BTW_cls pentru a aloca lecțiile pe orele 1:7 ale zilei curente).

Reluăm cover_gaps() și o modificăm astfel: în loc să returnăm o mutare arbitrară din setul tuturor mutărilor corectoare asociat orarului curent, vom returna una, tot la întâmplare, dar din subsetul de mutări corectoare corespunzător uneia dintre clasele de coeficient "betweeness" mare (nu neapărat, cel mai mare).
Subliniem că evităm să splităm lista mutărilor corectoare după clasă, alegând apoi subsetul corespunzător clasei cu cel mai mare coeficient — fiindcă operațiile necesare ar consuma prea mult timp; preferăm să folosim parametrul prob al funcției sample(): se va furniza un element arbitrar (o clasă), dar nu chiar la întâmplare, ci favorizând acele elemente cărora vectorul "prob" le asociază valori mici; fiindcă vrem să favorizăm clasele de coeficient mare, trebuie ca întâi să inversăm coeficienții respectivi (încât "mare" să devină "mic", cum are în vedere sample()):

load("BTW.rda")  # coeficienții "betweenness" 
BTW <- lapply(BTW_cls, function(B) 1/(B+0.5))  # inversează coeficienții

cover_gaps <- function(Mop) {  # versiunea din [3], modificată la sfârșit
    Vsb <- bin_patt(Mop)
    B <- which(unlist(lapply(Vsb, cnt_holes), use.names=FALSE) > 0)
    if(!length(B)) return(NULL)  # Bravo! zero ferestre...
    lh1 <- lh2 <- vector("integer", 0)
    lql <- vector("character", 0)
    nCOL <- ncol(Mop)
    for(id in B) {
        h12 <- SBC[[as.character(Vsb[id])]]
        H1 <- h12[["h1"]]; H2 <- h12[["h2"]]
        for(i in seq_along(H1)) {
            h1 <- H1[i]; h2 <- H2[i]
            if(max(h1, h2) > nCOL)
                next  # ocolește mutările în afara coloanelor existente
            lql <- c(lql, Mop[id, h1])
            lh1 <- c(lh1, h1)
            lh2 <- c(lh2, h2)
        }
    } 
    Cls <- lql %>% unique() %>% sample(size = 1, prob = BTW[.])
    wh <- which(lql == Cls) %>% sample(size = 1)
    c(lh1[wh], lh2[wh], Cls)  # returnează o mutare aleatorie, dintre cele
}                             # asociate unei clase de coeficient BTW mare.

Merită subliniat că am renunțat la construcția data.frame(h1,h2,ql) (v. [2], [3]), procedând acum mult mai direct (ceea ce a scurtat durata totală a execuției cam cu câte două minute/zi — cel puțin, pentru cazul redat mai jos): din vectorul lql am ales la întâmplare o clasă Cls de coeficient BTW mare, am aflat indecșii acesteia în vectorul lql și am ales unul wh la întâmplare, iar în final am returnat vectorul constituit din valorile de index wh din vectorii lh1 și lh2, împreună cu clasa Cls.

Obs. Este de văzut și de lămurit, dacă nu cumva este mai bine să alegem invers Cls, dintre clasele cu BTW mic…

Testare

În Cazul cel mai simplu, al problemei orarului am construit un caz extrem: 64 de clase, cu 95 de profesori dintre care 91 au câte cel puțin 18 ore (iar ceilalți 4 au și ei, 16 sau 17 ore/săpămână). Cu foarte puține excepții, profesorii respectivi au în fiecare zi câte 3, 4 sau 5 ore — încât apariția de (multe) ferestre este inevitabilă; reușisem să reducem numărul de ferestre — dar numai repetând de mai multe ori (pe câte o zi), execuția programului xgaps.R — doar până la 28 29 27 27 28 pe fiecare zi, respectiv.

Reluăm programul "xgaps.R", de data aceasta cu setul SBC constituit mai sus și cu funcția cover_gaps() redată mai sus (împreună cu modificarea BTW):

> source("xgaps.R")
21:00:43  (70 ferestre)
68  67  66  65  64  63  62  61  60  59  58  57  56  55  54  53  52  51  50  49  48  47  46  45  44  43  42  41  40  39  38  37  36  35  34  33  32  * 32  31  30  29  28  * 28  * 28  * 28  * 28  * 28  * 28  21:05:44  # 5 minute
21:05:44  (74 ferestre)
73  72  71  70  69  68  67  65  64  62  61  59  58  57  56  55  54  53  52  51  50  49  48  47  46  45  44  43  42  41  40  39  38  37  36  35  34  33  32  31  * 31  30  * 30  29  * 29  * 29  * 29  * 29  * 29  21:10:46 
21:10:46  (70 ferestre)
69  68  67  66  65  63  61  60  59  58  57  56  55  54  53  52  51  50  49  48  47  46  45  44  43  42  41  40  39  38  37  36  35  34  33  32  31  * 31  30  29  * 29  28  * 28  27  * 27  * 27  * 27  * 27  21:15:44 
21:15:44  (76 ferestre)
75  74  72  71  70  69  68  67  66  65  64  63  62  61  60  59  58  57  56  55  54  53  52  51  50  49  48  47  45  44  43  42  41  40  39  38  37  36  35  34  33  32  * 32  31  30  29  * 29  * 29  * 29  * 29  * 29  * 29 21:20:47   # așteptam 27
21:20:47  (74 ferestre)
72  71  70  69  68  67  66  65  64  63  62  61  60  59  58  57  56  55  54  53  52  50  49  48  47  46  45  43  42  41  40  39  38  37  36  35  34  33  32  31  * 31  30  29  * 29  * 29  28  * 28  * 28  * 28  * 28  21:25:53 

N-am reușit să reducem mai mult, numărul de ferestre; dar acum (cel puțin pentru instanța de lucru redată aici), se ajunge la valorile "minime" respective (exceptând ziua a 4-a, pe care ne-a rezultat mai sus 29 în loc de 27) într-o singură execuție a programului (cam de oricâte ori l-am repeta). Reducerile decurg în general cu câte una sau două ferestre; dar în alte câteva execuții ale programului am constatat și reduceri de câte 3 ferestre, într-un pas (73 72 71 70 67 66 64 63...).
Deși acum listele SBC sunt mult mai ample decât anterior și deși am mărit numărul de reluări din interiorul lui search_better() (avem 7 reluări "*", în loc de 6), timpul de execuție s-a diminuat cam cu câte un minut, pe fiecare zi (anterior, ne lua cam 6 min./zi).

Versiunea în care alegem Cls dintre clasele cu BTW mic s-a dovedit a fi mai proastă: au trebuit multe reluări ale execuției programului, pentru a ajunge la valorile "minime" ale numărului de ferestre.

vezi Cărţile mele (de programare)

docerpro | Prev | Next