knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

This is the last post-processing for root biomass data for the SDEF project.

Pre-processing steps are in:

SDEF_roots_pre_process.Rmd

and

SDEF_roots_post_aggregation.Rmd

Like the others, this vignette wasn't run, its just for archiving the code.

Of special note in this version is the season versions. The time aggregation here is one of five options: date, month, season_v1, season_v2, and season_v3. Date and month are self explanatory.

season_v1 aggregates October and December to Winter, January and February to Early Spring, and March and May to Late Spring.

season_v2 aggregates October and December to Winter, January and February to Early Spring, and leaves March and May as months.

season_v3 aggregates October, December, and January as Winter, February and March as Early Spring, and leaves May as its own month. May here could also be Late Spring.

There's a seperate .Rdata file for each season grouping, indicated by the filename.

# Aggregate root_scale data
library(SDEF.analysis)
data("SDEF_roots_pre_aggregation")
data_roots <- SDEF_roots_pre_aggregation

# Section making seasons
data_roots[["date"]] <- as.character(data_roots[["date"]])
data_roots[["date"]] <- strptime(x = data_roots[["date"]],
                                 format = "%m/%d/%Y")
month <- data_roots[["date"]][["mon"]]
month <- month + 1
month <- month.abb[month]
season_v1 <- rep(NA, length(month))
season_v1[which(month %in% c("Oct", "Dec"))] <- "Winter"
season_v1[which(month %in% c("Jan", "Feb"))] <- "Early Spring"
season_v1[which(month %in% c("Mar", "May"))] <- "Late Spring"
season_v2 <- month
season_v2[which(month %in% c("Oct", "Dec"))] <- "Winter"
season_v2[which(month %in% c("Jan", "Feb"))] <- "Early Spring"
season_v3 <- month
season_v3[which(month %in% c("Oct", "Dec", "Jan"))] <- "Winter"
season_v3[which(month %in% c("Feb", "Mar"))] <- "Early Spring"
data_roots <- data.frame(data_roots[, 1:3],
                                    month, season_v1, season_v2, season_v3,
                                    data_roots[, 4:7])
# Calculate biodensity from biomass
tube_r <- 5.08 # MMR tube radius, in centimeters
# This assumes that the install angle is 45 degrees!
bin_size <- 10 # Depth of each bin, in cm
# Frame depth is 0.74 mm, 0.074 cm, frame width is 9.0 mm, 0.9 cm
# Frame length is 6.75 mm, but that should be taken care of by the
# 'ConvertFrameDepth' function.
bin_volume <- bin_size * 0.9 * 0.078 # in cm^3
biodensity <- data_roots[["biomass"]] / bin_volume
data_roots <- data.frame(data_roots, biodensity)
data_roots[["date"]] <- as.POSIXct(data_roots[["date"]])
data_roots[["date"]] <- as.character(data_roots[["date"]])
data_roots_full <- data_roots

# variables for saving:
SDEF_roots_post_aggregation_by_date <- NULL
SDEF_roots_post_aggregation_by_month <- NULL
SDEF_roots_post_aggregation_by_season_v1 <- NULL
SDEF_roots_post_aggregation_by_season_v2 <- NULL
SDEF_roots_post_aggregation_by_season_v3 <- NULL

