ruut/R/gpkg_piirkonnale_polygoonide_lisamine.R

#' Piirkonnal andmebaasides olevate polügoonide 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()]
#' @keywords GPKG, boundary box, EPSG:3301
#' @export
#' @examples
#' \dontrun{
#'
#' gpkg_home <- "/tmp"
#' obj <- "marja"
#' gpkg_piirkonnale_polygoonide_lisamine(obj = obj, gpkg_home = gpkg_home)
#'
#' # Layers list.
#' dsn <- sprintf("%s/%s.gpkg", gpkg_home, obj)
#' sf::st_layers(dsn = dsn)
#' }
gpkg_piirkonnale_polygoonide_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=Polygon 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" = "osm_shp", "table" = "landuse_a"))
  andmed <- rbind(andmed, data.frame("schema" = "maaamet", "table" = "asustusyksus"))
  andmed <- rbind(andmed, data.frame("schema" = "maaamet", "table" = "shp_katastriyksus"))
  andmed <- rbind(andmed, data.frame("schema" = "osm_shp", "table" = "buildings_a"))
  andmed <- rbind(andmed, data.frame("schema" = "osm_shp", "table" = "water_a"))
  andmed <- rbind(andmed, data.frame("schema" = "osm_shp", "table" = "pofw_a"))
  andmed <- rbind(andmed, data.frame("schema" = "osm_shp", "table" = "pois_a"))
  andmed <- rbind(andmed, data.frame("schema" = "osm_shp", "table" = "natural_a"))
  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
      result <- qgisprocess::qgis_run_algorithm(
        algorithm = "native:extractbylocation",
        INPUT = sprintf(
          '%s table=\"%s\".\"%s\" (geom)',
          postgres, andmed$schema[i], andmed$table[i]
        ),
        INTERSECT = sprintf("%s|layername=%s", dsn, intersect),
        # OUTPUT = output,
        OUTPUT = tmp_gpkg_file,
        PREDICATE = c(0)
      )
      ## !!! Trikk jätkub: edasi leiame alles ühisosa
      result <- qgisprocess::qgis_run_algorithm(
        algorithm = "native:intersection",
        # INPUT = sprintf(
        #   '%s table=\"%s\".\"%s\" (geom)',
        #   postgres, andmed$schema[i], andmed$table[i]
        # ),
        INPUT = tmp_gpkg_file,
        INPUT_FIELDS = "",
        OVERLAY = sprintf("%s|layername=%s", dsn, intersect),
        OVERLAY_FIELDS = "",
        OVERLAY_FIELDS_PREFIX = "",
        OUTPUT = output
        # .quiet = TRUE
      )

      ## Filtreerime maakasutuse kihi 'landuse-a' eraldi alamkihtideks
      if (andmed$table[i] == "landuse_a") {
        landuse_a <- unique(as.data.frame(sf::read_sf(dsn = dsn, layer = sprintf("%s_landuse_a", intersect), as_tibble = T))[, c("code", "fclass")])
        parent_table <- conf$gpkg_table
        for (k in 1:nrow(landuse_a)) {
          table_suffix <- landuse_a$fclass[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 = "code",
            OPERATOR = 0, # 0 s.o '='
            VALUE = landuse_a$code[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)
}