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

Reducerea ferestrelor din orarul zilei (IV)

R | orar şcolar
2021 dec

Reinventăm programul nostru anterior "vrecast.R" (chiar cu alt nume):

# recast.R  (reduce numărul de ferestre din orarul unei zile)
source("stmt_utils.R")  # bin_patterns(), cnt_holes(), to_table(); prnTime()
load("Messing.RDS")  # cuplajele Tw1, Tw2 şi clasele săptămânii Cls

Nu prea nimerim, cele mai potrivite denumiri pentru variabile, funcţii şi fişiere – dar Messing e bine ales: cuplajele „încurcă” foarte mult, problema orarului.

Messing.RDS injectează date de la nivelul săptămânii: vectorul claselor Cls şi listele (de redus după ziua curentă) Tw1 şi Tw2 (de la twin=cuplat/geamăn), privitoare la cuplaje. Funcţiile care urmează folosesc anumite variabile globale, pe care le vom specifica în grup, abia la sfârşit (şi nu la început, cum se recomandă de obicei) – din motive care ţin de execuţia programului (dacă nu, de gust): funcţiile noastre vizează orarul curent al unei zile, iar la sfârşit vom vrea să le aplicăm totuşi (prin ciclare) pe toate zilele.

Ferestre ascunse

Când socotim ferestrele, trebuie să ţinem seama de acest caz: profesor implicat în unul sau mai multe cuplaje, dar care nu are ore proprii în ziua respectivă.
De exemplu, p33 apare pe orarul zilei în cuplajul p06p33, dar nu apare şi singur – atunci, orice fereastră a profesorului fictiv p06p33 devine o fereastră („reală”, dar cumva ascunsă) pentru p33. Sau: p34 nu are ore proprii, dar intră în cuplajele p34p07 şi p34p09; orice fereastră comună celor doi profesori fictivi, devine fereastră a lui p34.

Înregistrăm pentru ziua curentă (dar mult mai simplu ca în vechea "special_cases()"), cuplajele (profesorii fictivi) care angajează câte un profesor fără ore proprii:

hidden_gaps <- function() {
    sbf <- setdiff(names(Tw1), nTz1) %>%
           map(function(P) map_chr(Tw1[[P]], function(Pf)
               if(Pf %in% nTz2) Pf else NA))
    sbf[! is.na(sbf)]
}    

Tw1 are drept chei profesorii care intră în măcar un cuplaj, de-a lungul săptămânii; Tz1 selectează dintre aceştia, pe cei care au şi ore proprii, în ziua curentă. Deci diferenţa (prin setdiff()) dintre cei doi vectori de nume reprezintă profesorii care, în ziua respectivă, intră măcar într-un cuplaj dar nu au ore proprii; pentru fiecare dintre aceştia (folosind map() şi apoi map_chr()), se reţin acei profesori fictivi care apar în ziua curentă şi care angajează profesorul respectiv.
Va trebui (pe cât se va putea) ca profesorii fictivi astfel reţinuţi, să nu aibă ferestre comune – ele ar deveni ferestre „ascunse”, la profesorul fără ore proprii pe care-l angajează.

hidden_gaps() foloseşte nişte variabile „globale”, pe care va trebui să le introducem înainte de a invoca funcţia respectivă (în R, valorile se leagă la variabile doar în momentul execuţiei funcţiei, nu când aceasta este citită (încorporată în sesiunea de lucru)).

Numărul ferestrelor din orarul curent

Fiecare clasă are cel mult 7 ore pe zi (considerăm o şcoală cu un singur schimb, sau orarul unui singur schimb). Şablonăm orarul pe ziua respectivă al unui profesor, prin biţii 0..6 ai unui integer (ai unui octet, dar în R întregii nu măsoară mai puţin de 32 de biţi); bitul de rang b=0..6 corespunde orei de rang (b+1) a zilei. Numărul de ferestre (din orarul profesorului) este dat de numărul de biţi 0 aflaţi între biţi 1:

# în stmt_utils.R
h2bin <- as.integer(c(1, 2, 4, 8, 16, 32, 64))  # măştile orelor zilei
cnt_holes <- function(sb) {  # sb: şablonul binar al orelor profesorului
    bits <- which(bitwAnd(sb, h2bin) > 0)  # rangurile biţilor '1'
    n <- length(bits)
    bits[n] - bits[1] + 1 - n
}  # Numărul de biţi '0' aflaţi între biţi '1' ("ferestre")

De regulă, operaţiile cu vectori sunt „vectorizate”: vectorul sb de lungime 1 este extins prin repetare, la lungimea celuilalt operand, h2bin şi apoi (intern) operaţia respectivă decurge „în paralel” pe componentele acestor vectori.

