Printr-un algoritm greedy găsim foarte rapid o colorare, dar găsim o colorare optimă numai dacă știm (și în general nu știm) în ce ordine ar trebui să abordăm nodurile; totuși, putem recolora graful respectiv după ce-i permutăm aleatoriu vârfurile, repetând până ce (sperând că încă rapid) nimerim vreo ordine care conduce la o colorare optimă.

În [1] am folosit deja, pentru "recolorare", permute() și greedy_vertex_coloring() (investigate și lămurite pe un graf bipartit în [3]); în principiu, chestiunea este următoarea: să aplicăm în mod repetat cele două funcții până ce obținem o colorare convenabilă, iar în [1] ne interesa să obținem colorarea finală (și doar în treacăt, observam că sunt necesare "sute sau mii" de recolorări); acum ne-ar interesa ceva statistici asupra recolorărilor necesare (dar nu mizăm aici pe cine știe ce rezultate, doar vedem cam cum s-ar face și doar probăm pe unele cazuri din practica obișnuită, că numărul de recolorări este foarte mic față de totalul permutărilor posibile).

În [1] asociam orarului cls|zl|ora pe o anumită disciplină, graful G în care clasele X și Y sunt adiacente dacă există linii X|zl|ora și Y|zl|ora cu aceleași valori zl|ora (însemnând că X și Y trebuie să aibă profesori diferiți, pe disciplina respectivă). Aici reconstruim graful G pe baza listelor de adiacență redate deja în [2]; preluăm deasemenea, vectorul care indică pentru fiecare clasă numărul de ore pe disciplina respectivă.

În R-igraph nu avem un constructor bazat pe listele de adiacență (există în C-igraph, dar nu a fost importat în R), așa că preluăm listele respective prin readLines(), împărțim fiecare linie la spațiu (în prealabil trebuie ne asigurăm că avem câte un singur spațiu separator) și constituim o listă care asociază primei clase din rândul curent, vectorul constituit din celelalte clase de pe acel rând (cu alte cuvinte, se asociază fiecărei clase, vectorul format de adiacenții acesteia în G); pe baza acestei liste este ușor să constituim matricea de adiacență și apoi obiectul specific IGRAPH:

adj_lines <- readLines("list_adj.txt")  # cu câte un singur spațiu între clase!
CH <- readRDS("cls_ore.RDS")  # numărul de ore pe fiecare clasă
# Prima din linie are ca adiacenți celelalte clase de pe acea linie
adj_list <- strsplit(adj_lines, split = " ") %>%
            lapply(., function(X) list(X[-1]) %>% setNames(X[1])) %>%
            unlist(recursive = FALSE)
# Constituie matricea de adiacență și graful corespunzător
Kls <- names(adj_list)
Adj <- matrix(0L, nrow = length(Kls), ncol = length(Kls), byrow = TRUE, 
              dimnames = list(Kls, Kls))  # șablonul matricei de adiacență
for(q1 in Kls)
    for(q2 in adj_list[[q1]])
        Adj[q1, q2] <- 1L
G <- graph_from_adjacency_matrix(Adj, mode = "undirected")

G este un graf cu 34 noduri (clase din școala respectivă) și 202 muchii; nu este deloc "mare" (că doar n-o să operăm manual), totuși 34! (numărul de permutări posibile pe mulțimea vârfurilor) se termină cu 7 zerouri, adică este un număr foarte mare (are 39 de cifre zecimale; v. factorials).

Prevedem și o funcție care să afișeze convenabil, partiția corespunzătoare unei colorări a grafului G (reprezentând profesorii, numărul de ore și clasele repartizate acestora):

print_partition <- function(Vcol) {
    Pts <- sapply(1:max(Vcol), 
                  function(k) CH[names(Vcol[Vcol == k])]
           ) %>% setNames(paste0("p", 1:max(Vcol)))
    for(P in names(Pts)) {
        cls <- names(Pts[[P]]) %>% sort()  # clasele repartizate profesorului
        nh <- sum(Pts[[P]])  # totalul de ore
        cat(P, paste0("(",nh,"):"), cls, "\n")
    }
}

