[1] Instrumentarea reducerii ferestrelor din orar (I + II)
În [1] am demarat "recast.R
", care caută să reducă numărul de ferestre de pe orarul şcolar iniţial (al unei zile); pentru a acoperi o fereastră, se mută o anumită clasă dintr-o coloană a orarului în alta, pe baza unei liste prealabile (cât mai cuprinzătoare) de acoperiri posibile; dacă orarul rezultat în urma acoperirii unei ferestre are mai puţine ferestre decât cel curent, atunci este reţinut drept noul orar curent şi se repetă mutarea de clase pe baza listei de acoperiri corespunzătoare acestuia.
De fapt, în [1] am făcut un prim experiment, urmărind să ne convingem că lucrurile ar putea merge astfel, în direcţia dorită; am tratat mutarea claselor în măsura suficientă unei tatonări, fără să luăm seama la toate aspectele şi subtilităţile. Ori mutarea de clase este esenţială în procedura descrisă mai sus şi în primul rând, avem de corectat formulările din [1] pentru swap_cols()
şi swap_cls()
.
În formularea din [1], swap_cols()
schimba între ele două coloane ale orarului şi încheia mutând înapoi (dacă este cazul) clasele cu număr de ore mai mic decât rangul coloanei în care au ajuns prin schimbarea de coloane efectuată. Dar acest procedeu este defectuos – întâi schimbă coloanele şi apoi repară – şi incomplet:
1 2 3 4 5 6 7 12B 11B 8D - 10D - - # iniţial 10D 11B 8D - 12B - - # după intervertirea coloanelor 1 şi 5 12B 11B 8D - 10D - - # s-a mutat înapoi 12B (are numai 4 ore)
Încheind aici, rezultatul este greşit – fiindcă "10D
" apare acum de două ori în coloana 5: mai întâi, în urma intervertirii iniţiale a coloanelor (dat fiind că "10D
" figura undeva, în coloana 1) şi apoi, în urma mutării înapoi a clasei "12B
". În [1] nu întâmpinam această greşală, fiindcă acolo interverteam numai coloane dintre primele patru, iar fiecare dintre acestea conţine toate clasele (nu avem clase cu mai puţin de 4 ore).
N-ar fi greu să corectăm ad hoc: în loc să încheiem după ce am mutat înapoi "12B
", căutăm cealaltă apariţie a lui "10D
" şi o mutăm înapoi şi pe aceasta, ş.a.m.d. Dar ideea „schimbă, apoi repară” este chiar proastă…
Cel mai bine ar fi să intervertim cele două coloane numai pentru liniile care n-ar face obiectul vreunei reparaţii ulterioare. Instituim local un vector "EX
" în care colectăm indecşii acelor linii care trebuie exceptate; în final, intervertim cele două coloane numai pe liniile neindicate în EX
:
swap_cols <- function(orz, h1, h2) { h12 <- sort(c(h1, h2)) if(h12[2] > 4) { EX <- vector("integer", 0) # colectează indecşii liniilor de exceptat h1 <- h12[1]; h2 <- h12[2] Ql <- setdiff(orz[, h1], orz[, h2]) #; print(Ql) for(ql in Ql) { i <- which(orz[, h1] == ql) EX <- c(EX, i) q2 <- orz[i, h2] #; print(c(ql, q2)) if(q2 != '-') { i <- which(orz[, h1] == q2) EX <- c(EX, i) } } # interverteşte coloanele pe liniile neexceptate orz[-EX, c(h1, h2)] <- orz[-EX, c(h2, h1)] } else { # interverteşte coloanele pe toate liniile orz[, c(h1, h2)] <- orz[, c(h2, h1)] } orz }
Ca o mică verificare directă, table(rcs, H)
ar trebui să dea 1 pentru fiecare clasă care apare în coloana 'H
' (unde 'rcs
' este orarul rezultat după o operaţie swap_cols()
).
În [1] am tratat numai cazul particular al acoperirii unei ferestre: se mută clasa indicată, într-un loc liber aflat pe linia acelei clase.
Dacă locul pe care mutăm clasa nu este liber, atunci trebuie să mutăm (în sens invers) şi clasa de pe acest loc – repetând câte o asemenea pereche de mutări (într-un sens şi în celălalt) până când fie se ajunge pe un loc liber, fie se regăseşte clasa iniţială; funcţia interioară path_cls()
înlănţuie aceste mutări, parcugând alternativ cele două coloane (şi reţinând într-un vector indecşii de linie). Bineînţeles că mereu trebuie să avem în vedere cazul când clasa de mutat ar veni pe o coloană de rang mai mare decât numărul de ore ale acelei clase (situaţie în care abandonăm mutarea iniţiată, returnând NULL
):
move_cls <- function(morr, h1, h2, ql) { L1 <- morr[, h1] L2 <- morr[, h2] if(! (ql %in% L2 & ql %in% L1)) return(NULL) path_cls <- function(Q, rL) { if(rL == 1) {l1 <- L1; l2 <- L2} else {l1 <- L2; l2 <- L1} pth <- vector("integer", 0) i <- which(l1 == Q) if(length(i) == 0) return(NULL) pth <- c(pth, i) q <- Q repeat { i <- which(l2 == q) if(length(i) == 0) return(NULL) pth <- c(pth, i) q <- l1[i] if(q == '-' | q == Q) break } pth } path <- path_cls(ql, 1) # ; print(path) if(is.null(path)) return(NULL) ql2 <- L2[path[1]] if(ql2 != '-') { pth2 <- path_cls(ql2, 2) # ; print(pth2) if(is.null(pth2)) return(NULL) else path <- c(path, pth2) } morr[path, c(h1, h2)] <- morr[path, c(h2, h1)] morr }
Am colectat iarăşi, indecşii liniilor implicate în lanţul de mutări – încât în final, am putut efectua toate mutările printr-o singură instrucţiune (spre deosebire de swap_cls()
din [1], când foloseam câte o atribuire cu inversarea coloanelor imediat ce găseam câte o linie pe care trebuie să schimbăm clase); cu alte cuvinte, are loc o singură copiere pentru matricea "morr
", în loc de cam atâtea câte clase sunt intervertite (în R avem "copy-on-modify" – de regulă, modificarea unui obiect nu se face „pe loc”, ci necesită copierea internă a întregului obiect).
vezi Cărţile mele (de programare)