Reg al

R/calculate_regeneration_core_area_height_species.R

@@ -11,7 +11,7 @@
 #' @return dataframe with columns plot, species, year, height,
 #' number_of_subplots_with_regeneration, perc_subplots_with_regeneration,
 #' rubbing_damage_perc, nr_of_regeneration_ha (in case exact numbers are
-#' observed), mean_number_of_regeneration_ha (in case intervals are observed),
+#' observed), mean_number_of_regeneration_ha,
 #' lci_number_of_regeneration_ha, uci_number_of_regeneration_ha and
 #' approx_nr_regeneration_ha.
 #'
@@ -34,9 +34,11 @@
 #'
 calculate_regeneration_core_area_height_species <- function(data_regeneration) {
   by_plot_species <- data_regeneration %>%
+    group_by(.data$plot_id, .data$period) %>%
     mutate(
       n_subplots = n_distinct(.data$subplot_id)
     ) %>%
+    ungroup() %>%
     group_by(
       .data$plot_id, .data$year, .data$period, .data$height_class,
       .data$species, .data$plotarea_ha

R/calculate_regeneration_core_area_species.R

@@ -35,6 +35,7 @@
 #'
 calculate_regeneration_core_area_species <- function(data_regeneration) {
   by_plot_species <- data_regeneration %>%
+    group_by(.data$plot_id, .data$period) %>%
     mutate(
       n_subplots = n_distinct(.data$subplot_id),
       nr_established_ha =
@@ -62,6 +63,7 @@ calculate_regeneration_core_area_species <- function(data_regeneration) {
         ifelse(is.na(.data$subcircle) | .data$subcircle == "A1",
                .data$approx_nr_regeneration / .data$plotarea_ha, NA)
     ) %>%
+    ungroup() %>%
     group_by(
       .data$plot_id, .data$year, .data$period, .data$species
     ) %>%

R/calculate_regeneration_plot.R

@@ -8,7 +8,7 @@
 #'
 #' @inheritParams calculate_regeneration
 #'
-#' @return dataframe with columns plot, year, period, number_of_tree_species,
+#' @return dataframe with columns plot, subplot, year, period, number_of_tree_species,
 #' nr_established_ha, nr_seedlings_ha, mean_number_established_ha,
 #' lci_number_established_ha, uci_number_established_ha,
 #' mean_number_seedlings_ha, lci_number_seedlings_ha, uci_number_seedlings_ha,

R/calculate_regeneration_plot_height.R

@@ -7,10 +7,10 @@
 #'
 #' @inheritParams calculate_regeneration
 #'
-#' @return dataframe with columns plot_id, year, period, height_class,
+#' @return dataframe with columns plot, subplot, year, period, height_class,
 #' number_of_tree_species, rubbing_damage_perc,
 #' nr_of_regeneration_ha (in case exact numbers are observed),
-#' mean_number_of_regeneration_ha (in case intervals are observed),
+#' mean_number_of_regeneration_ha,
 #' lci_number_of_regeneration_ha, uci_number_of_regeneration_ha and
 #' approx_nr_regeneration_ha.
 #'

R/calculate_regeneration_plot_height_species.R

@@ -7,7 +7,7 @@
 #'
 #' @inheritParams calculate_regeneration
 #'
-#' @return dataframe with columns plot, year, height_class, species,
+#' @return dataframe with columns plot, subplot, year, height_class, species,
 #' rubbing_damage_perc, nr_of_regeneration_ha (in case exact numbers are
 #' observed), mean_number_of_regeneration_ha (in case intervals are observed),
 #' lci_number_of_regeneration_ha, uci_number_of_regeneration_ha and

R/calculate_vegetation_core_area_species.R

@@ -23,11 +23,13 @@
 #' @importFrom dplyr %>% group_by n_distinct summarise ungroup
 #' @importFrom rlang .data
 #'
-calculate_vegetation_core_area_species <- function(data_herblayer) {
+calculate_vegetation_core_area_species <- function(data_herblayer, data_vegetation) {
   by_core_area_species <- data_herblayer %>%
+    group_by(.data$plot_id, .data$period) %>%
     mutate(
       n_subplots = n_distinct(.data$subplot_id)
     ) %>%
+    ungroup() %>%
     group_by(
       .data$plot_id, .data$year, .data$period, .data$species
     ) %>%
@@ -39,13 +41,13 @@ calculate_vegetation_core_area_species <- function(data_herblayer) {
           all(is.na(.data$browse_index_id)),
           NA,
           sum(!is.na(.data$browse_index_id) &
-                .data$browse_index_id %in% c(10, 20))
+                .data$browse_index_id %in% c(110, 120))
         ),
       number_of_subplots_seriously_browsed =
         ifelse(
           all(is.na(.data$browse_index_id)),
           NA,
-          sum(!is.na(.data$browse_index_id) & .data$browse_index_id == 20)
+          sum(!is.na(.data$browse_index_id) & .data$browse_index_id == 120)
         ),
       perc_of_subplots_browsed =
         .data$number_of_subplots_browsed * 100 / .data$number_of_subplots_with_vegetation,

R/calculate_vegetation_plot.R

@@ -1,10 +1,10 @@
 #' aggregate vegetation parameters by plot and year
 #'
-#' This function calculates for each plot and year the total coverage and the number of species in the vegetation layer. Year refers to year of the main vegetation survey (source is table "data_vegetation"), and will in some cases differ from the year of the spring flora survey.
+#' This function calculates for each plot (subplot in case of core area) and year the total coverage and the number of species in the vegetation layer. Year refers to year of the main vegetation survey (source is table "data_vegetation"), and will in some cases differ from the year of the spring flora survey.
 #'
 #' @inheritParams calculate_vegetation
 #'
-#' @return dataframe with columns plot, year (year of main vegetation survey, possible deviating year of spring survey not taken into account) and number_of_tree_species
+#' @return dataframe with columns plot, subplot, year (year of main vegetation survey, possible deviating year of spring survey not taken into account) and number_of_tree_species
 #'
 #' @examples
 #' \dontrun{
@@ -53,6 +53,10 @@ calculate_vegetation_plot <- function(data_vegetation, data_herblayer) {
       by = c("plot_id", "period", "subplot_id")
     ) %>%
     mutate(
+      # CCC: total cover in percentage = (TL/100 + SL/100 - TL/100 * SL/100) * 100,
+      # where TL is the percentage cover of the tree layer and SL is the percentage cover of the shrub layer.
+      cumulated_canopy_cover_mean =
+        100 * (1 - (1 - .data$shrub_cover_mean / 100) * (1 - .data$tree_cover_mean / 100)),
       cumulated_canopy_cover_min =
         100 * (1 - (1 - .data$shrub_cover_min / 100) * (1 - .data$tree_cover_min / 100)),
       cumulated_canopy_cover_max =

R/compose_stem_data.R

@@ -23,6 +23,7 @@
 #'
 #' @importFrom rlang .data
 #' @importFrom dplyr %>% bind_rows filter inner_join mutate select
+#' @importFrom assertthat has_name
 #'
 compose_stem_data <- function(data_dendro, data_shoots) {
   #omit data that could be misinterpreted if data on shoot level are added
@@ -44,5 +45,38 @@ compose_stem_data <- function(data_dendro, data_shoots) {
       basal_area_m2 = pi * (.data$dbh_mm / 2000) ^ 2
     )
 
+  if (
+    has_name(
+      stem_data,
+      c("iufro_hght", "iufro_vital", "iufro_socia", "iufro_hght_shoots",
+        "iufro_vital_shoots", "iufro_socia_shoots",
+        "remark_shoots", "common_remark_shoots")
+    )
+  ) {
+    stem_data <- stem_data %>%
+      mutate(
+        iufro_hght =
+          ifelse(is.na(.data$iufro_hght_shoots),
+                 .data$iufro_hght, .data$iufro_hght_shoots),
+        iufro_hght_shoots = NULL,
+        iufro_vital =
+          ifelse(is.na(.data$iufro_vital_shoots),
+                 .data$iufro_vital, .data$iufro_vital_shoots),
+        iufro_vital_shoots = NULL,
+        iufro_socia =
+          ifelse(is.na(.data$iufro_socia_shoots),
+                 .data$iufro_socia, .data$iufro_socia_shoots),
+        iufro_socia_shoots = NULL,
+        remark =
+          ifelse(is.na(.data$remark_shoots),
+                 .data$remark, .data$remark_shoots),
+        remark_shoots = NULL,
+        common_remark =
+          ifelse(is.na(.data$common_remark_shoots),
+                 .data$common_remark, .data$common_remark_shoots),
+        common_remark_shoots = NULL,
+      )
+  }
+
   return(stem_data)
 }

R/load_data_dendrometry.R

@@ -47,7 +47,7 @@ load_data_dendrometry <-
       extra_variables,
       ", (Trees.X_m - Plots.Xorig_m) AS x_local, (Trees.Y_m - Plots.Yorig_m) AS y_local,
         Trees.CoppiceID AS coppice_id, Trees.IUFROHght AS iufro_hght,
-        Trees.IUFROVital AS iufro_vital, IUFROSocia AS iufro_socia,
+        Trees.IUFROVital AS iufro_vital, Trees.IUFROSocia AS iufro_socia,
         Trees.Remark AS remark, Trees.CommonRemark AS common_remark",
       ""
     )

R/load_data_regeneration.R

@@ -74,6 +74,7 @@ load_data_regeneration <-
       id = c(1, 3, 8, 15, 30, 50, 80, 101, 1001),
       number_class =
         c("1", "2 - 5", "6 - 10", "11 - 20", "21 - 40", "41 - 60", "61 - 100", "> 100", "> 1000"),
+      approx_nr_regeneration = c(1, 3, 8, 15, 30, 50, 80, 101, 1001),
       min_number_of_regeneration = c(1, 2, 6, 11, 21, 41, 61, 101, 1001),
       max_number_of_regeneration = c(1, 5, 10, 20, 40, 60, 100, 1000, 10000),
       stringsAsFactors = FALSE
@@ -153,9 +154,9 @@ load_data_regeneration <-
         ),
       approx_nr_regeneration =
         ifelse(
-          .data$min_number_of_regeneration < 100,
-          (.data$min_number_of_regeneration + .data$max_number_of_regeneration) / 2,
-          .data$min_number_of_regeneration + 1
+          is.na(.data$approx_nr_regeneration),
+          .data$nr_of_regeneration,
+          .data$approx_nr_regeneration
         )
     )
 

R/load_data_shoots.R

@@ -3,6 +3,9 @@
 #' This function queries the given database to retrieve additional data on shoots to use with dendrometry data.
 #'
 #' @param database name of fieldmap/access database (with specific fieldmap structure) including path
+#' @param extra_variables Should additional variables such as iufro_hght, iufro_vital, iufro_socia,
+#' remark and common_remark be added?
+#' Default is FALSE (no).
 #'
 #' @return Dataframe with shoot data
 #'
@@ -15,15 +18,25 @@
 #'
 #' @export
 #'
-load_data_shoots <- function(database) {
+load_data_shoots <- function(database, extra_variables = FALSE) {
+  add_fields <-
+    ifelse(
+      extra_variables,
+      ", Shoots.IUFROHght AS iufro_hght_shoots,
+        Shoots.IUFROVital AS iufro_vital_shoots,
+        Shoots.IUFROSocia AS iufro_socia_shoots,
+        Shoots.Remark AS remark_shoots,
+        Shoots.CommonRemark AS common_remark_shoots",
+      ""
+    )
   query_shoots <-
     "SELECT Shoots.IDPlots AS plot_id,
       Shoots.IDTrees%2$s AS tree_measure_id,
       Shoots.ID AS shoot_measure_id,
       Shoots.DBH_mm AS dbh_mm,
       Shoots.Height_m AS height_m,
       Shoots.IntactSnag AS intact_snag,
-      Shoots.DecayStage_Shoots AS decaystage
+      Shoots.DecayStage_Shoots AS decaystage %4$s
     FROM Shoots%2$s Shoots;"
 
   query_shoots_1986 <-

R/load_data_vegetation.R

@@ -53,7 +53,10 @@ load_data_vegetation <-
         %3$s;"
 
     query_total_cover <-
-      "SELECT tc.ID AS id, tc.Value1 AS cover_interval FROM qtotalCover tc"
+      "SELECT tc.ID AS id,
+              tc.Value1 AS cover_interval,
+              tc.Value2 AS mean_cover
+        FROM qtotalCover tc"
 
   con <- odbcConnectAccess2007(database)
   total_cover <- sqlQuery(con, query_total_cover, stringsAsFactors = FALSE) %>%
@@ -64,6 +67,8 @@ load_data_vegetation <-
       max_cover = ifelse(.data$max_cover == "< 1%", 1, .data$max_cover),
       min_cover = ifelse(.data$min_cover == "nvt", NA, .data$min_cover),
       max_cover = ifelse(.data$max_cover == "nvt", NA, .data$max_cover),
+      mean_cover = str_replace(string = .data$mean_cover, pattern = ",", replacement = "."),
+      mean_cover = as.numeric(.data$mean_cover) * 100,
       min_cover = as.numeric(.data$min_cover),
       max_cover = as.numeric(.data$max_cover)
     )
@@ -102,36 +107,42 @@ load_data_vegetation <-
     left_join(total_cover, by = c("total_moss_cover_id" = "id")) %>%
     rename(
       moss_cover_interval = .data$cover_interval,
+      moss_cover_mean = .data$mean_cover,
       moss_cover_min = .data$min_cover,
       moss_cover_max = .data$max_cover
     ) %>%
     left_join(total_cover, by = c("total_herb_cover_id" = "id")) %>%
     rename(
       herb_cover_interval = .data$cover_interval,
+      herb_cover_mean = .data$mean_cover,
       herb_cover_min = .data$min_cover,
       herb_cover_max = .data$max_cover
     ) %>%
     left_join(total_cover, by = c("total_shrub_cover_id" = "id")) %>%
     rename(
       shrub_cover_interval = .data$cover_interval,
+      shrub_cover_mean = .data$mean_cover,
       shrub_cover_min = .data$min_cover,
       shrub_cover_max = .data$max_cover
     ) %>%
     left_join(total_cover, by = c("total_tree_cover_id" = "id")) %>%
     rename(
       tree_cover_interval = .data$cover_interval,
+      tree_cover_mean = .data$mean_cover,
       tree_cover_min = .data$min_cover,
       tree_cover_max = .data$max_cover
     ) %>%
     left_join(total_cover, by = c("total_waterlayer_cover_id" = "id")) %>%
     rename(
       waterlayer_cover_interval = .data$cover_interval,
+      waterlayer_cover_mean = .data$mean_cover,
       waterlayer_cover_min = .data$min_cover,
       waterlayer_cover_max = .data$max_cover
     ) %>%
     left_join(total_cover, by = c("total_soildisturbance_game_id" = "id")) %>%
     rename(
       soildisturbance_game_cover_interval = .data$cover_interval,
+      soildisturbance_game_cover_mean = .data$mean_cover,
       soildisturbance_game_cover_min = .data$min_cover,
       soildisturbance_game_cover_max = .data$max_cover
     ) %>%

R/load_plotinfo.R

@@ -6,7 +6,9 @@
 #' @param database name of fieldmap/access database (with specific fieldmap
 #' structure) including path
 #'
-#' @return Dataframe with columns plot_id, plottype and forest_reserve
+#' @return Dataframe with columns plot_id, plottype, forest_reserve, period, year of dendrometric survey
+#' and information on (1) whether there has been a dendro, deadwood, regeneration and/or vegetation survey
+#' and (2) whether the data have been processed or not.
 #'
 #' @examples
 #' \dontrun{
@@ -30,6 +32,7 @@ load_plotinfo <- function(database) {
       pd.Survey_Deadwood_YN AS survey_deadw,
       pd.Survey_Vegetation_YN AS survey_veg,
       pd.Survey_Regeneration_YN AS survey_reg,
+      pd.Date_Dendro_%1$deSet AS date_dendro,
       pd.GameImpactVegObserved AS game_impact_veg,
       pd.GameImpactRegObserved AS game_impact_reg,
       pd.DataProcessed_YN AS data_processed
@@ -86,8 +89,10 @@ load_plotinfo <- function(database) {
                 summarise(min_period = min(.data$period)) %>%
 
                 ungroup()) %>%
-    mutate(survey_number = .data$period - .data$min_period + 1) %>%
-    select(-.data$min_period)
+    mutate(survey_number = .data$period - .data$min_period + 1,
+           year_dendro = year(round_date(.data$date_dendro, "year")) - 1
+           ) %>%
+    select(-.data$min_period, -.data$date_dendro)
 
   return(plotinfo)
 }

R/read_forresdat.R

@@ -10,14 +10,15 @@
 #' @param tablename name of the table that should be read
 #' @param repo_path name and path of local git repository from which data should be retrieved
 #' @param join_plotinfo should table plotinfo be joined to the chosen table to
-#' add columns plottype and forest_reserve?  Default is TRUE.  (This is only
+#' add columns plottype, forest_reserve, survey_dendro/deadw/reg/veg (T or F) and data_processed (T or F)?  Default is TRUE.  (This is only
 #' possible if the given table contains a column plot_id, so this parameter
 #' should be put FALSE if this column is absent.)
 #' @param plottype Data of which 'plottype' (used method) should be retrieved?
 #' Default is 'CP' or 'circle plot', alternatively 'CA' or 'core area' could be
 #' chosen.
 #'
-#' @return A dataframe with the specified table, default columns plottype and forest_reserve.
+#' @return A dataframe with the specified table, default columns plottype, forest_reserve,
+#' survey_dendro/deadw/reg/veg (T or F) and data_processed (T or F)
 #'
 #' @examples
 #' \dontrun{