De exemplu:

> q <- greedy_vertex_coloring(G)
> print_partition(q)
    p1 (20): 10A 10G 10H 11D 12F 8A  # profesor, total ore, clasele repartizate lui
    p2 (23): 10E 10F 11A 11E 7A 9B 
    p3 (19): 12B 5A 5B 6A 9E 
    p4 (17): 10B 10C 11B 11F 9G 
    p5 (16): 12C 12E 9C 9F 
    p6 (17): 10D 12A 6B 9A 
    p7 (9): 11C 9D 
    p8 (4): 8B 
    p9 (5): 12D 

Desigur, ceea ce am obținut în această exemplificare (încadrare cu 9 profesori) este departe de a fi acceptabil; în [2] am arătat că G poate fi colorat cu numai 6 culori.

Profitând de faptul că o colorare greedy consumă foarte puțin timp, să vedem, în vreo zece serii de câte vreo mie de repetări ale experimentului, cam câte recolorări ale grafului sunt necesare, până să nimerim una care să aibă 6 profesori. De fapt, probabil că ar fi suficient de relevantă o singură serie de vreo mie de repetări (iar aceasta n-ar lua decât vreo 10 minute), dar… ne știm din experiențe statistice anterioare, că vom fi tentați să repetăm execuția de încă vreo 10 ori! Așa că preferăm să nu mai reluăm execuția și prevedem din start repetarea de… 10000 de ori:

show_time <- function(S = "")  # funcție de afișare a timpului curent
    cat(strftime(Sys.time(), format="%H:%M:%S"), S)
frm <- list()  # 6-colorările rezultate în fiecare experiment
rep <- 10000  # de câte ori vom repeta experimentul (1000 ar fi suficient!)
rcl <- vector("integer", rep)  # câte recolorări/experiment
show_time()  # 13:32:12
for(cr in 1:rep) {
    iter <- 0  # contorizăm recolorările până la una cu 6 culori
    repeat {
        iter <- iter + 1
        H <- permute(G, sample(vcount(G)))
        pc <- greedy_vertex_coloring(H)
        if(max(pc) < 7) break  # o colorare optimă are 6 culori
    }
    rcl[cr] <- iter
    frm[[cr]] <- pc
}
show_time("\n")  # 15:12:40  (total: 100 minute) 
saveRDS(list(frm = frm, rcl = rcl), "10mii_frm.RDS")

Execuția a durat 100 de minute (deci cam 10 minute pentru o serie de 1000 reluări ale recolorărilor) și bineînțeles că (prudent, chipurile) am salvat rezultatele într-un fișier….

În vectorul rcl avem numărul de recolorări, pentru fiecare dintre cele 10000 de încercări aleatorii independente lansate pe rând asupra grafului G, căutând în fiecare să ajungem la o colorare optimă a acestuia; prin summary() obținem o sinteză a repartiției valorilor respective:

> L <- readRDS("10mii_frm.RDS")  # într-o nouă sesiune de lucru
> summary(L$rcl)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
      1     391     919    1321    1803   13451 

În 25%, 50%, respectiv 75% dintre cele 10000 de repetări, numărul de recolorări a fost mai mic decât 391, 919, respectiv 1803 (și în 25% dintre cazuri, numărul de recolorări a fost între 1803 și 13451); valoarea medie a numărului de recolorări este 1321.
Se constată astfel, că în cazul grafului nostru este nevoie de un număr foarte mic de recolorări (față de totalul de factorial(34) = 2.952328e+38 recolorări posibile), pentru a ajunge la o colorare optimă (am zice în general, că numărul necesar de recolorări este, în medie, cam de 40 de ori mai mare ca numărul de vârfuri).

Obs. Nu-i rău să privim și invers: rata de "succes" 1321/10000 ne-ar spune că în aproape 90% din cazuri, "greedy-coloring" ne dă soluții inacceptabile (cu mai multe culori decât necesar)!

