Pronalaženje oblika

Prvo želimo da nadjemo povezane delove slike koji su identične boje. S tim ciljem, koristimo funkciju solid_blobs da pretvorimo sliku u tzv. pixset ( sliku čije je svaki piksel ili TRUE ili FALSE) koji nam za svaki piksel govori da li je ćlan homogene jednobojne sredine ili nije.

To radimo tako što definišemo neku okolinu¹, npr. u obliku krsta:

pa prodjemo kroz celu sliku piksel po piksel, pri čemu za svaki piksel proverimo za ovako definisanu okolinu (u ovom slučaju trenutni piksel u sredini i po dva piksela u svakom pravcu) da li su svi pikseli iste boje. Ako jesu, trenutni piksel postavimo na TRUE, u suprotnom postaje FALSE.

Pogledajmo rezultat koji dobijamo kad uradimo ovo za našu sliku:

plot(solid_blobs(im), axes = FALSE)

Svi oblici su postali beli (= TRUE), ali, nažalost, i za neke duge linije smo zaključili da su homogene. Postoji način da se to prevazidje, što radi get_shapes funkcija² (videli smo da daje dobar rezultat), ali možemo i samo da povećamo veličinu okoline koju gledamo, npr. neka je sada dužina stranice krsta 9, a ne 5.

blobs <- solid_blobs(im, cr_n = 9)
plot(blobs, axes = FALSE)

Sada iz ovakve slike vrlo jednostavno, uz pomoć paketa imager, da izvučemo sve povezane celine, koje ćemo pretvoriti u oblike. Za to nam služi funkcija split_connected. Dakle, jednostavno dobijamo:

connected <- imager::split_connected(blobs)
print(connected)

## Image list of size 11

Dobili smo 11 slika, zapravo pixset-ova, gde svaki pixset predstavlja jedan oblik, tj jednu povezanu celinu u prethodnoj (crno-beloj) slici.

Na kraju, hoćemo da ove pixset-ove pretvorimo u nešto sa čim možemo lepo da radimo. To će biti objekti klase shape, koji su definisani u ssoftveR paketu.

shapes <- lapply(connected, shape_from_pixset)

Vidimo da je funkcija shape_from_pixset glavna ovde. Demonstrirajmo šta ona radi i vidimo kako izgleda jedan objekat klase shape.

# uzmimo jedan oblik
pixset <- connected[[7]]

# vidimo sta smo uzeli
plot(pixset, axes = FALSE)

# pretvorimo ga u objekat klase 'shape'
shape <- shape_from_pixset(pixset)

# prikazimo rezultat
plot(shape, axes = FALSE)

Vidimo da je slika za shape dosta drugačija od same slike za izvučeni pixset. Naime, vidimo da su sva temena obeležena, kao i sve stranice i centar oblika. To sve izvlači funkcija shape_from_pixset, uz korišćenje još nekih funkcija iz paketa, u koje nećemo sada zalaziti (naime, glavne od njih su get_sides i get_vertices, ali su dosta komplikovane da bi se bavili njima ovde).

Pogledajmo strukturu objekta shape da steknemo sliku šta se tu sve nalazi.

str(shape)

