|
|
@@ -0,0 +1,111 @@
|
|
|
+#' Piirkonnale andmebaasides olevate punktide lisamine
|
|
|
+#'
|
|
|
+#' Etteantud piirkonna geomeetrilise piirjoone ('piir') ja selle joone piirikasti ('bb') järele leitakse nende aladega kaetud polügoonid. Andmed salvestatakse GPKG faili kihtidena.
|
|
|
+#'
|
|
|
+#' @param obj str Objekti nimi. Edaspidi on oluline ainult see nimi. Piirkonna geomeetrilist joont ei ole vaja lisada.
|
|
|
+#' @param gpkg_home path Salvestatavate GPKG faili asukoht.
|
|
|
+#' @return Uute GPKG andmebaasi kihtide 'piir_...' ja 'bb_...' loomine.
|
|
|
+#' @seealso [sf::st_read()], [sf::write_sf()],[sf::st_transform()],[ruut::gpkg_piirkonnale_ruudustike_lisamine()] ,[ruut::gpkg_piirkonnale_polygoonide_lisamine()],[ruut::gpkg_sellest_alustame_gpkg_loomist()],[ruut::gpkg_piirkonnale_joonte_lisamine()],[ruut::gpkg_piirkonnale_punktide_lisamine()]
|
|
|
+#' @keywords GPKG, boundary box, EPSG:3301
|
|
|
+#' @export
|
|
|
+#' @examples
|
|
|
+#' \dontrun{
|
|
|
+#'
|
|
|
+#' gpkg_home <- "/tmp"
|
|
|
+#' obj <- "marja"
|
|
|
+#' gpkg_piirkonnale_punktide_lisamine(obj = obj, gpkg_home = gpkg_home)
|
|
|
+#'
|
|
|
+#' # Layers list.
|
|
|
+#' dsn <- sprintf("%s/%s.gpkg", gpkg_home, obj)
|
|
|
+#' sf::st_layers(dsn = dsn)
|
|
|
+#' }
|
|
|
+gpkg_piirkonnale_punktide_lisamine <- function(obj = NULL, gpkg_home = "/tmp") {
|
|
|
+ dsn <- sprintf("%s/%s.gpkg", gpkg_home, obj)
|
|
|
+ if (!file.exists(dsn)) {
|
|
|
+ cat(sprintf("\nSellist faili \"%s\" ei leitud.\n", dsn))
|
|
|
+ return(NULL)
|
|
|
+ }
|
|
|
+ ## Konfiguratsiooni muutujale väärtuste omistamine
|
|
|
+ conf <- ruut::get_config()
|
|
|
+ conf$gpkg_home <- gpkg_home
|
|
|
+ conf$gpkg_file <- obj
|
|
|
+ postgres <- sprintf(
|
|
|
+ "postgres://dbname=\'%s\' host=%s port=%s user=\'%s\' sslmode=%s password=\'%s\' key=\'id\' srid=3301 type=Point checkPrimaryKeyUnicity=\'1\' ",
|
|
|
+ conf$dbname, conf$host, conf$port, conf$user, conf$sslmode, conf$password
|
|
|
+ )
|
|
|
+ tmp_gpkg_file <- tempfile(fileext = ".gpkg")
|
|
|
+ ## Algorithm
|
|
|
+ # ruut::qgis_algorithm_search_by_word(str = "extract")
|
|
|
+ # algorithm <- "native:extractbylocation"
|
|
|
+ # cat(qgisprocess::qgis_show_help(algorithm = algorithm))
|
|
|
+
|
|
|
+ ## -------------------- Loop -----------------------
|
|
|
+ intersect_layers <- c("piir", "bb")
|
|
|
+ andmed <- data.frame("schema" = character(0), "table" = character(0))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "maaamet", "table" = "aadressandmed")) # POINT
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "osm_shp", "table" = "pofw"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "osm_shp", "table" = "pois"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_bussipeatus"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "kilomeetripostid"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_jaotus"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_kandur"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_mahasoit"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_onnetus"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_rdtyl"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_ristmik"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_ristumispunkt"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_sild"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_teeosa_points"))
|
|
|
+ andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_ylek"))
|
|
|
+ for (intersect in intersect_layers) {
|
|
|
+ for (i in 1:nrow(andmed)) {
|
|
|
+ conf$gpkg_table <- sprintf("%s_%s", intersect, andmed$table[i])
|
|
|
+ output <- ruut::construct_to_gpkg_output_file_str(conf = conf)
|
|
|
+ ## !!! Trikk: alguses leiame ühisosaga piirkonnad
|
|
|
+ if (andmed$schema[i] %in% c("teeregister_wfs")) geom <- "geometry" else geom <- "geom"
|
|
|
+ result <- qgisprocess::qgis_run_algorithm(
|
|
|
+ algorithm = "native:extractbylocation",
|
|
|
+ INPUT = sprintf(
|
|
|
+ '%s table=\"%s\".\"%s\" (%s)',
|
|
|
+ postgres, andmed$schema[i], andmed$table[i], geom
|
|
|
+ ),
|
|
|
+ INTERSECT = sprintf("%s|layername=%s", dsn, intersect),
|
|
|
+ OUTPUT = tmp_gpkg_file,
|
|
|
+ PREDICATE = c(0)
|
|
|
+ )
|
|
|
+ ## !!! Trikk jätkub: edasi leiame alles ühisosa
|
|
|
+ result <- qgisprocess::qgis_run_algorithm(
|
|
|
+ algorithm = "native:intersection",
|
|
|
+ INPUT = tmp_gpkg_file,
|
|
|
+ INPUT_FIELDS = "",
|
|
|
+ OVERLAY = sprintf("%s|layername=%s", dsn, intersect),
|
|
|
+ OVERLAY_FIELDS = "",
|
|
|
+ OVERLAY_FIELDS_PREFIX = "",
|
|
|
+ OUTPUT = output
|
|
|
+ # .quiet = TRUE
|
|
|
+ )
|
|
|
+ ## Filtreerime aadressandmete kihi eraldi alamkihtideks
|
|
|
+ if (andmed$table[i] == "aadressandmed") {
|
|
|
+ aadressandmed <- unique(as.data.frame(sf::read_sf(dsn = dsn, layer = sprintf("%s_aadressandmed", intersect), as_tibble = T))[, c("adob_liik"), drop = FALSE])
|
|
|
+ parent_table <- conf$gpkg_table
|
|
|
+ for (k in 1:nrow(aadressandmed)) {
|
|
|
+ table_suffix <- aadressandmed$adob_liik[k]
|
|
|
+ conf$gpkg_table <- sprintf("%s_%s", parent_table, table_suffix)
|
|
|
+ output <- ruut::construct_to_gpkg_output_file_str(conf = conf)
|
|
|
+ result <- qgisprocess::qgis_run_algorithm(
|
|
|
+ algorithm = "native:extractbyattribute",
|
|
|
+ FIELD = "adob_liik",
|
|
|
+ OPERATOR = 0, # 0 s.o '='
|
|
|
+ VALUE = aadressandmed$adob_liik[k],
|
|
|
+ INPUT = sprintf("%s|layername=%s_%s", dsn, intersect, andmed$table[i]),
|
|
|
+ OUTPUT = output,
|
|
|
+ FAIL_OUTPUT = qgisprocess::qgis_tmp_vector()
|
|
|
+ # .quiet = TRUE
|
|
|
+ )
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ ## Layers list
|
|
|
+ sf::st_layers(dsn = dsn)
|
|
|
+}
|
