momente şi schiţe de informatică şi matematică
anti point—and—click

Reducerea ferestrelor din orarul zilei

R | orar şcolar
2021 oct

O strategie coerentă de reducere a numărului de ferestre

Avem un orar al unei zile de lucru dintr-o şcoală cu un singur schimb – de exemplu acesta (obţinut prin programul daySchoolSchedule.R din [3]):

    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 9A	12A -	-   -	-   -	    P21 9E  12E -   11E -   -	-
P67 8C	-   7E	-   -	-   -	    P40 -   -	11D 11B 9C  8B	-
P72 10E 11E -	-   -	-   -	    P18 -   6C	-   7B	6E  7A	-
P63 11A 9A  11B -   -	-   -	    P55 -   -	8C  -	12A 5D	-
P58 6E	10B -	-   -	-   -	    P16 -   -	9A  10A 5C  11A -
P26 8A	10E 8B	10D -	-   -	    P42 -   -	-   9B	-   10B 9E
P48 8F	7B  6B	-   -	-   -	    P34 -   5A	5B  8B	11E -	-
P49 8D	9B  12B -   -	-   -	    P31 -   -	6C  11C 9B  5E	-
P29 8E	8A  -	12C -	-   -	    P11 -   5E	-   7E	8D  7D	-
P66 9D	-   11E -   -	-   -	    P19 -   -	8F  5A	7B  6E	-
P47 7E	8E  8A	-   -	-   -	    P41 -   -	-   8E	7A  9E	-
P51 6C	8D  9B	-   -	-   -	    P12 -   -	11C 12D 11D 7E	-
P60 12D 11C 12E -   -	-   -	    P04 -   -	7A  6C	6B  7C	-
P14 7C	10A 10B -   -	-   -	    P28 11B -	6A  12B 10C 9C	-
P57 5A	6B  5D	-   -	-   -	    P32 11E -	-   5E	5A  11C -
P10 12B 11B 8D	-   10D -   -	    P37 -   -	-   9A	6C  11E -
P45 5B	6E  -	-   12C -   -	    P08 5C  12C -   6D	12D -	-
P46 10C 12D 7B	-   -	-   -	    P22 -   6D	-   10E 8E  7B	-
P44 6A	9E  5C	-   -	-   -	    P13 -   8B	10D 8F	7D  10E -
P54 12E 12B 6E	-   -	-   -	    P39 -   -	-   8C	8F  8E	7C
P62 -	-   -	10B 9D	10A -	    P23 -   -	-   11D 9A  10C 7D
P52 11D 7C  5A	-   -	-   -	    P06 -   -	12A 9E	12E 12D -
P17 6D	8C  -	11A 11B -   -	    P09 10A 11A -   7C	11C 8F	-
P35 12A 10C 6D	-   11A -   -	    P01 10D -	11A 6A	8C  8A	8B
P24 6B	6A  12D -   -	-   -	    P25 12C -	-   5D	7E  9B	-
P27 8B	7D  10E 5B  -	-   -	    P03 7A  -	5E  7D	8A  8C	-
P53 -	9C  10C 7A  6D	-   -	    P07 -   -	9D  9C	10E 12A 8A
P38 9B	5B  9E	-   -	-   -	    P36 -   -	10A 9D	6A  8D	8C
P30 5D	8F  -	6B  5E	-   -	    P02 -   -	9C  6E	7C  6C	9B
P15 -	-   8E	8D  8B	10D -	    P05 -   10D 12C 12E 10B 9A	-
                                        41  41  41  41  39  31  7

În acest exemplu, avem 68 de profesori "Pnn" – de fapt, indecşi de linie ai matricei orelor 1..7 din acea zi ale claselor; ordinea liniilor corespunde crescător coeficienţilor "betweenness" din graful în care doi profesori sunt adiacenţi dacă au măcar o clasă comună (v. [3]), ceea ce aproximează superior listarea în ordinea numărului de ore ale fiecăruia. Numărul de clase este 41 ("A".."E" pe nivelele 5..7 şi 9..12 şi "A".."F" pe nivelul 8); toate clasele încep programul de lucru la prima oră din zi (în prima coloană apar exact 41 de clase); există şi clase care au numai 4 sau 5 ore, iar pe ultima coloană vedem că 7 dintre clase au câte 7 ore.