## List of 6
##  $ pixset  : 'pixset' logi [1:567, 1:378, 1, 1] FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ xy      :'data.frame':    8962 obs. of  2 variables:
##   ..$ x: num [1:8962] 171 172 170 171 172 169 170 171 172 168 ...
##   ..$ y: num [1:8962] 164 164 165 165 165 166 166 166 166 167 ...
##  $ contours:List of 1
##   ..$ :List of 3
##   .. ..$ level: num 1
##   .. ..$ x    : num [1:555] 70 70 70 71 72 ...
##   .. ..$ y    : num [1:555] 264 264 264 264 264 ...
##  $ centroid: Named num [1:2] 150 243
##   ..- attr(*, "names")= chr [1:2] "x" "y"
##  $ sides   :List of 3
##   ..$ :List of 4
##   .. ..$ x        : num [1:138] 71 72 73 74 75 76 77 78 79 80 ...
##   .. ..$ y        : num [1:138] 264 264 265 265 265 ...
##   .. ..$ direction: Named num [1:2] 0.965 0.264
##   .. .. ..- attr(*, "names")= chr [1:2] "x" "y"
##   .. ..$ slope    : Named num 15.3
##   .. .. ..- attr(*, "names")= chr "deg"
##   .. ..- attr(*, "class")= chr [1:2] "side" "list"
##   ..$ :List of 4
##   .. ..$ x        : num [1:138] 208 207 207 207 207 ...
##   .. ..$ y        : num [1:138] 301 300 299 298 297 ...
##   .. ..$ direction: Named num [1:2] -0.255 -0.967
##   .. .. ..- attr(*, "names")= chr [1:2] "x" "y"
##   .. ..$ slope    : Named num 75.2
##   .. .. ..- attr(*, "names")= chr "deg"
##   .. ..- attr(*, "class")= chr [1:2] "side" "list"
##   ..$ :List of 4
##   .. ..$ x        : num [1:103] 172 171 170 169 168 ...
##   .. ..$ y        : num [1:103] 164 164 165 166 167 ...
##   .. ..$ direction: Named num [1:2] -0.707 0.707
##   .. .. ..- attr(*, "names")= chr [1:2] "x" "y"
##   .. ..$ slope    : Named num -45
##   .. .. ..- attr(*, "names")= chr "deg"
##   .. ..- attr(*, "class")= chr [1:2] "side" "list"
##  $ vertices:List of 3
##   ..$ x    : num [1:3] 71 208 172
##   ..$ y    : num [1:3] 264 301 164
##   ..$ angle: num [1:3] 60.3 59.9 59.8
##  - attr(*, "class")= chr [1:2] "shape" "list"

Dakle, imamo originalni pixset, izvučene konture oblika, centar, sve stranice i sva temena. Stranice sadrže koordinate svih tačaka, (jedinični)vektor pravca i nagib. Temena sadrže koordinate, kao i ugao kod svakog temena.

Klasifikacija oblika

Do sada smo, dakle, izvukli sve oblike sa slike. Sada bi trebalo da ih klasifikujemo. U to nećemo toliko detaljno ulaziti, već ćemo samo navesti koje prediktore koristimo, pri čemu koristimo multinomni model (multinom) za klasifikaciju.

Dakle, prediktore koje koristimo za prepoznavanje oblika su:

1. Disperzija udaljenosti od centra (centroid_distance_variance):

   Kao što ime kaže, merimo disperziju udaljenosti tačaka sa konture oblika od centra. Ideja je da će to moći da razlikuje krug od elipse (kod kruga je disperzija bliska nuli), ali i mnoge druge oblike (kvadrat ima manju disperziju od pravougaonika i sl.).

2. Broj temena (vertex_count):

   Ovo je očigledno, krug i elipsa imaju 0, trouglovi 3, četvorouglovi 4 temena, itd. Ovaj prediktor čemo tretirati u modelu kao faktorsku promenljivu.

3. Disperzija dužina stranica (side_length_variance):

   Ovde je ideja slična kao u prvom prediktoru, ali je ovde poenta da će regularni poligoni imati disperziju približnu nuli (jednakostraničan trougao, kvadrat, romb, petougao, šestougao), a ostali oblici će imati neke veće vrednosti. Za krug i elipsu stavljamo da je ova disperzija nula.

4. Disperzija uglova (angle_variance):

   Merimo disperziju uglova na temenima. Ovo liči na prethodni prediktor, ali ovaj prediktor nam daje mogućnost da razlikujemo pravougaonike od paralelograma. Kvardat i romb imaju isti broj temena i disperziju dužina stranica (0), ali kod kvadrata je i disperzija uglova nula, dok kod romba nije.

5. Disperzija zbirova susednih uglova (adj_angle_sum_variance):

   Kod ovog prediktora inspiracija je bila to što znamo da je kod paralelograma zbir dva susedna ugla uvek 180°, pa je disperzija tad nula. Time dobijamo jedan način razlikovanja paralelograma i trapeza.

Kada smo to demistifikovali, prodjimo jedan primer klasifikacije, da vidimo šta radi i funkcja classify_shape. Klasifikovaćemo naš trougao od ranije.