Am inclus cnt_holes() în fişierul "stmt_utils.R", fiindcă folosim funcţia respectivă şi în programul "daySchoolSchedule.R" – prin care am obţinut anterior, orarele zilelor, punând condiţia ca fiecare profesor să aibă zero, una sau cel mult două ferestre (dar anterior, în locul vectorului global h2bin, implicam o funcţie "where_is_one()").

Următoarea funcţie produce vectorul şabloanelor binare ale orelor profesorilor de pe orarul curent (faţă de versiunea anterioară "get_bin_patt()", am renunţat să ne bazăm pe apply() – ocolind astfel anumite „erori” sâcâitoare, specifice implementării lui apply()):

# în stmt_utils.R
bin_patterns <- function(morr) {  # pe matricea curentă a orelor dintr-o zi
    dm <- dim(morr)
    B <- vector("integer", dm[1])
    for(i in 1:dm[1]) {
          byte <- 0L  # "byte" este de fapt, un "integer" (32/64 biţi)
          for(j in 1:dm[2])
              if(morr[i, j] != '-') 
                  byte <- bitwOr(byte, h2bin[j])
          B[i] <- byte
    }
    names(B) <- rownames(morr)
    B
}  # şabloanele binare ale orarelor profesorilor, din matricea-orar dată

Vectorul B returnat în final este un „vector cu nume” – practic, un dicţionar având drept chei numele profesorilor şi drept valori, şabloanele binare ale orelor acestora; va fi important, că putem accesa valorile din B prin cheile acestora (cât şi prin ranguri).

Vom avea de apelat cnt_holes() şi bin_patterns() de foarte multe ori (după fiecare modificare a orarului iniţial), încât am căutat să ne folosim de orice posibilitate de a eficientiza codul; operatorul "{" reprezintă de fapt o funcţie care va returna ultima expresie evaluată în „blocul” respectiv – nu este necesar să apelăm şi "return()" (cum se recomandă pentru înlesnirea citirii codului respectiv); deasemenea, dacă „blocul” se rezumă la o singură instrucţiune (cum avem sub for(), în mai multe locuri) – atunci vom evita să mai apelăm "{".

Funcţia următoare calculează numărul total de ferestre, din vectorul şabloanelor binare asociat orarului curent:

cnt_all_gaps <- function(vsb) { # vectorul şabloanelor orare
    holes_cupl <- function() {
        ng <- 0
        for(p in nTz1)  # cazul celor care intră în vreun cuplaj
            ng <- vsb[Tz1[[p]]] %>%
                  reduce(bitwOr, .init = vsb[p]) %>%
                  cnt_holes(.) + ng
        for(s in Sbf)  # ferestrele cuplajelor cu profesor fără ore proprii
            ng <- vsb[s] %>%
                  reduce(., bitwOr) %>%
                  cnt_holes(.) + ng
        ng 
    }
    holes_cupl() +  # plus ferestrele celor neimplicaţi în cuplaje
        sum(unlist(lapply(vsb[setdiff(names(vsb), nT12)], 
                          cnt_holes), use.names=FALSE))
}

Cel mai simplu caz (tratat direct, în final) este cel al profesorilor neimplicaţi în vreun cuplaj – deci aceia al căror nume nu figurează în vectorul global nT12 (acesta reuneşte cheile din Tz1 şi Tz2); prin lapply() am aplicat cnt_holes() pe şabloanele binare ale acestora şi am însumat (prin sum()) rezultatele.

Celelalte două cazuri sunt tratate în funcţia interioară („locală”) holes_cupl(). Pentru fiecare profesor care intră în vreun cuplaj (deci unul al cărui nume este o cheie din Tz1), se determină – prin reduce(), faţă de operaţia binară "OR" – octetul care acoperă atât şablonul binar al acelui profesor, cât şi şabloanele binare ale profesorilor fictivi care îl implică; aplicând cnt_holes() pe întregul rezultat astfel, găsim numărul de ferestre ale profesorului respectiv.
De exemplu – Tz1[["p08"]] este vectorul ("p08p11", "p08p25"); atunci, numărul de ferestre ale lui p08 este dat de numărul de biţi '0' interiori întregului rezultat prin "OR" din şabloanele binare curente pentru p08, p08p11 şi p08p25.

Cazul rămas corespunde cuplajelor cu un profesor fără ore proprii, indicate în variabila globală Sbf (rezultatul din hidden_gaps()); am dat mai sus un exemplu, pentru p34, fără ore proprii dar implicat în cuplajele p34p07 şi p34p09 (aplicând cnt_holes() întregului rezultat prin "OR" din şabloanele binare ale profesorilor fictivi p34p07 şi p34p09, obţinem numărul de ferestre ale lui p34).

Următoarea funcţie sintetizează apoi, numărul de ferestre dintr-o matrice orar dată:

count_gaps <- function(morr)
    morr %>% bin_patterns(.) %>% cnt_all_gaps(.)

Se cuvine poate, să precizăm că operatorul '%>%' (întâlnit deja în mai multe rânduri mai sus) transferă rezultatul evaluării expresiei din partea stângă, ca argument (indicat de obicei prin '.') al funcţiei invocate în partea dreaptă a operatorului.

Mutarea unei clase dintr-o coloană în alta

Avem orarul curent sub forma unei matrice; liniile pot fi accesate prin numele profesorilor, iar pe coloane avem clasele alocate profesorilor în fiecare oră a zilei (sau '-', când profesorul este liber în acea oră). Desigur, nu avem suprapuneri (v. [1]): pe fiecare coloană, fiecare clasă apare cel mult o singură dată.

Operaţia de bază, pe care o vom folosi pentru a reduce treptat ferestrele, constă în mutarea unei clase într-o altă coloană – ceea ce implică (pentru a evita suprapunerile) mai multe schimburi de clase între cele două coloane (de-a lungul unui lanţ Kempe al grafului în care arcele unesc clase de pe o aceeaşi linie – cum am arătat anterior).
Am modelat această operaţie prin funcţia move_cls(), pe care am mai redat-o anterior; o reluăm aici, simplificând constatarea în final a eventualei apariţii de suprapuneri ascunse (posibile, dacă există cuplaje):

move_cls <- function(morr, h1, h2, ql) {
    L11 <- L1 <- morr[, h1]
    L2 <- morr[, h2]
    if(! (ql %in% L2 & ql %in% L1)) return(NULL)

    path_kempe <- function(Q) {
        pth <- vector("integer", 0)
        i <- match(Q, L1, 0L)
        if(i == 0L) return(NULL)
        pth <- c(pth, i)
        q <- Q
        repeat {
            i <- match(q, L2, 0L)
            if(i == 0L) return(NULL)
            pth <- c(pth, i)
            q <- L1[i]
            if(q == '-' || q == Q) break
        }
        pth
    }
    
    path <- path_kempe(ql)
    if(is.null(path)) return(NULL)
    ql2 <- L2[path[1]]
    if(ql2 != '-') {
        L1 <- L2; L2 <- L11
        pth2 <- path_kempe(ql2)
        if(is.null(pth2)) return(NULL)
        path <- c(path, pth2)
    }
    # inversează coloanele h1 şi h2, pe liniile indicate de 'path'
    morr[path, c(h1, h2)] <- morr[path, c(h2, h1)]
    # evită suprapunerile ascunse, pe cele două coloane
    M <- morr[rows_Tw, c(h1, h2)]
    sn <- map_lgl(nTz2, function(prf)
              M[prf, 1] != "-" && sum(M[Tz2[[prf]], 1] != '-') > 0 ||
              M[prf, 2] != "-" && sum(M[Tz2[[prf]], 2] != '-') > 0)
    if(any(sn)) return(NULL)
    morr
}

Am „inversat” cele două coloane numai pe liniile pe care s-au produs interschimburi de clase – ceea ce ar trebui să fie mai eficient, decât angajând toate liniile matricei, cum procedam (expeditiv) anterior.
Anterior, angajam (expeditiv) o funcţie "vrf_over()", care verifica pe toate coloanele, dacă au apărut suprapuneri ascunse… Acum am corectat: trebuie verificat numai pe cele două coloane între care s-au schimbat clase.

Am selectat din matrice numai liniile corespunzătoare cuplajelor (indicate în variabila globală rows_Tw) şi numai valorile din cele două coloane; prin map_lgl(), am evidenţiat situaţia în care pe una sau alta dintre cele două coloane, apare şi o clasă cu profesor fictiv şi o clasă cu un profesor (fictiv sau nu) conexat acestuia (de exemplu, apare clasă şi la p08p25 şi la (p08p07 sau p08p11 sau p25 sau p08)) – caz în care am avea o suprapunere „ascunsă” de lecţii şi deci, mutarea propusă iniţial trebuie refuzată (returnând NULL).

Gama reparaţiilor de ferestre

În principiu, avem de corectat nişte ferestre „în masă” (nu pentru un anumit profesor), măsurând de fiecare dată numărul total de ferestre rezultat după fiecare move_cls(); continuăm procesul de corectare, plecând acum de la unul sau altul dintre orarele rezultate astfel, care are cel mai mic număr de ferestre.

