Merge pull request #16 from jogaudard/coding

Coding

NAMESPACE

@@ -33,6 +33,7 @@ importFrom(ggplot2,geom_line)
 importFrom(ggplot2,geom_point)
 importFrom(ggplot2,geom_text)
 importFrom(ggplot2,ggplot)
+importFrom(ggplot2,ggsave)
 importFrom(ggplot2,labs)
 importFrom(ggplot2,scale_color_manual)
 importFrom(ggplot2,scale_x_datetime)

R/flux_calc.R

@@ -2,13 +2,16 @@
 #' @description calculates a flux based on the rate of change
 #' of gas concentration over time
 #' @param slope_df dataframe of flux slopes
+#' @param slope_col column containing the slope to calculate the flux (in ppm*s^(-1))
 #' @param slope_col column containing the slope to calculate the flux
+#' @param cut_col column containing cutting information
+#' @param keep_filter name in cut_col of data to keep
 #' @param chamber_volume volume of the flux chamber in L,
 #' default for Three-D project chamber (25x24.5x40cm)
 #' @param tube_volume volume of the tubing in L, default for summer 2020 setup
 #' @param atm_pressure atmoshperic pressure, assumed 1 atm
 #' @param plot_area area of the plot in m^2, default for Three-D
-#' @param R_const gas constant, in L*atm*K^(-1)*mol^(-1)
+#' @param R_const gas constant (0.082057 L*atm*K^(-1)*mol^(-1))
 #' @param cols_keep columns to keep from the input to the output.
 #' Those columns need to have unique values for each flux.
 #' @param cols_ave columns with values that should be averaged
@@ -18,9 +21,9 @@
 #' to caculate fluxes. Will be averaged with NA removed.
 #' @param temp_air_unit units in which air temperature was measured.
 #' Has to be either celsius, fahrenheit or kelvin
-#' @return a df containing fluxID, fluxes, temperature average for each flux,
+#' @return a df containing fluxID, fluxes (in mmol*m^(-2)*h^(-1)), temperature average for each flux,
 #' slope used for each flux calculation,
-#' and any columns specified in cols_keep and cols_ave
+#' and any columns specified in cols_keep and cols_ave.
 #' @importFrom rlang .data
 #' @importFrom dplyr .data rename all_of select group_by summarise
 #' ungroup mutate case_when distinct left_join summarize_all