# uzmemo sve prediktore za nas shape. vracamo data.frame i ako negde imamo NA,
# pretvorimo ga u -1, da ne bismo imali problema sa modelom.
predictors <- get_shape_predictors(shape, df = TRUE, na_replacement = -1)
# stampamo rezultat
predictors

Vidimo da imamo 3 temena, da su disperzije dužina stranica, uglova i zbirova susednih uglova bliske nuli, što je i očekivano jer je ovo jednakostraničan trougao. Da li će i naš model isto to reći? Pa hoće, videli smo već na početku.

# klasifikujemo oblik koristeci multinom model "shapes_model"
shape_class <- as.character(predict(get_shapes_model(), predictors))

# da vidimo sta smo dobili
c(code = shape_class, long_name = shape_code_map[[shape_class]])

##                   code              long_name 
##                   "et" "equilateral triangle"

Upravo smo ovaj rezultat i očekivali!

Dosta uvoda, predjimo sad na zadatke, ali to je sada trivijalno.

Skup za obučavanje

Da ne bismo ručno klasifikovali polja za skupove za obučavanje i kontrolu, iskoristićemo fajlove minesolver/tr_cls.RDS i minesolver/ct_cls.RDS koje smo pripremili ranije. Oni sadrže klase polja (brojeve koji se nalaze na poljima), a polja ćemo izvući sa slika i kombinovati klase i prediktore da dobijemo skup za obučavanje i kotrolni skup. Počećemo od skupa za obučavanje. Ovo je blago modifikovano parče koda iz fajla minesolver/mines_training.R koji je izvorno korišćen za model.

library(imager)
library(ssoftveR)
source("minesolver/mines_predictors.R")

# load all images for training
files <- Sys.glob(paste("minesolver", "mines_img/*.png", sep = '/'))
images <- lapply(files, load.image)


# set predictors we want to use
predictors <- c("x_arc_length", "y_arc_length")

# extract fields from images
ext_fields <- lapply(images, function(im) {
                   im <- im %>% resize(780, 780)
                   extract_fields(process_img(im),
                                  get_boundaries(decolor(im), prob = 0.95))
              })

# combine the fields into one list
fields <- do.call(c, ext_fields)

# calculate predictors for the fields
tr_preds <- get_field_predictors(predictors, fields, FALSE)

# load saved training classes
tr_cls <- readRDS("minesolver/tr_cls.RDS")

# combine predictors and classes into one training set data.frame
tr_set <- cbind(tr_preds, class = tr_cls)

Ovime smo generisali skup za obučavanje. Pogledajmo kako izgleda pa ćemo objasniti prediktore koje koristimo.

library(ggplot2)
ggplot(tr_set, aes(x = x_arc_length, y = y_arc_length, color = class)) +
    geom_point()

Vidimo da su klase lepo razdvojene, možemo očekivati da ćemo imati dobar model.

Prediktori

Vizuelizujmo sada prediktore koje koristimo, jer slika govori hiljadu reči. Kod koji ovo radi se nalazi u fajlu minesolver/pred_visual.R.

source("minesolver/pred_visual.R")
visualise_predictors(fields, tr_cls)

Vidi se da svaki broj ima različit oblik krive koja predstavlja gustinu piksela po x i y koordinatama. Kao prediktore x_arc_length i y_arc_length mi jednostavno koristimo odgovarajuće dužine tih krivih.

Kontrolni skup

Hajde sad da formiramo i kontrolni skup. Na skoro isti način to radimo kao i što smo skup za obučavanje.

library(imager)
library(ssoftveR)
source("minesolver/mines_predictors.R")

# load all images for training
files <- Sys.glob(paste("minesolver", "mines_img/control/*.png", sep = '/'))
images <- lapply(files, load.image)


# set predictors we want to use
predictors <- c("x_arc_length", "y_arc_length")

# extract fields from images
ext_fields <- lapply(images, function(im) {
                   im <- im %>% resize(780, 780)
                   extract_fields(process_img(im),
                                  get_boundaries(decolor(im), prob = 0.95))
              })