Care ferestre, să încercăm să corectăm (urmărind să reducem treptat numărul acestora), pe orarul iniţial şi apoi pe orarele rezultate după fiecare move_cls()?
Pe orarul iniţial, la fiecare profesor nu avem – după "daySchoolSchedule.R" – mai mult de două ferestre (este drept că unele excepţii au putut apărea, prin execuţia ulterioară a programului de eliminare a eventualelor suprapuneri ascunse – "correct.R" din [3]).
Este firesc atunci, să ne rezumăm la ferestrele de câte o singură oră şi la cele de câte două ore (consecutive sau nu).

Din vectorul şabloanelor binare asociat matricei-orar curente (referit de data aceasta prin indecşi, nu prin nume), selectăm valorile care au între biţi '1' fie un singur bit '0', fie doi biţi '0' – acestea corespund acelor profesori care au una sau două ferestre.

Pentru fiecare dintre şabloanele binare selectate, determinăm poziţia bitului (sau celor doi biţi) '0' şi generăm „mutări de corectare” corespunzătoare; de exemplu, pentru şablonul "110111" înregistrăm două mutări de corectare a ferestrei existente în ora a 4-a (pe un şablon binar numărăm de la dreapta spre stânga), anume: (1, 4, cls1) şi (6, 4, cls2), prin care clasa 'cls1' va fi mutată din prima coloană în a 4-a, respectiv clasa 'cls2' va fi mutată din a 6-a coloană în coloana a 4-a (ocupând astfel, locul liber existent între orele profesorului căruia îi corespunde şablonul considerat – noul şablon fiind fie '111110', fie '11111').
Pe lângă mutările claselor extreme pe locul liber, exemplificate mai sus – pentru unele şabloane putem considera şi o a treia mutare de corectare; de exemplu, pentru '11010' putem adăuga (2, 6, cls) – mutând clasa din ora a 2-a nu pe locul liber din a 3-a oră, ci după clasa existentă în ora a 5-a.

Următoarea funcţie produce tabelul de mutări corectoare, pentru un orar dat:

cover_gaps <- function(morr) {
    binp <- bin_patterns(morr)
    # indecşii liniilor pe care avem una sau două ferestre
    B <- which(unlist(lapply(binp, cnt_holes), use.names=FALSE) %in% c(1, 2))
    if(!length(B)) return(NULL)  # alte cazuri (0 sau mai mult de 2 ferestre;)
    lh1 <- lh2 <- vector("integer", 0)
    lql <- vector("character", 0)
    for(id in B) {    
        pt <- which(bitwAnd(binp[id], h2bin) > 0)
        n <- length(pt)
        H1 <- pt[1]
        Hn <- pt[n]
        cls <- morr[id, ]
        igp <- which(cls == '-')  # indecşii ferestrelor din şablonul curent
        igp <- igp[igp > H1 & igp < Hn]
        lh1 <- c(lh1, c(H1, Hn))  # mutările claselor extreme pe locul liber
        lh2 <- c(lh2, c(igp[1], igp[1]))
        lql <- c(lql, c(cls[H1],cls[Hn]))
        if(length(igp) == 1) {  # mutare într-un anumit caz de fereastră unică
            if(igp[1] == H1 + 1L & Hn < Hmax) {
                lh1 <- c(lh1, H1)
                lh2 <- c(lh2, Hn + 1L)
                lql <- c(lql, cls[H1])
            } else {
                if(igp[1] == Hn - 1L & H1 > 1) {
                    lh1 <- c(lh1, Hn)
                    lh2 <- c(lh2, H1 - 1L) 
                    lql <- c(lql, cls[Hn])
                }
            }
        } else { # mutări pentru cazul a două ferestre
                lh1 <- c(lh1, c(H1, Hn))
                lh2 <- c(lh2, c(igp[2], igp[2]))
                lql <- c(lql, c(cls[H1], cls[Hn]))
        }
    }
    data.frame(h1 = lh1, h2 = lh2, ql = lql)
}

Faţă de versiunea anterioară, am procedat mai simplu (renunţând şi la funcţia „locală” cover(), pe care o aplicam în final, prin map_df(), vectorului de şabloane binare care conţin măcar o fereastră) – dar probabil că nu cel mai simplu, cum am dori având în vedere că vom avea de apelat cover_gaps() de foarte multe ori (pentru fiecare nouă matrice-orar pe care vom relua reducerea de ferestre).

Bifurcarea procesului de reducere a ferestrelor

Putem muta o clasă între două coloane, dacă acea clasă figurează în ambele coloane (adică exceptăm aducerea unei clase pe o coloană de rang mai mare decât numărul de ore ale clasei). Mutând o clasă oarecare, dintr-o coloană în alta, rezultă o nouă matrice orar – cu mai multe sau cu mai puţine ferestre şi cu altă gamă de mutări corectoare; dacă au rezultat mai puţine ferestre faţă de orarul iniţial, atunci vom putea continua procesul de reducere treptată a numărului de ferestre, plecând acum de la orarul obţinut prin mutarea respectivă.

