3  Plot locations and Tree Allometrics

A total of 46 forest plot sites were selected across the spatial extent of the project area. Plots locations were selected in order to capture a representative sample of the full biomass distribution across the site. This site selection was carried out through the inspection of LiDAR data collected in 2016 and satellite imagery. All plots were sampled twice, first in 2015/16 and then in 2021/2022. Figure 3.1 displays the locations of these points.

Figure 3.1: Plot locations within the Kuamut project area

This target calculates the Total Above Ground Carbon (AGC) for every measured tree in each plot. The AGC is estimated using taxa-specific allometric models obtained from the {BIOMASS} R package (Réjou-Méchain et al. 2023). An interactive table of the full plot inventory is provided in Table 3.1.

Table 3.1: Table detailing the full plot inventory for the Kuamut conservation area including: tree species, diameter at breast height, the estimated wood density, Above Ground Biomass (AGB) and Above Ground Carbon (AGC) derived using the allometric functions in

3.1 Code

save_tree_allometrics <- function(kuamut_AGB, site, save_csv) {
  # Remove remaining columns no longer needed
  # Save .csv file for next stage of analysis (see KuamutTree2Plot.R)
  parent_dir <- set_path("PlotData")
  if (!dir.exists(parent_dir)) dir.create(parent_dir)
  tlm_out_path <- file.path(parent_dir, sprintf("%sTreeLevelMetrics.csv", site))

  fin_agb_df <- kuamut_AGB |>
    dplyr::select(!any_of(c(
      "Distance_m", "Azimuth", "Notes", "Comments",
      "butress", "levelWD", "PlotWD"
    ))) |>
    dplyr::mutate(site = site)

  if (isTRUE(save_csv)) {
    fin_agb_df |>
      write.csv(tlm_out_path, row.names = FALSE)
    return(tlm_out_path)
  } else {
    return(tibble::tibble(fin_agb_df))
  }
}



