Reg al

R/access_to_sqlite.R

@@ -1,11 +1,15 @@
 #' moves data from fieldmap database to SQLite database
 #'
-#' This function moves all relevant tables from an unindexed Access database to a SQLite database with indexes, for performance reasons. (Not finished yet and not exported!)
+#' This function moves all relevant tables from an unindexed Access database to
+#' a SQLite database with indexes, for performance reasons.
+#' (Not finished yet and not exported!)
 #'
-#' @param source_db name of fieldmap/access database (with specific fieldmap structure) including path
+#' @param source_db name of fieldmap/access database (with specific
+#' fieldmap structure), including path
 #' @param new_db name and path of SQLite database to be made
 #'
-#' @return A SQLite database with the specified name is saved at the specified path
+#' @return A SQLite database with the specified name is saved at the
+#' specified path
 #'
 #' @importFrom RODBC odbcClose odbcConnectAccess2007 sqlQuery
 #'

R/add_zeros.R

@@ -1,23 +1,43 @@
-#' Add records with value zero for missing variable combinations in a given dataset
+#' Add records with value zero for missing variable combinations in a
+#' given dataset
 #'
 #' @description
-#' Datasets for which this package has been developed, typically contain measurements of observations.
-#' Absence is often not reported explicitly (e.g. there exists no record of a species that is not observed in a plot), while it can be important to include these zero values in an analysis (e.g. mean coverage per species in a certain forest reserve; mean stem number per diameter class in a forest reserve).
-#' This function automatically adds missing combinations with value zero to the dataset for each combination of values of the variables given in `comb_vars` (within each value of `grouping_vars`).
-#' All variables that are not mentioned in `comb_vars` or `grouping_vars`, are considered to be numerical variables and will get value 0 (zero).
-#' Note that if a certain value is not present in the dataset (or in one of the subsets defined by `grouping_vars`), it will not be added automatically; at least one record should be added manually for this value (e.g. a plot or diameterclass that doesn't exist in the given dataset, but has to be included in the output).
+#' Datasets for which this package has been developed, typically contain
+#' measurements of observations.
+#' Absence is often not reported explicitly (e.g. there exists no record of
+#' a species that is not observed in a plot),
+#' while it can be important to include these zero values in an analysis
+#' (e.g. mean coverage per species in a certain forest reserve; mean stem number
+#' per diameter class in a forest reserve).
+#' This function automatically adds missing combinations with value zero to
+#' the dataset #' for each combination of values of the variables given
+#' in `comb_vars` (within each value of `grouping_vars`).
+#' All variables that are not mentioned in `comb_vars` or `grouping_vars`,
+#' are considered to be numerical variables and will get value 0 (zero).
+#' Note that if a certain value is not present in the dataset
+#' (or in one of the subsets defined by `grouping_vars`), it will not be
+#' added automatically;
+#' at least one record should be added manually for this value
+#' (e.g. a plot or diameterclass that doesn't exist in the given dataset,
+#' but has to be included in the output).
 #'
 #'
 #' @param dataset data.frame in which records should be added
-#' @param comb_vars variables (given as a vector of strings) of which all combinations of their values should have a record in the dataset.
-#' @param grouping_vars one or more variables for which the combination of values of the variables given in `comb_vars` should be made for each value, e.g. if grouping_vars = "forest_reserve" and comb_vars = c("plot", "species"), all combinations of the values in "plot" and "species" are made within each value of "forest_reserve".
+#' @param comb_vars variables (given as a vector of strings) of which all
+#' combinations of their values should have a record in the dataset.
+#' @param grouping_vars one or more variables for which the combination of
+#' values of the variables given in `comb_vars` should be made for each value,
+#' e.g. if grouping_vars = "forest_reserve" and comb_vars = c("plot", "species"),
+#' all combinations of the values in "plot" and "species" are made
+#' within each value of "forest_reserve".
 #' @param add_zero_no_na variable indicating which records of the grouping_vars
 #' should get a zero value (variable should be TRUE) or a NA value (variable
 #' should be FALSE).
 #' E.g. a variable indicating whether or not observations are done.
 #' If no variable name is given (default NA), all added records get zero values.
 #'
-#' @return dataframe based on `dataset` to which records are added with value 0 (zero) for each measurement.
+#' @return dataframe based on `dataset` to which records are added with
+#' value 0 (zero) for each measurement.
 #'
 #' @examples
 #' \dontrun{
