ruut/R/pk_lisame_polygoonid.R

#' Piirkonnale 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 postgis andmebaasi.
#'
#' @param obj str Objekti nimi. Edaspidi on oluline ainult see nimi. Piirkonna geomeetrilist joont ei ole vaja lisada.
#' @param conf A list() of configuration variables. Default values \code{\link[ruut]{get_config}}.
#' @return Uute andmebaasi kihtide 'piir_...' ja 'bb_...' loomine.
#' @seealso [sf::st_read()], [sf::write_sf()],[sf::st_transform()],[ruut::pk_sellest_alustame_db_loomist()],[ruut::pk_lisame_ruudustikud()] ,[ruut::pk_lisame_polygoonid()],[ruut::pk_lisame_jooned()],[ruut::pk_lisame_punktid()],[ruut::pk_teisendame_polygoone()],[ruut::pk_teisendame_jooni()],[ruut::pk_teisendame_punkte()]
#' @keywords postgis, boundary box, EPSG:3301
#' @export
#' @examples
#' \dontrun{
#'
#' obj <- "marja"
#' pk_lisame_polygoonid(obj = obj, conf = NULL)
#'
#' # Layers list.
#' ruut::db_schema_tablenames(conf = conf)
#' }
pk_lisame_polygoonid <- function(obj = NULL, conf = NULL) {
  ## ------------- muutujad ja teisendused ---------------
  vars <- ajutised_muutujad(pk = NULL, obj, conf)
  obj <- vars$obj
  piir <- vars$pk
  conf <- vars$conf
  ## Konfiguratsiooni muutujale väärtuste omistamine, kui seda pole antud.
  if (!any("a00_piir" %in% ruut::db_schema_tablenames(conf = conf))) {
    cat(
      "\nAndmebaas loomata. Palun funktsiooniga ruut::pk_sellest_alustame_db_loomist() andmebaasi loomist.\n"
    )
    return(NULL)
  }

  ## Algorithm
  # ruut::qgis_algorithm_search_by_word(str = "extract")
  # algorithm <- "native:extractbylocation"
  # cat(ruut::qgis_show_help(algorithm = algorithm))

  ## -------------------- Loop -----------------------
  intersect_layers <- c("a00_bb2") # c("piir", "bb", "bb2")
  andmed <-
    data.frame("schema" = character(0), "table" = character(0))
  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" = "landuse_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "osm_shp", "table" = "natural_a"))
  andmed <-
    rbind(andmed, data.frame("schema" = "osm_shp", "table" = "places_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" = "traffic_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "osm_shp", "table" = "transport_a"))
  andmed <-
    rbind(andmed, data.frame("schema" = "osm_shp", "table" = "water_a"))
  # andmed <- rbind(andmed, data.frame("schema" = "eesti", "table" = "e_201_meri_a_dissolved"))
  # andmed <- rbind(andmed, data.frame("schema" = "eesti", "table" = "e_202_seisuveekogu_a_dissolved"))
  # andmed <- rbind(andmed, data.frame("schema" = "eesti", "table" = "e_203_vooluveekogu_a_dissolved"))
  # andmed <- rbind(andmed, data.frame("schema" = "eesti", "table" = "e_305_puittaimestik_a_dissolved"))
  # andmed <- rbind(andmed, data.frame("schema" = "eesti", "table" = "e_306_margala_a_dissolved"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_201_meri_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_202_seisuveekogu_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_203_vooluveekogu_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_301_muu_kolvik_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_301_muu_kolvik_ka"))
  andmed <-
    rbind(andmed, data.frame("schema" = "eesti", "table" = "e_302_ou_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_303_haritav_maa_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_304_lage_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_305_puittaimestik_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_306_margala_ka"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_307_turbavali_a"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_401_hoone_ka"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_403_muu_rajatis_ka"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_404_maaalune_hoone_ka"))
  andmed <-
    rbind(andmed,
          data.frame("schema" = "eesti", "table" = "e_501_tee_a"))
  andmed <-
    rbind(
      andmed,
      data.frame("schema" = "eesti", "table" = "e_505_liikluskorralduslik_rajatis_ka")
    )
  andmed <-
    rbind(andmed, data.frame("schema" = "eesti", "table" = "mullakaart"))
  ## Tabelid mis on juba andmebaasis ja mida ümber ei kirjutata.
  olemasolevad_tabelid <- ruut::db_schema_tablenames(conf = conf)
  for (intersect in intersect_layers) {
    conf$table <- intersect
    conf$schema <- obj
    intersect_layer <-
      ruut::construct_to_gpkg_output_postgres_str(
        conf = conf,
        geometry_type = "Polygon",
        srid = 3301,
        checkPrimaryKeyUnicity = TRUE,
        key = "id"
      )
    for (i in 1:nrow(andmed)) {
      cat("\n\n\n==========================================\n\n")
      cat(sprintf("Tabel: %s.%s", andmed[i, "schema"], andmed[i, "table"]))
      cat("\n==========================================\n\n")
      ## Kui olemasolev tabel eksisteerib andmebaasis, siis jätame arvutused
      ## selle tabeliga vahele.
      uus_tabel <- sprintf("data_a_%s_%s",
                           strtrim(as.character(andmed$schema[i]), 2),
                           andmed$table[i])
      if (uus_tabel %in% olemasolevad_tabelid) {
        cat("\nTabel on juba andmebaasis olemas.\n")
        next
      }
      ## Osadel tabelitel andmebaasisvõib olla geomeetria välja tähistus 'geometry'.
      geom <- "geom"
      # if (andmed$schema[i] %in% c("teeregister_wfs"))  geom <- "geometry" else geom <- "geom"
      conf$table <- andmed$table[i]
      conf$schema <- andmed$schema[i]
      input <- ruut::construct_to_gpkg_output_postgres_str(
        conf = conf,
        geometry_type = "Polygon",
        srid = 3301,
        checkPrimaryKeyUnicity = TRUE,
        key = "id",
        geometry_field = geom
      )
      # Geomeetria parandamine
      # ruut::qgis_algorithm_search_by_word("fix")
      algorithm <- "native:fixgeometries"
      output <- vars$tmp_gpkg_file_output_1 # ajutine fail
      str <-
        sprintf("{ 'INPUT' : '%s', 'OUTPUT' : '%s' }", input, output)
      cmd <-
        ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
      system(cmd)
      # Ühisosa leidmine ja salvestamine ajutiseks failiks.
      algorithm <- "native:intersection"
      input <- vars$tmp_gpkg_file_input_1
      output <- vars$tmp_gpkg_file_output_2 # ajutine fail
      str <-
        paste0(
          "{ 'INPUT' : '",
          input,
          "', 'INPUT_FIELDS' : [], 'OUTPUT' : '",
          output,
          "', 'OVERLAY' : '",
          intersect_layer,
          "', 'OVERLAY_FIELDS' : [], 'OVERLAY_FIELDS_PREFIX' : '' }"
        )
      cmd <-
        ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
      cat(sprintf("\n%s\n\n", cmd))
      system(cmd)
      ## Andmebaasi tabeli nimi: 2 esimest tähte tuleb schema nimest millest on andmed võetud, siis '_a_' s.o 'area' mis tähistab polügoone.
      # Eemaldame üleliigsed veerud ja salvestame postgis andmebaasi.
      # ruut::qgis_algorithm_search_by_word("Drop")
      algorithm <- "native:deletecolumn"
      input <- vars$tmp_gpkg_file_input_2
      conf$table <-
        sprintf("data_a_%s_%s",
                strtrim(as.character(andmed$schema[i]), 2),
                andmed$table[i])
      conf$schema <- obj
      output <-
        ruut::construct_to_gpkg_output_postgres_str(
          conf = conf,
          geometry_field = "geom",
          geometry_type = NULL,
          srid = 3301,
          checkPrimaryKeyUnicity = FALSE,
          key = "id"
        )
      cmd <-
        sprintf(
          "qgis_process run %s --COLUMN='fid' --COLUMN='id_2' --COLUMN='left' --COLUMN='top' --COLUMN='right' --COLUMN='bottom' --INPUT='%s' --OUTPUT='%s' ",
          algorithm,
          input,
          output
        )
      system(cmd)

      ## Filtreerime mõned andmetabelid eraldi alamkihtideks
      if (andmed$table[i] == "landuse_a") {
        parent_table <-
          sprintf("data_a_%s_%s",
                  strtrim(as.character(andmed$schema[i]), 2),
                  andmed$table[i])
        conn <- ruut::db_connect(conf = conf)
        landuse_a <-
          unique(as.data.frame(sf::st_read(
            dsn = conn,
            layer = c(conf$schema, parent_table),
            as_tibble = T
          ))[, c("code", "fclass")])
        DBI::dbDisconnect(conn)
        for (k in 1:nrow(landuse_a)) {
          table_suffix <- landuse_a$fclass[k]
          conf$table <- parent_table
          conf$schema <- obj
          input <-
            ruut::construct_to_gpkg_output_postgres_str(
              conf = conf,
              geometry_type = "MultiPolygon",
              srid = 3301,
              checkPrimaryKeyUnicity = TRUE,
              key = "id"
            )
          # sf::st_read(dsn = conn, layer = c(conf$schema, parent_table))
          conf$table <- sprintf("%s_%s", parent_table, table_suffix)
          output <-
            ruut::construct_to_gpkg_output_postgres_str(
              conf = conf,
              geometry_field = "geom",
              geometry_type = "MultiPolygon",
              srid = 3301,
              checkPrimaryKeyUnicity = FALSE,
              key = "id"
            )
          str <-
            paste0(
              "{ 'INPUT' : '",
              input,
              "', 'INTERSECT' : '",
              intersect_layer,
              "', 'OUTPUT' : '",
              output,
              "', FIELD : 'code', OPERATOR : 0, VALUE : '",
              landuse_a$code[k],
              "' }"
            )
          algorithm <- "native:extractbyattribute"
          cmd <-
            ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
          cat(sprintf("\n%s\n", cmd))
          system(cmd)
        }
      }

      ## Filtreerime mõned andmetabelid eraldi alamkihtideks
      if (andmed$table[i] == "e_401_hoone_ka") {
        parent_table <-
          sprintf("data_a_%s_%s",
                  strtrim(as.character(andmed$schema[i]), 2),
                  andmed$table[i])
        conn <- ruut::db_connect(conf = conf)
        alamobjektid <-
          unique(as.data.frame(sf::st_read(
            dsn = conn,
            layer = c(conf$schema, parent_table),
            as_tibble = T
          ))[, c("kood", "tyyp")])
        DBI::dbDisconnect(conn)
        for (k in 1:nrow(alamobjektid)) {
          table_suffix <- alamobjektid$tyyp[k]
          conf$table <- parent_table
          conf$schema <- obj
          input <-
            ruut::construct_to_gpkg_output_postgres_str(
              conf = conf,
              geometry_type = "MultiPolygon",
              srid = 3301,
              checkPrimaryKeyUnicity = TRUE,
              key = "id"
            )
          # sf::st_read(dsn = conn, layer = c(conf$schema, parent_table))
          conf$table <- sprintf("%s_%s", parent_table, table_suffix)
          output <-
            ruut::construct_to_gpkg_output_postgres_str(
              conf = conf,
              geometry_field = "geom",
              geometry_type = "MultiPolygon",
              srid = 3301,
              checkPrimaryKeyUnicity = FALSE,
              key = "id"
            )
          str <-
            paste0(
              "{ 'INPUT' : '",
              input,
              "', 'INTERSECT' : '",
              intersect_layer,
              "', 'OUTPUT' : '",
              output,
              "', FIELD : 'tyyp', OPERATOR : 0, VALUE : '",
              alamobjektid$tyyp[k],
              "' }"
            )
          algorithm <- "native:extractbyattribute"
          cmd <-
            ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
          cat(sprintf("\n%s\n", cmd))
          system(cmd)

          ## ----------- lisame tsentroidid -----------
          parent_table <-
            sprintf("data_a_%s_%s",
                    strtrim(as.character(andmed$schema[i]), 2),
                    andmed$table[i])

          conf$table <- sprintf("%s_%s", parent_table, table_suffix)
          conf$schema <- obj
          input <-
            ruut::construct_to_gpkg_output_postgres_str(
              conf = conf,
              geometry_type = "MultiPolygon",
              srid = 3301,
              checkPrimaryKeyUnicity = TRUE,
              key = "id"
            )
          conf$table <-
            sprintf(
              "data_p_%s_%s_%s",
              strtrim(as.character(andmed$schema[i]), 2),
              andmed$table[i],
              table_suffix
            )
          output <-
            ruut::construct_to_gpkg_output_postgres_str(
              conf = conf,
              geometry_field = "geom",
              geometry_type = "Point",
              srid = 3301,
              checkPrimaryKeyUnicity = FALSE,
              key = "id"
            )
          str <-
            sprintf("{ 'ALL_PARTS' : False, 'INPUT' : '%s', 'OUTPUT' : '%s' }",
                    input,
                    output)
          # ruut::qgis_algorithm_search_by_word("centroid")
          algorithm <- "native:centroids"
          # ruut::qgis_show_help(algorithm = algorithm)
          cmd <-
            ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
          cat(sprintf("\n%s\n", cmd))
          system(cmd)
        }
      }
    }
  }
  ## Layers list
  conf$schema <- obj
  ruut::db_schema_tablenames(conf = conf)
  sf::st_layers(dsn = vars$tmp_gpkg_file)
}