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

Instrumentarea reducerii ferestrelor din orar (II)

Local Search | limbajul R | orar şcolar
2021 sep

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)

docerpro | Prev | Next