@@ -38,7 +58,8 @@
 #'
 #' @importFrom plyr .
 #' @importFrom assertthat assert_that has_name
-#' @importFrom dplyr %>% distinct inner_join mutate mutate_at right_join select vars
+#' @importFrom dplyr %>% distinct inner_join mutate mutate_at right_join select
+#' vars
 #' @importFrom tidyselect all_of matches
 #' @importFrom rlang .data ensyms
 #'
@@ -53,7 +74,7 @@ add_zeros <-
   )
   assert_that(
     all(has_name(dataset, grouping_vars)),
-    msg =  "dataset should contain all variables from grouping_vars as column names"
+    msg =  "dataset should contain all variables from grouping_vars as column names" # nolint
   )
   if (!is.na(add_zero_no_na)) {
     assert_that(

R/calc_variables_stem_level.R

@@ -2,10 +2,13 @@
 #'
 #' This function calculates additional variables based on measurements, such as
 #' \itemize{
-#'  \item calc_height_m: calculated height based on `dbh_mm` and a species specific diameter-height model
+#'  \item calc_height_m: calculated height based on `dbh_mm` and a species
+#'  specific diameter-height model
 #'  \item basal_area_m2
-#'  \item vol_bole_m3: calculated based on `dbh_mm`, `calc_height_m` and species specific tariffs
-#'  \item vol_crown_m3: calculated based on `dbh_mm` and species specific tariffs
+#'  \item vol_bole_m3: calculated based on `dbh_mm`, `calc_height_m` and
+#'  species specific tariffs
+#'  \item vol_crown_m3: calculated based on `dbh_mm` and
+#'  species specific tariffs
 #'  \item vol_tot_m3: sum of `vol_bole_m3` and `vol_crowwn_m3`
 #'  \item basal_area_alive_m2_ha
 #'  \item basal_area_dead_m2_ha
@@ -16,7 +19,8 @@
 #' }
 #'
 #' @inheritParams calculate_dendrometry
-#' @param data_stems dataframe on stems (shoots and trees) as given from the function compose_stem_data()
+#' @param data_stems dataframe on stems (shoots and trees) as given from the
+#' function compose_stem_data()
 #'
 #' @return Dataframe with ...
 #'
@@ -37,7 +41,8 @@
 #'
 #' @importFrom readr read_csv2
 #' @importFrom rlang .data
-#' @importFrom dplyr %>% bind_rows filter group_by left_join mutate n select summarise ungroup
+#' @importFrom dplyr %>% bind_rows filter group_by left_join mutate n select
+#' summarise ungroup
 #'
 calc_variables_stem_level <-
   function(data_stems, height_model) {
@@ -70,9 +75,12 @@ calc_variables_stem_level <-
           1.3 + .data$P1 + .data$P2 * log(.data$dbh_mm / 10)
         ),
       dh_model = ifelse(!is.na(.data$P1), TRUE, FALSE),
-      # if no height_model is available, calc_height_fm on tree level (< FM-IA) is used
+      # if no height_model is available, calc_height_fm on tree level (< FM-IA)
+      # is used
       calc_height_m =
-        ifelse(is.na(.data$calc_height_r), .data$calc_height_fm, .data$calc_height_r)
+        ifelse(is.na(.data$calc_height_r)
+               , pmax(1.3, .data$calc_height_fm)
+               , pmax(1.3, .data$calc_height_r))
     ) %>%
     select(
       -.data$model, -.data$P1, -.data$P2
@@ -85,7 +93,8 @@ calc_variables_stem_level <-
           system.file("extdata/tariffs1entry.csv", package = "forrescalc")
         )
       ) %>%
-        select(-.data$name_nl, -.data$tariff_id, -.data$tariff_group, -.data$source),
+        select(-.data$name_nl, -.data$tariff_id, -.data$tariff_group,
+               -.data$source),
       by = "species"
     ) %>%
     mutate(
@@ -105,7 +114,8 @@ calc_variables_stem_level <-
           system.file("extdata/tariffs1entry_crown.csv", package = "forrescalc")
         )
       ) %>%
-        select(-.data$name_nl, -.data$tariff_id, -.data$tariff_group, -.data$source),
+        select(-.data$name_nl, -.data$tariff_id, -.data$tariff_group,
+               -.data$source),
       by = "species"
     ) %>%
     mutate(
@@ -125,7 +135,8 @@ calc_variables_stem_level <-
           system.file("extdata/tariffs2entries.csv", package = "forrescalc")
         )
       ) %>%