Următoarea funcţie aplică pe rând orarului indicat, toate mutările corectoare furnizate de cover_gaps() pentru acel orar, măsurând prin count_gaps() numărul de ferestre rezultat după fiecare mutare; în final, se alege la întâmplare, unul dintre orarele cu cel mai mic număr de ferestre (pe care vom continua apoi, procesul de reducere a numărului de ferestre):

choose_next <- function(mxt) {  # 'mxt': orarul rezultat după mutarea unei clase
    swp <- cover_gaps(mxt)  # lista reparaţiilor „standard” de ferestre
    if(is.null(swp)) return(NULL)
    ng <- map_dbl(1:nrow(swp), function(i) {
              mor <- move_cls(mxt, swp[i,1], swp[i,2], swp[i,3])
              if(is.null(mor)) return(100)
              count_gaps(mor)
    })
    m <- min(ng)
    if(m == 100) return(NULL)
    mi <- which(ng == m, useNames = FALSE)
    i <- sample.int(length(mi), 1)
    im <- mi[i] 
    list(move_cls(mxt, swp[im,1], swp[im,2], swp[im,3]), ng[im])
}

Faţă de anteriorul "choose_min()", am renunţat să folosim ifelse(is.null(mor), 100, count_gaps(mor)) – cu if() avem (în cazul de faţă) o execuţie sensibil mai rapidă. Dar deosebirea importantă constă în alegerea aleatorie din final – astfel, la fiecare nouă execuţie a programului vom obţine un orar diferit de cel rezultat într-o execuţie anterioară, poate mai „bun” (printr-o primă execuţie obţinem un orar cu 6 ferestre – la o a doua execuţie rezultă un orar cu 4 ferestre; sau… invers); n-avem decât să reţinem rezultatele şi să alegem apoi, pe cel mai convenabil.

Regizăm trecerea de la un orar la altul (principial, cu mai puţine ferestre) în acest fel:

recast <- function(mxt) {  # 'mxt' este orarul iniţial
    r1 <- r2 <- 0  # contorizează anumite oscilaţii ale numărului de ferestre
    repeat {
        Lmxt <- choose_next(mxt)  # alege o mutare corectoare, pe orarul curent
        if(is.null(Lmxt)) break
        mxt <- Lmxt[[1]]  # de-acum, 'mxt' este noul orar (după mutarea curentă)
        NG2 <- Lmxt[[2]] 
        if(NG2 < NG1) {  # NG1 reţine global, cel mai mic număr de ferestre
            NG1 <<- NG2  # ; cat(NG1, " ")
            break  # returnează orarul curent, dacă are mai puţine ferestre
        } else {  # altfel, reia alegerea mutării corectoare, după caz:
            if(NG2 == NG1) { 
                r1 <- r1 + 1
                if(r1 == 4)
                    break  # la repetarea de 4 ori a numărului de ferestre
            } else {
                r2 <- r2 + 1
                if(r2 == 6)
                    break  # la 6 repetări cu număr mărit de ferestre
            }
        }
    }
    mxt  # un orar cu mai puţine ferestre (de regulă)
}

Inserând cat(), se va putea urmări cum se desfăşoară lucrurile evidenţiate prin liniile de comentariu (şi marcări sintactice) strecurate în redarea de mai sus a funcţiei.

Devansând puţin – lucrurile se desfăşoară cam aşa:

> source("recast.R")
[1] 07:57:03  # timpul iniţial
[1] 32  # numărul ferestrelor din orarul iniţial (NG1 = 32)
[1] ***  # prima încercare de recast()
29  27  26  25  24  22  21  20  19  18  17  16  15  14  13  12  11  10
  9  8  7  6  # NG1 curent = 6
[1] ***  # încercare de reducere şi mai mare (eşuată) 
[1] ***  # a treia încercare, reuşită: au rămas 4 ferestre
5  4  [1] 4
[1] 08:11:07  # timpul final

Am plecat de la un orar care avea 32 de ferestre; prin recast(), după aplicarea unei anumite mutări corectoare, a rezultat un orar cu 29 de ferestre; aplicând şi acestuia, o anumită mutare din lista sa de mutări corectoare – a rezultat un orar cu 27 de ferestre; ş.a.m.d.
În final, după un anumit număr de iteraţii, s-a găsit un orar cu numai 6 ferestre (care desigur, diferă faţă de orarul iniţial numai prin ordinea orelor profesorilor). Încercarea de a reduce şi mai mult numărul de ferestre (bazată pe faptul că NG1 păstrează global numărul minim curent de ferestre), întâi a eşuat, apoi la următoarea încercare a reuşit – rezultând în final (după, în total, 4 minute) un orar cu numai 4 ferestre.

