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

Reducerea ferestrelor din orarul zilei (III)

limbajul R | orar şcolar
2021 dec

Ne-am format îndelung trei obiceiuri complementare, în această ordine: obiceiul de a greşi (nebanal şi nici grosolan), de a verifica şi de a rescrie lucrurile. Greşala promite, dacă nu te fereşti mereu şi dacă îi accesezi acareturile: a înţelege că ai greşit; a depista (în fel şi chip) unde anume; a înţelege de ce ai greşit; a stabili să nu repeţi greşala. Greşala este în fond, sămânţa progresului (exceptând desigur, lumea cea plină de greşeli ireparabile).

Experimentând suficient vrecast.R (v. [2] şi [1] - IV – vizate mai jos prin „anterior”), am putut constata diverse defecte şi chiar greşeli; prin urmare… avem iarăşi, de rescris.

Greşeli, fel de fel

Am reţinut câteva greşeli, corectate între timp (cum vom arăta mai încolo, rescriind programul); redându-le acum, post-factum, recunoaştem încă o dată greşala de a nu ne fi folosit de git, cum s-ar cuveni când lucrezi la un program vast: ne cam chinuim acum cu reconstituirea unor lucruri petrecute în versiuni vechi ale programului.

1.
Pentru unul dintre orare, ferestrele au fost reduse succesiv la 23, 17, 12 ş.a.m.d.; cam după 5 minute, s-a ajuns la 8 ferestre şi după încă vreo 5 minute, la rezultatul final, cu 6 ferestre:

> source("vrecast.R")  # o versiune veche, a programului
[1] 33   # numărul iniţial de ferestre
[1] 18:49:20  # momentul începerii execuţiei
23  17  12  11  10  9  8  7  6  [1] 6  # numărul de ferestre, pe parcurs (în final, 6)
       1   2   3   4   5   6   7  
p01    11A 10A -   -   -   12A -  
p01p02 -   -   12A 11A 9A  -   -   # p01 şi p02, împreună (ambii, fără ferestre)
p02    11D 11B -   -   -   9A  -  
p06    -   -   11D 12D 9F  12F -  
p06p33 9A  10E -   -   -   -   -   # p06 şi p33 nu au ferestre
p33    -   -   8G  9E  -   -   -  
p08    -   10F 9F  -   11B 12D -   # p08 şi p25 nu au ferestre
p08p25 -   -   -   12E -   -   -  
p08p47 12E -   -   -   -   -   -  
p11    10F -   9E  9F  12A -   -   # p11 nu are ferestre
p11p44 -   11E -   -   -   -   -  
p25    8G  10B 11A -   -   -   -  
p07    -   -   12F 9B  10C 10A -   # p07 nu are ferestre
p34p07 -   -   -   -   -   -   10E  # p34 şi p07
p09    -   -   7G  10D 11F 11C -   # p09 nu are ferestre
p34p09 -   9E  -   -   -   -   -   # p34 şi p09
# restul profesorilor (majoritatea) nu intră în cuplaje

Am redat aici numai liniile profesorilor care fac parte din cuplaje; am verificat că pe celelalte linii, avem în total 5 ferestre – deci a 6-a fereastră ar trebui să fie pe una dintre liniile redate… ceea ce nu este adevărat: p34 nu are ore proprii în ziua respectivă şi face a 2-a oră împreună cu p09, apoi tocmai a 7-a oră, împreună cu p07 – însemnând că are 4 ferestre (şi numai de aici, ar putea rezulta „a 6-a fereastră” – ceilalţi profesori cuplaţi nu au vreo fereastră). Rezultatul corect era 5+4=9 ferestre, nu 6.

2.
Pentru un alt orar, imediat după lansarea programului s-a semnalat:

Error in if (bitwAnd(bith[prf], B) > 0) return(FALSE) : 
  missing value where TRUE/FALSE needed

Comanda imediată traceback() ne-a indicat sursa erorii:

# dintr-o versiune anterioară a programului:
vrf_over <- function(morr) {
    bith <- get_bin_patt(morr)  # şabloanele binare ale orelor alocate curent
    for(prf in nx2) {  # 'prf' este unul dintre profesorii fictivi
        B <- 0L
        for(pc in Lx2[[prf]])
            B <- bitwOr(B, bith[pc])
        if(bitwAnd(bith[prf], B) > 0)  # cam de aici, provine eroarea
            return(FALSE)
    }
    TRUE  # lecţiile cuplate de profesorii fictivi NU se suprapun
}

N-a fost greu de lămurit lucrurile: întâi, am afişat 'bith' şi am verificat că acest vector conţine într-adevăr, numai profesorii care au ore în ziua respectivă (indicând pe câte un octet, orele 1..7 alocate fiecăruia prin orarul zilei); apoi, am listat 'Lx2', care este în fond un „dicţionar” prin care fiecărui profesor fictiv existent în orar i se asociază câte un vector care conţine profesorii (fictivi sau nu) cu care acesta nu are voie să se suprapună într-o aceeaşi oră – şi am descoperit îndată că acest dicţionar conţine şi "p08p11", care în ziua respectivă nu are ore (şi deci trebuia eliminat din Lx2).
Când 'prf' ajunge la "p08p11", vectorul Lx2[[prf]] devine "(p08, p11, p08p25, p08p47, p11p44)" – dar "p08p25" nu apare nici el în ziua respectivă, încât atunci când 'pc' ajunge "p08p25", valoarea bith[pc] este nedefinită ("missing value", sau NA), iar NA se propagă mai departe, conducând la mesajul de eroare deja redat mai sus.

