From 8adf47efe0da0ac02efa894ac5b340bdd3076ad1 Mon Sep 17 00:00:00 2001
From: hansvancalster <hans.vancalster@inbo.be>
Date: Wed, 15 Jan 2025 19:14:13 +0100
Subject: [PATCH] start grb targets

---
 source/pipelines/R/flea_functions.R         | 24 +++++++++++-
 source/pipelines/run_pipeline.R             | 23 ++++++-----
 source/pipelines/script_validation_sample.R | 42 ++++++++++++++++++++-
 3 files changed, 78 insertions(+), 11 deletions(-)

diff --git a/source/pipelines/R/flea_functions.R b/source/pipelines/R/flea_functions.R
index 8b8101b..88ac87b 100644
--- a/source/pipelines/R/flea_functions.R
+++ b/source/pipelines/R/flea_functions.R
@@ -233,7 +233,7 @@ extract_sample <- function(
 #' @param bbox A SpatExtent or an object from which a SpatExtent can be
 #' determined. The bbox values should be in CRS 31370.
 #'
-#' @return A SpatVector
+#' @return A SpatVector containing GRB layer objects that intersect bbox.
 #' @export
 #'
 #' @examples
@@ -261,3 +261,25 @@ get_grb <- function(layer, bbox) {
 
   return(grb)
 }
+
+read_layernames <- function(x) {
+  assertthat::assert_that(is.character(x))
+  return(x)
+}
+
+get_grb_by_row <- function(layer, polygons) {
+  assertthat::assert_that(inherits(polygons, "SpatVector"))
+
+  out <- vector("list", length = nrow(polygons))
+  namesvec <- polygons$grts_rank
+  out <- setNames(out, nm = namesvec)
+  for (i in seq_along(out)) {
+    bbox <- polygons[i, ]
+    grb <- get_grb(layer = layer, bbox = bbox)
+    grb$grts_rank <-  namesvec[i]
+    out[[as.character(namesvec[i])]] <- grb
+  }
+  out <- terra::vect(out)
+  return(out)
+}
+
diff --git a/source/pipelines/run_pipeline.R b/source/pipelines/run_pipeline.R
index ac94236..71f9579 100644
--- a/source/pipelines/run_pipeline.R
+++ b/source/pipelines/run_pipeline.R
@@ -12,11 +12,13 @@ tar_make()
 # inspect pipeline #
 ####################
 
+#targets::tar_prune()
+
 targets::tar_meta(
   fields = error,
   complete_only = TRUE
 )
-
+targets::tar_meta(fields = warnings, complete_only = TRUE)
 targets::tar_visnetwork(label = c("description", "time", "size"))
 
 
@@ -30,9 +32,10 @@ log_plot(log_data, metric = "resident")
 #tar_load(names = c(mapnames, catstable, grts_ext, grts_origin))
 
 tar_read(mapnames)
-tar_read(catstable) |> tail()
+ct <- tar_read(catstable)
 ml <- tar_read(maps)
 
+ct
 ml[[1]]
 terra::plot(ml[[1]], colNA = "orange")
 terra::values(ml[[1]], row = 5000, nrows = 1)
@@ -79,6 +82,10 @@ terra::vect(vs) |> sf::st_as_sf(crs = 31370) |>
   sf::st_drop_geometry() |>
   dplyr::count(grts_rank) |> dplyr::count(n)
 
+vp <- targets::tar_read(validation_polygons)
+lapply(vp, nrow) |> unlist() |> sum()
+
+
 library(ggplot2)
 library(sf)
 terra::vect(vs) |>
@@ -102,13 +109,11 @@ debugonce(get_changecats)
 get_changecats(separate_grts)
 
 targets::tar_load_globals()
-targets::tar_workspace("validation_sample_8ed063f6bf68fd26")
-debugonce(extract_sample)
-test <- extract_sample(
-  separate_grts = separate_grts,
-  ntot = 40 * 4 * 4,
-  nmin = 40,
-  min_stratum_size = 1000 # 10 ha
+targets::tar_workspace("grb_waterways_0b2d2afcb856bfba")
+debugonce(get_grb_by_row)
+test <- get_grb_by_row(
+  layer = lyrs_waterways,
+  polygons = validation_polygons
 )
 
 
diff --git a/source/pipelines/script_validation_sample.R b/source/pipelines/script_validation_sample.R
index d27f6d9..347e038 100644
--- a/source/pipelines/script_validation_sample.R
+++ b/source/pipelines/script_validation_sample.R
@@ -59,6 +59,24 @@ path_to_gdb <- "Z:/Projects/PRJ_FLEA/flea_data.gdb"
 path_to_lyr <- "Z:/Projects/PRJ_FLEA/reclass_bwk2016.lyr"
 path_to_grts <- file.path(flea_data, "data/c-mon/flea_cmon_level15.tiff")
 
+layers_ruimtebeslag <- c(
+  "GRB:WBN",
+  "GRB:SBN",
+  "GRB:GBG",
+  "GRB:GBA",
+  "GRB:KNW",
+  "GRB:TRN"
+)
+
+layers_water <- c(
+  "GRB:WTZ",
+  "GRB:WLAS"
+)
+
+layers_perceelgrens <- c(
+  "GRB:ADP"
+)
+
 
 # to be changed later: download the raster files from zenodo
 
@@ -159,10 +177,32 @@ list(
       crs = 31370
     ),
     pattern = map(validation_sample)
-  )
+  ),
   # add grb waterways
   # add grb settlements
   # add grb parcel outlines
+  tar_target(
+    name = lyrs_waterways,
+    command = read_layernames(x = layers_water)
+  ),
+  tar_target(
+    name = lyrs_settlements,
+    command = read_layernames(x = layers_ruimtebeslag)
+  ),
+  tar_target(
+    name = lyrs_parcels,
+    command = read_layernames(x = layers_perceelgrens)
+  ),
+  geotargets::tar_terra_vect(
+    name = grb_waterways,
+    command = get_grb_by_row(
+      layer = lyrs_waterways,
+      polygons = validation_polygons
+    ),
+    pattern = cross(lyrs_waterways, validation_polygons)
+  )
+
+
 
   # apply majority filter, use 3 by 3 block