Pe lângă cele 41×4+39+31+7=241 de ore propriu-zise, orarul iniţial conţine 25 de ferestre, repartizate câte una sau două, la 22 de profesori (de exemplu, P25 face prima oră la 12C, apoi are două ferestre şi la ora a 4-a intră la 5D); dar am zice că avem un caz fericit, fiindcă ferestrele din orarele produse prin daySchoolSchedule.R reprezintă cel mai adesea, 14% (cel mult) din totalul orelor (ar fi fost 33 ferestre, nu 25).

Experimentele din [1] şi [2] ne-au condus la conturarea unei strategii coerente (fără elemente aleatorii) de reducere a numărului de ferestre din orarul iniţial; plecăm nu de la ferestre, ci de la orele propriu-zise ale claselor.

Pentru fiecare coloană 1..7, mutăm pe rând fiecare clasă din coloana respectivă pe fiecare dintre celelalte coloane, aplicăm de fiecare dată o reducere „standard” de ferestre şi reţinem acel caz în care obţinem cel mai mic număr de ferestre.
Pentru exemplul de mai sus sunt de analizat astfel cam 6000 de cazuri (7×41×21 = 6027, unde 21 este numărul combinărilor de 7 luate câte 2); orarul reţinut în final are deja numai 10 ferestre (în loc de cele 25 iniţiale), iar prin programul prezentat mai jos (încă susceptibil de îmbunătăţiri) rezultatul se obţine cam în 15 minute.

Matricea orelor; evidenţierea ferestrelor

Reluăm programul iniţiat în [1]; avem de făcut anumite simplificări şi completări, dar deocamdată cam repetăm doar, unele lucruri:

# recast.R (reduce numărul de ferestre din orarul unei zile)
library(tidyverse)
TMT <- read_csv("orar.csv", col_types = "cccccccc")  # slice_sample(TMT, n=5)

MXT <- as.matrix(TMT[, 2:ncol(TMT)])  # print.table(MXT[sample(nrow(MXT),5), ])
row.names(MXT) <- TMT$prof
nHm <- ncol(MXT)  # nr. maxim de ore ale unei clase (7)

get_bin_patt <- function(morr) {  # şabloanele binare ale orarelor profesorilor
    apply(morr, 1, function(L) {
        byte <- 0L
        for(j in 1:ncol(morr))
            if(L[j] != '-') 
                byte <- bitwOr(byte, bitwShiftL(1, j-1))
        byte
    })
}

where_is_one <- function(w)  # indecşii biţilor '1' dintr-un şablon orar
    which(bitwAnd(w, c(1, 2, 4, 8, 16, 32, 64)) > 0)

cnt_holes <- function(w) { # Numărul biţi '0' între biţi '1' ("ferestre")
    bits <- where_is_one(w)
    n <- length(bits)
    bits[n] - bits[1] + 1 - n
}

cnt_all_gaps <- function(bin_patt)  # 'bin_patt': vectorul şabloanelor orare
    sum(unlist(lapply(bin_patt, cnt_holes)))  # numărul ferestrelor din orar

Faţă de [1], am schimbat unele denumiri de funcţii şi am adăugat o variabilă pentru numărul maxim de ore ale claselor (în [1] avem exemplificări ale formei CSV şi matriceale a orarului şi lămuriri asupra şabloanelor binare).

Mutarea unei clase dintr-o coloană în alta

Preluăm din [2], fără nicio modificare:

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
}

Fiecare clasă trebuie să apară (cel mult) o singură dată pe coloană; mutarea unei clase într-o altă coloană implică mai multe schimburi de clase, de-a lungul unui lanţ Kempe (reconstituit în mod implicit de path_cls()) din graful în care arcele unesc clase de pe o aceeaşi linie (v. [1]).

În [2] formulasem şi o funcţie prin care să intervertim două coloane; între timp ne-am dat seama că este mai bine să mutăm câte o clasă (în toate modurile posibile) şi să evaluăm ce putem obţine prin anumite „reparaţii” în fiecare caz, decât să mutăm simultan toate clasele coloanei şi apoi, să vedem (şi să reparăm cumva) rezultatul.

Posibilităţi rezonabile de acoperire a unei ferestre

„Reparăm” o fereastră mutând pe locul respectiv una sau alta dintre clasele aflate pe linia respectivă; desigur, pot rezulta astfel alte ferestre, pe liniile implicate prin operaţia de mutare a clasei.

