Vom experimenta o procedură de reducere a ferestrelor, pe acest orar (v. [1]) :
1 2 3 4 5 6 7 1 2 3 4 5 6 7
P59 5E 5D - - - - - P33 - - 7C 12A 10A 9D -
P65 7D 7E - - - - - P50 - - - 5C 9E 6B -
P64 9C 9D - - - - - P20 7B 7A - 10C 5D - -
P56 10B 5C - - - - - P21 9E 12E - 11E - - -
P71 9A 12A - - - - - P40 - - 11D 11B 9C 8B -
P67 8C - 7E - - - - P18 - 6C - 7B 6E 7A -
P72 10E 11E - - - - - P55 - - 8C - 12A 5D -
P63 11A 9A 11B - - - - P16 - - 9A 10A 5C 11A -
P58 6E 10B - - - - - P42 - - - 9B - 10B 9E
P26 8A 10E 8B 10D - - - P34 - 5A 5B 8B 11E - -
P48 8F 7B 6B - - - - P31 - - 6C 11C 9B 5E -
P49 8D 9B 12B - - - - P11 - 5E - 7E 8D 7D -
P29 8E 8A - 12C - - - P19 - - 8F 5A 7B 6E -
P66 9D - 11E - - - - P41 - - - 8E 7A 9E -
P47 7E 8E 8A - - - - P12 - - 11C 12D 11D 7E -
P51 6C 8D 9B - - - - P04 - - 7A 6C 6B 7C -
P60 12D 11C 12E - - - - P28 11B - 6A 12B 10C 9C -
P14 7C 10A 10B - - - - P32 11E - - 5E 5A 11C -
P57 5A 6B 5D - - - - P37 - - - 9A 6C 11E -
P10 12B 11B 8D - 10D - - P08 5C 12C - 6D 12D - -
P45 5B 6E - - 12C - - P22 - 6D - 10E 8E 7B -
P46 10C 12D 7B - - - - P13 - 8B 10D 8F 7D 10E -
P44 6A 9E 5C - - - - P39 - - - 8C 8F 8E 7C
P54 12E 12B 6E - - - - P23 - - - 11D 9A 10C 7D
P62 - - - 10B 9D 10A - P06 - - 12A 9E 12E 12D -
P52 11D 7C 5A - - - - P09 10A 11A - 7C 11C 8F -
P17 6D 8C - 11A 11B - - P01 10D - 11A 6A 8C 8A 8B
P35 12A 10C 6D - 11A - - P25 12C - - 5D 7E 9B -
P24 6B 6A 12D - - - - P03 7A - 5E 7D 8A 8C -
P27 8B 7D 10E 5B - - - P07 - - 9D 9C 10E 12A 8A
P53 - 9C 10C 7A 6D - - P36 - - 10A 9D 6A 8D 8C
P38 9B 5B 9E - - - - P02 - - 9C 6E 7C 6C 9B
P30 5D 8F - 6B 5E - - P05 - 10D 12C 12E 10B 9A -
P15 - - 8E 8D 8B 10D -
P43 11C 11D 7D 8A - - -
Avem aici 25 de ferestre; muncind vreo două ore în aplicaţia interactivă /dayRecast, am ajuns la numai 8 ferestre; în schimb, prin procedura „automată” pe care o introducem mai jos, obţinem într-o secundă un orar cu 14 ferestre.
Operaţia swap_cls() din [1] asigură acoperirea unei ferestre (cu riscul apariţiei altora) şi returnează orarul astfel modificat. Aplicăm orarului iniţial (sau celui curent) o secvenţă (potrivită) de swap_cls() şi dintre orarele rezultate reţinem (ca orar curent) unul cu numărul minim de ferestre; aplicăm orarului reţinut aceeaşi procedură, cât timp se ajunge astfel la un număr de ferestre mai mic decât cel curent.
Obs. Căutarea astfel a celui „mai bun” orar (plecând de la unul dat) corespunde metodei "local search" de optimizare a soluţiei unei probleme combinatoriale dificile.
Următoarea funcţie (care deşi este incompletă, este mai „lungă” decât ar fi cazul în R – dar pentru acest experiment ne mulţumim cu asta) produce o listă (de fapt, prin map_df() – un obiect "data.frame") de parametri potriviţi pentru swap_cls():
cover_gaps <- function(morr) { binp <- bin_patterns(morr) B <- which(unlist(lapply(binp, nHoles)) > 0) cover <- function(id) { pt <- whereOne(binp[id]) n <- length(pt) H1 <- pt[1] Hn <- pt[n] cls <- morr[id, ] igp <- which(cls == '-') igp <- igp[igp > H1 & igp < Hn] D <- data.frame(h1 = 0L, h2 = 0L, ql = "") k <- 1 if(igp[1] >= H1 + 1) { D[k, ] <- list(H1, igp[1], cls[H1]) k <- k + 1 D[k, ] <- list(Hn, igp[1], cls[Hn]) k <- k + 1 if(n == 2 & Hn < ncol(morr)) { D[k, ] <- list(H1, Hn + 1, cls[H1]) k <- k + 1 } if(length(igp) == 2) { if(igp[2] - igp[1] == 1) { D[k, ] <- list(H1, igp[2], cls[H1]) k <- k + 1 D[k, ] <- list(Hn, igp[2], cls[Hn]) k <- k + 1 } } } D } map_df(B, cover) }
De exemplu, pentru prima linie pe care avem o fereastră "P67 8C - 7E - ...", obţinem:
> cover_gaps(MXT)[1:3, ] h1 h2 ql 1 1 2 8C # swap_cls(., 1, 2, "8C") va da: "- 8C 7E" (acoperind fereastra iniţială) 2 3 2 7E # swap_cls() va da "8C 7E - ..." 3 1 4 8C # mută "8C" în a 4-a oră: "- - 7E 8C"
iar pentru o linie cu două ferestre consecutive, precum "P25 12C - - 5D 7E 9B -", am prevăzut 4 variante de acoperire: se mută clasa iniţială (12C) şi respectiv, cea finală (9B) pe fiecare dintre ferestre; probabil că, la un moment dat, vom adăuga o funcţie swap2_cls(), permiţând pentru cazul unei linii cu două ferestre, efectuarea pe acelaşi orar a două (sau chiar trei) mutări consecutive.
Funcţia cover() (încorporată în cover_gaps()) este esenţială în cadrul procedurii de reducere schiţate mai sus: cu cât va produce mai multe (şi mai „potrivite”) variante de acoperire, cu atât cresc şansele de a reduce (cât mai mult) numărul de ferestre. După ce vom finaliza experimentul de faţă, ne vom gândi cum să simplificăm şi să flexibilizăm cover() (faţă de formularea mecanică de mai sus)…
În funcţia următoare, obţinem prin cover_gaps() lista variantelor de acoperire; apoi, obţinem prin swap_cls() orarul corespunzător fiecărei variante şi determinăm numărul de ferestre ale acestuia; se returnează acela dintre orarele rezultate care are numărul minim de ferestre (primul de fapt, dintre cele cu minimum de ferestre):
choose_min <- function(mxt) { swp <- cover_gaps(mxt) swp$ng <- 100 for(i in 1:nrow(swp)) { mor <- swap_cls(mxt, swp[i,1], swp[i,2], swp[i,3]) if(! is.null(mor)) { B <- bin_patterns(mor) swp$ng[i] <- sum(unlist(lapply(B, nHoles))) } } im <- which.min(swp$ng) swap_cls(mxt, swp[im,1], swp[im,2], swp[im,3]) }
Funcţia recast() înlocuieşte orarul curent cu cel returnat de choose_min(), repetând cât timp numărul de ferestre devine mai mic decât valoarea curentă păstrată şi actualizată în variabila globală NG1:
NG1 <- nGaps(bin_patterns(MXT)) # numărul de ferestre din orarul iniţial recast <- function(mxt) { repeat { mxt <- choose_min(mxt) NG2 <- nGaps(bin_patterns(mxt)) # numărul de ferestre din noul orar if(NG2 < NG1) { NG1 <<- NG2 # actualizează numărul curent de ferestre } else { break } } mxt # orarul care are NG2 ferestre }
Să observăm că şi recast() este formulată „mecanic”; orarul returnat este cel rezultat prin choose_min(), deci este cel „corect” (cu min(NG1, NG2) ferestre) dacă NG2 ajunge egal cu NG1 – altfel (NG2 > NG1), se returnează (incorect) orarul cu NG2 ferestre!
Dar… de dragul experimentului, lăsăm deocamdată aşa.
Putem face o primă probă, să zicem din consolă:
> rcs <- recast(MXT) > print.table(rcs) > print(NG1)
Rezultatul este mai degrabă, nesatisfăcător; s-a redus numărul de ferestre (şi chiar, într-o fracţiune de secundă) – dar abia la 19.
Avem un loc unde am putea încerca imediat, o îmbunătăţire: choose_min() returna primul dintre orarele găsite cu numărul minim de ferestre – era mai bine să fi returnat lista tuturor orarelor care au un acelaşi cel mai mic număr de ferestre (urmând ca recast() să le trateze pe toate acestea).
Dar avem şi o altă idee, chiar firească: să reconsiderăm funcţia swap_cols(), pe care o recuzasem la început, în [1]:
swap_cols <- function(orz, h1, h2) { orz[ , c(h1, h2)] <- orz[ , c(h2, h1)] # ora h1 (h2) devine h2 (h1) h12 <- sort(c(h1, h2)) # mută înapoi clasele cu h = 4/5/6 ore ajunse în coloana h2 > h if(h12[2] > 4) { h1 <- h12[1]; h2 <- h12[2] Ql <- setdiff(orz[, h2], orz[, h1]) for(ql in Ql) { i <- which(orz[, h2] == ql) ql1 <- orz[i, h1] orz[i, h1] <- ql orz[i, h2] <- ql1 } } orz # clasele din coloana h1 (h2) au trecut în coloana h2 (h1) }
Să observăm că în orarul nostru iniţial, majoritatea profesorilor cu două sau trei ore încep programul chiar de la prima oră a zilei; schimbând coloanele 1 şi 3 între ele, asigurăm ca majoritatea profesorilor menţionaţi să înceapă de la a doua oră a zilei – ceea ce ar putea fi mai convenabil pentru profesorii respectivi, dar s-ar putea să convină şi procedurii de reducere ulterioară a ferestrelor.
Bineînţeles că schimbând două coloane ale orarului între ele, a trebuit să ţinem seama de faptul că unele clase au mai puţine ore în ziua respectivă, decât altele; schimbând de exemplu, coloanele 2 şi 5, o clasă cu 4 ore ar ajunge în fereastră, deci trebuie mutată înapoi în coloana 2.
În secvenţa următoare (care, ca şi celelalte funcţii redate aici, se poate formula mult mai bine), aplicăm recast() dar şi swap_cols() de câte un anumit număr de ori:
rcs <- recast(MXT) rcs <- swap_cols(rcs, 1, 3) NG1 <- nGaps(bin_patterns(rcs)) #; print(NG1) rcs <- recast(rcs) #; print(NG1) rcs <- swap_cols(rcs, 1, 2) NG1 <- nGaps(bin_patterns(rcs)) #; print(NG1) rcs <- recast(rcs) #; print(NG1) rcs <- swap_cols(rcs, 3, 1) NG1 <- nGaps(bin_patterns(rcs)) #; print(NG1) rcs <- recast(rcs) #; print(NG1) rcs <- swap_cols(rcs, 2, 1) NG1 <- nGaps(bin_patterns(rcs)) #; print(NG1) rcs <- recast(rcs) #; print(NG1) rcs %>% as_tibble() %>% mutate(prof=rownames(rcs), .before=1) %>% write_csv(., file="rcs14.csv", append=TRUE)
Obţinem de fiecare dată, un număr de ferestre mai mic, sau mai mare – dar în final (şi doar într-o secundă) obţinem un orar care are 14 ferestre, ceea ce ar fi deja acceptabil, faţă de cele 25 iniţiale:
1 2 3 4 5 6 7 1 2 3 4 5 6 7
P59 5E 5D - - - - - P43 11C 11D 7D 8A - - -
P65 7D 7E - - - - - P33 - - 7C 12A 10A 9D -
P64 9C 9D - - - - - P50 - - - 5C 9E 6B -
P56 10B 5C - - - - - P20 7B 7A - 10C 5D - -
P71 12A 9A - - - - - P21 9E 12E - 11E - - -
P67 7E 8C - - - - - P40 - - 11D 9C 11B 8B -
P72 11E 10E - - - - - P18 7A 6C - 6E 7B - -
P63 9A 11B 11A - - - - P55 5D 12A 8C - - - -
P58 6E 10B - - - - - P16 - - 9A 10A 5C 11A -
P26 8B 8A 10E - 10D - - P42 - - - - 9B 10B 9E
P48 8F 7B 6B - - - - P34 5B 5A - 8B 11E - -
P49 12B 9B 8D - - - - P31 - - 6C 9B 11C 5E -
P29 8E 12C 8A - - - - P11 - 5E - 7E 8D 7D -
P66 9D 11E - - - - - P19 - - 6E 7B 5A 8F -
P47 8A 8E 7E - - - - P41 - - - 7A 8E 9E -
P51 6C 8D 9B - - - - P12 - - 11C 11D 12D 7E -
P60 12D 11C 12E - - - - P04 - - 7A 6B 6C 7C -
P14 7C 10A 10B - - - - P28 11B 9C 6A 12B 10C - -
P57 5A 6B 5D - - - - P32 - - 11E 5A 5E 11C -
P10 8D 12B 11B 10D - - - P37 - - - 6C 9A 11E -
P45 - - - 5B 12C 6E - P08 5C - 12D 12C 6D - -
P46 10C 12D 7B - - - - P22 - 6D - 8E 10E 7B -
P44 6A 9E 5C - - - - P13 10D 8F - - 7D 10E 8B
P54 12E 6E 12B - - - - P39 - - - 8C 8F 8E 7C
P62 - - - 10B 9D 10A - P23 - - - 9A 11D 10C 7D
P52 11D 7C 5A - - - - P06 - - 12A 9E 12E 12D -
P17 - - 6D 11B 11A 8C - P09 10A 11A 8F 11C 7C - -
P35 6D 10C - 11A 12A - - P01 11A 10D 8B 6A 8C 8A -
P24 6B 6A - 12D - - - P25 - - 12C 5D 7E 9B -
P27 10E 8B 5B 7D - - - P03 8C 7D - 5E 8A 7A -
P53 - - 10C 6D 7A 9C - P07 - - 9D 10E 9C 12A 8A
P38 9B 5B 9E - - - - P36 - - 10A 9D 6A 8D 8C
P30 - - 5E 8F 6B 5D - P02 - - 9C 7C 6E 6C 9B
P15 - - 8E 8D 8B 10D - P05 12C - 10D 12E 10B 9A -
Un singur profesor, P13 are două ferestre; dar se vede imediat că swap_cls(., 7, 3, "8B") lasă lui P13 o singură fereastră, făcând o fereastră (unică) lui P01. În final avem 14 ferestre de câte o singură oră (dintre care 10 sunt în a treia oră a zilei).
Mai departe am avea de ales între două direcţii de dezvoltare – una clară, cealaltă complicată şi laborioasă: fie rescriem funcţiile care mai sus, în scopul unui prim experiment, au fost formulate „mecanic” şi incomplet, fie o luăm mai de la capăt, revenind la structura de bază prof|cls|ora (în loc de prof|1|...|7) şi înlocuind mutarea de clase dintr-o coloană în alta, cu „recolorarea” claselor (schimbând valorile din coloana $ora) conform lanţurilor Kempe asociate orarului (v. [1]).
vezi Cărţile mele (de programare)