Lisatud f-n pk_teisendame_liiklussagedusi.

.Renviron

@@ -0,0 +1,2 @@
+_R_CHECK_SYSTEM_CLOCK_=0
+

DESCRIPTION

@@ -11,5 +11,5 @@ License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1.9000
-Imports: DBI, pool, RPostgreSQL, sf, raster, stars, rgdal, tidyverse, inborutils, rvest, seleniumPipes, rjson, methods,jsonlite,magrittr,rlang
+RoxygenNote: 7.2.0
+Imports: DBI, pool, RPostgreSQL, sf, raster, stars, rgdal, tidyverse, inborutils, rvest, seleniumPipes, rjson, methods, jsonlite, magrittr, rlang

NAMESPACE

@@ -22,6 +22,7 @@ export(pk_lisame_punktid)
 export(pk_lisame_ruudustikud)
 export(pk_sellest_alustame_db_loomist)
 export(pk_teisendame_jooni)
+export(pk_teisendame_liiklussagedusi)
 export(pk_teisendame_polygoone)
 export(pk_teisendame_punkte)
 export(qgis_algorithm_search_by_word)

R/pk_lisame_jooned.R

@@ -45,7 +45,7 @@ pk_lisame_jooned <- function(obj = NULL, conf = NULL) {
   andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "ramp"))
   andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "teeosa"))
   andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_kergliiklustee"))
-  andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_liiklussagedus"))
+  # andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_liiklussagedus"))
   andmed <- rbind(andmed, data.frame("schema" = "teeregister_wfs", "table" = "n_omand"))
   # andmed <- rbind(andmed, data.frame("schema" = "gtfs", "table" = "shapes"))
   andmed <- rbind(andmed, data.frame("schema" = "eesti", "table" = "e_203_vooluveekogu_j"))
@@ -81,6 +81,21 @@ pk_lisame_jooned <- function(obj = NULL, conf = NULL) {
       cmd <- ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
       cat(sprintf("\n%s\n\n", cmd))
       system(cmd)
+      ## Filtreerime mõned andmetabelid eraldi alamkihtideks
+      if (andmed$table[i] == "n_liiklussagedus") {
+        parent_table <-
+          sprintf("data_a_%s_%s",
+                  strtrim(as.character(andmed$schema[i]), 2),
+                  andmed$table[i])
+        conn <- ruut::db_connect(conf = conf)
+        data <-
+          unique(as.data.frame(sf::st_read(
+            dsn = conn,
+            layer = c(conf$schema, parent_table),
+            as_tibble = T
+          ))[, c("code", "fclass")])
+        DBI::dbDisconnect(conn)
+      }
     }
   }
   ## Layers list

R/pk_teisendame_liiklussagedusi.R