# combine the fields into one list
fields <- do.call(c, ext_fields)

# calculate predictors for the fields
ct_preds <- get_field_predictors(predictors, fields, FALSE)

# load saved test classes
ct_cls <- readRDS("minesolver/ct_cls.RDS")

# combine predictors and test into one control set data.frame
ct_set <- cbind(ct_preds, class = ct_cls)

Sada možemo da predjemo na pravljenje modela.

Modeli

Napravićemo 3 modela (LDA, QDA i multinomni) i testirati njihovu preciznost da ustanovimo koji je najbolji.

library(MASS)

lda_model <- lda(class ~ . , data = tr_set)

library(klaR)

partimat(class ~ . , data = tr_set, method = "lda")

# get predicted classes
predictions <- predict(lda_model, tr_set[ , -3])$class

# compare real values and predicted
print(table(tr_set[ , 3], predictions))

##    predictions
##       0   1   2   3   4   m   z
##   0 196   0   0   0   0   0   0
##   1   0 231   0   0   0   0   0
##   2   0   0  86   0   0   0   0
##   3   0   0   0  28   0   0   0
##   4   0   0   0   0  11   0   0
##   m   0   0   0   0   0  31   3
##   z   0   0   0   0   0   0 386

# see the accuracy
mean(tr_set[ , 3] == predictions)

## [1] 0.9969136

# get predicted classes
predictions <- predict(lda_model, ct_set[ , -3])$class

# compare real values and predicted
print(table(ct_set[ , 3], predictions))

##    predictions
##      0  1  2  3  4  m  z
##   0 63  0  0  0  0  0  0
##   1  0 46  0  0  0  0  0
##   2  0  0 18  0  0  0  0
##   3  0  0  0  3  0  0  0
##   4  0  0  0  0  3  0  0
##   m  0  0  0  0  0 13  0
##   z  0  0  0  0  0  0 16

# see the accuracy
mean(ct_set[ , 3] == predictions)

## [1] 1

library(MASS)

qda_model <- qda(class ~ . , data = tr_set)

library(klaR)

partimat(class ~ . , data = tr_set, method = "qda")

# get predicted classes
predictions <- predict(qda_model, tr_set[ , -3])$class

# compare real values and predicted
print(table(tr_set[ , 3], predictions))

##    predictions
##       0   1   2   3   4   m   z
##   0 196   0   0   0   0   0   0
##   1   0 231   0   0   0   0   0
##   2   0   0  86   0   0   0   0
##   3   0   0   0  28   0   0   0
##   4   0   0   0   0  11   0   0
##   m   0   0   0   0   0  34   0
##   z   0   0   0   0   0   1 385

# see the accuracy
mean(tr_set[ , 3] == predictions)

## [1] 0.9989712

# get predicted classes
predictions <- predict(qda_model, ct_set[ , -3])$class

# compare real values and predicted
print(table(ct_set[ , 3], predictions))

##    predictions
##      0  1  2  3  4  m  z
##   0 63  0  0  0  0  0  0
##   1  0 46  0  0  0  0  0
##   2  0  0 18  0  0  0  0
##   3  0  0  0  3  0  0  0
##   4  0  0  0  0  3  0  0
##   m  0  0  0  0  0 13  0
##   z  0  0  0  0  0  0 16

# see the accuracy
mean(ct_set[ , 3] == predictions)

## [1] 1

library(nnet)

mnm_model <- multinom(class ~ . , data = tr_set, maxit = 1e3)

## # weights:  28 (18 variable)
## initial  value 1891.424665 
## iter  10 value 777.486480
## iter  20 value 40.850530
## iter  30 value 2.278428
## iter  40 value 1.684191
## iter  50 value 0.003788
## final  value 0.000058 
## converged

# get predicted classes
predictions <- predict(mnm_model, tr_set[ , -3])

# compare real values and predicted
print(table(tr_set[ , 3], predictions))

##    predictions
##       0   1   2   3   4   m   z
##   0 196   0   0   0   0   0   0
##   1   0 231   0   0   0   0   0
##   2   0   0  86   0   0   0   0
##   3   0   0   0  28   0   0   0
##   4   0   0   0   0  11   0   0
##   m   0   0   0   0   0  34   0
##   z   0   0   0   0   0   0 386

