Update replace_by_existing function to increase generality

inbo · Feb 4, 2024 · 7c4ee78 · 7c4ee78
1 parent cd6ea4f
commit 7c4ee78
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 1 deletion.
diff --git a/source/R/steekproeftrekking_nabehandeling.R b/source/R/steekproeftrekking_nabehandeling.R
@@ -64,16 +64,32 @@ thin_sample <- function(sample, thin_dist) {
 
 replace_by_existing <- function(sample,
                                 existing_points,
+                                id_existing_points,
+                                gebied,
                                 overlap_prop = 0.5,
                                 sbp_file) {
+  # Determine where HOL and OL is in gebied
+  ol <- selectie_openheid(
+    gebied = gebied,
+    ol_strata = c("OL"))
+
+  hol <- selectie_openheid(
+    gebied = gebied,
+    ol_strata = c("HOL"))
   # Recalculate sbp stratum existing points
   old_points <- existing_points %>%
+    filter(st_within(., perimeters_data, sparse = FALSE)) %>%
     mutate(is_sbp = st_intersects(.,
                                   st_union(sbp_file),
                                   sparse = FALSE) %>%
              as.logical()
     ) %>%
-    mutate(openheid_klasse = ifelse(grepl("HOL", stratum), "HOL", "OL")) %>%
+    mutate(openheid_klasse = ifelse(st_within(., hol, sparse = FALSE),
+                                    "HOL",
+                                    ifelse(st_within(., ol, sparse = FALSE),
+                                           "OL",
+                                           NA))) %>%
+    rename(definitief_punt = id_existing_points) %>%
     select(definitief_punt, openheid_klasse, is_sbp)
 
   # Add buffers

diff --git a/source/targets/mas_steekproef_zl_lm_za_kp_po/targets_steekproef_zl_lm_za_kp_po.Rmd b/source/targets/mas_steekproef_zl_lm_za_kp_po/targets_steekproef_zl_lm_za_kp_po.Rmd
@@ -418,6 +418,8 @@ list(
     replace_by_existing(
       sample = steekproef_thinned,
       existing_points = existing_data,
+      id_existing_points = id,
+      gebied = perimeters_data,
       overlap_prop = 0.5,
       sbp_file = do.call(rbind.data.frame, sbp_akkervogels)
       ),