Prechádzať zdrojové kódy

Uue f-ni pk_tif_to_true lisamine.

Ardo Kubjas 3 rokov pred
rodič
commit
0065c4abb2
4 zmenil súbory, kde vykonal 303 pridanie a 11 odobranie
  1. 1 0
      NAMESPACE
  2. 177 11
      R/pk_lisame_rahvaarvud.R
  3. 89 0
      R/pk_tif_to_true.R
  4. 36 0
      man/pk_tif_to_true.Rd

+ 1 - 0
NAMESPACE

@@ -26,6 +26,7 @@ export(pk_teisendame_jooni)
 export(pk_teisendame_liiklussagedusi)
 export(pk_teisendame_polygoone)
 export(pk_teisendame_punkte)
+export(pk_tif_to_true)
 export(qgis_algorithm_search_by_word)
 export(qgis_show_help)
 importFrom(magrittr,"%>%")

+ 177 - 11
R/pk_lisame_rahvaarvud.R

@@ -54,8 +54,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
     for (i in 1:nrow(andmed)) {
       geom <- "geom"
       # if (andmed$schema[i] %in% c("teeregister_wfs"))  geom <- "geometry" else geom <- "geom"
-      ## 1. Ruutude sidumine asukoha järele.
-      # Geomeetria parandamine
+      ## 1.1 Ruutude sidumine asukoha järele.
       # ruut::qgis_algorithm_search_by_word("fix")
       algorithm <- "native:joinattributesbylocation"
       conf$table <- andmed$table[i]
@@ -86,7 +85,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
       cmd <-
         ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
       system(cmd)
-      ## 2. Asendame NULL väärtustega 0.
+      ## 1.2 Asendame NULL väärtustega 0.
       algorithm <- "qgis:advancedpythonfieldcalculator"
       input <- vars$tmp_gpkg_file_input_1 # ajutine fail
       output <- vars$tmp_gpkg_file_output_2
@@ -103,7 +102,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
           output
         )
       system(cmd)
-      ## 3. tif salvestamine tmp kataloogi
+      ## 1.3 tif salvestamine tmp kataloogi
       conf$schema <- obj
       conn <- ruut::db_connect(conf = conf)
       grid_layer <-
@@ -136,7 +135,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
       cmd <-
         ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
       system(cmd) # Salvestame kataloogi
-      ## 4. ----------- TIF TO POSTGIS -------------
+      ## 1.4 ----------- 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",
@@ -151,8 +150,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
         )
       )
       system(cmd)
-
-      ## 5. Eemaldame üleliigsed veerud ja salvestame tiff alusfaili andmebaasi
+      ## 1.5 Eemaldame üleliigsed veerud ja salvestame tiff alusfaili andmebaasi
       # ruut::qgis_algorithm_search_by_word("Drop ")
       algorithm <- "native:deletecolumn"
       input <- vars$tmp_gpkg_file_input_2
@@ -175,8 +173,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
           output
         )
       system(cmd)
-
-      ## 9. Kustutame geom veeru.
+      ## 1.6 Kustutame geom veeru.
       conf$schema <- obj
       conn <- ruut::db_connect(conf = conf)
       q <-
@@ -185,7 +182,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
                 conf$table)
       cat(sprintf("\n-----------------\n%s\n\n", q))
       DBI::dbSendQuery(conn, q)
-      ## 10. Vaakum.
+      ## 1.7 Vaakum.
       q <-
         sprintf(
           "VACUUM (FULL, FREEZE, VERBOSE, ANALYZE, INDEX_CLEANUP) \"%s\".\"%s\";",
@@ -194,7 +191,7 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
         )
       cat(sprintf("\n-----------------\n%s\n\n", q))
       DBI::dbSendQuery(conn, q)