Căutarea orarului cu număr cât mai mic, de ferestre

Experimentând, am constatat că rezultatele cele mai bune se obţin nu plecând de la setul de mutări corectoare constituit pentru orarul curent, ci plecând pe un drum mai ocolit: întâi facem o mutare oarecare de clasă şi abia apoi, pe orarul rezultat, angajăm lista mutărilor corectoare; putem genera astfel mult mai multe orare, decât dacă plecam direct de la mutările corectoare ale orarului iniţial – crescând astfel, şansele de a găsi un orar cu cât mai puţine ferestre.

Substratul acestei idei este următoarea aserţiune (plauzibilă): există o clasă pentru care mutarea ei într-o altă coloană conduce la un orar cu mai puţine ferestre; dar nu vedem cum am putea depista clasa şi coloana, încât lăsăm alegerea acestora în seama unui generator de valori aleatorii (sau „în seama calculatorului”).

Alegem la întâmplare o clasă (din vectorul global Cls) şi tot la întâmplare, două coloane (asigurându-ne că ambele, conţin clasa respectivă); schimbăm clasa între cele două coloane – repetând alegerile menţionate, dacă mutarea nu reuşeşte – şi pe orarul rezultat aplicăm recast() (şi returnăm rezultatul):

gen_rand_tmt <- function(morr) {
    repeat {
        ql <- sample(Cls, size = 1)  # alege aleatoriu o clasă
        repeat {
            h12 <- Cmb[, sample(ncol(Cmb), 1)]  # două coloane conţinând clasa
            if(ql %in% morr[, h12[1]] & ql %in% morr[, h12[2]]) 
                break
        }
        mor <- move_cls(morr, h12[1], h12[2], ql)
        if(!is.null(mor)) 
            break  # orar cu schimbarea între coloane a clasei alese
    }
    recast(mor)  # aplică mutări corectoare, reducând numărul ferestrelor 
}

Adoptăm orarul returnat în final, dacă are mai puţine ferestre decât precedentul; altfel (probabil, cel mai adesea) reapelăm gen_rand_tmt(), repetând până când numărul de ferestre se stabilizează la o anumită valoare (şi dacă numărul de repetări este suficient de mare, putem spera ca această valoare să fie acceptabil de mică):

search_better <- function(mxt, Niter = 5000, GD = Good) {
    ng <- NG <- count_gaps(mxt)
    if(ng <= GD) return(mxt)
    while(ng > GD) {
        Best <- mxt
        ng <- NG  # print("***", quote=FALSE)
        repeat {
            for(i in 1:Niter) {
                Si <- gen_rand_tmt(Best)  # derivează aleatoriu un "nou" orar
                ngi <- count_gaps(Si)  # ; cat(ngi, " ")
                if(ngi <= ng) {  # acceptă, dacă nu-s mai multe ferestre
                    Best <- Si
                    ng <- ngi
                }
            }
            if(ng == ngi || ng <= GD)  # Best n-a mai putut fi îmbunat (sau ng <= GD)
                break  # reia de la capăt (reiniţializând Best cu 'mxt', dacă ng > GD)
        }
    }
    Best
}

Valoarea globală Good – indicată iniţial în parametrul 'GD' – precizează cumva, numărul aşteptat de ferestre, pentru orarul returnat în final; am ales rezonabil, 5% din totalul orelor claselor, pe ziua curentă – dar dacă nu s-au epuizat cele Niter iteraţii, atunci reducerea de ferestre va continua şi dincolo de această limită; de exemplu, pentru 167 de ore ale claselor, avem Good=8, iar limita de 8 ferestre se atinge eventual după 1000 de iteraţii, încât dacă Niter a fost fixat la 2000 să zicem, atunci vom putea ajunge eventual, la un orar cu numai 4 ferestre (pe de altă parte, putem fixa direct în GD, valoarea 5, sau chiar 4, în loc de Good).

Variabilele globale şi execuţia programului

Într-un anumit fişier avem orarele zilelor (obţinute prin programele anterioare daySchoolSchedule.R şi correct.R), sub forma unor matrici-orar pe clase; instituim o listă RC în care să obţinem folosind cele de mai sus, variante cu număr redus de ferestre, ale orarelor respective:

l5mo <- readRDS("correct.RDS")  # matricele-orar după clase, ale zilelor
Zile <- c("Lu", "Ma", "Mi", "Jo", "Vi")
RC <- vector("list", 5)  # va înregistra orarele, după reducerea ferestrelor
names(RC) <- Zile
prnTime()  # va afişa timpul curent

O „matrice-orar după clase” are liniile indexate (sau denumite) după clase şi indică pe fiecare linie, profesorii şi eventual cuplurile care intră la clasele respective în fiecare oră 1..7 a zilei (forma lăsată de correct.R pentru orarele pe care le produce):

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

