[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)
[3] v. partea a II-a
Prin programele din [2] — folosind sau nu, varianta îmbunătățită în [3] a funcției cover_gaps() — rezultă în final, orare zilnice cu un număr rezonabil de ferestre. De regulă, la profesorii cu 5 sau 6 ore/zi apare cel mult câte o singură fereastră (iar cei cu mai puțin de 4 ore/zi nu au ferestre); însă la cei care au 4 ore/zi, apare uneori și situația foarte nedorită, când sunt două ferestre consecutive:
mORR <- readRDS("orar_3.RDS") # orarul rezultat în [3] OZ <- mORR[["Lu"]] apply(OZ, 1, function(Row) if(grepl("\\w+--\\w+", paste0(Row, collapse=""))) Row ) %>% compact() %>% list2DF() %>% t() %>% print(., quote=FALSE) [,1] [,2] [,3] [,4] [,5] [,6] [,7] Fr3 12A 8C - - 9B 10C - Is5 10A 7E - - 5A 10E - Ro8 8H 12D - - 7D 10H -
Vom arăta cum, prin aceleași programe, putem reduce numărul acestor cazuri (uneori, chiar la zero), adaptând puțin funcțiile cover_gaps() și search_better().
Întâi, constituim ca în [3] (prin funcția register_holes()) setul MC, etalând informații asupra celor 28 de ferestre rămase în matricea-orar OZ; splităm MC după șabloanele binare din câmpul $sb și aflăm care șabloane corespund liniilor pe care avem 4 clase cu cel puțin o fereastră:
S <- MC %>% split(.$sb) map(names(S), function(B) if(cnt_hours(S[[B]]$sb[1]) == 4) B ) %>% compact() %>% unlist() [1] "23" "27" "51" # "***-*--" "**-**--" "**--**-"
De exemplu, avem:
> S[["51"]] # A tibble: 36 × 7 h1 h2 ql sb SB sb1 SB1 1 1 3 12A 51 **--**- 54 -**-**- 2 1 4 12A 51 **--**- 58 -*-***- 3 1 7 12A 51 **--**- 114 -*--*** 4 2 3 8C 51 **--**- 53 *-*-**- 5 2 4 8C 51 **--**- 57 *--***- 6 2 7 8C 51 **--**- 113 *---*** 7 5 3 9B 51 **--**- 39 ***--*- 8 5 4 9B 51 **--**- 43 **-*-*- 9 5 7 9B 51 **--**- 99 **---** 10 6 3 10C 51 **--**- 23 ***-*-- # 26 more rows
Deci orarele individuale din OZ de câte 4 ore cu cel puțin o fereastră încep la prima oră și au fie o singură fereastră (în ora 3, sau în ora 4), fie două ferestre consecutive (în orele 3 și 4). Subliniem că pentru orarul unei alte zile, putem găsi alte situații — de exemplu, cele 4 lecții încep de la a doua oră (cu ferestre în orele 4 sau 5)…; altfel spus, etapa preliminară de depistare în orarul curent a șabloanelor de 4 lecții cu cel puțin o fereastră este una neapărat necesară pentru cele ce urmează.
Aici vom viza numai OZ, la care șabloanele respective sunt 23, 27, 51 (dintre cele 31 de șabloane din SBC, de 4 ore cu una, două sau trei ferestre).
Pentru orarul curent, următoarea funcție ne dă numărul de cazuri de 4 lecții cu două ferestre consecutive (aflate fie în orele 3 și 4 ca în șablonul 51, fie în orele 4 și 5 ca în șablonul 102="-**--**"):
count_2g <- function(Mop) apply(Mop, 1, function(Row) ifelse(grepl("\\w+--\\w+", paste0(Row, collapse=""))==TRUE, 1L, 0L)) %>% as.vector() %>% sum()
În cover_gaps() din [3] (păstrăm deocamdată numele, ca să nu mai modificăm în alte părți din programul de reducere a ferestrelor) considerăm numai cele trei șabloane fixate mai sus și returnăm una la întâmplare, dintre mutările specificate pentru ele în SBC:
cover_gaps <- function(Mop) { Vsb <- bin_patt(Mop) B <- which(Vsb %in% c(51, 23, 27)) lh1 <- lh2 <- vector("integer", 0) lql <- vector("character", 0) 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) } } wh <- sample(x = 1:length(lh1), size = 1) c(lh1[wh], lh2[wh], lql[wh]) }
Reluăm funcția search_better() din [2], pentru a ține seama acum și de count_2g():
search_better <- function(Mop, Niter = 6000, GD = 4) { ng <- NG <- count_gaps(Mop) if(ng <= GD) return(Mop) mg <- N51 <- count_2g(Mop) # numărul de cazuri "**--**" Rep <- 4 # 5 (limitează repetarea buclei de căutare) while(ng > GD) { Best <- Mop ng <- NG mg <- N51 repeat { for(i in 1:Niter) { Si <- recast(Best) # gen_rand_tmt(Best) (abandonată în [3]) if(is.null(Si)) next ngi <- count_gaps(Si) mgi <- count_2g(Si) if(ngi <= ng & mgi < mg) { Best <- Si ng <- ngi mg <- mgi } } cat("*", ng, " ", mg, " ") # semnalează încheierea căutării Rep <- Rep - 1 if(ng <= GD || Rep < 0) return(Best) # orarul curent n-a mai putut fi îmbunătăţit } } }
Lansând programul "xgaps.R" (modificat pentru cazul de față):
> source("xgaps2.R") # numai pe ziua "Lu" 17:53:48 (28 ferestre; 3) # inițial: 28 ferestre, cu 3 cazuri "**--**" * 28 0 * 28 0 * 28 0 * 28 0 * 28 0 17:58:27
constatăm că numărul total de ferestre n-a putut fi coborât sub 28 (… dar nici nu era de așteptat), însă numărul de cazuri de 4 lecții cu două ferestre consecutive a fost redus la zero (bineînțeles că ne-am ocupat numai de ziua "Lu"; pentru celelalte zile ar trebui întâi să vedem ce șabloane avem de considerat, în loc de 51, 23 și 27).
Am putea să ne convingem investigând iarăși prin register_holes(); în loc de aceasta, redăm în întregime orarul rezultat, marcând (prin boldare) ferestrele existente:
> W[["Lu"]] %>% as.data.frame() 1 2 3 4 5 6 7 Bi1 - - 10A 7H 12G 7C - Bi2 11D 7D 6B - - - - Bi3 9D 10C 12C - - - - Bi4 10D 5B 6D 8C - - - Bi5 - - 8D 7G 5C 9G - Ch1 - - - 7C 11G 12D 7G Ch2 - - - 11B 10B 7D - Ch3 - - - 8E 12B 9A - Ch4 8F 9F 7B 10D - - - Ds1 - - - - 12F 11F 10A Ds2 - - - 10B 7H 7B 9A Ds3 - - 5D 11E 9E 10F - En1 9H 8G - 12C 5D 6E - En2 - - - 8H 11C 6F 10B En3 12E 9A 10C - 6G 7H - En4 11E 5G 9B - - - - En5 12G 11F 8B - 10E 7A - En6 - - 12H 10F 9D 8C - En7 - - - 10G 8D 9E 9E En8 - - 6C 7D 9F 12A - En9 - - 5C 9C 8F 12B - Fi1 8C 9G - 10A 10G - - Fi2 8D 9B 10H - - - - Fi3 7G 6C 9C 11A 8E - - Fi4 12C 6D 11B - - - - Fi5 12D 6G 8A 11C - - - Fi6 - - 8H 6F 6H 8B - Fr1 11F 8A - 7B 10A 10H - Fr2 10B 7C - 8B 9A 12F - Fr3 12A 8C - 10C 9B - - Fr4 - - 6F 5A 6C 8D - Fr5 10E 7F 5B - 12C 9D - Fr6 5C 7H 12D - 10F - - Ge1 5E 7A 12E - 6A 8A - Ge2 5F 6F 9F 6B - - - Ge3 - - 10E 5G 9C 11C - Ge4 11H 5D - 6D 11D 8H - Gr1 - - - 12G 8G 10G - Gr2 - - - 11G 9G 5G - In1 8G 10A - 9E 6E 11E - In2 - - 9G 5B 9H 10B - In3 - - 9A 6A 11A 11G - In4 9B 11B 12F - 10D - - In5 11C 12A - 7A 5E 9C - In6 12B 7B - 9D 6D 6G - Is1 10F 12E 11H - 5G 5B - Is2 10G 12F 5H 6E - - - Is3 10H 12B 11E - - - - Is4 9C 10D 6G - 8A 8F - Is5 10A 7E - 10E 5A - - La1 5D 5H - 11D 10H 7E - La2 - - - 7F 11H 9F - Mt1 8A 9D 11D - 6F 10A - Mt10 6D 5A - 9B 7G 11B - Mt11 5B 9C 11C - - - - Mt2 6G 8B 10B - - - - Mt3 - - 11G 6H 8C 10C - Mt4 7A 8D - 9G 12A 10D - Mt5 - - 12B 9H 7B 8E - Mt6 7C 8F - 5F 5H 12C - Mt7 7D 6A 10G 8G 12D - - Mt8 6B 5C 7E - - - - Mt9 - - 11A 6C 7F 12G - Mz1 11G 5F 9D 6G - - - Mz2 9E 6E - - - - - Mz3 - - 7D 5E 8H 7G - Rg1 - - - 8D 11B 7F - Rg2 8E 11C 12G - - - - Rg3 12H 11A 5F 7E - - - Ro1 6E 9E 5A 8A 11E - - Ro10 - - 7F 12F 6B 9B - Ro11 6C 12G 7G - - - - Ro12 - - 7H 12H 12H 11D - Ro2 8B 10B 11F 11F 5B - - Ro3 9G 11G 8C 5C 10C - - Ro4 6H 11H 9H - - - - Ro5 - - 8E 12A 7A 10E - Ro6 7B 10F 8F 12B - - - Ro7 5G 12C - 9F 7C 8G - Ro8 8H 12D - 10H 7D - - Ro9 - - 6A 9A 12E 11A - Sp1 7F 8H 5G - - - - Sp2 5H 10G 6E - - - - Sp3 10C 8E 7C 5D - - - Sp4 11A 5E 10D - 11F - - Sp5 7E 6H - 12D 8B 6C - SU1 11B 9H 8G - - - - SU2 6F 7G 5E - - - - SU3 7H 11D - 12E 5F - - SU4 12F 11E 6H - - - - SU5 9A 10E 7A 5H - - - SU6 6A 12H 10F - - - - SU7 5A 6B 9E 11H - - - SU8 9F 10H 12A - - - - SU9 - - - 8F 7E 5C -
Pe ziua respectivă avem 95 de profesori (pe 64 de clase, cu 5, 6 sau 7 ore/clasă); dintre aceștia, 28 au câte o singură fereastră (ceilalți 67 nu au ferestre), anume în ora a 3-a (în total, 18 ferestre), sau în a 4-a (10 ferestre).
În [3] folosisem (cu succes, am zice) această idee pentru cover_gaps(): alegem la întâmplare o clasă de coeficient betweenness mare și returnăm una oarecare dintre mutările corectoare asociate ei în orarul curent; cele de mai sus sugerează o nouă idee: alegem cumva (iar problema este de a vedea după ce criteriu, nu chiar la întâmplare) un șablon din SBC și returnăm una oarecare dintre mutările specifice acestuia…
vezi Cărţile mele (de programare)