-        select(-.data$name_nl, -.data$tariff_id, -.data$tariff_group, -.data$source),
+        select(-.data$name_nl, -.data$tariff_id, -.data$tariff_group,
+               -.data$source),
       by = "species"
     ) %>%
       mutate(
@@ -134,18 +145,23 @@ calc_variables_stem_level <-
           ifelse(
             .data$formula == 1,
             yes =
-              .data$a + .data$b * .data$perimeter + .data$c * .data$perimeter ^ 2 +
-              .data$d * .data$perimeter ^ 3 + .data$e * .data$calc_height_m +
+              .data$a + .data$b * .data$perimeter +
+              .data$c * .data$perimeter ^ 2 +
+              .data$d * .data$perimeter ^ 3 +
+              .data$e * .data$calc_height_m +
               .data$f * .data$calc_height_m * .data$perimeter +
               .data$g * .data$calc_height_m * .data$perimeter ^ 2,
             no =
               1 / 1000 *
               #spil
-              (exp(1.10597 * log(.data$calc_height_m) + 1.78865 * log(.data$d_cm) - 3.07192) -
+              (exp(1.10597 * log(.data$calc_height_m) +
+                     1.78865 * log(.data$d_cm) - 3.07192) -
                  #Verlies
-                 exp(-4.608923 * log(.data$d_cm) + 3.005989 * log(.data$calc_height_m) -
+                 exp(-4.608923 * log(.data$d_cm) +
+                       3.005989 * log(.data$calc_height_m) -
                        1.3209 * log(.data$calc_height_m) * log(.data$calc_height_m) +
-                       1.605266 * log(.data$d_cm) * log(.data$calc_height_m) + 5.410272))
+                       1.605266 * log(.data$d_cm) * log(.data$calc_height_m) +
+                       5.410272))
           )
         , vol_bole_t2_m3 = pmax(0, .data$vol_bole_t2_m3)
         , vol_bole_m3 =
@@ -171,7 +187,7 @@ calc_variables_stem_level <-
                               # 1/3 x π x h x ( R² + R x r + r² ) - truncated cone
                               # AS CILINDER - GIVES BETTER RESULTS
                               pi * .data$height_m * .data$dbh_mm^2 / 2000^2,
-                              # ! TEMPORARY SOLUTION: goal is to incormporate taper functuions cfr FM-IA
+                              # ! TEMPORARY SOLUTION: goal is to incorporate taper functions cfr FM-IA
                                 NA),
       # !!! ? als calc_height er niet is, dan ev. wel nog als cilinder???
       # nee, want dan ook geen volumes van de andere bomen ...)