Prin funcţiile din [3] (introduse în stmt_utils.R), ere_matrix() şi to_table(), transformăm matricele-orar pe clase în matrice-orar pe profesori; între timp, am extins to_table() astfel încât (dar numai pentru lizibilitate) liniile matricei-orar pe profesori să fie ordonate după cuplaje şi apoi, alfabetic.

Pentru fiecare zi, constituim variabilele globale necesare şi lansăm search_better(), alegând ca Niter 2000 şi ca GD 5; în final, afişăm timpul curent şi salvăm rezultatul:

for(z in 1:5) {
    Z <- to_table(l5mo[[z]])  # orarul iniţial al zilei curente
    profz <- unlist(unique(Z$prof))  # prof. (şi cei fictivi) pe ziua curentă
    Tz1 <- twin_day(Tw1, profz)
    Tz2 <- twin_day(Tw2, profz)
    nTz1 <- names(Tz1);  nTz2 <- names(Tz2)
    Sbf <- hidden_gaps()  # cuplajele cu profesor fără ore proprii
    MOP <- as.matrix(Z[, 2:ncol(Z)])  # matricea orelor profesorilor
    row.names(MOP) <- Z$prof 
    nT12 <- union(nTz1, nTz2)
    rows_Tw <- rownames(MOP) %in% nT12  # selector pentru submatricea cuplajelor
    Hmax <- ncol(MOP)  # nr. maxim de ore ale unei clase, în ziua respectivă
    Good <- sum(MOP != '-') / 100 * 5 # nr. aşteptat de ferestre, pe ziua curentă
    Cmb <- combn(Hmax, 2)  # combinările de două coloane ale matricei curente
    NG1 <- count_gaps(MOP) # numărul iniţial de ferestre
    print(NG1)  # numărul iniţial de ferestre
    W <- search_better(MOP, 2000, 5)  # a reduce la cel mult 5 ferestre
    print(count_gaps(W))
    prnTime()
    RC[[Zile[z]]] <- W  # salvează orarul rezultat
}
save(RC, file="RC-10dec.RDS")  # încheie "recast.R"

Redăm o mostră de execuţie a programului (bineînţeles că afişările intermediare de valori ne-au servit doar pentru a urmări cât de cât, mersul programului):

> source("recast.R")
[1] 16:08:27
[1] 32  # ferestre iniţiale, în prima zi
[1] ***
31  28  27  26  25  24  23  22  21  20  19  18  16  15  14  11  10  9  8  7  
[1] ***
6  5  [1] 5  # ferestre rămase după reducere
[1] 16:18:22  # timpul consumat de reducere: 10 min.
[1] 37  # ferestre iniţiale în a 2-a zi
[1] ***
35  34  33  32  31  30  29  28  26  25  24  23  22  21  19  18  17  16  15  14  13 
 11  10  9  8  7  5  4  3  [1] 3  # rămase după reducere
[1] 16:23:06  # timpul consumat de reducere: 5 min.
[1] 27  # ferestre iniţiale, ziua 3
[1] ***
25  24  23  22  21  20  19  18  17  15  14  13  12  11  
10  9  6  5  [1] 5  # rămase după reducere
[1] 16:28:33  # timpul consumat de reducere: 5 min.
[1] 22  # ferestre iniţiale, ziua 4
[1] ***
19  17  16  15  14  13  11  9  8  7  6  5  4  [1] 4  # după reducere
[1] 16:32:40  # timpul consumat de reducere: 4 min.
[1] 37  # ferestre iniţiale, ziua 5
[1] ***
36  34  33  32  31  30  29  28  27  26  25  24  23  22  21  20  19  18  17  16  15
  14  13  12  11  10  9  8  7  6  5  4  [1] 4  # rămase
[1] 16:38:22  # timpul consumat de reducere: 6 min.

În total, execuţia a durat 30 de minute – infim, faţă de cât ne lua procedeul „manual” anterior, prin aplicaţia interactivă dayRecast.html; durata medie de 5-6 minute pentru o zi, s-a menţinut într-un număr de reexecutări independente ale programului.

Fiecare nouă executare a programului produce pentru fiecare zi (presupunând totuşi, un număr rezonabil de repetări), un orar care diferă măcar în câteva locuri, de orarul obţinut într-o execuţie anterioară (cum era de aşteptat, dat fiind că programul mizează pe câteva elemente aleatorii). Bineînţeles că putem alege din diverse execuţii orarul câte unei anumite zile, sau putem rula repetat numai pentru o anumită zi (sau putem rula programul pe mai multe calculatoare, simultan); extrăgând din execuţii repetate, am putut obţine (pentru cazul de faţă) un set de orare zilnice care au câte numai 3 ferestre (câte una, la 3 profesori), exceptând o singură zi – aceea cu matricea-orar pe clase redată mai sus – pe care au rămas totuşi 4 ferestre (iniţial erau 32 de ferestre):

