## 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")