Revenim asupra testării programului su_doku.R pe setul de 481 grile "HgridSet.csv" (v. [1]), fiindcă acest set este mult mai interesant decât cel de 25000 de grile Sudoku considerat în [2]: mai întâi, valorile back sunt mult mai mari şi mai variate (deci grilele respective sunt într-adevăr, „dificile”); apoi, există subseturi de grile care au o aceeaşi soluţie (specific generării printr-un anumit program, a unui set de grile Sudoku).
Aceste aspecte distinctive fac ca „explorarea datelor” respective să aibă sens, prilejuindu-ne ilustrarea unor structurări, grupări şi sumarizări a datelor, specifice limbajului R (cu „dialectul” tidyverse).
Rescriem programul "test_mysu.R" din [2]:
# test_mysu.R library(tidyverse) source("su_doku.R") # soluţionează Sudoku, prin fixgrid(), aspire(), reshat(); v. [1] N <- 10 # de câte ori repetăm soluţionarea unei grile hgs <- read_csv("HgridSet.csv", col_types="c") %>% mutate(sol = "", back = list(vector("integer", N)))
În "HgridSet.csv" avem o singură coloană de date (cu numele "grid"), pe care am declarat-o în read_csv() ca fiind de tip character; am adăugat apoi coloana "sol" (în care intenţionăm să înscriem soluţiile grilelor) şi coloana "back", care este o listă având drept valori vectori de câte N întregi – unde prin N am specificat de câte ori vrem să repetăm soluţionarea fiecăreia dintre grile.
În [2] specificam back ca integer şi doar relansând întregul program, obţineam soluţii cu alte valori back; acum fiecare grilă va fi soluţionată de câte N ori, înscriind consecutiv valorile back în vectorul cu N valori asociat grilei prin lista $back.
hgs rezultat mai sus este un obiect de clasă tibble, cu această structură:
> str(hgs) tibble [481 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame) $ grid: chr [1:481] "85...24..72......9..4.........1.7..23.5...9...4...........8..7..17..........36.4." "..53.....8......2..7..1.5..4....53...1..7...6..32...8..6.5....9..4....3......97.." ... $ sol : chr [1:481] "" "" "" "" ... $ back: List of 481 ..$ : int [1:10] 0 0 0 0 0 0 0 0 0 0 ..$ : int [1:10] 0 0 0 0 0 0 0 0 0 0 ...
Pentru fiecare valoare din câmpul $grid, vom aplica aspire(), fixgrid() şi apoi reshat() de câte N ori, înregistrând soluţia şi valorile back.
Dar aspire() – care produce „tabelul de bază al candidaţilor” – cere grila ca vector de 81 întregi (nu şir de caractere); pentru a evita să facem la fiecare pas conversia necesară, instituim o listă „paralelă” coloanei $grid, conţinând valorile acesteia în formatul necesar (înlocuind prin gsub(), '.' cu '0', separând apoi caracterele prin strsplit() şi în final, transformând în vector de întregi prin unlist() şi as.integer()):
grid_int <- lapply(hgs$grid, function(G) as.integer(unlist(strsplit(gsub("\\.", "0", G), split=NULL, perl=TRUE))))
Pentru a înscrie soluţia găsită pentru grila curentă, prevedem funcţia (în care convertim înapoi, vectorul de întregi care reprezintă soluţia, în „şir de caractere” – folosind toString()):
printSol <- function(Z) { # înscrie soluţia, ca şir de caractere mat <- sapply(Z, convICP) # v. [1] (convICP()) gsub(", ", "", toString(mat)) }
Putem formula acum „partea principală” a programului de testare:
bcks <- vector("integer", N) # valoarea 'back' pentru fiecare execuţie for(i in 1:nrow(hgs)) { grd <- grid_int[[i]] Z <- fixgrid(aspire(grd)) # tabelul de bază al candidaţilor, redus for(j in 1:N) { # soluţionează de N ori, grila curentă back <- 0 reshat(Z) # îmbină reducerea candidaţilor cu "backtracking" bcks[j] <- back # total reveniri asupra alegerii aleatoare a candidatului } hgs[i, 2] <- printSol(Result) # înregistrează soluţia şi vectorul de reveniri hgs$back[[i]] <- bcks # caracteristic celor N soluţionări ale grilei } saveRDS(hgs, file="hgs4.RDS")
Bineînţeles… n-am reuşit formularea de mai sus de la bun început: iniţial – rescriind direct programul din [2] – lăsasem fixgrid(aspire(grd)) alături de reshat() (aici, în interiorul ciclului de variabilă j), obţinând hgs1.RDS cam în 70 minute; abia apoi, am observat că fixgrid(aspire(grd)) nu depinde de j şi scoţând linia respectivă în afara acestui ciclu, am obţinut rezultatele hgs2.RDS în 60 (şi nu 70) de minute.
În pofida faptului că durează aproape o oră, am rulat "test_mysu.R" de cinci ori (cu unele mici modificări; de exemplu, iniţial înscriam individual valorile back, în hgs$back[[i]][j] – în loc de a le înscrie într-un vector 'bcks' de depus apoi o singură dată în hgs$back[[i]], cum avem în formularea de mai sus).
Am obţinut astfel 5 fişiere hgs{0,4}.RDS, care diferă numai prin valorile din listele $back; este drept că dacă rulam programul cu N=50 atunci obţineam cam acelaşi rezultat – dar într-un singur fişier (nu cinci) şi desigur, cam în 4-5 ore (nu în câte o oră azi, poate două mâine, etc. – ceea ce pare totuşi mai aşezat).
Pentru cele ce urmează, pornim un program prin care să restructurăm cumva datele rezultate mai sus şi apoi, să le analizăm (folosind şi consola interactivă din mediul R); deocamdată, pe lângă funcţiile preluate din "su_doku.R", prevedem o funcţie care preia rolul listei grid_int de mai sus, furnizând vectorul de 81 de întregi 0..9 corespunzător unei grile date sub forma unui şir de caractere '.' şi '1'..'9':
# explore.R library(tidyverse) source("su_doku.R") su2int <- function(grila) # şir de caractere '.' sau '1'..'9' ==> vector de 0..9 as.integer(unlist(strsplit(gsub("\\.", "0", grila), split=NULL, perl=TRUE)))
Prima problemă ar consta în concatenarea vectorilor de câte 10 întregi aflaţi pe un acelaşi nivel în cele 5 liste $back, obţinând o listă de vectori cu câte 50 întregi care poate constitui noua coloană $back în oricare dintre cele 5 obiecte tibble asociate fişierelor hgs*.RDS.
O a doua problemă ar consta în eliminarea grilelor „uşoare”, dacă există – adică a acelora pentru care toate cele 50 de valori din $back sunt 0; apoi, de a vedea ce semnificaţie are pentru soluţionarea grilei faptul că între valorile asociate ei pe coloana $back avem şi una sau mai multe valori 0 (nu-i obligatoriu ca soluţia să se fi obţinut fără a folosi reshat()!).
În sfârşit probabil, vom vedea cum să comparăm şi să ierarhizăm după „dificultate”, grilele respective; în plus, vom vedea cum să evidenţiem subseturile de grile cărora le corespunde câte au o aceeaşi soluţie (şi eventual, ce putem spune despre ele).
Constituim un vector al numelor celor 5 fişiere "hgs*.RDS" şi îi aplicăm map() pentru a obţine o listă având ca elemente cele 5 liste din coloanele $back ale obiectelor tibble asociate prin readRDS() fişierelor respective:
files <- paste0("hgs", 0:4, ".RDS") lstB <- map(files, function(fl) readRDS(fl)$back)
Dacă L ar fi una oarecare dintre sublistele lui lstB, atunci prin L[[i]] putem accesa vectorul al i-lea din L; putem folosi lapply(lstB, ...), pentru a viza fiecare sublistă din lstB, aplicându-i operatorul de accesare "[[", pentru vectorul al i-lea:
lB <- lapply(1:481, function(i) as.integer(unlist(lapply(lstB, `[[`, i))))
Prin unlist(), cei câte 5 vectori a câte 10 întregi care constituie lista returnată pentru valoarea curentă i de către lapply(), sunt „concatenaţi” într-un vector cu 50 de valori, care devine elementul al i-lea din lista vizată în final de lB.
Acum n-avem decât să reconstituim unul dintre obiectele tibble asociate celor 5 fişiere şi să înlocuim lista iniţială din coloana $back, cu lista lB:
HG <- readRDS("hgs0.RDS") %>% mutate(back = lB) saveRDS(HG, file="HG50.rds") # salvăm, pentru orice eventualitate
În HG, fiecăreia dintre cele 481 de grile îi corespunde în coloana $back un vector conţinând 50 de valori întregi, reprezentând fiecare „numărul de reveniri” asupra alegerii candidatului curent, efectuate în fiecare dintre cele 50 de execuţii ale secvenţei (din programul precedent, test_mysu.R) de soluţionare a grilei respective.
Filând cumva datele respective, putem observa că există grile pentru care valorile aferente din $back sunt 0 (probabil toate, indiferent de N):
> str(HG) #tibble [481 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame) # $ grid: chr [1:481] ... # $ sol : chr [1:481] ... # $ back: List of 481 ... # ..$ : int [1:50] 0 0 0 0 0 0 0 0 0 0 ... # ..$ : int [1:50] 283 283 297 0 283 0 303 297 303 20 ...
Să identificăm întâi, aceste grile (dacă există):
N <- 50 # de câte ori s-a repetat soluţionarea grilelor # există grile pentru care 'back' este 0 în fiecare dintre cele N soluţionări? HG0 <- HG %>% filter(back %in% list(rep(0L, N))) ## A tibble: 3 x 3 # grid sol back # <chr> <chr> <list> #1 7..1523........92....3.....1....47… 796152384531468927428379651152634… <int [… #2 1...34.8....8..5....4.6..21.18....… 152934687763821549984567321618493… <int [… #3 .6.5.4.3.1...9...8.........9...5..… 869574132124396758375128694932857… <int […
Deci pentru aceste 3 grile, soluţia se găseşte direct (fără "backtracking" – v. [1]); să verificăm aceasta, pentru prima dintre ele:
Z <- su2int(HG0$grid[1]) print(matrix(Z, nrow=9, byrow=TRUE)) # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] # grila iniţială (22 valori fixate) # [1,] 7 0 0 1 5 2 3 0 0 # [2,] 0 0 0 0 0 0 9 2 0 # [3,] 0 0 0 3 0 0 0 0 0 # [4,] 1 0 0 0 0 4 7 0 8 # [5,] 0 0 0 0 0 0 0 6 0 # [6,] 0 0 0 0 0 0 0 0 0 # [7,] 0 0 9 0 0 0 5 0 6 # [8,] 0 4 0 9 0 7 0 0 0 # [9,] 8 0 0 0 0 6 0 1 0 W <- aspire(Z) # v. [1] printKand(W) # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] # tabelul candidaţilor rămaşi # [1,] 7 9 6 1 5 2 3 8 4 # [2,] 35 35 13 467 467 8 9 2 17 # [3,] 4 28 128 3 67 9 16 5 17 # [4,] 1 2356 23 26 36 4 7 9 8 # [5,] 359 23578 23478 278 3789 15 12 6 135 # [6,] 359 235678 2378 2678 36789 15 12 4 135 # [7,] 2 1 9 48 48 3 5 7 6 # [8,] 6 4 5 9 1 7 8 3 2 # [9,] 8 37 37 5 2 6 4 1 9 printKand(fixgrid(W)) # aplică repetat "Hidden Single" şi "Naked Pair" (v. [1]) # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] # soluţia grilei # [1,] 7 9 6 1 5 2 3 8 4 # [2,] 5 3 1 4 6 8 9 2 7 # [3,] 4 2 8 3 7 9 6 5 1 # [4,] 1 5 2 6 3 4 7 9 8 # [5,] 3 8 4 7 9 1 2 6 5 # [6,] 9 6 7 2 8 5 1 4 3 # [7,] 2 1 9 8 4 3 5 7 6 # [8,] 6 4 5 9 1 7 8 3 2 # [9,] 8 7 3 5 2 6 4 1 9
Am putut constata prin length(Z[Z > 0]) că iniţial, grila avea fixate 22 de valori; aspire() a aplicat repetat regula de bază (fiecare valoare 1..9 se află o singură dată în fiecare linie, coloană sau bloc), rezultând fixarea a încă 24 de valori (length(W[W %in% FIX]) afişează 46) şi stabilirea candidaţilor posibili pe celulele rămase; apoi, fixgrid() a aplicat pe tabelul candidaţilor cele mai simple două reguli de reducere a candidaţilor (rezultând astfel şi unele noi fixări de valori), repetând până când nu se mai poate determina astfel o nouă fixare de valoare.
Constatăm că astfel, se obţine chiar soluţia finală pentru grila respectivă – fără să mai fie necesar mecanismul "backtracking" regizat în reshat() (încât back rămâne 0).
În contextul nostru, grilele „uşoare” nu prezintă interes – încât le eliminăm:
HG <- HG %>% filter(! grid %in% HG0$grid) # A tibble: 478 x 3 saveRDS(HG, file="HG.rds") # salvăm, pentru orice eventualitate
Între cele 478 de grile rămase, avem unele pentru care între cele 50 de valori back asociate avem şi 0, alături de valori destul de mari. La prima vedere, aceasta ar însemna că măcar într-una dintre cele 50 de soluţionări consecutive ale grilei respective, soluţia a fost găsită direct prin fixgrid(aspire()) (fără a implica şi reshat()); de fapt, nu este chiar aşa…
Pentru grila de pe linia a 14-a, în $back avem 4 valori 0, 18 valori mici (între 1 şi 8) şi 28 de valori de ordinul lui 500:
> HG$back[[14]] [1] 499 3 0 4 3 7 3 497 499 496 496 4 496 499 499 497 6 498 499 [20] 3 5 4 496 500 8 492 496 496 500 3 500 0 1 500 8 1 3 496 [39] 0 499 499 496 4 496 492 493 0 8 492 500
Grila respectivă are 17 valori fixate iniţial:
> Z <- su2int(HG$grid[14]) > print(matrix(Z, nrow=9, byrow=TRUE)) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 0 0 0 0 0 0 5 2 0 [2,] 0 8 0 4 0 0 0 0 0 [3,] 0 3 0 0 0 9 0 0 0 [4,] 5 0 1 0 0 0 6 0 0 [5,] 2 0 0 7 0 0 0 0 0 [6,] 0 0 0 3 0 0 0 0 0 [7,] 6 0 0 0 1 0 0 0 0 [8,] 0 0 0 0 0 0 7 0 4 [9,] 0 0 0 0 0 0 0 3 0
De data aceasta (spre deosebire de cazul prezentat mai sus), fixgrid(aspire()) nu duce la soluţie, reuşind fixarea doar a încă 6 valori şi reducând tabelul candidaţilor:
> printKand(fixgrid(aspire(Z))) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 1479 14679 4679 168 3 1678 5 2 16789 [2,] 179 8 25679 4 2567 12567 3 1679 1679 [3,] 147 3 24567 12568 25678 9 148 14678 1678 [4,] 5 479 1 289 2489 248 6 4789 3 [5,] 2 469 3 7 45689 14568 1489 14589 1589 [6,] 4789 4679 46789 3 245689 124568 12489 145789 125789 [7,] 6 24579 245789 2589 1 3 289 589 2589 [8,] 3 1259 2589 25689 25689 2568 7 15689 4 [9,] 14789 124579 245789 25689 2456789 245678 1289 3 125689
Merită observat că cele 6 valori fixate astfel sunt toate, egale cu 3; altfel spus, ştim acum locul lui 3 în fiecare linie şi coloană.
Deci, de data aceasta trebuie să intre în funcţiune şi reshat() (v. [1]). Numărul de candidaţi pe celulele rămase de fixat este cuprins între 3 şi 7 (pe ultima celulă din coloana a 5-a avem 7 candidaţi); prima celulă cu 3 candidaţi este cea care în Z are indexul 4, având drept candidaţi "168". În reshat() se alege aleatoriu unul dintre cei 3 candidaţi şi după fixarea (temporară) a lui pe celula respectivă, se aplică fixgrid(cutKand()) pe tabelul de candidaţi rezultat; dacă tabelul redus obţinut astfel este incorect, atunci se revine asupra alegerii temporare precedente, incrementând totodată back – altfel, se caută iarăşi acea celulă (din tabelul de candidaţi rezultat anterior) cu numărul minim de candidaţi şi se reia procesul de fixare temporară (aleatorie) a unui candidat, cu avansare la celulele următoare, sau cu eventuală revenire la celula precedentă.
Obs.Bineînţeles că „alegerea aleatorie” este astfel regizată încât în cazul unei eventuale reveniri ulterioare, să se evite alegerea unui aceluiaşi candidat: se constituie un vector în care candidaţii respectivi sunt plasaţi într-o ordine aleatorie a indecşilor şi apoi, se încearcă fiecare pe rând, în ordinea respectivă.
Vrând să păstrăm 0 în back, să ne uităm la soluţie:
> HG$sol[14] "416837529982465371735129468571298643293746185864351297647913852359682714128574936"
şi să observăm că valoarea corectă pe celula de index 4 este 8; în cazul (de probabilitate 2/6) în care candidaţii "168" ar fi ordonaţi prin (8, 1, 6) sau prin (8, 6, 1) – reshat() va fixa „din prima” valoarea corectă 8 (şi back va rămâne 0). Să fixăm direct valoarea respectivă şi să vedem dacă aşa, obţinem deja (direct) soluţia finală:
> Z[4] <- 8 > printKand(fixgrid(aspire(Z))) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 149 1469 469 8 3 7 5 2 169 [2,] 179 8 25679 4 256 256 3 1679 1679 [3,] 47 3 24567 1 256 9 48 4678 678 [4,] 5 479 1 29 2489 28 6 4789 3 [5,] 2 469 3 7 45689 1568 1489 14589 1589 [6,] 4789 4679 46789 3 245689 12568 12489 145789 125789 [7,] 6 24579 245789 259 1 3 289 589 2589 [8,] 3 1259 2589 2569 25689 2568 7 15689 4 [9,] 189 1259 2589 2569 7 4 1289 3 125689
A rezultat un nou tabel de candidaţi (redus, faţă de cel precedent şi cu unele valori fixate în plus). Prima celulă cu doi candidaţi este prima din linia 3 (având în Z indexul 19); în soluţia redată mai sus, la indexul 19 avem "7" – să vedem ce obţinem fixând:
> Z[19] <- 7 > printKand(fixgrid(aspire(Z))) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 149 1469 469 8 3 7 5 2 169 [2,] 19 8 2569 4 256 256 3 1679 1679 [3,] 7 3 2456 1 256 9 48 468 68 [4,] 5 479 1 29 2489 28 6 4789 3 [5,] 2 469 3 7 45689 1568 1489 14589 1589 [6,] 489 4679 46789 3 245689 12568 12489 145789 125789 [7,] 6 24579 245789 259 1 3 289 589 2589 [8,] 3 1259 2589 2569 25689 2568 7 15689 4 [9,] 189 1259 2589 2569 7 4 1289 3 125689
De data aceasta nu s-a reuşit fixarea vreunei noi valori şi doar s-a eliminat "7" dintre candidaţii celulelor din linia 3, din coloana 1 şi din blocul 1.
Prima celulă cu 2 candidaţi este la indexul 10, la care în soluţie avem "9":
> Z[10] <- 9 > printKand(fixgrid(aspire(Z))) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 14 146 46 8 3 7 5 2 9 [2,] 9 8 256 4 256 256 3 167 167 [3,] 7 3 2456 1 256 9 48 468 68 [4,] 5 479 1 29 2489 28 6 4789 3 [5,] 2 469 3 7 45689 1568 1489 14589 158 [6,] 48 4679 46789 3 245689 12568 12489 145789 12578 [7,] 6 24579 245789 259 1 3 289 589 258 [8,] 3 1259 2589 2569 25689 2568 7 15689 4 [9,] 18 1259 2589 2569 7 4 1289 3 12568
Acum, prima celulă cu 2 candidaţi este la indexul 1, având în soluţie valoarea 4 şi constăm că fixgrid(aspire()) conduce în sfârşit, la soluţie:
> Z[1] <- 4 > printKand(fixgrid(aspire(Z))) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [1,] 4 1 6 8 3 7 5 2 9 # soluţia grilei [2,] 9 8 2 4 6 5 3 7 1 [3,] 7 3 5 1 2 9 4 6 8 [4,] 5 7 1 2 9 8 6 4 3 [5,] 2 9 3 7 4 6 1 8 5 [6,] 8 6 4 3 5 1 2 9 7 [7,] 6 4 7 9 1 3 8 5 2 [8,] 3 5 9 6 8 2 7 1 4 [9,] 1 2 8 5 7 4 9 3 6
Putem concluziona că back va rămâne 0 doar dacă în cursul primelor câteva reapelări ale lui reshat() (în cazul redat mai sus, am avea 4 reapelări) se nimereşte de fiecare dată, pe celula curentă, ordinea în care primul candidat este chiar cel care şi trebuie fixat, pentru a ajunge la soluţia grilei.
Obs. Pentru grila a 14-a considerată mai sus, probabilitatea de a nimeri ordinea corectă în primele 4 reapelări reshat() este $\frac{2}{6}(\frac{1}{2})^3\approx 0.04$ (se alege un candidat din trei posibili, apoi câte unul dintre doi); Pentru N=50 am obţinut însă 4 valori 0 în back şi nu 0.04*50 = 2 – ceea ce înseamnă că N=50 este totuşi, prea mic (dar desigur, ar trebui analizate mai multe grile).
vezi Cărţile mele (de programare)