# see the accuracy
mean(tr_set[ , 3] == predictions)

## [1] 1

# get predicted classes
predictions <- predict(mnm_model, ct_set[ , -3])

# compare real values and predicted
print(table(ct_set[ , 3], predictions))

##    predictions
##      0  1  2  3  4  m  z
##   0 63  0  0  0  0  0  0
##   1  0 46  0  0  0  0  0
##   2  0  0 18  0  0  0  0
##   3  0  0  0  3  0  0  0
##   4  0  0  0  0  3  0  0
##   m  0  0  0  0  0 13  0
##   z  0  0  0  0  0  0 16

# see the accuracy
mean(ct_set[ , 3] == predictions)

## [1] 1

(a) resi_tablu(matrica, …)

Treba da definišemo funkciju resi_tablu(matrica, ...) koja rešava datu tablu Minolovca.

source("minesolver/solver.R")
resi_tablu <- function(matrica, broj_mina) solve_board(matrica, broj_mina)

Funkcija solve_board rešava tablu primenjujući uzastopno dve tehnike. Prva tehnika je direktna upotreba pravila Minolovca da se odrede mesta koja su sigurno mine ili sigurno nisu mine. To je najosnovnija logika.

Druga tehnika je “metod kontradikcije”. On funkcioniše tako što nadjemo sva neotvorena polja koja se nalaze uz otvorena (za ona polja koja su okružena samo zatvorenim nemamo nikakvu informaciju za rešavanje), pa krenemo redom i ponavaljamo sledeći postupak za svako od tih polja:

1. Stavimo minu na polje
2. Rešimo tablu koristeći osnovnu logiku
3. Ako smo dobili kontradiktornu (nevalidnu) tablu, označimo da na tom polju ne sme biti mina.

Analogan postupak ponovimo i stavljajući na početku da na polju nije mina i vidimo da li dolazi do kontradikcije, pa da mora da bude mina na tom polju.

(b) MK_simulacija(matrica, …)

Zadatak je da od preostalih neotvorenih polja odredimo ono koje ima najveću i ono koje ima najmanju verovatnoću da ima minu na sebi. Ovo radimo u funkciji get_mine_probs iz minesolver/solver.R tako što preostali broj mina mnogo puta razbacamo po zatvorenim poljima i vidimo da li je tabla validna, pa na kraju vidimo koliko puta je procentualno svako polje bilo prisutno u validnoj tabli.

source("minesolver/solver.R")

MK_simulacija <- function(matrica, broj_mina) {
    # odredimo verovatnoce pojave matrica za svako polje
    prob_mat <- get_mine_probs(matrica, broj_mina, pre_solve = TRUE)
    # odstampamo da vidimo verovatnoce
    print(prob_mat)

    # nadjemo indekse otvorenih polja
    open_ind <- which(matrica != "z")
    # i stavimo ih na NA da nam ne smetaju
    prob_mat[open_ind] <- NA

    # vratimo indekse polja sa najmanjom, odnosno najvecom verovatnocom
    d <- dim(matrica)

    list("min_prob" = arrayInd(which.min(prob_mat), d),
         "max_prob" = arrayInd(which.max(prob_mat), d))
}