@@ -182,10 +198,12 @@ calc_variables_stem_level <-
     mutate(
       # volume correction for broken crown or branches
       reduction_crown =
-        ifelse(is.na(.data$crown_volume_reduction), 0, .data$crown_volume_reduction),
+        ifelse(is.na(.data$crown_volume_reduction), 0,
+               .data$crown_volume_reduction),
       vol_crown_m3 = .data$vol_crown_m3 * (1 - .data$reduction_crown),
       reduction_branch =
-        ifelse(is.na(.data$branch_length_reduction), 0, .data$branch_length_reduction),
+        ifelse(is.na(.data$branch_length_reduction), 0,
+               .data$branch_length_reduction),
       vol_crown_m3 = .data$vol_crown_m3 * (1 - .data$reduction_branch),
       # total volume
       vol_tot_m3 = .data$vol_bole_m3 + .data$vol_crown_m3

R/calc_variables_tree_level.R

@@ -2,12 +2,17 @@
 #'
 #' This function calculates additional variables based on measurements, such as
 #' \itemize{
-#'  \item nr_of_stems: the number of shoots in the tree (= 1 for an individual tree; >= 1 when coppice)
-#'  \item individual: true for individual tree or coppice, false if record is a secondary shoot
-#'  \item calc_height_m: calculated height based on `dbh_mm` and a species specific diameter-height model
+#'  \item nr_of_stems: the number of shoots in the tree
+#'  (= 1 for an individual tree; >= 1 when coppice)
+#'  \item individual: true for individual tree or coppice,
+#'  false if record is a secondary shoot
+#'  \item calc_height_m: calculated height based on `dbh_mm` and
+#'  a species specific diameter-height model
 #'  \item basal_area_m2
-#'  \item vol_bole_m3: calculated based on `dbh_mm`, `calc_height_m` and species specific tariffs
-#'  \item vol_crown_m3: calculated based on `dbh_mm` and species specific tariffs
+#'  \item vol_bole_m3: calculated based on `dbh_mm`, `calc_height_m` and
+#'  species specific tariffs
+#'  \item vol_crown_m3: calculated based on `dbh_mm` and
+#'  species specific tariffs
 #'  \item vol_tot_m3: sum of `vol_bole_m3` and `vol_crowwn_m3`
 #'  \item dbh_mm (based on average for coppice trees)
 #'  \item decaystage (based on average for coppice trees)
@@ -20,7 +25,10 @@
 #' }
 #'
 #' @inheritParams calculate_dendrometry
-#' @param data_stems_calc dataframe on stem level measurements with variables plot_id, plottype, tree_measure_id, date_dendro, dbh_mm, height_m, species, alive_dead, decaystage, period, year, subcircle, plotarea_ha,... (output of function calc_variables_stem_level())
+#' @param data_stems_calc dataframe on stem level measurements with variables
+#' plot_id, plottype, tree_measure_id, date_dendro, dbh_mm, height_m, species,
+#' alive_dead, decaystage, period, year, subcircle, plotarea_ha,...
+#' (output of function calc_variables_stem_level())
 #'
 #' @return Dataframe with ...
 #'
@@ -42,7 +50,8 @@
 #'
 #' @importFrom readr read_csv2
 #' @importFrom rlang .data
-#' @importFrom dplyr %>% bind_rows filter group_by left_join mutate n select summarise ungroup
+#' @importFrom dplyr %>% bind_rows filter group_by left_join mutate n select
+#' summarise ungroup
 #'
 calc_variables_tree_level <-
   function(data_dendro, data_stems_calc) {

R/calculate_DAS_indicator.R

@@ -1,16 +1,19 @@
 #' @title calculate DAS indicator
 #'
 #' @description
-#' This function does all preparing steps (selection of relevant plots and reserves) and calculations to obtain the DAS-indicator.
+#' This function does all preparing steps (selection of relevant plots and
+#' reserves) and calculations to obtain the DAS-indicator.
 #'
-#' First the relevant forest reserves are selected based on the following criteria:
+#' First the relevant forest reserves are selected based on the following
+#' criteria:
 #'
 #' @template selection_criteria_for_DAS
 #'
 #' @template calculate_das_indicator_explanation_part2
 #'
 #' @inheritParams calculate_dendro_plot
-#' @param na.rm Ignore records with no value? Default is FALSE, so no records will be ignored unless it is explicitly mentioned by 'na.rm = TRUE'
+#' @param na.rm Ignore records with no value? Default is FALSE, so no records
+#' will be ignored unless it is explicitly mentioned by 'na.rm = TRUE'
 #'
 #' @return dataframe with results for DAS indicator on forest level (?)
 #'
@@ -32,7 +35,8 @@
 #' @export
 #'
 #' @importFrom assertthat assert_that
-#' @importFrom dplyr %>% distinct filter group_by inner_join left_join mutate n select summarise ungroup
+#' @importFrom dplyr %>% distinct filter group_by inner_join left_join mutate n
+#' select summarise ungroup
 #' @importFrom readr read_delim
 #' @importFrom rlang .data
 #' @importFrom tidyr pivot_wider
@@ -61,9 +65,12 @@ calculate_DAS_indicator <- function(data_dendro_calc, na.rm = FALSE) {
 
   #select relevant plots
   DAS_reserve <- data_dendro_calc %>%
-    select_for_DAS_indicator(grouping_vars = c("forest_reserve", "year", "period")) %>%
-    inner_join(data_dendro_calc, by = c("forest_reserve", "year", "period")) %>%
-    select_for_DAS_indicator(grouping_vars = c("plot_id", "year", "period")) %>%
+    select_for_DAS_indicator(grouping_vars = c("forest_reserve", "year",
+                                               "period")) %>%
+    inner_join(data_dendro_calc, by = c("forest_reserve", "year"
+                                        , "period")) %>%
+    select_for_DAS_indicator(grouping_vars = c("plot_id", "year"
+                                               , "period")) %>%
     inner_join(
       data_dendro_calc %>%
         select(.data$plot_id, .data$forest_reserve) %>%
@@ -76,16 +83,19 @@ calculate_DAS_indicator <- function(data_dendro_calc, na.rm = FALSE) {
     ) %>%
     ungroup() %>%
     filter(.data$n_plots >= 12) %>%
-    #add data again to selected plots and calculate difference in basal area proportion
-    inner_join(data_dendro_calc, by = c("forest_reserve", "plot_id", "year", "period")) %>%
+    #add data again to selected plots and calculate difference in basal area
+    # proportion
+    inner_join(data_dendro_calc, by = c("forest_reserve", "plot_id", "year"
+                                        , "period")) %>%
     left_join(
       read_delim(
         system.file("extdata/DAS_tree_groups.csv", package = "forrescalc"),
         delim = ";", col_types = "cd"
       ),
       by = "species"
     ) %>%
-    group_by(.data$forest_reserve, .data$period, .data$year, .data$group, .data$plot_id) %>%
+    group_by(.data$forest_reserve, .data$period, .data$year, .data$group,
+             .data$plot_id) %>%
     summarise(
       basal_area_m2_ha = sum(.data$basal_area_alive_m2_ha)
     ) %>%

R/calculate_dendro_plot.R

@@ -1,11 +1,16 @@
 #' aggregate parameters by plot and year
 #'
-#' This function calculates for each plot and year some values per hectare: number of tree species, number of trees, basal area and volume.
+#' This function calculates for each plot and year some values per hectare:
+#' number of tree species, number of trees, basal area and volume.
 #'
 #' @inheritParams calculate_dendrometry
-#' @param data_dendro_calc dataframe on tree measures with variables plot_id, plottype, tree_measure_id, date_dendro, dbh_mm, height_m, species, alive_dead, decaystage, vol_tot_m3, basal_area_m2, period, OldID, year, subcircle, plotarea_ha,... (output of function calc_variables_tree_level())
+#' @param data_dendro_calc dataframe on tree measures with variables plot_id,
+#' plottype, tree_measure_id, date_dendro, dbh_mm, height_m, species,
+#' alive_dead, decaystage, vol_tot_m3, basal_area_m2, period, OldID, year,
+#' subcircle, plotarea_ha,... (output of function calc_variables_tree_level())
 #'
-#' @return dataframe with columns plot, year, number_of_tree_species, number_of_trees_ha, basal_area_m2_ha, volume_m3_ha
+#' @return dataframe with columns plot, year, number_of_tree_species,
+#' number_of_trees_ha, basal_area_m2_ha, volume_m3_ha
 #'
 #' @examples
 #' \dontrun{

R/calculate_dendro_plot_species.R

@@ -1,10 +1,12 @@
 #' aggregate parameters by plot and tree species
 #'
-#' This function calculates for each plot, tree species and year some values per hectare: number of trees, basal area and volume.
+#' This function calculates for each plot, tree species and year some values
+#' per hectare: number of trees, basal area and volume.
 #'
 #' @inheritParams calculate_dendro_plot
 #'
-#' @return dataframe with columns plot, year, tree_species, number_of_trees_ha, basal_area_m2_ha, volume_m3_ha
+#' @return dataframe with columns plot, year, tree_species, number_of_trees_ha,
+#' basal_area_m2_ha, volume_m3_ha
 #'
 #' @examples
 #' \dontrun{
@@ -39,7 +41,7 @@ calculate_dendro_plot_species <- function(data_dendro_calc, data_deadwood) {
           sum((.data$alive_dead == 11) * .data$nr_of_stems / .data$plotarea_ha),
       basal_area_alive_m2_ha = sum(.data$basal_area_alive_m2_ha),
       basal_area_dead_m2_ha = sum(.data$basal_area_dead_m2_ha),
-      vol_alive_m3_ha = sum(.data$vol_alive_m3_ha ),
+      vol_alive_m3_ha = sum(.data$vol_alive_m3_ha),
       vol_dead_standing_m3_ha = sum(.data$vol_dead_standing_m3_ha),
       vol_bole_alive_m3_ha = sum(.data$vol_bole_alive_m3_ha),
       vol_bole_dead_m3_ha = sum(.data$vol_bole_dead_m3_ha)