210127_artikkel/maatriksid.R

## Maatriksid
# 0 - intersect
# 1 - contain
# 2 - disjoint
# 3 - equal
# 4 - touch
# 5 - overlap
# 6 - are within
# 7 - cross


source("functions/delete_existing_variables.R")
library(dplyr)
library(sf)

gpkg_home <- "/data/gpkg/artiklid/artikkel_210127_valga_matsalu_lahemaa"
obj <- "marja"
dsn <- sprintf("%s/%s.gpkg", gpkg_home, obj)
conf <- ruut::get_config()
conf$gpkg_home <- gpkg_home
conf$gpkg_file <- obj

ruut::gpkg_andmebaasi_kihtide_nimekiri(obj = obj, gpkg_home = gpkg_home)



## Kõik geomeetrilised objektid GPKG andmebaasist
## Loeme andmebaasist piiri ja piirikasti.
# Layers list
gpkg_info <- sf::st_layers(dsn = dsn)
layer_names <- gpkg_info$name
for (layer_name in layer_names) {
  cat(sprintf("\n%s", layer_name))
  assign(layer_name, sf::read_sf(dsn = dsn, layer = layer_name))
}




## 0-maatriks
# bb_epk02t_grid <- sf::read_sf(dsn = dsn, layer = "bb_epk02t_grid")
rows <- sort(unique(bb_epk02t_grid$bottom), decreasing = T)
cols <- sort(unique(bb_epk02t_grid$left))
length(rows) * length(cols)

## Nullmaatriks
(m.0 <- matrix(0L, nrow = length(rows), ncol = length(cols), byrow = F)) # 0-maatriks
## Ruudu id väärtustega maatriks
(m.id <- matrix(bb_epk02t_grid$id, nrow = length(rows), ncol = length(cols), byrow = F))
## Ruudu vasakpoolse koordinaadi väärtustega maatriks
(m.left <- matrix(bb_epk02t_grid$left, nrow = length(rows), ncol = length(cols), byrow = F))
## Ruudu parempoolse koordinaadi väärtustega maatriks
(m.right <- matrix(bb_epk02t_grid$right, nrow = length(rows), ncol = length(cols), byrow = F))
## Ruudu ülemise koordinaadi väärtustega maatriks
(m.top <- matrix(bb_epk02t_grid$top, nrow = length(rows), ncol = length(cols), byrow = F))
## Ruudu alumise koordinaadi väärtustega maatriks
(m.bottom <- matrix(bb_epk02t_grid$bottom, nrow = length(rows), ncol = length(cols), byrow = F))

## ----------------------- TRUE/FALSE matrix ----------------------
## Kas alusruudustik sisaldab meie valitud kihti?

x <- layer_names[11]
x <- "piir"
x <- "bb_e_401_hoone_ka_10"
x <- "bb_muutee"
x <- "bb_aadressandmed"


for (x in layer_names) {
  ruumiline_obj <- get(x)
  y <- unlist(sf::st_intersects(ruumiline_obj, bb_epk02t_grid, sparse = TRUE))
  z <- rep(0, length(bb_epk02t_grid$id))
  z[y] <- 1
  assign(sprintf("m.%s", x), matrix(z, nrow = length(rows), ncol = length(cols), byrow = F))
  get(sprintf("m.%s", x))

  ruudustik <- bb_epk02t_grid
  ruudustik$value <- z

  ## plot to file
  png(filename = sprintf("tmp/img/matrix_true_false/%s.png", x))

  sf::st_geometry(ruudustik) %>% plot(main = x, sub = "True/False")
  sf::st_geometry(ruumiline_obj) %>% plot(add = T, border = "dark red", lwd = 1, col = "blue", pch = 16)
  text(x = (ruudustik$left + ruudustik$right) / 2, y = (ruudustik$bottom + ruudustik$top) / 2, labels = as.character(ruudustik$value))
  sf::st_geometry(ruudustik) %>% plot(add = T)

  dev.off()


  ## Punktide arv ruudus
  ## Kontlrollime kas geomeetriline objekt on punkt.
  (is_point <- any(grepl("point", tolower(attributes(ruumiline_obj$geom)$class), fixed = TRUE)))
  if (is_point) {
    # ruut::qgis_algorithm_search_by_word("Count")
    algorithm <- "native:countpointsinpolygon"
    conf$gpkg_table <- sprintf("%s_numpoints", x)
    output <- ruut::construct_to_gpkg_output_file_str(conf = conf, geometry_field = "geom", is_input_str = F)
    conf$gpkg_table <- sprintf("%s", x)
    points <- ruut::construct_to_gpkg_output_file_str(conf = conf, geometry_field = "geom", is_input_str = T)
    conf$gpkg_table <- sprintf("%s", "bb_epk02t_grid")
    polygons <- ruut::construct_to_gpkg_output_file_str(conf = conf, geometry_field = "geom", is_input_str = T)
    str <- sprintf("{ 'CLASSFIELD' : '', 'FIELD' : 'value', 'OUTPUT' : '%s', 'POINTS' : '%s', 'POLYGONS' : '%s', 'WEIGHT' : '' }", output, points, polygons)
    cmd <- ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
    system(cmd)
  }



  ## Kontlrollime kas geomeetriline objekt on polügoon.
  ## Arvutame sel juhul pindala.
  is_polygon <- any(grepl("polygon", tolower(attributes(ruumiline_obj$geom)$class), fixed = TRUE))
  if (is_polygon) {

  }
}















## ----------------- Confusion matrix -------------------
# \url{https://en.wikipedia.org/wiki/Confusion_matrix}


## ----------------- export matrix -------------------
mat <- matrix(1:10, ncol = 2)
rownames(mat) <- letters[1:5]
colnames(mat) <- LETTERS[1:2]

mat
write.table(mat, file = "test.txt") # keeps the rownames
read.table("test.txt", header = TRUE, row.names = 1) # says first column are rownames
unlink("test.txt")
write.table(mat, file = "test2.txt", row.names = FALSE) # drops the rownames
read.table("test.txt", header = TRUE)
unlink("test2.txt")