Proverimo na primeru. Opet tajno učitavamo dve table…

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
##  [1,] "1"  "z"  "1"  "0"  "1"  "z"  "2"  "1"  "0" 
##  [2,] "2"  "2"  "2"  "0"  "z"  "3"  "z"  "2"  "0" 
##  [3,] "z"  "z"  "1"  "0"  "z"  "2"  "z"  "z"  "z" 
##  [4,] "1"  "1"  "1"  "1"  "1"  "2"  "1"  "1"  "0" 
##  [5,] "1"  "1"  "1"  "z"  "z"  "1"  "0"  "0"  "0" 
##  [6,] "1"  "z"  "1"  "1"  "1"  "1"  "0"  "0"  "0" 
##  [7,] "1"  "1"  "z"  "0"  "0"  "1"  "2"  "2"  "1" 
##  [8,] "z"  "0"  "0"  "1"  "1"  "2"  "z"  "z"  "1" 
##  [9,] "0"  "0"  "0"  "1"  "z"  "2"  "2"  "2"  "1"

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
##  [1,] "0"  "0"  "0"  "0"  "0"  "0"  "0"  "1"  "m" 
##  [2,] "0"  "0"  "0"  "0"  "0"  "1"  "1"  "2"  "1" 
##  [3,] "0"  "0"  "0"  "0"  "0"  "1"  "m"  "1"  "0" 
##  [4,] "0"  "0"  "0"  "0"  "0"  "1"  "1"  "1"  "0" 
##  [5,] "0"  "0"  "0"  "0"  "0"  "0"  "0"  "0"  "0" 
##  [6,] "0"  "0"  "0"  "1"  "2"  "2"  "2"  "1"  "1" 
##  [7,] "1"  "1"  "0"  "1"  "m"  "m"  "z"  "z"  "z" 
##  [8,] "m"  "1"  "0"  "1"  "3"  "m"  "z"  "z"  "z" 
##  [9,] "1"  "1"  "0"  "0"  "1"  "2"  "z"  "z"  "z"

… i da vidimo rezultat:

print(MK_simulacija(board1, 10))

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
##  [1,]    0    1    0    0    0    1    0    0    0
##  [2,]    0    0    0    0    0    0    1    0    0
##  [3,]    0    1    0    0    0    0    1    0    0
##  [4,]    0    0    0    0    0    0    0    0    0
##  [5,]    0    0    0    0    1    0    0    0    0
##  [6,]    0    1    0    0    0    0    0    0    0
##  [7,]    0    0    0    0    0    0    0    0    0
##  [8,]    0    0    0    0    0    0    1    1    0
##  [9,]    0    0    0    0    1    0    0    0    0
## $min_prob
##      [,1] [,2]
## [1,]    3    1
## 
## $max_prob
##      [,1] [,2]
## [1,]    1    2

print(MK_simulacija(board2, 10))

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7]      [,8]      [,9]
##  [1,]    0    0    0    0    0    0  0.0 0.0000000 1.0000000
##  [2,]    0    0    0    0    0    0  0.0 0.0000000 0.0000000
##  [3,]    0    0    0    0    0    0  1.0 0.0000000 0.0000000
##  [4,]    0    0    0    0    0    0  0.0 0.0000000 0.0000000
##  [5,]    0    0    0    0    0    0  0.0 0.0000000 0.0000000
##  [6,]    0    0    0    0    0    0  0.0 0.0000000 0.0000000
##  [7,]    0    0    0    0    1    1  0.0 1.0000000 0.0000000
##  [8,]    1    0    0    0    0    1  0.5 0.4634551 0.5016611
##  [9,]    0    0    0    0    0    0  0.5 0.4983389 0.5365449
## $min_prob
##      [,1] [,2]
## [1,]    7    7
## 
## $max_prob
##      [,1] [,2]
## [1,]    7    8

Vidimo da smo prvu tablu rešili potpuno i sve verovatnoće su 1 ili 0, dok u drugoj polja koja nismo uspeli da rešimo sva imaju oko 50% šanse da budu mine, što je i očekivano budući da ne možemo da odredimo gde je mina na tim poljima sem da nagadjamo.

(c) prava_matrica(matrica, dimenzija, broj_mina)

Ovde treba da napišemo funkciju koja nam kaže da li je matrica validna tabla minolovca. Ova funkcija je implementirana u minesolver/boards.R kao valid_board funkcija, tako da ćemo samo iskoristiti nju.

Ova funkcija je vrlo jednostavna za implementaciju kada imamo matrice okolina. Naime samo se proveri da li u svakom redu matrice okolina broj polja označenih sa “m” odgovara broju na srednjem elementu u redu.

prava_matrica <- function(matrica, dimenzija, broj_mina) {
    valid_board(matrica, broj_mina)
}

Čisto radi demonstracije proverimo da li je naša prva tabla validna:

prava_matrica(board, 3, 3)

## [1] TRUE

