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

De Die Cedulas (orare pentru lecţiile unei zile) - 3

R | orar şcolar
2021 aug

5. Cu ordonare după un „grad” empiric

Să considerăm profesorii în ordinea crescătoare a numărului de „legături” cu lecţiile celorlalţi; cel mai simplu, acest număr ar fi dat de numărul tuturor lecţiilor din acea zi la clasele profesorului respectiv:

# traceMount5.R
source("schedulesDay.R")
lessons <- csv2tidy(3)  # lecţiile <prof><cls> în ziua 3 (241 lecţii, 68 prof., 40 clase)

prfOrd <- function(vp) {  # ordonare după numărul de "legături"
    clsH <- table(lessons$cls)
    prf <- sort(unique(lessons$prof))
    names(prf) <- prf
    degs <- map(prf, function(P) 
                sum(clsH[lessons %>% filter(prof == P) %>% .$cls]))
    names(sort(unlist(degs)))
}  # print(prfOrd(""))

task <- setProfBits(lessons, FUN = prfOrd)

print(strftime(Sys.time(), format="%H:%M:%S"), quote=FALSE)
trM <- map_dbl(1:1000, function(i) {
    TB <- task[[1]] %>% split(.$cls)
    Bits <<- task[[2]]
    orZ <- mountHtoDay(TB)
    sum(unlist(lapply(orZ[[2]], holes)))
})
print(strftime(Sys.time(), format="%H:%M:%S"), quote=FALSE)
print(table(trM));  print(summary(trM));  print(NTRY)

Programul generează 1000 de orare, afişând durata, numărul de încercări (III)+(IV) (v. [2]) şi numărul de ferestre din orarele obţinute:

> source("traceMount5.R")
[1] 09:14:27
[1] 12:05:13  # durata execuţiei: aproape 3 ore
trM
 32  33  34  35  36  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51 
  1   6   4  12  18  30  45  57  67  91 111 119  82  83  70  67  54  26  17  23 
 52  53  54  55 
  9   4   2   2 
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  32.00   41.00   43.00   43.17   46.00   55.00 
[1] 79029  # numărul total de încercări 

Cele 1000 de orare au rezultat după aproape 3 ore, necesitând în total cam 79000 încercări – adică în medie, cam 5 minute, cu 70-80 de reordonări aleatorii de clase, până la obţinerea unui orar pe seama ordonării fixate iniţial (prin prfOrd()) pentru lista profesorilor.
Numărul de ferestre are valoarea medie 43 şi cam 25% dintre orare au cel mult 40-41 de ferestre – ceea ce este mai convenabil, decât în cazul din §3.

Ordonarea descrescătoare după „gradul” vizat mai sus iese din discuţie (ca şi în §3): programul durează enorm şi rezultă orare care au în jur de 55-60 de ferestre (şi foarte rar, mai puţin de 40 ferestre).

6. Ordonare după „grad”, aleatorie în cazul egalităţii

Ordinea stabilită prin prfOrd() nu este (nici în §3, nici în §4) strict crescătoare: există profesori care au un acelaşi număr de „legături” – iar aceştia ar putea fi listaţi şi într-o altă ordine decât cea asigurată implicit de către prfOrd(). Ar fi de văzut dacă schimbarea ordinii acelora dintre profesori care au acelaşi „grad” (fără a afecta ordinea celorlalţi) modifică semnificativ constatările din §4; dar probabil că mai interesantă este însăşi problema generală care a apărut…

Se dă o listă (de nume, de exemplu) şi un criteriu de ordonare nestrictă a acestora („grad”, de exemplu); se cere o funcţie care să returneze şirul numelor din lista primită, ordonat după criteriul respectiv, dar astfel încât numele cărora le corespunde câte un acelaşi „grad” să apară într-o ordine arbitrară (aleatorie). Pentru exemplu:

> lst  # lista iniţială (<nume>/<grad>)
K E G J L C B A H I D F 
6 3 5 5 7 2 2 1 5 5 2 4
> random_for_equals(lst)       # ordonează după grad, dar cu ordine arbitrară 
[1] "A D B C E F H J G I K L"  # (aleatorie) pe numele de acelaşi grad
> random_for_equals(lst)
[1] "A D C B E F G J H I K L"