Dar nu ne interesăm de toate posibilităţile de reparare; considerăm două mutări „principale”, indiferent câte ferestre ar fi pe linia respectivă – anume, acoperirea primei ferestre cu prima, respectiv cu ultima clasă; iar pentru cazul unei singure ferestre şi pentru cazul a două ferestre, adăugăm încă două sau trei mutări fireşti – de exemplu, mutăm prima clasă pe locul liber (dacă există) de după ultima, sau mutăm ultima clasă pe locul liber (dacă există) dinaintea primeia:

cover_gaps <- function(morr) {
    binp <- get_bin_patt(morr)
    B <- which(unlist(lapply(binp, cnt_holes)) > 0)

    cover <- function(id) {  # posibilităţi de acoperire a ferestrelor, pe o linie
        pt <- where_is_one(binp[id])
        n <- length(pt)
        H1 <- pt[1]
        Hn <- pt[n]
        cls <- morr[id, ]  # ; print(cls)  #(afişează linia curentă)
        igp <- which(cls == '-')
        igp <- igp[igp > H1 & igp < Hn]
        lh1 <- c(H1, Hn)  # una, două, sau mai multe ferestre
        lh2 <- c(igp[1], igp[1])
        lql <- c(cls[H1],cls[Hn])
        ig <- length(igp)
        if(ig == 1) {  # o singură fereastră
            if(igp[1] == H1 + 1L & Hn < nHm) {
                lh1 <- c(lh1, H1)
                lh2 <- c(lh2, Hn + 1L)
                lql <- c(lql, cls[H1])
            } else {
                if(igp[1] == Hn - 1L & H1 > 1) {
                    lh1 <- c(lh1, Hn)
                    lh2 <- c(lh2, H1 - 1L) 
                    lql <- c(lql, cls[Hn])
                }
            }
        } else {
            if(ig == 2)  { # două ferestre
                lh1 <- c(lh1, c(H1, Hn))
                lh2 <- c(lh2, c(igp[2], igp[2]))
                lql <- c(lql, c(cls[H1], cls[Hn]))
            }
        }
        D <- data.frame(h1 = lh1, h2 = lh2, ql = lql)
        row.names(D) <- NULL
        D
    }

    map_df(B, cover)
}

În funcţia interioară cover(), în [1] consideram un obiect "data.frame" căruia îi adăugam repetat noi rânduri; acum am folosit trei vectori, pe care i-am extins după caz, asamblându-i în final într-un "data.frame" (am sperat că astfel creşte puţin, eficienţa de execuţie – care în cazul modificării unui obiect, suferă cumva din cauza copierilor intermediare obişnuite).

Este important de „perfecţionat” în privinţa vitezei de execuţie, funcţia cover_gaps() – fiindcă ea va fi apelată după fiecare mutare dintr-o coloană în alta, a unei clase:

choose_min <- function(mxt) {  # 'mxt': orarul rezultat după mutarea unei clase
    swp <- cover_gaps(mxt)  # lista reparaţiilor „standard” de ferestre
    swp$ng <- 100
    for(i in 1:nrow(swp)) {  # aplică pe rând, reparaţiile
        mor <- move_cls(mxt, swp[i,1], swp[i,2], swp[i,3])
        if(! is.null(mor)) {
            B <- get_bin_patt(mor)
            swp$ng[i] <- sum(unlist(lapply(B, cnt_holes)))  # numărul de ferestre
        }
    }
    im <- which.min(swp$ng)  # reţine primul orar cu minimum de ferestre 
    list(move_cls(mxt, swp[im,1], swp[im,2], swp[im,3]), 
         swp$ng[im])
}

În choose_min() am preluat orarul rezultat după o mutare de clasă, am obţinut din cover_gaps() lista reparaţiilor de ferestre, am aplicat prin move_cls() fiecare dintre aceste reparaţii şi am înregistrat numărul de ferestre rezultat astfel; în final returnăm primul orar dintre cele „reparate”, care are numărul minim de ferestre.

Este de bănuit că şi choose_min() s-ar putea formula mai eficient…

Obţinerea orarului cu numărul minim de ferestre

Instrumentarea care urmează (susceptibilă de anumite variaţiuni şi rescrieri) se bazează pe o observaţie chiar simplă: aplicând choose_min() orarului produs anterior prin choose_min(), obţinem un orar care eventual, are şi mai puţine ferestre:

NG1 <- cnt_all_gaps(get_bin_patt(MXT))  # numărul de ferestre din orarul curent