Naravno, tabla je validna.

(a) generator_table(dimenzija, broj_mina)

Ovde ćemo otkriti kako smo pravili table u prethodnim primerima. Razočaraćemo se jer je i ovo već uradjeno u minesolver/boards.R pa nećemo dva puta istu stvar pisati. Način na koji radi je inverzan proveri validnosti table. Naime, prvo razbacamo mine na praznu matricu, pa koristeći matricu okolina popunimo brojeve u sredini tako da oslikavaju broj mina u svom redu.

source("minesolver/boards.R")
generator_table <- generate_board

Generišimo radi primera jednu 9x9 tablu sa 10 mina.

print(generator_table(9, 10))

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
##  [1,] "0"  "0"  "0"  "0"  "0"  "0"  "0"  "0"  "0" 
##  [2,] "1"  "1"  "0"  "0"  "1"  "1"  "1"  "0"  "0" 
##  [3,] "m"  "2"  "0"  "0"  "1"  "m"  "3"  "2"  "1" 
##  [4,] "m"  "3"  "1"  "1"  "2"  "2"  "m"  "m"  "1" 
##  [5,] "m"  "2"  "1"  "m"  "1"  "1"  "2"  "2"  "1" 
##  [6,] "1"  "1"  "2"  "2"  "2"  "0"  "0"  "0"  "0" 
##  [7,] "1"  "1"  "2"  "m"  "1"  "0"  "0"  "0"  "0" 
##  [8,] "1"  "m"  "2"  "1"  "1"  "1"  "1"  "1"  "0" 
##  [9,] "1"  "1"  "1"  "0"  "0"  "1"  "m"  "1"  "0"

(b) sakrivanje_polja(matrica, broj_polja)

I ova funkcija postoji u minesolver/boards.R, tako da se nećemo zadržavati na njoj, jednostavno sakrije sve mine i još slučajno odabranih broj_polja polja.

source("minesolver/boards.R")
sakrivanje_polja <- hide_random

Demonstracija:

tabla <- generator_table(9, 10)
print(sakrivanje_polja(tabla, 20))

##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
##  [1,] "0"  "z"  "1"  "z"  "1"  "0"  "0"  "z"  "0" 
##  [2,] "z"  "0"  "2"  "2"  "2"  "z"  "0"  "0"  "0" 
##  [3,] "1"  "1"  "1"  "z"  "1"  "0"  "z"  "0"  "0" 
##  [4,] "z"  "1"  "1"  "z"  "1"  "0"  "0"  "1"  "1" 
##  [5,] "z"  "1"  "z"  "z"  "z"  "0"  "z"  "2"  "z" 
##  [6,] "z"  "1"  "0"  "0"  "0"  "0"  "z"  "z"  "4" 
##  [7,] "z"  "z"  "0"  "0"  "z"  "0"  "2"  "z"  "z" 
##  [8,] "2"  "2"  "0"  "0"  "z"  "z"  "2"  "z"  "z" 
##  [9,] "z"  "1"  "0"  "0"  "0"  "z"  "z"  "1"  "0"

(c) Prosečan broj otvorenih polja potrebnih za rešavanje

Ovo je prilično zanimljiv zadatak, koji ćemo rešiti na prilično zanimljiv način. Naime, potrebno je da odredimo koliko je, u proseku, potrebno da bude otvoreno polja da bismo mogli jedinstveno da razrešimo tablu. Da bismo ovo postigli, treba da generisemo veliki broj tabli, sakrijemo različite brojeve mina i vidimo koliko često možemo da rešimo tablu. I to sve za dve dimenzije tabli - 9x9 i 16x16.

Problem u ovome je što rešavanje table, tačnije metod kontradikcije, jako dugo traje, pa bi isuviše mnogo vremena proteklo dok dodjemo do rezultata. Zato, budući da ne postoji jednostavan način da se rešavanje značajno ubrza, posegnućemo za drugim metodom ubrzavanja koda - iskoristićemo mnogo jaču mašinu na kojoj ćemo da odradimo posao. Štaviše, koristićemo Cloud! Uzdaćemo se u Google Compute Engine da odradi posao za nas na dva računara, gde jedan ima 8 jezgara (za 9x9 table), a drugi 16 jezgara (za 16x16 table).