@@ -0,0 +1,250 @@
+#' Piirkonnale andmebaasis oleva liiklussageduse andmete jagamine kihtideks
+#'
+#' Etteantud piirkonna geomeetrilise piirjoone ('piir') ja selle joone piirikasti ('bb') järele leitud liiklussagedusandmete eraldamine kihtideks ("sapa", "vaab", "ar", "sapaarv", "vaabarv", "ararv"). 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 Liiklussageduse andmete jagamine kihtideks.
+#' @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_teisendame_liiklussagedusi(obj = obj, conf = NULL)
+#'
+#' # Layers list.
+#' ruut::db_schema_tablenames(conf = conf)
+#' }
+pk_teisendame_liiklussagedusi <- 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)
+  }
+
+  ## ====================== teisendused =====================
+  # Layers list
+  layer_names <- ruut::db_schema_tablenames(conf = conf)
+  layer_names <-
+    layer_names[!layer_names %in% c(
+      "a00_piir",
+      "a00_bb2",
+      "a00_piir_bb",
+      "bb2_epk10t_grid",
+      "bb2_epk02t_grid",
+      "bb2_epk2t_grid"
+    )]
+  layer_names <- layer_names[grepl("^data_l_", layer_names)]
+  layer_name <- "n_liiklussagedus"
+  parent_table <- "data_l_te_n_liiklussagedus"
+
+  ## Konfiguratsiooni muutujale väärtuste omistamine, kui seda pole antud.
+  if (!parent_table %in% layer_names) {
+    cat(sprintf("\nPuudub andmebaas \"%s\".\n", parent_table))
+    return(NULL)
+  }
+
+  conn <- ruut::db_connect(conf = conf)
+  try(ruumiline_obj <-
+        sf::st_read(dsn = conn,
+                    layer = c(conf$schema, parent_table)))
+  DBI::dbDisconnect(conn)
+  ## Kontlrollime kas geomeetriline objekt on polügoon.
+  ## Arvutame sel juhul pindala.
+  is_line <-
+    any(grepl("line", tolower(attributes(
+      ruumiline_obj$geom
+    )$class), fixed = TRUE))
+  # Liiklussageduse klassid.
+  ls_klassid <-
+    c("sapa", "vaab", "ar", "sapaarv", "vaabarv", "ararv")
+  if (is_line) {
+    for (ls_klass in ls_klassid) {
+      ls <- ruumiline_obj[, ls_klass]
+      ## Veeru ümbernimetamine
+      names(ls) <- c("ls", "geom")
+
+      ## 1. Ajutise sf salvestamine
+      pk <- sf::st_transform(ls, 3301)
+      # Write to gpkg and check validity
+      sf::write_sf(
+        pk,
+        dsn = vars$tmp_gpkg_file,
+        layer = vars$conf$gpkg_table,
+        driver = "gpkg",
+        fid_column_name = "fid",
+        delete_dsn = T
+      )
+      ## 2. Lõikame objekti ruudistikga tükkideks. Ühte ruutu võib jääda mitu tükki.
+      ## Peame need pärast ühendama
+      # ruut::qgis_algorithm_search_by_word("join")
+      algorithm <- "native:joinattributesbylocation"
+      conf$table <- sprintf("%s", "bb2_epk02t_grid")
+      input <- ruut::construct_to_gpkg_output_postgres_str(
+        conf = conf,
+        geometry_type = "Polygon",
+        srid = 3301,
+        checkPrimaryKeyUnicity = TRUE,
+        key = "id",
+        geometry_field = "geom"
+      )
+      join <- vars$tmp_gpkg_file_input_1
+      output <- vars$tmp_gpkg_file_output_2 # ajutine fail
+      str <-
+        sprintf(
+          "{
+    'DISCARD_NONMATCHING' : false,
+    'INPUT' : '%s',
+    'JOIN' : '%s',
+    'JOIN_FIELDS' : ['ls'],
+    'METHOD' : 2,
+    'OUTPUT' : '%s',
+    'PREDICATE' : [0],
+    'PREFIX' : ''
+}",
+          input,
+          join,
+          output
+        )
+      cmd <-
+        ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
+      system(cmd)
+
+      ## ------------- TIFF ----------------
+      ## 5. Asendame NULL väärtustega 0.
+      algorithm <- "qgis:advancedpythonfieldcalculator"
+      input <- vars$tmp_gpkg_file_input_2 # ajutine fail
+      output <- vars$tmp_gpkg_file_output_1
+      cmd <-
+        sprintf(
+          "qgis_process run %s --FIELD_NAME='value' --FIELD_TYPE=1 --FIELD_LENGTH=4 --FIELD_PRECISION=2 --GLOBAL=\"def getValue(x):
+    if not x:
+        value = 0
+    else:
+        value = round(x,1)
+    return value\" --FORMULA='value = getValue( <ls> )' --INPUT='%s' --OUTPUT='%s' ",
+          algorithm,
+          input,
+          output
+        )
+      system(cmd)
+
+      ## 6. tif salvestamine tmp kataloogi
+      conn <- ruut::db_connect(conf = conf)
+      grid_layer <-
+        sf::read_sf(dsn = conn,
+                    layer = c(conf$schema, "bb2_epk02t_grid"))
+      DBI::dbDisconnect(conn)
+      # sf::st_crs(grid_layer) <- 3301
+      pk_attributes <- attributes(grid_layer$geom)
+      extent <-
+        sprintf(
+          "%s,%s,%s,%s [EPSG:3301]",
+          round((pk_attributes$bbox["xmin"] / 100), digits = 0) * 100,
+          ceiling((pk_attributes$bbox["xmax"] / 100)) * 100,
+          round((pk_attributes$bbox["ymin"] / 100), digits = 0) * 100,
+          ceiling((pk_attributes$bbox["ymax"] / 100)) * 100
+        )
+      # ruut::qgis_algorithm_search_by_word("Rasterize")
+      algorithm <- "gdal:rasterize"
+      # ruut::qgis_show_help(algorithm = algorithm)
+      input <- vars$tmp_gpkg_file_input_1
+      tif_file_name <-
+        sprintf("tif_%s_%s", gsub("^data_", "", parent_table), ls_klass)
+      output <- sprintf("%s/%s.tif", vars$tmp_dir, tif_file_name)
+      str <-
+        sprintf(
+          "{ 'BURN' : 0, 'DATA_TYPE' : 5, 'EXTENT' : '%s', 'EXTRA' : '-a_srs epsg:3301', 'FIELD' : 'value', 'HEIGHT' : 100, 'INIT' : None, 'INPUT' : '%s', 'INVERT' : False, 'NODATA' : -1, 'OPTIONS' : '', 'OUTPUT' : '%s', 'UNITS' : 1, 'WIDTH' : 100 }",
+          extent,
+          input,
+          output
+        )
+      cmd <-
+        ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
+      system(cmd) # Salvestame kataloogi
+
+      ## 7. ----------- TIF TO POSTGIS -------------
+      (
+        cmd <- sprintf(
+          "export PGPASSWORD=%s && raster2pgsql -s 3301 -d -I -C -M %s %s.%s_tif | psql -U %s -d %s -h %s -p %s",
+          conf$password,
+          output,
+          conf$schema,
+          tif_file_name,
+          conf$user,
+          conf$dbname,
+          conf$host,
+          conf$port
+        )
+      )
+      system(cmd)
+
+      ## 8. Eemaldame üleliigsed veerud ja salvestame tiff alusfaili andmebaasi
+      # ruut::qgis_algorithm_search_by_word("Drop ")
+      algorithm <- "native:deletecolumn"
+      input <- vars$tmp_gpkg_file_input_1
+      conf$table <-
+        sprintf("grid_%s_%s", gsub("^data_", "", parent_table), ls_klass)
+      output <-
+        ruut::construct_to_gpkg_output_postgres_str(
+          conf = conf,
+          geometry_field = "geom",
+          geometry_type = "Polygon",
+          srid = 3301,
+          checkPrimaryKeyUnicity = FALSE,
+          key = "id"
+        )
+      cmd <-
+        sprintf(
+          "qgis_process run %s --COLUMN='fid' --COLUMN='left' --COLUMN='top' --COLUMN='right' --COLUMN='bottom' --COLUMN='ls' --INPUT='%s' --OUTPUT='%s' ",
+          algorithm,
+          input,
+          output
+        )
+      system(cmd)
+
+      ## 9. Kustutame geom veeru.
+      conn <- ruut::db_connect(conf = conf)
+      q <-
+        sprintf("ALTER TABLE \"%s\".\"%s\" DROP COLUMN geom;",
+                conf$schema,
+                conf$table)
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbSendQuery(conn, q)
+      ## 10. Vaakum.
+      q <-
+        sprintf(
+          "VACUUM (FULL, FREEZE, VERBOSE, ANALYZE, INDEX_CLEANUP) \"%s\".\"%s\";",
+          conf$schema,
+          conf$table
+        )
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbSendQuery(conn, q)
+      ## 11. Add foreign key.
+      q <-
+        sprintf(
+          "ALTER TABLE \"%s\".\"%s\" ADD CONSTRAINT %s_fk FOREIGN KEY (id) REFERENCES %s.bb2_epk02t_grid(id);",
+          conf$schema,
+          conf$table,
+          conf$table,
+          conf$schema
+        )
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbSendQuery(conn, q)
+      DBI::dbDisconnect(conn)
+    }
+  }
+  ## Layers list
+  conf$schema <- obj
+  ruut::db_schema_tablenames(conf = conf)
+  sf::st_layers(dsn = vars$tmp_gpkg_file)
+}