> print.table(RC[[1]])  # ziua "Lu"
        1   2   3   4   5   6   7  
p01     -   -   -   -   12A 11A -    # 1 (ora a 4-a)
p01p02  11B 10A 12A -   -   -   -  
p02     -   -   -   11D 11B 9A  -  
p06     -   5G  -   -   11F 12F -    # nu are ferestre, fiind cuplat prin "p06p33"
p06p33  -   -   10F 9C  -   -   -  
p33     -   9D  -   -   7G  9F  -    # nu are ferestre, fiind cuplat prin "p06p33"
p08     -   12D -   -   9F  6G  -  
p08p11  -   -   -   12E -   -   -  
p08p25  -   -   12E -   -   -   -  
p08p47  12E -   -   -   -   -   -  
p11     10F 9B  -   -   -   9C  -    # 1 (ora a 3-a)
p11p44  -   -   -   -   11E -   -  
p25     11A 11F -   10C -   -   -    # nu are fereastră, fiind cuplat prin "p08p25"
p07     10C 12F 9C  12C -   -   -  
p34p07  -   -   -   -   10E -   -  
p09     -   10B 11E 11F 10D -   -  
p34p09  -   -   -   -   -   9E  -    # p34 intră numai în cuplaj, orele 5 şi 6
p03     9B  9E  10E 11E 9C  10F -  # urmează (alfabetic) cei neimplicaţi în cuplaje  
p04     12A 11D 12F 10E 5G  -   -  
p05     10B 11B 10C 8G  9A  -   -  
p10     11E 9C  11D 9F  9B  -   -  
p12     -   -   10D 11B 12F 10A -  
p13     -   -   10A 9E  8G  11B -  
p14     11F 8G  -   9A  10A -   -    # 1 (ora a 3-a)
p15     -   -   -   10B 12D 12E 10A
p16     -   12B -   9B  10C 10D -    # 1 (ora a 3-a)
p17     -   -   11C 5G  12B 12A -  
p18     -   -   12C 11C 9D  10B -  
p19     -   -   9D  10D 12E 12C -  
p20     -   -   11A 12F 10F 8G  -  
p21     10D 12E 7G  10A -   -   -  
p22     -   -   12D 12B 10B 9B  -  
p23     -   -   9F  11A 12C 11F -  
p24     12B 9A  6G  7G  -   -   -  
p26     12F 11E 11F 9D  -   -   -  
p27     -   -   9E  12D 11D 10E -  
p28     10E 11C 11B -   -   -   -  
p29     9D  12C 12B -   -   -   -  
p30     -   -   -   12A 11C 12B -  
p31     11C 10D 9B  -   -   -   -  
p32     9A  7G  10B -   -   -   -  
p35     -   -   -   10F 11A 10C -  
p36     10A 12A 9A  -   -   -   -  
p37     9C  9F  -   -   -   -   -  
p38     9E  10C -   -   -   -   -  
p39     -   -   -   -   9E  9D  10E
p40     7G  11A -   -   -   -   -  
p42     12C 6G  -   -   -   -   -  
p45     9F  10F 5G  6G  -   -   -  
p46     5G  10E 8G  -   -   -   -  
p49     12D -   -   -   -   -   -  
p50     6G  -   -   -   -   -   -  
p56     -   -   -   -   6G  5G  8G 
p58     11D -   -   -   -   -   -  
p61     8G  -   -   -   -   -   -  
p62     -   -   -   -   -   7G  -  

Dar ce-ar zice oare, profesorii noştri (p01, p02, ş.a.m.d.) – e bun orarul, sau nu? De obicei, fiecare apreciază prin prisma propriilor interese.

Răspunsul ar trebui să depindă de principii, nu de indivizi şi de nazuri (mascate pompos prin „soft constraints”, în diverse lucrări asupra "timetable problem"); putem încă înţelege (dar nu credem) că 4 ferestre pe zi este prea mult (am vrea desigur, orare cu zero ferestre) – dar cerinţe de genul "p35 trebuie să aibă orele numai de la ora 8 la ora 11" (şi nu ultimele ore, cum apare în orar) ţin nu de principii juste, ci numai de nazuri individuale (şi important desigur, de „vezi că aşa a zis şefu'”).
Chiar n-ar trebui permise, presiuni asupra programului (programatorului), pentru a ţine seama de asemenea artificii; ar fi de ţinut partea unui principiu de bază pentru orice dezvoltare: "as simple as possible, but not simpler".

vezi Cărţile mele (de programare)

docerpro | Prev |