Prin urmare, greşala trebuie căutată în funcţia anterioară select_cupl(), a cărei intenţie era aceea de a restrânge listele săptămânale Lx1 şi Lx2 la datele existente în ziua curentă ("p08p11" trebuia eliminat din Lx2).

Dar este de observat o altă greşală, de data aceasta una „promiţătoare”. Înfiinţasem vrf_over() pentru a semnala vreo eventuală suprapunere ascunsă, apărută în urma mutării prin move_cls() a unei clase, dintr-o coloană orară în alta; numai că mutarea de clase între două coloane angajează numai aceste două coloane ale orarului, în timp ce vrf_over() verifică absenţa suprapunerilor pe toate coloanele. Progresăm deci, la ideea de a elimina vfr_over(), incluzând în schimb la finalul lui move_cls() o mică secvenţă de verificare a celor două coloane.

3.
În sfârşit, urmărind iarăşi un anumit progres, să analizăm cumva funcţia anterioară choose_min(); ea preia orarul rezultat după o mutare de clasă, obţine din cover_gaps() lista reparaţiilor de ferestre, aplică prin move_cls() fiecare dintre aceste reparaţii şi înregistrează numărul de ferestre rezultat astfel; în final returnează primul orar dintre cele „reparate”, care are numărul minim de ferestre:

# choose_min() din prima versiune a programului
choose_min1 <- function(mxt) {  # 'mxt': orarul rezultat după mutarea unei clase
    swp <- cover_gaps(mxt)  # lista reparaţiilor „standard” de ferestre
    swp$ng <- 100
    for(i in 1:nrow(swp)) {  # aplică pe rând, reparaţiile
        mor <- move_cls(mxt, swp[i,1], swp[i,2], swp[i,3])
        if(! is.null(mor)) {
            swp$ng[i] <- count_gaps(mor)  # numărul de ferestre (inclusiv, fictive)
        }
    }
    im <- which.min(swp$ng)  # reţine primul orar cu minimum de ferestre 
    list(move_cls(mxt, swp[im,1], swp[im,2], swp[im,3]), 
         swp$ng[im])
}

Am adăugat în tabelul de reparaţii coloana $ng, pe care am înscris (prin for()) pentru fiecare nou orar numărul de ferestre ale acestuia; în final, am determinat valoarea minimă din coloana $ng şi pentru a returna rezultatul, am re-aplicat move_cls() pe datele liniei respective.

Dar de regulă este mai eficient să folosim operaţii map() în loc de for() şi pare mai eficient să folosim un vector ng simplu, în loc de a anexa tabelului şi a folosi coloana $ng (deşi… o asemenea coloană nu este decât tot un „vector simplu”):

# variantă de choose_min(), cu map_dbl() 
choose_min2 <- function(mxt) {  # 'mxt': orarul rezultat după mutarea unei clase
    swp <- cover_gaps(mxt)  # lista reparaţiilor „standard” de ferestre
    ng <- map_dbl(1:nrow(swp), function(i) {
             mor <- move_cls(mxt, swp[i,1], swp[i,2], swp[i,3])
             ifelse(is.null(mor), 100, count_gaps(mor))
    })
    im <- which.min(ng)  # reţine primul orar cu minimum de ferestre 
    list(move_cls(mxt, swp[im,1], swp[im,2], swp[im,3]), 
         ng[im])
}

Dar decât să reţinem într-un vector toate numerele de ferestre, să determinăm numărul minim înscris în acest vector şi apoi să re-aplicăm move_cls() pe linia de reparaţii corespunzătoare acestui minim – parcă ar trebui să fie mai eficient, algoritmul obişnuit de găsire a minimului dintr-o secvenţă introdusă iterativ (păstrăm la fiecare pas valoarea mai mică):

# variantă de choose_min() (căutarea obişnuită, a minimului)
choose_min3 <- function(mxt) {  # 'mxt': orarul rezultat după mutarea unei clase
    ng <- count_gaps(mxt)
    swp <- cover_gaps(mxt)  # lista reparaţiilor „standard” de ferestre
    M <- mxt
    for(i in 1:nrow(swp)) {
        mor <- move_cls(mxt, swp[i,1], swp[i,2], swp[i,3])
        if(! is.null(mor)) {
            ng1 <- count_gaps(mor)
            if(ng1 < ng) {  
                ng <- ng1
                M <- mor  # la momentul curent, are minimum de ferestre
            }
        }
    }
    list(M, ng)
}

Următoarea secvenţă ad-hoc iterează pe lista constituită din funcţiile redate mai sus şi măsoară pentru fiecare, timpul de execuţie pe câte 1000 de repetări:

for(choose in list(choose_min1, choose_min2, choose_min3)) {
    start <- Sys.time()
    for(i in 1:1000) LM <- choose(MXT)
    end <- Sys.time()
    print(end - start) 
}
Time difference of 3.827449 mins  choose_min1()
Time difference of 3.819324 mins  choose_min2()
Time difference of 3.844236 mins  choose_min3()

Ca timp de execuţie, diferenţa între ele este foarte mică – totuşi, ea se menţine pe toate orarele încercate şi fiindcă vom avea de repetat choose_min() de măcar vreo două-trei mii de ori, vom alege de-acum a doua dintre cele trei funcţii (ceva mai rapidă, dar şi mai scurtă şi să zicem elegantă, faţă de celelalte).

vezi Cărţile mele (de programare)

docerpro | Prev | Next