În L$frm avem colorările finale (optime) rezultate prin cele 10000 de recolorări aplicate grafului G; să vedem care sunt acestea. Amintim că o colorare optimă a grafului G înseamnă o încadrare la clasele respective cu 6 profesori și deocamdată, să vedem totalurile de ore care sunt repartizate fiecăruia:

CH <- readRDS("cls_ore.RDS")  # numărul de ore la fiecare clasă
FR <- lapply(L$frm, function(K) 
             sapply(1:6, function(k) sum(CH[names(K[K==k])])) %>% 
             sort()
      ) %>% list2DF() %>% t()
print(FR %>% unique())
#     [,1] [,2] [,3] [,4] [,5] [,6]
#       19   19   21   23   24   24  ## încadrări "Mt" (v. [1])
#       19   19   20   24   24   24  # încadrări "MT"

Deci sunt numai două tipuri de încadrări, pe care — fiindcă am sortat crescător după numărul de ore — le deosebim ușor după valoarea din a patra poziție; recunoaștem imediat că e vorba de încadrările pe care în [1] și [2] le numisem "Mt" și respectiv, "MT". Rezultă ușor câte încadrări s-au găsit, de fiecare tip:

> sum(FR[, 4] == 24)
[1] 246  de tip "MT" și 10000-246=9754 de tip "Mt"

De observat că încadrările "MT" sunt mult mai puține față de cele de tip "Mt"; probabil că într-o serie de numai 10 recolorări, n-am obține niciuna de tip "MT" și probabil, ca să avem și una-două încadrări "MT" trebuie făcute cam 100 de recolorări.

Să vedem acum și care sunt de fapt, încadrările respective — de exemplu, una la întâmplare dintre cele de tip "Mt":

> id <- which(FR[, 4] == 23) %>% sample(size = 1)
> print_partition(L$frm[[id]])
    p1 (21): 10G 11B 11C 11D 7A 
    p2 (19): 10B 10H 12E 9A 9D 
    p3 (24): 5A 5B 6A 8B 9C 9E 9F 
    p4 (24): 10D 10E 12B 12C 12F 6B 
    p5 (23): 10C 11F 12A 12D 8A 9G 
    p6 (19): 10A 10F 11A 11E 9B 

Speculând mai general statistica rezultată mai sus, am zice că practicarea de algoritmi greedy (care de regulă necesită foarte puțin timp de execuție) are sens: în general, căutarea directă a "celei mai bune" soluții este nefezabilă, implicând un timp de execuție exorbitant — în schimb, imaginând un algoritm greedy potrivit contextului problemei respective, găsim ușor o soluție oarecare, de obicei nesatisfăcătoare, dar repetând de la capăt algoritmul respectiv într-o ordine schimbată aleatoriu a elementelor implicate, putem obține după un număr de câteva zeci, sute sau poate mii de reluări (ceea ce este infim față de totalul posibilităților), o soluție acceptabilă.
Am probat aceasta mai sus, dar și în multe alte situații evocate anterior pe aici; în pachetul days2lessons, pentru a repartiza echilibrat lecțiile prof|cls pe zilele de lucru, urmam un algoritm greedy foarte simplu: pentru fiecare clasă, pe rând, distribuiam lecțiile acesteia pe zile și dacă la un moment dat încălcam conđițiile necesare asupra numărului de ore/zi pentru profesor sau pentru clasa curentă, atunci o luam de la capăt dar într-o altă ordine, aleatorie, a claselor — iar după un timp relativ scurt (însemnând totuși, uneori, mii și chiar zeci de mii de reluări), ne rezulta câte o soluție în care numărul de ore/zi are cum doream, distribuție uniformă pentru clase și cvasi-uniformă pentru profesori. Deasemenea, printr-un algoritm greedy similar (dar acum, permutând clasele și în funcție de anumiți coeficienți de "centralitate" asociați acelor clase), în pachetul hours2lessons alocam lecțiile repartizate într-o aceeași zi, pe orele zilei (astfel încât să nu existe suprapuneri de lecții). Iar în pachetul refitgaps, modificam colorarea cu ore a lecțiilor zilei (folosind lanțurile Kempe din grafurile asociate), astfel încât să reducem pe cât se poate numărul total de ferestre.