-      ## 11. Add foreign key.
+      ## 1.8 Add foreign key.
       q <-
         sprintf(
           "ALTER TABLE \"%s\".\"%s\" ADD CONSTRAINT %s_fk FOREIGN KEY (id) REFERENCES %s.bb2_epk2t_grid(id);",
@@ -206,6 +203,175 @@ pk_lisame_rahvaarvud <- function(obj = NULL, conf = NULL) {
       cat(sprintf("\n-----------------\n%s\n\n", q))
       DBI::dbSendQuery(conn, q)
       DBI::dbDisconnect(conn)
+      ## ----------- 1x1 km rahvaarvu ülekandmine 100x100m ruutudesse ----------
+      ## Selleks leiame elamute aadressandmed 1x1km ruutudes, arvutame elanike
+      ## keskmise arvu elamutes (s.o elanike arv / majade arv). Edasi leitud
+      ## keskmise kaudu kanname elanike arvud 100x100m asuvatesse ruutudesse.
+      conf$schema <- obj
+      # 2.1 Elamute arv 1x1 km ruutudes
+      algorithm <- "native:countpointsinpolygon"
+      output <- vars$tmp_gpkg_file_output_1
+      conf$table <- "data_p_ma_aadressandmed_EE"
+      points <-
+        ruut::construct_to_gpkg_output_postgres_str(
+          conf = conf,
+          geometry_field = "geom",
+          geometry_type = NULL,
+          srid = 3301,
+          checkPrimaryKeyUnicity = FALSE,
+          key = "id"
+        )
+      conf$table <- "bb2_epk2t_grid"
+      polygons <-
+        ruut::construct_to_gpkg_output_postgres_str(
+          conf = conf,
+          geometry_field = "geom",
+          geometry_type = NULL,
+          srid = 3301,
+          checkPrimaryKeyUnicity = FALSE,
+          key = "id"
+        )
+      str <- sprintf(
+        "{
+    'FIELD' : 'numpoints',
+    'OUTPUT' : '%s',
+    'POINTS' : '%s',
+    'POLYGONS' : '%s'}",
+        output,
+        points,
+        polygons
+      )
+      cmd <-
+        ruut::construct_qgis_output_result_to_better_format(str, algorithm)
+      system(cmd)
+      ## 2.2 tif salvestamine tmp kataloogi
+      conn <- ruut::db_connect(conf = conf)
+      # 1x1km ruudud
+      grid_layer <-
+        sf::read_sf(dsn = conn,
+                    layer = c(conf$schema, "bb2_epk2t_grid"))
+      DBI::dbDisconnect(conn)
+      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_stat_%s", "p_ma_aadressandmed_ee")
+      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' : 'numpoints', '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)
+      ## 2.3 ----------- 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)
+      ## 2.4 Elanike tihedus majades. Salvestame TIF-na andmebaasi.
+      majade_arv <- "tif_stat_p_ma_aadressandmed_ee_tif"
+      rahvaarv <- sprintf("tif_stat_%s_tif", andmed$table[i])
+      tihedus <- sprintf("tif_stat_density_%s_tif", andmed$table[i])
+      # F-n tiheduse leidmiseks mapalgebra f-ni jaoks
+      conn <- ruut::db_connect(conf = conf)
+      q <- sprintf(
+        "create or replace function
+  rahvaarv_tihedus_epk2t_fn(pixel float[][][], pos integer[][], variadic userargs text[])
+  returns float
+  language plpgsql
+  immutable  -- careful: this function is immutable, yours may not be
+as $$
+  declare
+    pixval1 float;
+    pixval2 float;
+    tihedus float;
+  begin
+    pixval1 := pixel[1][1][1];  -- pixel indices: [raster #][xdistance][ydistance]
+    pixval2 := pixel[2][1][1];  -- pixel indices: [raster #][xdistance][ydistance]
+    if pixval1 > 0  then
+      tihedus := (pixval2 / pixval1);
+    else
+      tihedus := 0;
+    end if;
+    return tihedus;
+  end;
+$$;"
+      )
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbSendQuery(conn, q)
+      # Salvestame andmebaasi
+      q <- sprintf("
+DROP TABLE IF EXISTS  \"%s\".\"%s\";
+",
+                   conf$schema,
+                   tihedus)
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbSendQuery(conn, q)
+      q <-
+        sprintf(
+          "SELECT ST_MapAlgebra(t2.rast, 1, t1.rast, 1, 'rahvaarv_tihedus_epk2t_fn(double precision[], int[], text[])'::regprocedure) AS rast INTO \"%s\".\"%s\" FROM \"%s\".\"%s\" t1,  \"%s\".\"%s\" t2;",
+          conf$schema,
+          tihedus,
+          conf$schema,
+          rahvaarv,
+          conf$schema,
+          majade_arv
+        )
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbGetQuery(conn, q)
+      DBI::dbDisconnect(conn)
+      ## 2.2 Rahvaarv 100x100m ruutudes.
+      tihedus <- sprintf("tif_stat_density_%s_tif", andmed$table[i])
+      majade_arv <- "tif_stat_p_ma_aadressandmed_ee_tif"
+      rahvaarv <- sprintf("tif_stat_%s_epk02t_tif", andmed$table[i])
+      conn <- ruut::db_connect(conf = conf)
+      q <- sprintf("
+DROP TABLE IF EXISTS  \"%s\".\"%s\";
+",
+                   conf$schema,
+                   rahvaarv)
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbSendQuery(conn, q)
+      q <- sprintf(
+        "SELECT
+    ST_MapAlgebra(
+        t1.rast, 1,
+        t2.rast, 1,
+        '([rast2.val] * [rast1.val])'
+    ) AS rast INTO \"%s\".tif_stat_rel_1x1km_epk02t_tif
+FROM \"%s\".tif_p_ma_aadressandmed_ee_tif t1
+cross JOIN \"%s\".tif_stat_density_rel_1x1km_tif t2;",
+        conf$schema,
+        conf$schema,
+        conf$schema
+      )
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbGetQuery(conn, q)
+      DBI::dbDisconnect(conn)
     }
   }
   ## Layers list