recast <- function(mxt) {  # pe orarul curent
    r1 <- r2 <- 0
    repeat {
        Lmxt <- choose_min(mxt)
        mxt <- Lmxt[[1]]
        NG2 <- Lmxt[[2]]  # numărul de ferestre după aplicarea reparaţiilor
        if(NG2 < NG1) {
            NG1 <<- NG2
        } else {
            if(NG2 == NG1) {    # r2 <- 0  ## ?
                r1 <- r1 + 1
                if(r1 == 4) {
                    break
                }
            } else {    # r1 <- 0  ## ?
                r2 <- r2 + 1
                if(r2 == 6)
                    break
            }
        }
    }
    mxt
}

În variabila globală 'NG1' înregistrăm numărul de ferestre din orarul curent (iniţial, orarul din 'MXT'), iar în variabila locală 'NG2' avem numărul de ferestre din orarul reparat curent prin choose_min(). Dacă aplicând choose_min(), obţinem un orar cu mai puţine ferestre faţă de cel căruia i s-a aplicat (NG2 < NG1), atunci reaplicăm choose_min() noului orar; dacă de un anumit număr de ori (am ales 4) constatăm că numărul de ferestre nu se micşorează (NG2 = NG1), atunci încheiem, returnând ultimul orar produs de choose_min(); iar dacă de un anumit număr de ori (am ales 6) obţinem orare cu NG2 > NG1, atunci supozăm că numărul de ferestre nu poate fi micşorat în condiţiile curente (având în vedere gama de „reparaţii” pe care am considerat-o) şi acceptăm un asemenea orar (cu număr de ferestre mai mare decât cel iniţial, sperând să-l putem reduce ulterior).

Următoarea funcţie mută pe rând (prin move_cls()), fiecare clasă dintr-o coloană indicată, într-o altă coloană dată a orarului şi aplică recast() fiecăruia dintre orarele rezultate; se returnează acela dintre rezultatele aplicării recast(), care are cel mai puţine ferestre:

disturb <- function(morr, h1, h2) {
    Q1 <- morr[, h1]; Q1 <- Q1[Q1 != '-']; names(Q1) <- NULL
    res <- morr
    ng1 <- cnt_all_gaps(get_bin_patt(res))
    NG1 <<- ng1
    for(q in Q1) {
        rcs <- move_cls(morr, h1, h2, q)
        if(!is.null(rcs)) {
            rcs <- recast(rcs)
            if(!is.null(rcs)) {
                ng2 <- cnt_all_gaps(get_bin_patt(rcs))
                if(ng2 < ng1) {
                    res <- rcs
                    ng1 <- ng2    # NG1 <<- ng2  ## ?
                }
            }
        }
    }
    list(res, ng1)
}

În următoarea funcţie aplicăm disturb() fiecărei perechi de coloane distincte din orarul curent, returnând acela dintre orarele produse astfel, care are cel mai mic număr de ferestre:

cb7 <- combn(ncol(MXT), 2)  # combinările de 7 luate câte 2
search_disturb <- function(rcs) {
    ng1 <- cnt_all_gaps(get_bin_patt(rcs))  # numărul de ferestre din orarul curent
    res <- rcs
    for(i in 1:ncol(cb7)) {
        h1 <- cb7[1, i]; h2 <- cb7[2, i]
        lRC <- disturb(rcs, h1, h2)
        ng2 <- lRC[[2]]  # numărul de ferestre, după perturbarea curentă
        if(ng2 < ng1) {
            res <- lRC[[1]]
            ng1 <- ng2
        }
    }
    list(res, ng1)
}

Plecând de la orarul curent, funcţia următoare înlănţuie search_disturb() până când numărul curent de ferestre se stabilizează la o cea mai mică valoare:

tochain_disturb <- function(rcs) {
    SD <- search_disturb(rcs)
    ng1 <- SD[[2]]
    repeat {
        SD <- search_disturb(SD[[1]])
        ng2 <- SD[[2]]
        if(ng2 < ng1)
            ng1 <- ng2
        else  break
    }
    SD
}

Pentru orarul iniţial prezentat la început (cu 25 de ferestre) tochain_disturb(MXT) ne dă cam în 15 minute, următorul orar (cu 10 ferestre, câte una singură – fie a doua, fie a treia oră din zi – la 10 profesori care au câte cel puţin 4 ore):

    1   2   3   4   5   6   7           1   2   3   4   5   6   7 
