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).
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)