library(dplyr)
sub_list <- c("date", "month", "season_v1", "season_v2", "season_v3")
# Instead of one data product now, there's five!
for (j in 1:length(sub_list)) {
  i <- sub_list[j]
  cat("Time aggregation:", i, "\n")
  col_subs <- c("site", "tube", i, "length", "diameter",
                "depth_bin", "biomass", "biodensity")
  data_roots <- data_roots_full[, which(colnames(data_roots_full) %in% col_subs)]
  print("Aggregating mean length...")
  mean_length <- aggregate(
    x = data_roots[["length"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { mean(x, na.rm = TRUE) })
  colnames(mean_length) <- c("site", i, "depth_bin", "mean_length")
  # Find s.d. of root length, binned by site/date/depth_bin
  print("Aggregating sd length...")
  sd_length <- aggregate(
    x = data_roots[["length"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { sd(x, na.rm = TRUE) })
  colnames(sd_length) <- c("site", i, "depth_bin", "sd_length")
  # Find sample size ('n') of root length, binned by site/date/depth_bin
  print("Aggregating n length...")
  n_length <- aggregate(
    x = data_roots[["length"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { length(x) })
  colnames(n_length) <- c("site", i, "depth_bin", "n_length")
  # Find mean of root diameter, binned by site/date/depth_bin
  print("Aggregating mean diameter...")
  mean_diam <- aggregate(
    x = data_roots[["diameter"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { mean(x, na.rm = TRUE) })
  colnames(mean_diam) <- c("site", i, "depth_bin", "mean_diameter")
  # Find s.d. of root diameter, binned by site/date/depth_bin
  print("Aggregating sd diameter...")
  sd_diam <- aggregate(
    x = data_roots[["diameter"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { sd(x, na.rm = TRUE) })
  colnames(sd_diam) <- c("site", i, "depth_bin", "sd_diameter")
  # Find sample size ('n') of root diameter, binned by site/date/depth_bin
  print("Aggregating n diameter...")
  n_diam <- aggregate(
    x = data_roots[["diameter"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { length(x) })
  colnames(n_diam) <- c("site", i, "depth_bin", "n_diameter")
  # Find mean of root biomass, binned by site/date/depth_bin
  print("Aggregating sum biomass...")
  total_biomass <- aggregate(
    x = data_roots[["biomass"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { sum(x, na.rm = TRUE) })
  colnames(total_biomass) <- c("site", i, "depth_bin", "total_biomass")
  # Find s.d. of root biomass, binned by site/date/depth_bin
  print("Aggregating sd biomass...")
  sd_biomass <- aggregate(
    x = data_roots[["biomass"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { sd(x, na.rm = TRUE) })
  colnames(sd_biomass) <- c("site", i, "depth_bin", "sd_biomass")
  # Find sample size ('n') of root biomass data, binned by site/date/depth_bin
  print("Aggregating n biomass...")
  n_biomass <- aggregate(
    x = data_roots[["biomass"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { length(x) })
  colnames(n_biomass) <- c("site", i, "depth_bin", "n_biomass")
  # Find mean root biodensity, binned by site/date/depth_bin
  print("Aggregating mean biodensity...")
  mean_biodensity <- aggregate(
    x = data_roots[["biodensity"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { mean(x, na.rm = TRUE) })
  colnames(mean_biodensity) <- c("site", i, "depth_bin", "mean_biodensity")
  # Find s.d. of root length, binned by site/date/depth_bin
  print("Aggregating sd biodensity...")
  sd_biodensity <- aggregate(
    x = data_roots[["biodensity"]], by = list(
      data_roots[["site"]],
     data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { sd(x, na.rm = TRUE) })
  colnames(sd_biodensity) <- c("site", i, "depth_bin", "sd_biodensity")
  # Find sample size ('n') of root length, binned by site/date/depth_bin
  print("Aggregating n biodensity...")
  n_biodensity <- aggregate(
    x = data_roots[["biodensity"]], by = list(
      data_roots[["site"]],
      data_roots[[i]],
      data_roots[["depth_bin"]]
    ), FUN = function(x) { length(x) })
  colnames(n_biodensity) <- c("site", i, "depth_bin", "n_biodensity")
  # Merge the data - using dplyr for convenience.
  print("Putting it all together...")
  data_roots <- list(mean_length, sd_length, n_length, mean_diam, sd_diam,
                     n_diam, total_biomass, sd_biomass, n_biomass,
                     mean_biodensity, sd_biodensity, n_biodensity) %>%
    Reduce(function(dtf1, dtf2) left_join(dtf1, dtf2, by = NULL), .)
  # Sort the data, looks weird as it is
  #data_roots <- data_roots[order(data_roots[["site"]]), ]
  save_name <- paste("SDEF_roots_post_aggregation_by", i, sep = "_")
  assign(x = save_name, value = data_roots, inherits = TRUE)
  SDEF_roots_post_aggregation <- data_roots
  #devtools::use_data(SDEF_roots_post_aggregation)
}

#devtools::use_data(SDEF_roots_post_aggregation_by_date)
#devtools::use_data(SDEF_roots_post_aggregation_by_month)
#devtools::use_data(SDEF_roots_post_aggregation_by_season_v1)
#devtools::use_data(SDEF_roots_post_aggregation_by_season_v2)
#devtools::use_data(SDEF_roots_post_aggregation_by_season_v3)

End script!



bmcnellis/SDEF.analysis documentation built on June 4, 2019, 10 a.m.