@@ -34,6 +37,8 @@
 
 flux_calc <- function(slope_df,
                       slope_col,
+                      cut_col = c(),
+                      keep_filter = c(),
                       chamber_volume = 24.5,
                       tube_volume = 0.075,
                       atm_pressure = 1,
@@ -44,41 +49,49 @@ flux_calc <- function(slope_df,
                       fluxID_col = "f_fluxID",
                       temp_air_col = "temp_air",
                       temp_air_unit = "celsius") {
-  if (!is.double(chamber_volume)) stop("chamber_volume has to be a double")
-  if (!is.double(tube_volume)) stop("tube_volume has to be a double")
-  if (!is.double(atm_pressure)) stop("atm_pressure has to be a double")
-  if (!is.double(plot_area)) stop("plot_area has to be a double")
-  if (!is.double(R_const)) stop("R_const has to be a double")
-  if (!(temp_air_unit %in% list("celsius", "fahrenheit", "kelvin"))) {
+  if (!is.double(((chamber_volume)))) stop("chamber_volume has to be a double")
+  if (!is.double(((tube_volume)))) stop("tube_volume has to be a double")
+  if (!is.double(((atm_pressure)))) stop("atm_pressure has to be a double")
+  if (!is.double(((plot_area)))) stop("plot_area has to be a double")
+  if (!is.double(((R_const)))) stop("R_const has to be a double")
+  if (!(((temp_air_unit)) %in% list("celsius", "fahrenheit", "kelvin"))) {
     stop("temp_air_unit has to be either celsius, fahrenheit or kelvin")
   }
 
   colnames <- colnames(slope_df)
-  if (!(slope_col %in% colnames)) stop("could not find slope_col in slope_df")
-  if (!(fluxID_col %in% colnames)) stop("could not find fluxID_col in slope_df")
-  if (!(temp_air_col %in% colnames)) {
+  if (!(((slope_col)) %in% ((colnames)))) stop("could not find slope_col in slope_df")
+  if (!(((fluxID_col)) %in% ((colnames)))) stop("could not find fluxID_col in slope_df")
+  if (!(((temp_air_col)) %in% ((colnames)))) {
     stop("could not find temp_air_col in slope_df")
   }
 
 
-  if (length(setdiff(cols_keep, colnames)) > 0) {
+  if (length(setdiff(((cols_keep)), ((colnames)))) > 0) {
     stop("some names in cols_keep cannot be found in slope_df")
   }
-  if (length(setdiff(cols_ave, colnames)) > 0) {
+  if (length(setdiff(((cols_ave)), ((colnames)))) > 0) {
     stop("some names in cols_ave cannot be found in slope_df")
   }
 
 
 
   slope_df <- slope_df |>
     rename(
-      f_fluxID = all_of(fluxID_col),
-      air_temp = all_of(temp_air_col),
-      f_slope = all_of(slope_col)
+      f_fluxID = all_of(((fluxID_col))),
+      air_temp = all_of(((temp_air_col))),
+      f_slope = all_of(((slope_col)))
     )
 
 
-  vol <- chamber_volume + tube_volume
+  vol <- ((chamber_volume)) + ((tube_volume))
+
+  if(length(((cut_col))) > 0) {
+    slope_df <- flux_cut(
+                        slope_df,
+                        cut_col = ((cut_col)),
+                        keep_filter = ((keep_filter))
+      )
+  }
 
   slope_temp <- slope_df |>
     select("f_slope", "f_fluxID", "air_temp") |>
@@ -89,18 +102,18 @@ flux_calc <- function(slope_df,
     ungroup() |>
     mutate(
       temp_air_ave = case_when(
-        temp_air_unit == "celsius" ~ .data$temp_air_ave + 273.15,
-        temp_air_unit == "fahrenheit" ~ (.data$temp_air_ave + 459.67) * (5 / 9),
-        temp_air_unit == "kelvin" ~ .data$temp_air_ave
+        ((temp_air_unit)) == "celsius" ~ .data$temp_air_ave + 273.15,
+        ((temp_air_unit)) == "fahrenheit" ~ (.data$temp_air_ave + 459.67) * (5 / 9),
+        ((temp_air_unit)) == "kelvin" ~ .data$temp_air_ave
       )
     )
 
 
 
   # a df with all the columns we just want to keep and join back in the end
-  if (length((cols_keep)) > 0) {
+  if (length(((cols_keep))) > 0) {
     slope_keep <- slope_df |>
-      select(all_of(cols_keep), "f_fluxID") |>
+      select(all_of(((cols_keep))), "f_fluxID") |>
       distinct() |>
       left_join(slope_temp, by = "f_fluxID")
   } else {
@@ -110,7 +123,7 @@ flux_calc <- function(slope_df,
   # a df with the columns that have to be averaged
   if (length((cols_ave)) > 0) {
     slope_ave <- slope_df |>
-      select(all_of(cols_ave), "f_fluxID") |>
+      select(all_of(((cols_ave))), "f_fluxID") |>
       group_by(.data$f_fluxID) |>
       summarize_all(mean, na.rm = TRUE) |>
       ungroup() |>

R/flux_cut.R

@@ -0,0 +1,21 @@
+#' filter cut data before calculating fluxes
+#' @param slope_df dataset containing slopes and cut column
+#' @param cut_col column containing cutting information
+#' @param keep_filter name in cut_col of data to keep
+
+flux_cut <- function(slope_df,
+                    cut_col,
+                    keep_filter
+)
+{
+
+    if(is.na(((keep_filter)))) {
+      stop("please provide the keep_filter argument to filter the data to keep")
+    }
+
+       slope_df <- slope_df |>
+      rename(
+        f_cut = all_of(((cut_col)))
+      ) |>
+      filter(.data$f_cut == ((keep_filter)))
+}

R/flux_fitting_lin.R

@@ -29,15 +29,15 @@ flux_fitting_lin <- function(conc_df,
                              fluxID_col = "f_fluxID") {
   conc_df <- conc_df |>
     rename(
-      f_start = all_of((start_col)),
-      f_end = all_of((end_col)),
-      f_datetime = all_of((datetime_col)),
-      f_conc = all_of((conc_col)),
-      f_fluxID = all_of((fluxID_col))
+      f_start = all_of(((start_col))),
+      f_end = all_of(((end_col))),
+      f_datetime = all_of(((datetime_col))),
+      f_conc = all_of(((conc_col))),
+      f_fluxID = all_of(((fluxID_col)))
     )
 
-  if (!is.double(start_cut)) stop("start_cut has to be a double")
-  if (!is.double(end_cut)) stop("end_cut has to be a double")
+  if (!is.double(((start_cut)))) stop("start_cut has to be a double")
+  if (!is.double(((end_cut)))) stop("end_cut has to be a double")
 
   length_flux_max <- conc_df |>
     mutate(
@@ -97,9 +97,9 @@ flux_fitting_lin <- function(conc_df,
     mutate(
       temp = map(.data$data, \(d) {
         model <- lm(f_conc ~ f_time_cut, data = d)
-        glance <- broom::glance(model) |>
+        glance <- broom::glance(((model))) |>
           select("r.squared", "adj.r.squared", "p.value")
-        tidy <- broom::tidy(model) |>
+        tidy <- broom::tidy(((model))) |>
           select("term", "estimate") |>
           pivot_wider(names_from = "term", values_from = "estimate")
         bind_cols(((glance)), ((tidy)))

R/flux_match.R

@@ -69,19 +69,19 @@ flux_match <- function(raw_conc,
     stop("start in field_record dataframe is not ymd_hms!")
   }
 
-  if (!is.double(startcrop)) {
+  if (!is.double(((startcrop)))) {
     stop("startcrop has to be a double")
   }
-  if (!is.double(time_diff)) {
+  if (!is.double(((time_diff)))) {
     stop("time_diff has to be a double")
   }
-  if (!is.double(measurement_length)) {
+  if (!is.double(((measurement_length)))) {
     stop("measurement_length has to be a double")
   }
-  if (!is.double(ratio_threshold)) {
+  if (!is.double(((ratio_threshold)))) {
     stop("ratio_threshold has to be a number between 0 and 1")
   }
-  if (ratio_threshold < 0 || ratio_threshold > 1) {
+  if (((ratio_threshold)) < 0 || ((ratio_threshold)) > 1) {
     stop("ratio_threshold has to be a number between 0 and 1")
   }