#' Tree Allometrics for Kuamut
#'
#' Generate Tree-level Above-Ground Biomass, Carbon and Volume
#'
#' @param ... csv file paths containing the raw plot data.
#' @param site default is "kuamut". Site name.
#' @param CF default is 0.47. Carbon Fraction
#' @param save_csv default is TRUE. Save the csv file.
#' @return csv file path.
#'
#' @details
#' This code takes the individual tree measurement and calculates Tree-level
#' Above-Ground Biomass, Carbon and Volume
#' Returns .csv file with Tree level AGB estimates
#' Written in accordance with VM0010, Version 1.2
#'
#' Tapering:
#'
#' When trees have large buttress roots, or other features making DBH
#' measurement at 1.3 meters is impossible. The Point Of Measurement (POM) is
#' raised from 1.3m and the POM recorded. We follow a standard protocol of
#' estimating the DBH at 1.3m using a tapering model
#'
#' We followed methods and equations in Cushman (2014) (but see also, Metcalf
#' et el. (2008), Jucker (2018), & Philipson (2020). We used the overall best
#' taper model (see also Metcalf et el. (2008)). Define function to calculate
#' equivalent diameter at 1.3 m given a diameter measurement in cm (DBH_cm)
#' taken at a nonstandard height in m (POM), and a taper parameter. We use the
#' geometric mean tapering parameter from Cushman (2014), which is 0.029 as per
#' Jucker (2018)
Kuamut_TreeAllometrics <- function(
    ...,
    site = "kuamut", CF = 0.47, save_csv = TRUE) {
  plts_csvs <- list(...)

  # ---------------- 1. Load and clean Tree measurements data -----------------
  read_trees <- function(plot_data) {
    if (inherits(plot_data, "character")) {
      plot_data <- read.csv(plot_data, header = TRUE)
    }
    plot_data |>
      # remove two trees with missing DBH's  keeps things neater
      dplyr::filter(!is.na(DBH_mm)) |>
      # Give a unique tree ID
      mutate(
        TreeID = paste(PlotNo, TreeNo, sep = "_"),
        # Calculate DBH in cm (DBH was measured in mm for accuracy)
        DBH_cm = DBH_mm / 10,
        # fix excel dates
        Date = lubridate::as_date(Date, origin = "1899-12-30")
      ) |>
      # drop the full.names and DBH_mm columns
      select(!any_of(c("DBH_mm", "Full.names", "Botanist"))) # names to drop
  }

  kuamut <- plts_csvs |>
    purrr::map(~ read_trees(.x)) |>
    bind_rows() |>
    mutate(
      MONTH = lubridate::round_date(Date, "month"),
      YEAR = lubridate::year(Date),
      CAMP_YEAR = case_when(
        YEAR %in% c(2015:2016) ~ 2016,
        YEAR == 2017 ~ YEAR,
        YEAR == 2020 ~ YEAR,
        YEAR %in% c(2021:2022) ~ 2022,
        TRUE ~ NA_real_
      )
    )

  # -------------------- 2. Tapering -------------------------------------------
  # Define the Tapering Equation
  TaperEqn <- function(DBH_cm, POM) {
    # round DBH to 1 decimal place
    round(DBH_cm / (exp(-0.029 * (POM - 1.3))), 1)
  }

  # If there is a POM value (measured above 1.3m), then apply tapering equation
  # to DBH measurement. Otherwise use direct DBH measurement
  kuamut_tap <- kuamut |>
    mutate(DBH = case_when(
      !is.na(POM) ~ TaperEqn(DBH_cm, POM),
      TRUE ~ DBH_cm
    )) |>
    # remove DBH before tapering_cm and POM (no longer needed0)
    select(!tidyselect::any_of(c("DBH_cm", "POM", "SolsOldName")))


  # ----------- 3. Excluding some carbon pools (5.3, page 10 in VM0010) ------

  # Excluding Aboveground non-tree measurement
  # Liana biomass not included
  # see Page 10 VM0010-v1.2 'Aboveground non-tree, Excluded'
  # 'Exclusion is always conservative when forests remains as forest'

  # Removes standing dead trees
  # see Page 10 VM0010-v1.2 ''Dead wood, Excluded'
  # take out all cases of standing dead trees D1,D2,D3, D4

  kuamut_excl_cp <- kuamut_tap |>
    dplyr::filter(
      is.na(Notes) | Notes != "AL", # removes 35 liana measurements
      !Notes %in% c("D1", "D2", "D3", "D4")
    ) # Removes standing dead trees



  # -------------------- 4. Check Taxonomic Information -----------------------
  # Corrects Synonyms spelling errors (uses BIOMASS package)
  # Uses Taxonomic Name Resolution Service
  # (http://tnrs.iplantcollaborative.org/; requires access to internet)
  # Set up cache...
  if (!dir.exists(here::here("BIOMASS_cache"))) {
    dir.create(here::here("BIOMASS_cache"))
  }
  BIOMASS::createCache(path = here::here("BIOMASS_cache"))

  # Correct taxa spelling and get family.
  Taxo <- BIOMASS::correctTaxo(
    genus = kuamut_excl_cp$Genus, species = kuamut_excl_cp$Species,
    score = 0.5, useCache = TRUE
  )

  # Retrieve APG III Families and Orders from Genus names
  Taxo <- mutate(Taxo, Family = BIOMASS::getTaxonomy(Taxo$genusCorr)$family)

  # replaces our names with those corrected from the taxonic
  # database (or if NA, use the name we had)
  kuamut_cln_taxa <- kuamut_excl_cp |>
    mutate(
      Genus = case_when(
        !is.na(Taxo$genusCorrected) ~ Taxo$genusCorrected,
        TRUE ~ Genus
      ),
      Species = case_when(
        !is.na(Taxo$speciesCorrected) ~ Taxo$speciesCorrected,
        TRUE ~ Species
      ),
      Family = case_when(
        !is.na(Taxo$Family) ~ Taxo$Family,
        TRUE ~ Family
      )
    )

  # ---------- 5. Assign Wood Density Data -----------------------------------
  # Retrieve wood density from Global wood density database
  dataWD <- BIOMASS::getWoodDensity(
    genus = kuamut_cln_taxa$Genus,
    species = kuamut_cln_taxa$Species,
    family = kuamut_cln_taxa$Family
  )

  # Assign wood density (& indicator of the level of wood density (from Species,
  # Genus or Family mean))
  kuamut_WD <- kuamut_cln_taxa |>
    mutate(
      WD = round(dataWD$meanWD, 3),
      levelWD = dataWD$levelWD,
      WD = case_when(
        levelWD == "dataset" ~ NA_real_,
        TRUE ~ WD
      ) # replace 'dataset' values with NA's
    )


  # Plot level Basal Area-weighted mean wood density
  # When we have no taxonomic information getWoodDensity() takes the average
  # wood density of the dataset. It makes more sense to take the Basal Area
  # Weighted mean for that specific plot
  # Calculate Plot level Basal Area-weighted mean wood density
  Plot_WD <- kuamut_WD |>
    group_by(PlotNo) |>
    dplyr::summarise(PlotWD = round(weighted.mean(WD, (pi * ((DBH) / 2)^2), na.rm = T), 3))

  # Merge Plot level wood density into full dataset
  kuamut_PWD <- kuamut_WD |>
    left_join(Plot_WD, by = "PlotNo") |>
    # For the trees with no taxonomic information, write 'PlotWD_w.mean' in the
    # column 'levelWD'. Assign  with the Basal Area weighted mean wood density
    # for that plot.
    #  Assign  trees with no taxonomic information with plot level Basal Area
    #  weighted mean wood density.
    mutate(
      levelWD = case_when(
        is.na(WD) ~ "PlotWD",
        TRUE ~ levelWD
      ),
      WD = case_when(
        is.na(WD) ~ PlotWD,
        TRUE ~ WD
      )
    )

  # ------------------- 6. Above-Ground Biomass estimation --------------------
  # Calculate Tree-level Above-Ground Biomass (in Mg) according to Eq. 4 in
  # Chave et al. (2014)

  chave_2014_height_DBH <- function(.WD, .Height_m, .DBH) {
    (0.0673 * (.WD * .Height_m * .DBH^2)^0.976) / 1000
  }

  # 3 param weibull height model, from our data plus others. previous version
  # reported in philipson 2020
  Hwei3p_sabah_cdp <- function(.DBH) {
    (90.4997) * (1 - exp(-(0.0221) * .DBH^(0.7404)))
  }

  kuamut_AGB <- kuamut_PWD |>
    dplyr::mutate(
      height_src = case_when(
        is.na(Height_m) ~ "modelled",
        TRUE ~ "measured"
      ),
      Height_m = dplyr::case_when(
        is.na(Height_m) ~ Hwei3p_sabah_cdp(DBH),
        TRUE ~ Height_m
      ),
      AGB = chave_2014_height_DBH(WD, Height_m, DBH),
      AGC = AGB * CF
    ) |>
    dplyr::mutate(dplyr::across(c("AGB", "AGC"), \(x) round(x, 4)))


  return(save_tree_allometrics(kuamut_AGB, site, save_csv))
}

Réjou-Méchain, Maxime, Guillaume Cornu, Dominique Lamonica, Arthur Pere, Ariane Tanguy, Camille Piponiot, and Bruno Hérault. 2023. BIOMASS: Estimating Aboveground Biomass and Its Uncertainty in Tropical Forests. https://github.com/umr-amap/BIOMASS.