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

Testare, măsurare şi sumarizare (II)

R | backtracking
2021 jul

O nouă testare

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

Îmbinarea datelor

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.

Verificări şi eliminări

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

Dar ce înseamnă de fapt, că back este zero?

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

docerpro | Prev | Next