Za to će nam doći u pomoć paket googleComputeEngineR, koji značajno olakšavao posao i omogućava nam da sve odradimo direktno iz R-a, bez logovanja na servere Google-a i preuzimanja rezultata. Takodje, od velikog značaja je i paket future, koji nam olakšava paralelno izvršavanje koda na našem klasteru na Google Cloud-u.

Funkcija koja izvršava konkretno naš zadatak je get_solving_probs u fajlu minesolver/gce.R i ona je dokumentovana u tom fajlu, a mi ćemo je ovde samo iskoristiti da dobijemo rezultat.

Za celu operaciju nam uz pomoć oblaka treba samo 10-ak minuta, dok na laptop računaru to nisam želeo ni da pokušavam da uradim, tako da je u svakom slučaju neuporedivo.

Ako želite da sami pokrenete funkciju i vidite kako to izgleda, morate me kontaktirati da sredimo pristup serveru³.

Pre pokretanja je potrebno da oslobodimo memoriju u R sesiji, budući da je sada pretrpana zbog svih komandi koje smo pokretali, a future paket celo okruženje prebacuje na oblak pa želimo da to bude što manje. Zato ćemo obrisati sve objekte iz okruženja⁴.

rm(list = ls())

Sada možemo da nastavimo…

Dakle, uključimo štoperice i krenimo:

source("minesolver/gce.R")

solving_probs <- get_solving_probs()

## Launching VMs...

## VM previously created but not running, starting VM

## Operation running...
## Operation running...
## Operation running...
## Operation running...

## Operation complete in 11 secs

## VM running

## VM previously created but not running, starting VM

## Checking operation...PENDING

## Operation running...
## Operation running...
## Operation running...
## Operation running...

## Operation complete in 15 secs

## VM running

## Setting up SSH...
## Waiting for docker to pull the image...
## Making a future plan...

## External IP for instance d9x9 : 104.155.73.205

## External IP for instance d16x16 : 35.195.252.78

## Running samples...

## Auto-refreshing stale OAuth token.

Trajalo je oko 7 minuta, nije loše.

Hajde da vidimo rezultate probamo da dodjemo do nekog zaključka.

solving_probs

## $d9x9
##         3         6         9        12        15        18        21 
## 1.0000000 0.9903846 0.9807692 0.9567308 0.9134615 0.8894231 0.8173077 
##        24        27        30        33 
## 0.6923077 0.5673077 0.4230769 0.3076923 
## 
## $d16x16
##        10        15        20        25        30        35        40 
## 0.9903846 0.9903846 0.9759615 0.8942308 0.9423077 0.9230769 0.8413462 
##        45        50        55        60 
## 0.7788462 0.7932692 0.6923077 0.6105769

Ovde su prikazane verovatnoće rešavanja table ako je sakriven odredjen broj polja. Dakle, kad su sakrivena 3 polja (tj. otvoreno 68 polja), uvek može da reši tablu.

Za 9x9 tablu nema nekog jako naglog skoka ka velikom procentu, kod 21 sakrivenih polja je značajna razlika ali je ipak i dalje samo 81% procenat rešenih tabli. Malo manji skok, ali vidljiv se desio kod 12 sakrivenih polja, pri čemu smo tad prešli 95% rešenih tabli, tako da bi to mogli da kažemo kao odgovor na postavljeno pitanje, tj. da je u proseku dovoljno da bude 59 otvorenih polja da bi tabla bila razrešiva.

Za 16x16 tablu imamo jako čudan rezultat, budući da sa 40 na 35 zatvorenih polja imamo veliki skok i do 30 raste do čak 94% uspešnosti, ali zatim naglo pada na 89% kod 25, pa imamo nagli skok na čak 97% za 20 sakrivenih polja, odakle raste postepeno do 99%. Dakle, u ovom slučaju mogli bismo da kao odgovor na pitanje kažemo da je prosečno dovoljno da bude 20 sakrivenih polja, tj. 196 otvorenih polja da bi tabla bila razrešiva.