Funcţia random_for_equals() se poate formula pe 4 rânduri: transformăm lista dată (care poate fi şi un „vector cu nume”, ca mai sus) într-un „tabel” cu o coloană pentru nume şi una pentru grad, pe care îl splităm după valorile gradului; pentru fiecare grup de nume cu un acelaşi grad, producem câte un şir aleatoriu al numelor din acel grup; în final, folosim Reduce() pentru a alipi succesiv şirurile respective.

Considerăm un anumit număr (20) de reordonări prin random_for_equals() ale listei profesorilor şi pentru fiecare dintre acestea, generăm prin mountHtoDay() câte un anumit număr (100) de orare – înregistrând statisticile cuvenite într-un fişier:

# traceMount6.R
rm(list=ls())
source("schedulesDay.R")
lessons <- csv2tidy(3)  # 241 lecţii <prof><cls> (68 × 40)

prof_deg <- function(Prof) {  # "grad" asociat profesorului
    S <- lessons %>% split(.$prof == Prof)
    nrow(S[[2]]) + nrow(S[[1]] %>% filter(cls %in% S[[2]]$cls))
}  # însumează numărul de ore ale claselor profesorului

list_by_deg <- function(lss) {
    sup <- sort(unique(lss$prof))
    names(sup) <- sup
    Lp <- map(sup, prof_deg)
    Lp[order(sapply(Lp, '[[', 1))]
}  # lista profesorilor în ordinea crescătoare a gradelor

random_for_equals <- function(Lst2) {
    tibble(prof = names(Lst2), grad = sapply(Lst2, '[[', 1)) %>%
    split(.$grad) %>%
    map(., function(X) paste(c(sample(X$prof)), collapse=" ")) %>%
    Reduce(paste, .)
}

prfOrd <- function(vp) {
    Lp <- list_by_deg(lessons)
    unlist(strsplit(random_for_equals(Lp), " "))
}  #  ordonare după "grad", aleatorie în cazul egalităţii

nTRY <- rep(0, 20)
sink("trMount.txt", append=TRUE)
print(strftime(Sys.time(), format="%H:%M:%S"), quote=FALSE)
for(i in 1:20) { 
    NTRY <- 0
    task <- setProfBits(lessons, FUN = prfOrd)
    trM <- map_dbl(1:100, function(i) {
        TB <- task[[1]] %>% split(.$cls)
        Bits <<- task[[2]]
        orZ <- mountHtoDay(TB)
        sum(unlist(lapply(orZ[[2]], holes)))
    })
    print(table(trM))
    print(summary(trM))
    nTRY[i] <- NTRY
}
print(strftime(Sys.time(), format="%H:%M:%S"), quote=FALSE)
print(nTRY)
sink()

Cele 20×100 de orare au fost produse cam în 5.5 ore; pentru numărul de încercări nTRY listat în final, avem:

> summary(nTRY)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   4408    6759    7408    7619    8150   11060 

însemnând că în medie, pentru cele 100 de orare corespunzătoare câte unei aceleiaşi ordini a profesorilor, s-au făcut în total 7619 încercări (deci în medie, 70-80 de încercări pentru fiecare orar – ca şi în §5).

Pentru numărul de ferestre din orarele produse, avem caracteristici apropiate de cele constatate în §5 – redăm una dintre cele 20 de înregistrări scrise în "trMount.txt":

trM
35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 
 2  2  4  4  4 11 14  9  8  7 12  6  4  3  5  3  1  1 
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  35.00   40.00   42.50   42.88   45.00   52.00 

Concluzia ar fi că ordonarea crescătoare după gradul considerat în §5 (cu sau fără schimbarea ordinii profesorilor de acelaşi grad, din §6) produce rezultate (ceva) „mai bune” (pentru tendinţa numărului de ferestre), decât în §3.

Dar începe să pară clar că ar trebui să ne mulţumim că obţinem orare cu un număr de ferestre de 14-15% din totalul orelor zilei respective – cam 34 de ferestre, pentru cele 241 de lecţii vizate aici (cazul orarului cu 25 de ferestre obţinut în [1] rămâne unul singular, încă dificil de interpretat sau de imitat).
Probabil că adevărata problemă, ar fi aceea de a modela o procedură de reducere a numărului de ferestre, pe orarul produs de mountHtoDay().

vezi Cărţile mele (de programare)

docerpro | Prev | Next