checking species names in forests by trees or forests

emf-creaf · Sep 23, 2024 · 9562b88 · 9562b88
1 parent 67b6b59
commit 9562b88
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 8 deletions.
diff --git a/R/check_inputs.R b/R/check_inputs.R
@@ -114,11 +114,13 @@ check_forests <-function(x, SpParams = NULL,
                          verbose = TRUE) {
   if(!inherits(x, "sf")) cli::cli_abort("'x' should be of class 'sf' ")
   match.arg(missing_action, c("no_action", "filter"))
-  accepted_names <- NULL
+  accepted_tree_names <- NULL
+  accepted_shrub_names <- NULL
   if(!is.null(SpParams)) {
     if(!inherits(SpParams, "data.frame")) cli::cli_abort("'SpParams' should be a data frame with species parameters")
     if(!("Name" %in% names(SpParams))) cli::cli_abort("'SpParams' should contain a column 'Name'")
-    accepted_names <- SpParams$Name
+    accepted_tree_names <- SpParams$Name[SpParams$GrowthForm %in% c("Tree", "Tree/Shrub")]
+    accepted_shrub_names <- SpParams$Name[SpParams$GrowthForm %in% c("Shrub", "Tree/Shrub")]
   }
   if(!("forest" %in% names(x))) cli::cli_abort("Column 'forest' must be defined.")
   npoints <- nrow(x)
@@ -170,8 +172,8 @@ check_forests <-function(x, SpParams = NULL,
             mis_tree_height[i] <- any(is.na(f$treeData$Height))
             nr_mis_tree_species <- nr_mis_tree_species + sum(is.na(f$treeData$Species))
             mis_tree_species[i] <- any(is.na(f$treeData$Species))
-            if(!is.null(accepted_names)) {
-              wrong_spp  <- !(f$treeData$Species[!is.na(f$treeData$Species)] %in% accepted_names)
+            if(!is.null(accepted_tree_names)) {
+              wrong_spp  <- !(f$treeData$Species[!is.na(f$treeData$Species)] %in% accepted_tree_names)
               nr_wrong_tree_species <- nr_wrong_tree_species + sum(wrong_spp)
               wrong_tree_species[i] <- any(wrong_spp)
             }
@@ -184,8 +186,8 @@ check_forests <-function(x, SpParams = NULL,
             mis_shrub_height[i] <- any(is.na(f$shrubData$Height))
             nr_mis_shrub_species <- nr_mis_shrub_species + sum(is.na(f$shrubData$Species))
             mis_shrub_species[i] <- any(is.na(f$shrubData$Species))
-            if(!is.null(accepted_names)) {
-              wrong_spp <- !(f$shrubData$Species[!is.na(f$shrubData$Species)] %in% accepted_names)
+            if(!is.null(accepted_shrub_names)) {
+              wrong_spp <- !(f$shrubData$Species[!is.na(f$shrubData$Species)] %in% accepted_shrub_names)
               nr_wrong_shrub_species <- nr_wrong_shrub_species + sum(wrong_spp)
               wrong_shrub_species[i] <- any(wrong_spp)
             }
@@ -256,11 +258,11 @@ check_forests <-function(x, SpParams = NULL,
               }
               if(wrong_tree_species[i]) {
                 f$treeData <- f$treeData |>
-                  dplyr::filter(.data$Species %in% accepted_names)
+                  dplyr::filter(.data$Species %in% accepted_tree_names)
               }
               if(wrong_shrub_species[i]) {
                 f$shrubData <- f$shrubData |>
-                  dplyr::filter(.data$Species %in% accepted_names)
+                  dplyr::filter(.data$Species %in% accepted_shrub_names)
               }
               x$forest[[i]] <- f
             }

diff --git a/vignettes/evaluation/RegionalLevelEvaluation.Rmd b/vignettes/evaluation/RegionalLevelEvaluation.Rmd
@@ -94,6 +94,26 @@ for(i in 1:n) {
   if(i %in% 1:2) IDs <- IDs_23
   else if(i %in% 3:4) IDs <- IDs_34
   else if(i %in% 5:6) IDs <- IDs_24
+  dfdbh_vec[[i]]$version <- as.character(dfdbh_vec[[i]]$version)
+  dfh_vec[[i]]$version <- as.character(dfh_vec[[i]]$version)
+  dfbai_sp_vec[[i]]$version <- as.character(dfbai_sp_vec[[i]]$version)
+  dfbai_plot_vec[[i]]$version <- as.character(dfbai_plot_vec[[i]]$version)
+  dfbadead_sp_vec[[i]]$version <- as.character(dfbadead_sp_vec[[i]]$version)
+  dfbadead_plot_vec[[i]]$version <- as.character(dfbadead_plot_vec[[i]]$version)
+  dfbarecr_sp_vec[[i]]$version <- as.character(dfbarecr_sp_vec[[i]]$version)
+  dfbarecr_plot_vec[[i]]$version <- as.character(dfbarecr_plot_vec[[i]]$version)
+  dfbatot_sp_vec[[i]]$version <- as.character(dfbatot_sp_vec[[i]]$version)
+  dfbatot_plot_vec[[i]]$version <- as.character(dfbatot_plot_vec[[i]]$version)
+  dfNdead_sp_vec[[i]]$version <- as.character(dfNdead_sp_vec[[i]]$version)
+  dfNdead_plot_vec[[i]]$version <- as.character(dfNdead_plot_vec[[i]]$version)
+  dfNrecr_sp_vec[[i]]$version <- as.character(dfNrecr_sp_vec[[i]]$version)
+  dfNrecr_plot_vec[[i]]$version <- as.character(dfNrecr_plot_vec[[i]]$version)
+  dfNtot_sp_vec[[i]]$version <- as.character(dfNtot_sp_vec[[i]]$version)
+  dfNtot_plot_vec[[i]]$version <- as.character(dfNtot_plot_vec[[i]]$version)
+  dfshcov_plot_vec[[i]]$version <- as.character(dfshcov_plot_vec[[i]]$version)
+  dfshheight_plot_vec[[i]]$version <- as.character(dfshheight_plot_vec[[i]]$version)
+  dflai_allom_plot_vec[[i]]$version <- as.character(dflai_allom_plot_vec[[i]]$version)
+  dflai_state_plot_vec[[i]]$version <- as.character(dflai_state_plot_vec[[i]]$version)
   
   dfdbh_vec[[i]] <- dfdbh_vec[[i]] |> filter(id %in% IDs)
   dfh_vec[[i]] <- dfh_vec[[i]] |> filter(id %in% IDs)