P59 5E	5D  -	-   -	-   -	    P43 11D 8A	7D  11C -   -	-
P65 -	-   -	7D  7E	-   -	    P33 -   -	7C  12A 10A 9D	-
P64 9C	9D  -	-   -	-   -	    P50 -   -	-   5C	9E  6B	-
P56 10B 5C  -	-   -	-   -	    P20 7B  7A	-   10C 5D  -	-
P71 9A	12A -	-   -	-   -	    P21 9E  12E 11E -	-   -	-
P67 7E	8C  -	-   -	-   -	    P40 -   -	11D 9C	11B 8B	-
P72 11E 10E -	-   -	-   -	    P18 6C  6E	-   7A	7B  -	-
P63 11A 9A  11B -   -	-   -	    P55 -   -	-   -	12A 5D	8C
P58 -	-   -	-   10B 6E  -	    P16 -   -	9A  10A 5C  11A -
P26 10E 8B  10D 8A  -	-   -	    P42 -   -	-   -	9B  10B 9E
P48 8F	7B  6B	-   -	-   -	    P34 -   5A	5B  11E 8B  -	-
P49 9B	8D  12B -   -	-   -	    P31 -   -	6C  9B	11C 5E	-
P29 8A	12C 8E	-   -	-   -	    P11 -   -	8D  7E	5E  7D	-
P66 9D	11E -	-   -	-   -	    P19 -   -	8F  6E	5A  7B	-
P47 8E	7E  8A	-   -	-   -	    P41 -   -	-   9E	7A  8E	-
P51 8D	6C  9B	-   -	-   -	    P12 -   -	11C 11D 12D 7E	-
P60 12D 11C 12E -   -	-   -	    P04 -   -	7A  6B	6C  7C	-
P14 10A 7C  10B -   -	-   -	    P28 11B 10C -   12B 6A  9C	-
P57 5A	6B  5D	-   -	-   -	    P32 -   -	5E  5A	11E 11C -
P10 12B 11B -	10D 8D	-   -	    P37 -   -	-   6C	9A  11E -
P45 6E	5B  12C -   -	-   -	    P08 -   -	5C  12C 6D  12D -
P46 10C 12D 7B	-   -	-   -	    P22 6D  8E	10E 7B	-   -	-
P44 5C	9E  6A	-   -	-   -	    P13 10D 7D	-   8B	10E 8F	-
P54 12E 12B 6E	-   -	-   -	    P39 -   -	-   8E	8F  8C	7C
P62 -	-   -	10B 9D	10A -	    P23 -   -	-   9A	11D 10C 7D
P52 7C	11D 5A	-   -	-   -	    P06 -   -	12A 12D 12E 9E	-
P17 8C	6D  11A 11B -	-   -	    P09 11C 11A 10A 8F	7C  -	-
P35 12A -   6D	11A 10C -   -	    P01 8B  10D 8C  6A	11A 8A	-
P24 6B	6A  12D -   -	-   -	    P25 -   -	7E  5D	12C 9B	-
P27 -	-   8B	5B  7D	10E -	    P03 7D  5E	-   8C	8A  7A	-
P53 7A	9C  10C 6D  -	-   -	    P07 -   -	9D  10E 9C  12A 8A
P38 5B	9B  9E	-   -	-   -	    P36 6A  10A -   9D	8C  8D	-
P30 5D	8F  -	5E  6B	-   -	    P02 -   -	9C  7C	6E  6C	9B
P15 -	-   -	8D  8E	10D 8B	    P05 12C 10B -   12E 10D 9A	-

Procedura de reducere modelată mai sus este chiar întortocheată: tochain_disturb() repetă de un anumit număr de ori search_disturb(), care iterează disturb() pe toate perechile de coloane, care la rândul ei aplică move_cls() fiecărei clase din coloana curentă şi apoi aplică recast() fiecăruia dintre orarele intermediare; rezultatul este totuşi mulţumitor (inclusiv, ca timp de execuţie), chiar şi pentru un orar iniţial mai „încărcat” (cum este cel considerat aici).

„Mulţumitor”… pentru o bucată de timp! Pare avantajos, că nu am implicat elemente aleatorii – din orarul iniţial obţinem totdeauna (la orice execuţie a programului) un acelaşi orar final (cu mai puţine ferestre decât cel iniţial); dar ştim deja că randomizând totuşi cât de cât lucrurile, ne creem şansa de a obţine diverse orare finale, chiar cu şi mai puţine ferestre (şi uneori, într-un timp mai scurt).

vezi Cărţile mele (de programare)

docerpro | Prev | Next