Pentru a ţine seama de cuplaje la repartizarea pe ore a lecţiilor dintr-o aceeaşi zi, am avea chiar două posibilităţi: modificăm programul respectiv ("daySchoolSchedule.R" din [2]) pentru a condiţiona şi faţă de cuplaje, etichetarea cu ore 1..7 – sau nu-l modificăm, dar constituim un program de ajustare finală a lecţiilor cuplate. A doua variantă ar fi cea mai bună: necesită rescrierea funcţiilor din [3] pentru mutarea unei clase, ori acestea trebuie oricum rescrise, pentru a repara ferestrele ţinând seama şi de cuplaje; dar să încercăm deocamdată prima variantă (fiind mai simplă).
Rescriem programul din [2], pe cât este necesar, dar într-un nou fişier:
# daySch.R (versiune 'daySchoolShedule.R', considerând şi cuplaje) library(tidyverse) lessons <- readRDS("dis_Mi.RDS") # lecţiile prof|cls repartizate miercurea (Mi) lessons <- lessons %>% mutate(prof = tolower(sub('-','', prof)))
Am preluat lecţiile din a 3-a zi – mai uşoară decât ziua "Lu", angajând mai puţine cuplaje (v. tabelul de repartizare pe zilele săptămânii din [1]). În fişierele "dis_*.RDS" aveam "P" şi "-", în coloana prof; prin tolower() şi sub() am ajuns la notaţia convenită ulterior în [1] (implicată deja în fişierul "messing.RDS").
Preluăm din "messing.RDS" cele două liste de dependenţe (pentru întreaga săptămână) între profesorii cuplaţi şi le restrângem la cuplajele existente în ziua curentă:
load("messing.RDS") # Lx1 şi Lx2 prof_day <- unique(lessons$prof) # profesorii şi profesorii fictivi din ziua curentă select_cupl <- function(L) { # lista de dependenţe săptămânale (Lx1 sau Lx2) for(i in seq_along(L)) { if(! names(L[i]) %in% prof_day) L[i] <- NULL } L %>% compact() %>% map(., function(D) intersect(D, prof_day)) %>% compact() } # păstrează numai cuplajele existente în ziua curentă Lx1 <- select_cupl(Lx1) # de cine depinde alocarea orelor profesorilor din cuplaje Lx2 <- select_cupl(Lx2) # de cine depinde alocarea orelor unui cuplu iCup1 <- names(Lx1) iCup2 <- names(Lx2)
Avem de modificat numai funcţia mountHtoCls(); identificăm profesorii din iCup1 şi respectiv iCup2 existenţi la clasa curentă Q şi constituim un octet B al tuturor alocărilor făcute anterior orelor acestora; dacă etichetarea curentă cu 1..7 a lecţiilor clasei Q se suprapune cu B, atunci încercăm o altă permutare a etichetelor:
mountHtoCls <- function(Q) { # alocă pe ore 1..7, lecţiile unei clase mpr <- Pore[[nrow(Q)-3]] # matricea de permutări corespunzătoare clasei bhp <- bith[Q$prof] # biţii alocaţi anterior, profesorilor clasei H1 <- intersect(Q$prof, iCup1) # angajează Lx1 H2 <- intersect(Q$prof, iCup2) # angajează Lx2 B <- 0L # alocările anterioare pentru cei din H1 şi H2 V <- vector() # indecşii în Q$prof ai profesorilor din H1, H2 for(p in H1) { V <- c(V, which(Q$prof == p)) B <- bitwOr(B, bith[p]) for(f in Lx1[[p]]) B <- bitwOr(B, bith[f]) # biţii alocaţi anterior profesorilor din H1 } for(p in H2) { # extinde V şi B pentru cazul celor din H2 V <- c(V, which(Q$prof == p)) B <- bitwOr(B, bith[p]) for(f in Lx2[[p]]) B <- bitwOr(B, bith[f]) } for(i in 1:ncol(mpr)) { po <- mpr[, i] # o etichetare cu orele zilei, a lecţiilor clasei bis <- bitwShiftL(1, po - 1) if(B & any(bitwAnd(bis[V], B) > 0)) next # avem suprapunere cu alocări anterioare la H1, H2 if(any(bitwAnd(bhp, bis) > 0)) next # permută etichetele, evitând biţi '1' alocaţi deja # Dacă un profesor are 2 sau mai multe ore pe zi la aceeaşi clasă: if(anyDuplicated(names(bhp)) > 0) { # în [1] omisesem names() for(jn in 1:(nrow(Q)-1)) { if(names(bhp)[jn] == names(bhp)[jn+1]) bis[jn] <- bis[jn+1] <- bis[jn] + bis[jn+1] } } # se poate comenta, dacă NU există profesor cu 2 ore la clasă blks <- bitwOr(bhp, bis) # cumulează biţii vechilor şi noii alocări Cond1 <- unlist(lapply(blks, holes)) if(any(Cond1 > 2)) next # controlează numărul de ferestre bith[Q$prof] <<- blks return(Q %>% mutate(ora = po)) # înscrie orarul clasei curente } return(NULL) # pentru clasa curentă NU s-a reuşit un orar "bun" }
Următoarea funcţie va formula orarul rezultat prin rularea programului "daySch.R" – anume, pe clase şi ore (redând profesorii care intră la clasa respectivă în fiecare oră 1..7), ordinea claselor fiind aceea în care mountHtoCls() a montat orarul fiecăreia (ordinea alfabetică nu ne spunea nimic despre cum a decurs constituirea orarului):
orarByCls <- function(dorar) { # prof|cls|ora levs <- unique(dorar$cls) # sort(unique(dorar$cls)) orr <- dorar %>% mutate(cls = factor(cls, levels=levs, ordered=TRUE)) %>% split(.$cls) map_df(orr, function(K) { Q <- K[order(K$ora), ] tibble(cls = Q$cls[1], "1" = Q$prof[1], "2" = Q$prof[2], "3" = Q$prof[3], "4" = Q$prof[4], "5" = Q$prof[5], "6" = Q$prof[6], "7" = Q$prof[7]) }) }
Am rulat "daySch.R" de mai multe ori, obţinând în cel mai mult 7 minute, câte un orar al zilei Mi, având numărul de ferestre mai mic decât 30; redăm unul (cu 24 de ferestre, obţinut cam în 90 secunde):
orz <- orarByCls(orar) print(as.data.frame(orz), row.names=FALSE, na.print="-") cls 1 2 3 4 5 6 7 11E p11p44 p35 p14 p21 p26 p15 - 9F p43 p23 p03 p26 p11 p10 - 12E p08p47 p57 p20 p15 p13 p21 - 10E p25 p10 p13 p04 p34p07 p27 - 9E p34p09 p48 p38 p10 p27 p26 - 6G p50 p06 p16 p28 p31 p01 p08 8G p55 p51 p06 p25 p14 p05 - 11D p04 p15 p24 p27 p58 p28 - 12B p49 p30 p09 p22 p16 p13 - 12D p10 p49 p15 p54 p22 p02 - 12C p37 p18 p12 p13 p19 p30 - 9D p26 p11 p08 p37 p21 p19 - 11F p54 p14 p39 p23 p25 p09 - 7G p41 p40 p51 p11 p24 p31 - 10F p05 p41 p21 p48 p06 p08 - 11B p35 p19 p05 p02 p08 p16 - 9C p32 p38 p18 p31 p10 p24 - 10C p38 p32 p29 p16 p05 p20 - 9B p31 p13 p32 p03 p23 p07 - 10A p36 p07 p17 p12 p20 p14 - 11A p40 p36 p01p02 p30 p01 p22 - 9A p29 p01p02 p36 p14 p09 p12 - 12A p01p02 p17 p07 p01 p04 p11 - 12F p39 p04 p23 p07 p15 - - 10D p19 p39 p48 p24 p12 p03 - 10B p18 p29 p22 p05 p03 p25 - 5G p17 p12 p27 p20 p28 - - 11C p03 p09 p30 p17 p18 p04 -
Dacă nu „sare în ochi”, corectitudinea rezultatului se verifică uşor, printr-o mică secvenţă de comenzi care, folosind listele Lx1 şi Lx2, să constate apariţiile (cel mult o dată) în fiecare coloană orară, pentru fiecare dintre profesorii care intră în cuplaje.
Ordinea în care clasele au trecut prin mountHtoCls() a rămas aceea prevăzută iniţial în [2] – o ordine apropiată aleatoriu de ordinea coeficienţilor "betweenness" din graful în care două clase sunt adiacente dacă au măcar un profesor comun (analog avem şi ordinea profesorilor); dar în [2] nu aveam în vedere şi profesorii fictivi, corespunzători cuplajelor – încât aici s-ar fi cuvenit ca în prealabil, să revizuim modul de stabilire a coeficienţilor respectivi (atât pentru clase, cât şi pentru profesori)…
Cazul redat mai sus, al zilei Mi, este unul fericit; pentru Jo am obţinut un orar (iarăşi, corect) în nu mai puţin de două ore (şi am abandonat ideea de a mai repeta execuţia programului), iar pentru Vi – într-o oră; în schimb, pentru Lu şi Ma n-am mai ajuns la orar, nici după câteva ore cât am răbdat execuţia programului…
Pentru a vedea cumva ce se petrece, am introdus în program o secvenţă de scriere a orarului incomplet constituit, pentru măcar 26 dintre cele 28 de clase; am obţinut numeroase astfel de orare (cu una sau cel mai frecvent, cu două clase lipsă), cu o frecvenţă cam de 3 orare la câte 6 minute. Am întrerupt execuţia programului şi am ales dintre fişierele obţinute, unul la care lipseşte o singură clasă; am verificat apoi ce ore 1..7 au fost alocate în acest orar (cu 27 de clase), profesorilor clasei lipsă şi am putut constata (manual) că este posibilă (fără suprapuneri cu alocările făcute anterior) şi alocarea orelor acestora, la clasa care lipsea.
Desigur, putem proceda mai riguros astfel: salvăm nu numai orarul incomplet, dar şi vectorul curent al octeţilor de alocare bith (v. [1]); încărcând într-o sesiune de lucru ulterioară, orarul respectiv şi vectorul bith – putem invoca direct mountHtoCls("11F") – 11F fiind clasa care lipseşte din orar – şi putem astfel constata producerea orarului acestei clase (în condiţiile în care orarele celorlalte 27 de clase au fost deja constituite, conform octeţilor de alocare din bith).
Odată ce ne-am convins că este posibilă constituirea orarului şi pentru clasa omisă la rularea iniţială a programului, deducem că motivul pentru care nu s-a reuşit completarea orarului respectiv este faptul că în daySch.R am păstrat condiţia din [1] privitoare la numărul total de ferestre: să nu depăşească valoarea nGaps=30 (orarele menţionate mai sus pentru Mi, Jo şi Vi satisfăceau această condiţie).
Şi într-adevăr – rulând din nou daySch.R, dar cu nGaps=50, am obţinut (cam în 20 minute) şi orarul (complet) pentru ziua Lu, cu 44 de ferestre.
Subliniem totuşi că timpul de execuţie depinde de noroc, dat fiind că ordinea claselor cărora mountHtoCls() este chemată să le constituie pe rând orarul este una aleatorie (corect ar fi să considerăm media duratelor, într-o serie mai lungă de execuţii cu aceleaşi date, ale programului). Reluând execuţia pentru Jo, am obţinut un orar (cu 29 ferestre) şi în 15 minute, iar pentru Vi am obţinut un orar cu 32 de ferestre, într-un minut.
vezi Cărţile mele (de programare)