man/pk_teisendame_liiklussagedusi.Rd

@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pk_teisendame_liiklussagedusi.R
+\name{pk_teisendame_liiklussagedusi}
+\alias{pk_teisendame_liiklussagedusi}
+\title{Piirkonnale andmebaasis oleva liiklussageduse andmete jagamine kihtideks}
+\usage{
+pk_teisendame_liiklussagedusi(obj = NULL, conf = NULL)
+}
+\arguments{
+\item{obj}{str Objekti nimi. Edaspidi on oluline ainult see nimi. Piirkonna geomeetrilist joont ei ole vaja lisada.}
+
+\item{conf}{A list() of configuration variables. Default values \code{\link[ruut]{get_config}}.}
+}
+\value{
+Liiklussageduse andmete jagamine kihtideks.
+}
+\description{
+Etteantud piirkonna geomeetrilise piirjoone ('piir') ja selle joone piirikasti ('bb') järele leitud liiklussagedusandmete eraldamine kihtideks ("sapa", "vaab", "ar", "sapaarv", "vaabarv", "ararv"). Andmed salvestatakse postgis andmebaasi.
+}
+\examples{
+\dontrun{
+
+obj <- "marja"
+pk_teisendame_liiklussagedusi(obj = obj, conf = NULL)
+
+# Layers list.
+ruut::db_schema_tablenames(conf = conf)
+}
+}
+\seealso{
+\code{\link[sf:st_read]{sf::st_read()}}, \code{\link[sf:st_write]{sf::write_sf()}},\code{\link[sf:st_transform]{sf::st_transform()}},\code{\link[=pk_sellest_alustame_db_loomist]{pk_sellest_alustame_db_loomist()}},\code{\link[=pk_lisame_ruudustikud]{pk_lisame_ruudustikud()}} ,\code{\link[=pk_lisame_polygoonid]{pk_lisame_polygoonid()}},\code{\link[=pk_lisame_jooned]{pk_lisame_jooned()}},\code{\link[=pk_lisame_punktid]{pk_lisame_punktid()}},\code{\link[=pk_teisendame_polygoone]{pk_teisendame_polygoone()}},\code{\link[=pk_teisendame_jooni]{pk_teisendame_jooni()}},\code{\link[=pk_teisendame_punkte]{pk_teisendame_punkte()}}
+}
+\keyword{EPSG:3301}
+\keyword{boundary}
+\keyword{box,}
+\keyword{postgis,}