[1] V.Bazon - De la seturi de date și limbajul R, la orare școlare (Google Books)
[2] V. Bazon - Orare școlare echilibrate și limbajul R (Google Books)
Fie "gaps.R" fișierul funcțiilor din [2] pentru reducerea ferestrelor din orarul unei zile; listăm aici prototipurile, boldând pe cele care constituie "mecanismul de reducere":
> grep("^[^#]\\S.*function", readLines("gaps.R"), value = TRUE) %>% sub(").*", ")", .) %>% print(quote=FALSE) [1] prnTime <- function(S = "") [2] hourly_matrix <- function(Dorar) [3] cnt_holes <- function(sb) [4] bin_patt <- function(matPr) [5] count_gaps <- function(Mop) [6] move_cls <- function(Mop, h1, h2, Cls) [7] cover_gaps <- function(Mop) [8] choose_next <- function(Mop) [9] recast <- function(Mop) [10] search_better <- function(Mop, Niter = 6000, GD = 4)
hourly_matrix() transformă forma normală 'Dorar' a orarului zilei (linii prof|cls|ora), în matrice-orară (cu liniile numite după prof, indicând pentru fiecare oră 1:7 clasele la care au de intrat profesorii).
cnt_holes() dă numărul de ferestre ale unui orar individual (de cel mult 7 ore) care este furnizat ca șablon binar 'sb' al orelor profesorului respectiv.
bin_patt() furnizează vectorul șabloanelor binare ale liniilor din matricea-orară 'matPr' indicată, permițând depistarea liniilor pe care avem ferestre. Lista prealabilă SBC (v. [3]) asociază șabloanelor cu ferestre câte o listă de "mutări corectoare" — exploatată, în cursul procesului de reducere a ferestrelor, prin cover_gaps() și move_cls().
count_gaps() socotește și returnează numărul total de ferestre, din matricea-orară 'Mop' indicată (având în vedere și cazul când profesorul este implicat în cuplaje).
search_better() modelează trecerea succesivă de la un orar la unul cu mai puține ferestre, repetând de un anumit număr de ori (cel mult 'Niter' × Rep iterații) următoarea operație: aplică recast() pe matricea-orar curentă (inițial, 'Mop') și dacă pe orarul rezultat 'Best', nu sunt mai multe ferestre decât pe cel curent, atunci 'Best' devine "orarul curent" al următoarelor iterații.
Însă funcția recast() din [2], a fost gândită cam mecanic (fără "bun simț"):
recast <- function(Mop) { # 'Mop' este orarul iniţial Rep <- 5 # asigură un maximum de 6 reluări ale buclei de căutare repeat { mpn <- choose_next(Mop) if(is.null(mpn)) break Mop <- mpn[[1]] # noul orar (după mutarea curentă) NG2 <- mpn[[2]] if(NG2 < NG1) { # în NG1 avem global, cel mai mic număr de ferestre NG1 <<- NG2 cat(NG1, " ") # semnalează reducerea curentă și continuă break } else { # contorizează eșecurile și eventual, reia căutarea Rep <- Rep - 1 if(Rep < 0) break } } Mop # de regulă, un orar cu mai puţine ferestre }
Demersurile prevăzute în recast() seamănă mult cu cele din search_better — semn că lucrurile n-au fost tocmai bine gândite… Plecând de la orarul curent 'Mop', se repetă de vreo șase ori, următoarea operație: prin choose_next(), se aplică lui 'Mop' o "mutare corectoare" și… se reține rezultatul în 'Mop'; abia apoi, se verifică dacă numărul de ferestre s-a micșorat, caz în care se returnează 'Mop' (după semnalarea pe ecran, a reducerii respective).
Dar dacă numărul de ferestre nu s-a micșorat, atunci se repetă a doua oară această operație, plecând însă de la 'Mop' rezultat în precedenta operație; dacă repetând a doua oară, a treia oară, etc. numărul de ferestre nu se micșorează, atunci se returnează matricea 'Mop' din ultima operație — deci în final avem un orar depărtat putem zice (cu vreo șase pași) față de orarul inițial și care nu are mai puține ferestre ca acesta!
Justificam tacit acest procedeu plecând de la faptul că choose_next() returnează un orar în care numărul de ferestre este fie mai mic (cum ne dorim), fie egal cu cel din orarul curent; când numărul de ferestre ar fi cel minim posibil, prin choose_next() va rezulta mereu fie NULL (orar cu mai multe ferestre decât cel curent), fie un orar în care numărul de ferestre nu s-a modificat — semn că procesul de reducere este încheiat.
Pe de altă parte, acceptând pe parcurs și trecerea la un orar cu același număr de ferestre, se creează o anumită variație a căutării, prevenind blocarea înainte de vreme a procesului de reducere; dar obținând un orar cu același număr de ferestre, firesc ar fi să continuăm cu acesta, în loc de a repeta choose_next() asupra lui (ceea ce oricum s-ar întâmpla dacă este cazul, în cursul iterațiilor următoare din search_better()).
Revăzând acum aceste justificări, ne dăm seama că funcția recast() este inutilă și o putem elimina, încorporând apelul choose_next() direct în search_better():
search_better <- function(Mop, Niter = 3000, GD = 4) { ng <- NG1 # NG1 reține (global) numărul de ferestre din orarul curent Rep <- 4 # asigură maximum 5 reluări ale următoarei secvențe iterative while(ng > GD) { Best <- Mop repeat { for(i in 1:Niter) { mpn <- choose_next(Best) # aplică o mutare corectoare if(is.null(mpn)) next ngi <- mpn[[2]] # numărul de ferestre pe orarul rezultat if(ngi <= ng) { Best <- mpn[[1]] # acceptă, dacă nu-s mai multe ferestre if(ngi < ng) cat(ngi, " ") # afișează reducerea ng <- ngi NG1 <<- ng # actualizează global numărul minim } } cat("*", ng, " ") # semnalează încheierea iterațiilor Rep <- Rep - 1 # lansează eventual, o nouă serie de iterații if(ng <= GD || Rep < 0) return(Best) # orarul curent n-a mai putut fi îmbunătăţit } } Mop # când orarul inițial ar avea nu mai mult de GD ferestre }
Pentru testare, să considerăm orarul din [4], cu o încadrare foarte densă: 64 de clase, pe 95 de profesori cu normă întreagă (unul singur are 16 ore, trei au câte 17 ore, iar ceilalți au câte 18-22 de ore/săptămână); experimentele anterioare (în care foloseam recast(), ca în [2]) ne-au convins că numărul de ferestre din orarele zilnice existente nu poate fi mai mic decât (28,29,27,27,28). În următorul program, repetăm search_better() — în versiunea redată mai sus — pe fiecare zi, pănă ce numărul de ferestre ajunge la valoarea știută pentru ziua respectivă (sau eventual, la una mai mică):
source("gaps.R") ORR <- readRDS("Orar1.RDS") # listă [[Zi]]: lecții prof|cls|ora mORR <- map(ORR, hourly_matrix) W <- list() # va înregistra orarele cu număr redus de ferestre stakes <- c(28, 29, 27, 27, 28) %>% setNames(Zile) # numărul mizat de ferestre/zi for(zi in Zile) { repeat { NG1 <- count_gaps(OZ) # numărul inițial de ferestre prnTime(paste0(" ", zi, " (", NG1, " ferestre)\n")) orr <- search_better(OZ) if(NG1 <= stakes[zi]) break prnTime("\n") } W[[zi]] <- orr[order(rownames(orr)), ] prnTime("\n") }
Bineînțeles că rezultatele diferă de la o execuție la alta: în cover_gaps() (invocată din choose_next()) se alege la întâmplare o parte de o anumită dimensiune din subsetul liniilor cu ferestre și apoi dintre mutările corectoare corespunzătoare prin SBC acestei părți, se alege una, aleatoriu.
În general, rezultatele se obțin în 20-30-40 de minute, dar în cel mai fericit caz, execuția a durat numai 11 minute și ne permitem să o evocăm aici:
07:47:34 Lu (70 ferestre) 69 68 67 66 65 64 63 62 60 59 58 57 56 55 54 53 52 51 50 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 * 33 32 31 * 31 30 * 30 * 30 29 * 29 07:48:31 # s-a coborât la 29 ferestre, în 1 minut 07:48:31 Lu (70 ferestre) 69 68 67 66 65 64 63 62 61 60 59 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 * 31 30 * 30 * 30 * 30 07:49:28 07:49:28 Lu (70 ferestre) 69 68 67 66 64 63 62 61 60 59 58 55 54 53 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 * 33 32 * 32 31 30 * 30 * 30 * 30 07:50:25 07:50:25 Lu (70 ferestre) 69 68 67 66 65 64 63 62 61 59 57 56 55 54 52 51 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 * 32 * 32 31 * 31 * 31 * 31 07:51:22 07:51:22 Lu (70 ferestre) 69 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 * 31 * 31 * 31 * 31 07:52:19 07:52:19 Lu (70 ferestre) 69 68 67 66 65 63 62 61 60 59 58 57 56 54 53 51 50 49 48 47 46 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 * 29 * 29 28 * 28 * 28 * 28 07:53:15 07:53:15 Ma (74 ferestre) 72 71 70 69 68 67 66 65 64 63 62 61 60 58 57 56 55 54 53 50 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 * 31 * 31 30 * 30 29 * 29 * 29 07:54:12 # au rezultat 29 de ferestre, dar nu mai puțin, în 1 minut 07:54:12 Mi (70 ferestre) 69 68 67 66 65 64 63 62 61 60 58 56 54 53 52 50 49 48 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 29 * 29 * 29 28 * 28 * 28 27 * 27 07:55:08 07:55:08 Jo (76 ferestre) 75 74 72 71 70 69 68 67 66 65 64 63 60 59 58 57 56 55 54 53 52 51 50 49 48 47 46 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 * 30 * 30 29 * 29 * 29 * 29 07:56:06 07:56:06 Jo (76 ferestre) 75 74 73 72 71 70 69 68 67 66 65 64 63 62 61 60 59 58 57 56 55 54 53 52 51 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 32 31 30 * 30 29 28 27 * 27 * 27 * 27 * 27 07:57:02 07:57:02 Vi (74 ferestre) 73 72 71 70 69 68 67 66 65 64 63 61 60 59 58 57 56 55 54 53 52 51 49 48 47 46 45 44 43 42 41 40 39 38 37 36 35 34 33 * 33 32 31 30 * 30 29 * 29 28 * 28 * 28 07:58:00
În general, o execuție search_better() durează acum (constant) un minut (nu cel puțin parcă 4 minute, ca în [2]) și conduce la un orar în care numărul de ferestre este doar cu 1, 2 sau 3 mai mare decât cel minim posibil (trebuind să repetăm search_better() de mai multe ori pentru ziua respectivă, pentru a ajunge chiar la "minimul posibil").
Dar subliniem că lucrurile depind și de valoarea aleasă pentru parametrul 'Niter' din apelul search_better() (aici, 3000 s-a dovedit a fi suficient; în [2] alesesem 6000); deasemenea, depind și de proporția de linii cu ferestre aleasă (la întâmplare) în cover_gaps() (aici am ales după câteva experimente, min(wg, 8), unde wg este numărul de linii cu ferestre din cadrul matricei-orar curente).
vezi Cărţile mele (de programare)