+ 89 - 0
R/pk_tif_to_true.R

@@ -0,0 +1,89 @@
+#' TIF failide teisendamine TRUE-ks
+#'
+#' Funktsioon teisendab rasterandmebaase millede tabeli nimed on kujul tif_[...]_tif rasterbaasiks nimedega tif_[...]_tif_true. Iga rasteri pixel mis on nullist erineva väärtusega, saab väärtuseks 1 ja nullid saavad väärtuse 0. Ehk tekib true/false raster andmetabel (maatriks).
+#'
+#' @importFrom magrittr %>%
+#' @importFrom rlang .data
+#' @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 Raster andmebaaside loomine minedega tif_[...]_tif_true.
+#' @seealso [sf::st_read()], [sf::write_sf()],[sf::st_transform()],[ruut::pk_tif_to_true()],[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_rahvaarvud(obj = obj, conf = NULL)
+#'
+#' # Layers list.
+#' ruut::db_schema_tablenames(conf = conf)
+#' }
+pk_tif_to_true <-
+  function(obj = NULL, conf = NULL) {
+    ## ------------- muutujad ja teisendused ---------------
+    vars <- ajutised_muutujad(pk = NULL, obj, conf)
+    obj <- vars$obj
+    piir <- vars$pk
+    conf <- vars$conf
+    ## Raster andmebaaside nimekiri, mille tabeli nimi on kujul tif_[...]_tif .
+    tabels_list <- ruut::db_schema_tablenames(conf = conf)
+    tabels_list <-
+      tabels_list[grepl("^(tif_).*(_tif)$", tabels_list)]
+    ## Konfiguratsiooni muutujale väärtuste omistamine, kui seda pole antud.
+    if (length(tabels_list) == 0) {
+      cat("\nAndmebaasis puuduvad raster tabelid, mille nimi on kujul tif_[...]_tif.\n")
+      return(NULL)
+    }
+    ## Ühendus andmebaasiga
+    conn <- ruut::db_connect(conf = conf)
+    q <- sprintf(
+      "create or replace function
+tif_to_tru_fn(pixel float[], pos integer[], variadic userargs text[])
+  returns float
+  language plpgsql
+  immutable  -- careful: this function is immutable, yours may not be
+as $$
+  declare
+    pixval float;
+    jahei float;
+  begin
+    pixval := pixel[1][1][1];  -- pixel indices: [raster #][xdistance][ydistance]
+
+    if pixval > 0 then
+      jahei := 1;
+    else
+      jahei := 0;
+    end if;
+    return jahei;
+  end;
+$$;"
+    )
+    cat(sprintf("\n-----------------\n%s\n\n", q))
+    DBI::dbSendQuery(conn, q)
+
+    conf$schema <- obj
+
+    for (tabel in tabels_list) {
+      print(tabel)
+      ## Drop tabel if exist.
+      q <-
+        sprintf("DROP TABLE IF EXISTS \"%s\".\"%s_true\";",
+                conf$schema,
+                tabel)
+      cat(sprintf("\n-----------------\n%s\n\n", q))
+      DBI::dbSendQuery(conn, q)
+      # Create new raster tabel.
+      q <-
+        sprintf(
+          "SELECT ST_MapAlgebra(rast, 1, 'tif_to_tru_fn(float[], integer[], text[])'::regprocedure) AS rast INTO \"%s\".\"%s_true\"  FROM \"%s\".\"%s\";",
+          conf$schema,
+          tabel,
+          conf$schema,
+          tabel
+        )
+      DBI::dbSendQuery(conn, q)
+    }
+    DBI::dbDisconnect(conn)
+
+  }

+ 36 - 0
man/pk_tif_to_true.Rd

@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/pk_tif_to_true.R
+\name{pk_tif_to_true}
+\alias{pk_tif_to_true}
+\title{TIF failide teisendamine TRUE-ks}
+\usage{
+pk_tif_to_true(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{
+Raster andmebaaside loomine minedega tif_\link{...}_tif_true.
+}
+\description{
+Funktsioon teisendab rasterandmebaase millede tabeli nimed on kujul tif_\link{...}\emph{tif rasterbaasiks nimedega tif}\link{...}_tif_true. Iga rasteri pixel mis on nullist erineva väärtusega, saab väärtuseks 1 ja nullid saavad väärtuse 0. Ehk tekib true/false raster andmetabel (maatriks).
+}
+\examples{
+\dontrun{
+
+obj <- "marja"
+pk_lisame_rahvaarvud(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_tif_to_true]{pk_tif_to_true()}},\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,}