R/qc_unit_transformations.R

In sapfluxnet/sapfluxnetQC1: Package with functions related to sapfluxnet project data

################################################################################
#' Helper function for unit conversion
#'
#' \code{qc_get_sapw_md} allows to extract all necessary variables from plant
#' metadata in order to be able to convert sap flow units.
#'
#' @family Quality Checks Functions
#'
#' @param pl_metadata Data frame containing the plant metadata
#'
#' @return A data frame with extracted plant metadata variables as columns and
#'   individual plants as rows. Also a new variable \code{pl_sapw_area_est} is
#'   created as an empty numeric vector.
#'
#' @importFrom magrittr %>%
#'
#' @export

# START
# Function declaration
qc_get_sapw_md <- function(pl_metadata, parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Argument checks
    # Is pl_data a data frame?
    if (!is.data.frame(pl_metadata)) {
      stop('Provided pl_data object is not a data frame')
    }
    # Is the correct metadata? (Check for pl_code variable)
    if (is.null(pl_metadata$pl_code)) {
      stop('pl_code variable is missing from pl_data')
    }

    # STEP 1
    # Extract the desired variables
    res <- pl_metadata %>%
      dplyr::select(pl_code, pl_sap_units, pl_sapw_area, pl_leaf_area,
                    pl_dbh, pl_sapw_depth, pl_bark_thick) %>%
      dplyr::mutate(pl_sapw_area_est = 0)

    # STEP 2
    # Return the results
    return(res)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_get_sapw_md', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_get_sapw_md', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_get_sapw_md', sep = '.'))})

}

################################################################################
#' Sapwood area calculator
#'
#' Function to calculate sapwood area from DBH, bark thickness and sapwood depth
#'
#' In the case that sapwood area variable (\code{pl_sapw_area}) is not provided,
#' it still is needed to perform the unit conversion. In this case sapwood area
#' can be estimated from DBH and sapwood depth and bark thickness. If bark
#' thickness is not provided, estimation can be made but results should be
#' revised as, depending on the species, error in the estimates can be large.
#'
#' @section Ring area formula:
#' The area of a ring is \eqn{\pi(R² - r²)}, where \code{R} is the radius
#'   including the ring and \code{r} is the radius till the ring. Thus,
#'   \eqn{R = (dbh / 2) - bark_thickness} and
#'   \eqn{r = (dbh / 2) - bark_thickness - sapwood_depth}.
#'
#' @family Quality Checks Functions
#'
#' @param pl_vars Data frame containing the needed variables, usually the result
#'   of \code{\link{qc_get_sapw_md}}.
#'
#' @return A data frame, exactly as returned by \code{\link{qc_get_sapw_md}},
#'   but with the variable pl_sapw_area_est filled with the estimated values.
#'
#' @export

# START
# Function declaration
qc_sapw_area_calculator <- function(pl_vars, parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Argument checking
    # is pl_vars a data frame?
    if (!is.data.frame(pl_vars)) {
      stop('Provided pl_vars object is not a data frame')
    }
    # has pl_vars the necessary variables?
    if (!all(c('pl_sapw_depth', 'pl_dbh',
               'pl_bark_thick', 'pl_sapw_area') %in% names(pl_vars))) {
      stop('Provided pl_vars object has not the needed variables to make ',
           'the conversion')
    }

    # STEP 1
    # Helper function to use in vapply
    helper <- function(i) {
      # mandatory variables + bark
      depth_dbh_bark <- all(!is.na(pl_vars$pl_sapw_depth[i]),
                            !is.na(pl_vars$pl_dbh[i]),
                            !is.na(pl_vars$pl_bark_thick[i]))
      # mandatory variables only
      depth_dbh <- all(!is.na(pl_vars$pl_sapw_depth[i]),
                       !is.na(pl_vars$pl_dbh[i]),
                       is.na(pl_vars$pl_bark_thick[i]))


      # if there is a sapwood area value, return it
      if (!is.na(pl_vars$pl_sapw_area[i])) {
        return(pl_vars$pl_sapw_area[i])
      } else {
        # if all mandatory variables and bark thickness are present, return the
        # estimate
        if (depth_dbh_bark) {
          return(pi*(((pl_vars$pl_dbh[i] / 2) - (pl_vars$pl_bark_thick[i]*0.1))^2 - ((pl_vars$pl_dbh[i] / 2) - (pl_vars$pl_bark_thick[i]*0.1) - pl_vars$pl_sapw_depth[i])^2))
        } else {
          # if all mandatory variables are present, but no bark thickness value
          # return estimate with a message
          if (depth_dbh) {
            message(pl_vars$pl_code[i], ' has no bark thickness value.',
                    ' Estimate of sapwood area must be taken with caution')
            return(pi*(((pl_vars$pl_dbh[i] / 2))^2 - ((pl_vars$pl_dbh[i] / 2) - pl_vars$pl_sapw_depth[i])^2))
          } else {
            # if one or more mandatory variables are missing, return NA with a
            # messege
            message(pl_vars$pl_code[i], ' has no sapwood depth and/or ',
                    'dbh values.', ' Estimate of sapwood area ',
                    'can not be calculated. Returning NA.')
            return(NA)
          }
        }
      }
    }

    # STEP 2
    # Calculate the estimates, if possible
    res_vec <- vapply(seq_along(pl_vars$pl_code), helper, numeric(1))

    # STEP 3
    # Return the results
    pl_vars$pl_sapw_area_est <- res_vec
    return(pl_vars)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_sapw_area_calculator', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_sapw_area_calculator', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_sapw_area_calculator', sep = '.'))})

}

################################################################################
#' Unit conversion
#'
#' Conversion of sap flow units to sapwood level
#' (cm³·cm⁻²·h⁻¹), plant level (cm³·h⁻¹) or leaf area level (cm³·cm⁻²·h⁻¹)
#'
#' @family Unit conversion
#'
#' @param x Numeric value in which the conversion must be done
#'
#' @param sapw_area Numeric value with the plant sapwood area in cm²
#'
#' @param leaf_area Numeric value with the plant leaf area in m²
#'
#' @param output_units Character vector indicating the kind of output units.
#'   Allowed values are \code{'plant'}, \code{'sapwood'} and \code{'leaf'}.
#'
#' @return A numeric value resulting from unit conversion
#'
#' @export

# START
# Function declaration
qc_cm_cm_h <- function(x, sapw_area, leaf_area, output_units,
                       parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area)/(leaf_area*10000)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_cm_cm_h', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_cm_cm_h', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_cm_cm_h', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from cm³·m⁻²·h⁻¹
#'
#' @export

# START
# Function declaration
qc_cm_m_s <- function(x, sapw_area, leaf_area, output_units,
                      parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x*0.36
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area*0.36
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area*1e-4*0.36)/(leaf_area)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_cm_m_s', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_cm_m_s', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_cm_m_s', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from dm³·dm⁻²·h⁻¹
#'
#' @export

# START
# Function declaration
qc_dm_dm_h <- function(x, sapw_area, leaf_area, output_units,
                       parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x*10
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area*10
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area*1e-3)/(leaf_area)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_dm_dm_h', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_dm_dm_h', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_dm_dm_h', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from dm³·dm⁻²·s⁻¹
#'
#' @export

# START
# Function declaration
qc_dm_dm_s <- function(x, sapw_area, leaf_area, output_units,
                       parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x*36000
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area*36000
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area*3.6)/(leaf_area)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_dm_dm_s', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_dm_dm_s', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_dm_dm_s', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from mm³·mm⁻²·s⁻¹
#'
#' @export

# START
# Function declaration
qc_mm_mm_s <- function(x, sapw_area, leaf_area, output_units,
                       parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x*360
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area*360
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area*0.036)/(leaf_area)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_mm_mm_s', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_mm_mm_s', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_mm_mm_s', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from g·m⁻²·s⁻¹
#'
#' @export

# START
# Function declaration
qc_g_m_s <- function(x, sapw_area, leaf_area, output_units,
                     parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x*0.36
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area*0.36
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area*0.36*1e-4)/(leaf_area)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_g_m_s', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_g_m_s', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_g_m_s', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from kg·m⁻²·h⁻¹
#'
#' @export

# START
# Function declaration
qc_kg_m_h <- function(x, sapw_area, leaf_area, output_units,
                      parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x*1e-1
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area*1e-1
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area*1e-5)/(leaf_area)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_kg_m_h', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_kg_m_h', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_kg_m_h', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from kg·m⁻²·s⁻¹
#'
#' @export

# START
# Function declaration
qc_kg_m_s <- function(x, sapw_area, leaf_area, output_units,
                      parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x*360
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*sapw_area*360
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*sapw_area*0.036)/(leaf_area)
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_kg_m_s', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_kg_m_s', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_kg_m_s', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from cm³·h⁻¹
#'
#' @export

# START
# Function declaration
qc_cm_h <- function(x, sapw_area, leaf_area, output_units,
                    parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x/sapw_area
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*1e-4)/leaf_area
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_cm_h', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_cm_h', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_cm_h', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from dm³·h⁻¹
#'
#' @export

# START
# Function declaration
qc_dm_h <- function(x, sapw_area, leaf_area, output_units,
                    parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- (x*1e3)/sapw_area
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*1e3
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*1e-1)/leaf_area
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_dm_h', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_dm_h', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_dm_h', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from cm³·s⁻¹
#'
#' @export

# START
# Function declaration
qc_cm_s <- function(x, sapw_area, leaf_area, output_units,
                    parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- (x*3600)/sapw_area
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*3600
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*0.36)/leaf_area
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_cm_s', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_cm_s', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_cm_s', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from g·h⁻¹
#'
#' @export

# START
# Function declaration
qc_g_h <- function(x, sapw_area, leaf_area, output_units,
                   parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- x/sapw_area
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*1e-4)/leaf_area
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_g_h', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_g_h', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_g_h', sep = '.'))})

}

################################################################################
#' @describeIn qc_cm_cm_h Conversion of sap flow units from kg·h⁻¹
#'
#' @export

# START
# Function declaration
qc_kg_h <- function(x, sapw_area, leaf_area, output_units,
                    parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # If x is NA, return NA to avoid check for numeric error
    if (is.na(x)) {return(NA)}
    # Are values numeric?
    if (any(!is.numeric(x), !is.numeric(sapw_area), !is.numeric(leaf_area))) {
      stop('x, sapw_area and/or leaf_area are not numeric values')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Sapwood
    if (output_units == 'sapwood') {
      res <- (x*1e3)/sapw_area
      return(res)
    } else {

      # STEP 2
      # Plant
      if (output_units == 'plant') {
        res <- x*1e3
        return(res)
      } else {

        # STEP 3
        # Leaf area
        if (output_units == 'leaf') {
          res <- (x*1e-1)/leaf_area
          return(res)
        }
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_kg_h', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_kg_h', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_kg_h', sep = '.'))})

}

################################################################################
#' Sap flow units transformation
#'
#' Function to transform between sap flow units
#'
#' Sap flow accepted units can be of two kinds, \code{per sapwood area} and
#' \code{per plant}. Both kinds can come in many flavours and unit conversion
#' must be done to allow data integration and analysis.
#' This function can return three kind of units:
#' \describe{
#'   \item{\bold{Per sapwood  area}}{
#'   In this case, units returned are \eqn{cm³·cm⁻²·h⁻¹}
#'   }
#'   \item{\bold{Per plant}}{
#'   In this case, units returned are \eqn{cm³·h⁻¹}
#'   }
#'   \item{\bold{Per leaf area unit}}{
#'   In this case, units returned are \eqn{cm³·cm⁻²·h⁻¹}
#'   }
#' }
#'
#' @section Sapwood area:
#' If origin units are \emph{per sapwood area}, direct transformation is made. If
#' origin units are \emph{per plant} then \code{pl_sapw_area} variable from
#' plant metadata is needed to make the conversion.
#'
#' @section Plant:
#' If origin units are \emph{per plant}, direct transformation is made. If
#' origin units are \emph{per sapwood area} then \code{pl_sapw_area} variable
#' from plant metadata is needed to make the conversion.
#'
#' @section Leaf area:
#' If origin units are \emph{per plant} then \code{pl_leaf_area} variable from
#' plant metadata is needed to make the conversion. If origin units are
#' \emph{per sapwood area} then \code{pl_leaf_area} and \code{pl_sapw_area}
#' variables from plant metadata are needed.
#'
#' @section \code{pl_sapw_area}:
#' If \code{pl_sapw_area} is not available but \code{pl_sapw_depth} and
#' \code{pl_dbh} are provided, sapwood area value can be estimated by means of
#' \code{\link{qc_sapw_area_calculator}} function previous to the use of this
#' function.
#'
#' @family Quality Checks Functions
#'
#' @param data Data frame containing the sap flow measurements
#'
#' @param sapw_md Data frame containing the sapwood metadata, as obtained from
#'   \code{\link{qc_get_sapw_md}} or \code{\link{qc_sapw_area_calculator}}.
#'
#' @param output_units Character vector indicating the kind of output units.
#'   Allowed values are \code{'plant'}, \code{'sapwood'} and \code{'leaf'}.
#'   See details to obtain more information
#'
#' @export

# START
# Function declaration
qc_sapw_conversion <- function(data, sapw_md, output_units = 'plant',
                               parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Arguments checking
    # Are data and sapw_md data frames?
    if (any(!is.data.frame(data), !is.data.frame(sapw_md))) {
      stop('data and/or sapw_md objects are not data frames')
    }
    # Is output units a character vector?
    if (!is.character(output_units)) {
      stop('output_units value is not a character vector')
    }
    # Is output units a valid value?
    if (!(output_units %in% c('plant', 'sapwood', 'leaf'))) {
      stop('output_units = "', output_units, '" is not a valid value. See function ',
           'help (?qc_sapw_conversion) for a list of valid values')
    }

    # STEP 1
    # Needed objects

    # 1.1 create a list/dictionary with the conversion functions
    funs_list <- list(
      '“cm3 cm-2 h-1”' = sapfluxnetQC1::qc_cm_cm_h,
      '“cm3 m-2 s-1”' = sapfluxnetQC1::qc_cm_m_s,
      '“dm3 dm-2 h-1”' = sapfluxnetQC1::qc_dm_dm_h,
      '“dm3 dm-2 s-1”' = sapfluxnetQC1::qc_dm_dm_s,
      '“mm3 mm-2 s-1”' = sapfluxnetQC1::qc_mm_mm_s,
      '“g m-2 s-1”' = sapfluxnetQC1::qc_g_m_s,
      '“kg m-2 h-1”' = sapfluxnetQC1::qc_kg_m_h,
      '“kg m-2 s-1”' = sapfluxnetQC1::qc_kg_m_s,
      '“cm3 s-1”' = sapfluxnetQC1::qc_cm_s,
      '“cm3 h-1”' = sapfluxnetQC1::qc_cm_h,
      '“dm3 h-1”' = sapfluxnetQC1::qc_dm_h,
      '“g h-1”' = sapfluxnetQC1::qc_g_h,
      '“kg h-1”' = sapfluxnetQC1::qc_kg_h
    )

    # 1.2 TIMESTAMP variable is not needed for the loop, drop it
    data_tmp <- data
    data_tmp$TIMESTAMP <- NULL

    # 1.3 Results data frame, here TIMESTAMP is needed
    res_df <- data.frame(TIMESTAMP = data$TIMESTAMP,
                         stringsAsFactors = FALSE)

    # STEP 2
    # Loop for each plant/tree
    for (code in names(data_tmp)) {

      # 3.1 units, sapw area and leaf area values
      sapw_units <- as.character(sapw_md[sapw_md[,'pl_code'] == code, 'pl_sap_units'])
      sapw_area <- as.numeric(sapw_md[sapw_md[,'pl_code'] == code, 'pl_sapw_area'])
      leaf_area <- as.numeric(sapw_md[sapw_md[,'pl_code'] == code, 'pl_leaf_area'])

      # 3.2 vapply to convert all the plant measures
      plant_res <- vapply(
        data_tmp[[code]],
        funs_list[[sapw_units]],
        numeric(1),
        sapw_area = sapw_area, leaf_area = leaf_area, output_units = output_units,
        parent_logger = parent_logger
      )

      # 3.3 add the plant results to the data frame results
      res_df[[code]] <- plant_res
    }

    # STEP 4
    # Return the results
    return(res_df)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_sapw_conversion', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_sapw_conversion', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_sapw_conversion', sep = '.'))})

}

################################################################################
#' Radiation units transformation
#'
#' Function to transform between radiation units
#'
#' Radiation accepted measures can be of two kinds, \code{incoming photosynthetic photon flux density}
#' and \code{shortwave incoming radiation}. Unit conversion must be done to allow data
#' integration and analysis.
#' This function converts between:
#' \describe{
#'   \item{\bold{Incoming photosynthetic photon flux density}}{
#'   In this case, units returned are \eqn{{\mu}mol·m⁻²·s⁻¹}
#'   }
#'   \item{\bold{Shortwave incoming radiation}}{
#'   In this case, units returned are \eqn{W·m⁻²}
#'   }
#' }
#'
#' @section Incoming photosynthetic photon flux density:
#' Direct transformation is made from \emph{shortwave incoming radiation}.
#'
#' @section Shortwave incoming radiation:
#' Direct transformation is made from \emph{incoming photosynthetic photon flux density}.
#'
#' @family Quality Checks Functions
#'
#' @param data Data frame containing the environmental measurements
#'
#' @export

# START
# Function declaration
qc_rad_conversion <- function(data, parent_logger = 'test') {

  # Using calling handlers to logging
  withCallingHandlers({

    # STEP 0
    # Is data a data frame?
    if (!is.data.frame(data)) {
      stop('data object is not a data frame')
    }

    # STEP 1
    # Convert radiation values

    # 1.1 If both measures appear in the data frame, no transformation is made
    if (all(c('sw_in', 'ppfd_in') %in% names(data))){

      message('Radiation in both sw_in and ppfd_in units already exists. No transformation made.')

      # 1.2 If none of the measures appear in the data frame, no transformation is made,
      # with a warning
    } else if (all(!(c('sw_in', 'ppfd_in') %in% names(data)))){

      warning('Both sw_in and ppfd_in are missing. No transformation is possible.')

      # 1.3 If only sw_in appears in the data frame, transformation to ppfd_in is made
    } else if ('sw_in' %in% names(data)){

      # ppfd_in <- LakeMetabolizer::sw.to.par.base(data$sw_in)
      # data <- cbind(data, ppfd_in)
      # coefficient from Britton and Dodd (1976)
      data$ppfd_in <- data$sw_in * 2.114

      # 1.3 If only ppfd_in appears in the data frame, transformation to sw_in is made
    } else if ('ppfd_in' %in% names(data)){

      # sw_in <- LakeMetabolizer::par.to.sw.base(data$ppfd_in)
      # data <- cbind(data,sw_in)
      # coefficient from Britton and Dodd (1976)
      data$sw_in <- data$ppfd_in * 0.473

    }

    # STEP 2
    # Return the results
    return(data)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger, 'qc_rad_conversion', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger, 'qc_rad_conversion', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger, 'qc_rad_conversion', sep = '.'))})

}

################################################################################
#' Soil texture classification
#'
#' Function to classify soil texture
#'
#' Using the percentage of clay, silt and sand in the soil, soil
#' texture is calculated using the USDA classification if the category
#' is not given in the data frame.
#'
#' @family Quality Checks Functions
#'
#' @param data Data frame containing the data about the stand soil texture.
#'   It must have the variabes st_clay_perc, st_silt_perc, st_sand_perc and
#'   st_soil_texture.
#'
#'
#' @return The initial data frame with a new variable 'st_USDA_soil_texture'
#' which contains the soil texture if it is different from NA.
#'
#'
#' @export

# START
# Function declaration
qc_soil_texture <- function(data, parent_logger = 'test') {

  # Using calling handlers to manage errors
  withCallingHandlers({

    # STEP 0
    # Argument checks
    # Is data a data.frame?
    if (!is.data.frame(data)) {
      stop('Data is not a data frame')
    }
    # Are there the st_clay_perc, st_silt_perc, st_sand_perc and
    # st_soil_texture variables in data?
    if (any(is.null(data$st_clay_perc), is.null(data$st_silt_perc),
            is.null(data$st_sand_perc), is.null(data$st_soil_texture))) {
      stop('At least one of the required variables is missing in data')
    }

    # STEP 1
    # names and temp objects
    data_perc <- data.frame(CLAY = data$st_clay_perc,
                            SILT = data$st_silt_perc,
                            SAND = data$st_sand_perc,
                            row.names = 'Percentage')

    list_abbr <- list(Cl = 'clay', SiCl = 'silty clay', SaCl = 'sandy clay',
                      ClLo = 'clay loam', SiClLo = 'silty clay loam',
                      SaClLo = 'sandy clay loam', Lo = 'loam', SiLo = 'silty loam',
                      SaLo = 'sandy loam', Si = 'silt', LoSa = 'loamy sand',
                      Sa = 'sand')

    # STEP 2

    # 2.1 : check missing data about %
    # IF there is any percentage missing for clay, silt or sand

    #We use IF to see if there is any NA in the data.frame :
    #     --> if there are some NA : we read the category in st_soil_texture
    #     --> if there aren't any NA : we use the function of the package
    #         'soil texture'.
    if (any(is.na(data_perc))) {

      # If there is no information about clay, silt and sand and neither for
      # soil texture, the data frame remains the same and a warning message
      # appears to say that there is no info about the soil texture.

      if (is.na(data$st_soil_texture)){
        warning('There is no information about the soil texture, ',
                'returning the original data')
        return(data)
      } else {
        data$st_USDA_soil_texture <- tolower(data$st_soil_texture)
        message('One or more percentages are missing. ',
                'Soil classification taken from the original data')
        return(data)
      }
    } else {

      # 2.2 check the format of data (% or decimal ?)
      # Are the percentage given in decimal (0.1 instead of 10%) ?
      # Conversion to percentage if it is the case.
      if (sum (data_perc) <= 1 ) {
        data_perc <- data_perc * 100
      }

      # Check sum of the %
      # Is the sum of the percentages of clay, silt and sand equal to 100 ?
      if (sum(data_perc) != 100) {
        warning('The sum of the different percentages of clay, silt and sand is not equal to 100% ',
                'and soil texture can not be calculated')
        return(data)
      } else {

        # STEP 3
        # Obtain the soil texture class
        # 3.1 Using the package 'soiltexture', find the class of the texture of the soil
        tmp_soil_texture <- soiltexture::TT.points.in.classes(
          tri.data = data_perc,
          class.sys = 'USDA.TT', # We use the USDA classification
          PiC.type = 't') %>%
          stringr::str_split(., ", ")
        data$st_USDA_soil_texture <- list_abbr[[tmp_soil_texture[[1]][[1]]]]

        # 3.2 If soil texture class was already provided, check that it matches
        if (!is.na(data$st_soil_texture)){
          if (data$st_USDA_soil_texture != tolower(as.character(data$st_soil_texture))){
            warning('Calculated soil texture class differs ',
                    'from the class in the original data.')
          }
        }

        # 3.3 Return the data
        return(data)
      }
    }

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger,
                                                        'qc_soil_texture', sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger,
                                                       'qc_soil_texture', sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger,
                                                        'qc_soil_texture', sep = '.'))})
}

################################################################################
#' Solar time conversion
#'
#' Calculate the Extraterrestrial Radiation from the TIMESTAMP
#'
#' This function uses several functions from \code{solaR} package in order to
#' obtain the mean solar time, the equation of time for each day included in the
#' TIMESTAMP and the extraterrestrial radiation for each step of the TIMESTAMP.
#'
#' @section Apparent (Real) Solar Time:
#' The Apparent Solar Time is calculated as:
#' \deqn{Apparent Solar Time = Mean Solar Time + Equation of Time}
#' The Equation of Time is calculated for each day, whereas the Mean Solar Time
#' is calculated for each step of the TIMESTAMP.
#'
#' @family Quality Checks Functions
#'
#' @param data Environmental data frame containing the TIMESTAMP variable.
#'
#' @param site_md Data frame containing the latitude and longitude variables of
#'   the site (\code{si_lat} and \code{si_long})
#'
#' @param add_solar_ts Logical indicating if solar timestamp must be added to
#'   the environmental data frame.
#'
#' @return A data frame exactly as \code{data}, but with an additional column
#'   containing the extraterrestrial radiation in W/m2, and optionally another
#'   column containing apparent solar timestamp.
#'
#' @export

# START
# Function declaration
qc_ext_radiation <- function(data, site_md, add_solar_ts = FALSE,
                             parent_logger = 'test') {

  # Using calling handlers to manage errors
  withCallingHandlers({

    # STEP 0
    # Argument checks
    # Are data and site_md data frames?
    if (any(!is.data.frame(data), !is.data.frame(site_md))) {
      stop('data and/or site_md are not data frames')
    }
    # have data the timestamp variable?
    if (is.null(data$TIMESTAMP)) {
      stop('data has not a TIMESTAMP variable')
    }
    # have metadata objects the mandatory variables?
    if (any(is.null(site_md$si_lat), is.null(site_md$si_long))) {
      stop('site_md has not the needed variables. ',
           'See function help (?qc_solar_timestamp)')
    }
    # Is type a valid value?
    if (!is.logical(add_solar_ts)) {
      stop('add_solar_ts must be either TRUE or FALSE')
    }

    # STEP 1
    # Retrieve the accessory info
    lat <- site_md$si_lat
    long <- site_md$si_long
    timestamp <- data$TIMESTAMP

    # STEP 2
    # Intermediate objects
    # 2.2 Mean Solar Time
    mst <- solaR::local2Solar(timestamp, long)

    # 2.2.1 warning if solartimestamp has repeated values (due to rounding)
    if (length(mst) != length(unique(mst))) {
      warning('solar mean time generates repeated timestamps. ',
              'Please revise the original timestamp for repeated values.')
    }

    # STEP 3
    # Calculating Apparent Solar Time (Mean Solar Time + Equation of Time)
    # 2.1 Equation of time
    solD <- solaR::fSolD(lat, mst)
    EoT <- solaR::r2sec(solD$EoT)

    ast <- lapply(as.Date(strptime(zoo::index(EoT), format = '%Y-%m-%d')),
                  function(id, vect)
                    (vect[as.Date(vect) == id] +
                       zoo::coredata(EoT)[which(as.Date(strptime(zoo::index(EoT),
                                                                 format = '%Y-%m-%d')) == id)]),
                  vect = mst)

    ast <- do.call("c", ast)

    solD <- solaR::fSolD(lat, ast)
    solI <- zoo::coredata(solaR::fSolI(solD, BTi = ast)$Bo0)

    data$ext_rad <- solI

    if (add_solar_ts) {
      data$solarTIMESTAMP <- ast
    }

    # STEP 4
    # Return data frame with new columns
    return(data)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger,
                                                        'qc_ext_radiation',
                                                        sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger,
                                                       'qc_ext_radiation',
                                                       sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger,
                                                        'qc_ext_radiation',
                                                        sep = '.'))})
}

################################################################################
#' Calculation of VPD from rh and ta
#'
#' Calculate the VPD if needed from other environmental variables
#'
#' The calculations for this function were obtained from the REddyProc R package
#' (https://cran.r-project.org/package=REddyProc) by the MPI-BGC in Jena
#' licensed under GPL > 2
#'
#' @family Unit conversion
#'
#' @param data Data frame containing the environmental data
#'
#' @return a Data frame of the environmental data with the new VPD variable
#'   calculated
#'
#' @export

# START
# Function declaration
qc_vpd <- function(data, parent_logger = 'test') {

  # using calling handlers to manage errors
  withCallingHandlers({

    # STEP 0
    # Check arguments
    # data frame
    if (!is.data.frame(data)) {
      stop("data object is not a data frame")
    }

    # check variables
    if (any(is.null(data[['rh']]), is.null(data[['ta']]))) {
      stop("data not contains rh and/or ta variables")
    }

    # check if vpd already exists
    if (!is.null(data[['vpd']])) {
      warning("data already has a vpd variable. Please revise if there",
              " is really necessary to recalculate vpd")
      return(data)
    }

    # STEP 1
    # Get the values of ta and rh
    ta <- data[['ta']]
    rh <- data[['rh']]

    # STEP 2
    # Calculate the VPD
    vpd <- 0.61078 * (1 - rh / 100) * exp(17.08085 * ta / (234.175 + ta))

    # 2.1 check for sure that vpd is not negative, and if it is transform to 0
    vpd_checked <- dplyr::case_when(
      vpd < 0 ~ 0,
      TRUE ~ vpd
    )

    # STEP 3
    # Build the data res object
    data[['vpd']] <- vpd_checked

    # STEP 4
    # Return the data
    return(data)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger,
                                                        'qc_vpd',
                                                        sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger,
                                                       'qc_vpd',
                                                       sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger,
                                                        'qc_vpd',
                                                        sep = '.'))})
}

################################################################################
#' Calculation of rh from vpd and ta
#'
#' Calculate the rh if needed from other environmental variables
#'
#' The calculations for this function were obtained from "Plants and Microclimate"
#' by Hamlyn G. Jones (Cambridge University Press, 3rd Edition). The enhancement
#' factor that corrects for the slight departure of the behaviour of water in
#' air from that of a pure gas is NOT implemented
#'
#' @family Unit conversion
#'
#' @param data Data frame containing the environmental data
#'
#' @return a Data frame of the environmental data with the new rh variable
#'   calculated
#'
#' @export

# START
# Function declaration
qc_rh <- function(data, parent_logger = 'test') {

  # using calling handlers to manage errors
  withCallingHandlers({

    # STEP 0
    # Check arguments
    # data frame
    if (!is.data.frame(data)) {
      stop("data object is not a data frame")
    }

    # check variables
    if (any(is.null(data[['vpd']]), is.null(data[['ta']]))) {
      stop("data not contains vpd and/or ta variables")
    }

    # check if vpd already exists
    if (!is.null(data[['rh']])) {
      warning("data already has a rh variable. Please revise if there",
              " is really necessary to recalculate rh")
      return(data)
    }

    # STEP 1
    # Get the values of ta and vpd
    ta <- data[['ta']]
    vpd <- data[['vpd']]

    # STEP 2
    # Calculate the rh from sat_pd and vpd
    sat_pd <- 0.001 * 611.21 * exp((18.678 - (ta / 234.5)) * ta / (257.14 + ta))
    rh <- (1 - vpd / sat_pd) * 100

    # 2.1 check for sure that vpd is not negative, and if it is transform to 0
    rh_checked <- dplyr::case_when(
      rh > 100 ~ 100,
      TRUE ~ rh
    )

    # STEP 3
    # Build the data res object
    data[['rh']] <- rh_checked

    # STEP 4
    # Return the data
    return(data)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger,
                                                        'qc_rh',
                                                        sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger,
                                                       'qc_rh',
                                                       sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger,
                                                        'qc_rh',
                                                        sep = '.'))})
}

################################################################################
#' Presence of variables needed for transformations summary
#'
#' Summary table for variables needed for unit and any other kind of conversions
#'
#' This function generates a table (data frame) with information about the
#' presence of the variables needed for unit, radiation, solar time and others
#' data transformations/conversions.
#'
#' @family Unit conversion
#'
#' @param sfndata SfnData object for the site containing all the information
#'
#' @return A data frame with the following columns:
#'
#'   \itemize{
#'     \item{Variable: Variable name}
#'     \item{Location: Variable location (i.e. env_data or env_md)}
#'     \item{Trasformation: Tranformation/Conversion for whihc the variable is needed}
#'     \item{Presence: Logical indicating if the variable is present}
#'   }
#'
#' @export

# START
# Function declaration
qc_transformation_vars <- function(sfndata, parent_logger = 'test') {

  # Using calling handlers to manage errors
  withCallingHandlers({

    # STEP 0
    # Checking arguments
    # Is sfndata a SfnData object?
    if (!is(sfndata, "SfnData")) {
      stop('Data provided is not a SfnData object')
    }

    # STEP 1
    # Radiation conversion
    rad_vars <- c('sw_in', 'ppfd_in')
    rad_loc <- rep('env_data', length(rad_vars))
    rad_transf <- rep('radiation_conversion', length(rad_vars))
    rad_presence <- c(
      !is.null(get_env(sfndata)$sw_in),
      !is.null(get_env(sfndata)$ppfd_in)
    )

    # STEP 2
    # Extraterrestrial radiation
    exr_vars <- c('TIMESTAMP', 'si_lat', 'si_long')
    exr_loc <- c('env_data', 'site_md', 'site_md')
    exr_transf <- rep('solar_time', length(exr_vars))
    exr_presence <- c(
      !all(is.na(get_env(sfndata)$TIMESTAMP)),
      !all(is.na(get_site_md(sfndata)$si_lat)),
      !all(is.na(get_site_md(sfndata)$si_long))
    )

    # STEP 3
    # Sapflow unit transformations. Here we have to add units info
    sfu_vars <- c('pl_sap_units', 'pl_sapw_area', 'pl_leaf_area', 'pl_sap_units')
    sfu_loc <- c(rep('plant_md', length(sfu_vars) - 1),
                 unique(get_plant_md(sfndata)$pl_sap_units))
    sfu_transf <- rep('sapf_units', length(sfu_vars))
    sfu_presence <- c(
      !all(is.na(get_plant_md(sfndata)$pl_sap_units)),
      !all(is.na(get_plant_md(sfndata)$pl_sapw_area)),
      !all(is.na(get_plant_md(sfndata)$pl_leaf_area)),
      NA
    )

    # STEP 4
    # VPD & rh calculation
    vpd_vars <- c('rh', 'ta', 'vpd')
    vpd_loc <- rep('env_data', length(vpd_vars))
    vpd_transf <- rep('vpd_and_rh_calc', length(vpd_vars))
    vpd_presence <- c(
      !is.null(get_env(sfndata)$rh),
      !is.null(get_env(sfndata)$ta),
      !is.null(get_env(sfndata)$vpd)
    )

    # STEP n
    # combining vector for each transformation in a data frame
    vars <- c(rad_vars, exr_vars, vpd_vars, sfu_vars)
    loc <- c(rad_loc, exr_loc, vpd_loc, sfu_loc)
    transf <- c(rad_transf, exr_transf, vpd_transf, sfu_transf)
    presence <- c(rad_presence, exr_presence, vpd_presence, sfu_presence)

    # n.1 data frame
    res <- data.frame(
      Variable = vars,
      Location = loc,
      Transformation = transf,
      Presence = presence,
      stringsAsFactors = FALSE
    )

    return(res)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger,
                                                        'qc_transformation_vars',
                                                        sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger,
                                                       'qc_transformation_vars',
                                                       sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger,
                                                        'qc_transformation_vars',
                                                        sep = '.'))})
}

################################################################################
#' Transformations list
#'
#' Show all the transformations indicating which ones can be done with the data
#' provided.
#'
#' The data frame returned by this function is intended to use it in the next
#' level, allowing automatized transformations depending on the available
#' variables.
#'
#' @family Unit conversion
#'
#' @param transf_info Data frame with info about the variables needed for
#'   transformations as generated by \code{\link{qc_transformation_vars}}
#'
#' @return A data frame with the following columns:
#'
#'   \itemize{
#'     \item{Transformation: Transformation/Conversion name}
#'     \item{Available: Logical indicating if the transformation is possible}
#'   }
#'
#' @export

# START
# Function declaration
qc_transf_list <- function(transf_info, parent_logger = 'test') {

  # Using calling handlers to manage errors
  withCallingHandlers({

    # STEP 0
    # Argument checks
    if (!is.data.frame(transf_info)) {
      stop('trans_info provided is not a data.frame')
    }

    # STEP 1
    # Radiation conversion
    rad_transf <- 'radiation_conversion'
    rad_info <- transf_info %>%
      dplyr::filter(Transformation == 'radiation_conversion')
    if (all(rad_info$Presence) | all(!rad_info$Presence)) {
      rad_avail <- FALSE
    } else {
      rad_avail <- TRUE
    }

    # STEP 2
    # Extraterrestrial radiation
    exr_trasnf <- 'solar_time'
    exr_info <- transf_info %>%
      dplyr::filter(Transformation == 'solar_time')
    if (all(exr_info$Presence)) {
      exr_avail <- TRUE
    } else {exr_avail <- FALSE}

    # STEP 3
    # Sapflow unit conversions
    sfu_info <- transf_info %>%
      dplyr::filter(Transformation == 'sapf_units')

    # 3.0 get the units for plant and the units for sapwood
    sapwood_level_units <- c(
      '“cm3 cm-2 h-1”',
      '“cm3 m-2 s-1”',
      '“dm3 dm-2 h-1”',
      '“dm3 dm-2 s-1”',
      '“mm3 mm-2 s-1”',
      '“g m-2 s-1”',
      '“kg m-2 h-1”',
      '“kg m-2 s-1”'
    )

    plant_level_units <- c(
      '“cm3 s-1”',
      '“cm3 h-1”',
      '“dm3 h-1”',
      '“g h-1”',
      '“kg h-1”'
    )

    # 3.1 plant level
    # 3.1.1 if origin units are plant level,
    #       automatically the conversion is available
    if (sfu_info[4, 'Location'] %in% plant_level_units) {
      sfu_plant_avail <- TRUE
    } else {
      sfu_plant_avail <- all(sfu_info$Presence[1:2])
    }
    sfu_plant_transf <- 'sapf_units_to_plant'

    # sfu_info_plant <- sfu_info %>%
    #   dplyr::filter(Variable != 'pl_leaf_area')
    # sfu_plant_trasnf <- 'sapf_units_to_plant'
    # sfu_plant_avail <- all(sfu_info_plant$Presence)

    # 3.2 sapwood level (is the same that for plant)
    # 3.2.1 if origin units are sapwood level,
    #       automatically the conversion is available
    if (sfu_info[4, 'Location'] %in% sapwood_level_units) {
      sfu_sapw_avail <- TRUE
    } else {
      sfu_sapw_avail <- all(sfu_info$Presence[1:2])
    }
    sfu_sapw_transf <- 'sapf_units_to_sapwood'

    # sfu_sapw_trasnf <- 'sapf_units_to_sapwood'
    # sfu_sapw_avail <- all(sfu_info_plant$Presence)

    # 3.3 leaf area level
    # 3.3.1 depending on the origin units level we need one or another
    if (sfu_info[4, 'Presence'] %in% plant_level_units) {
      sfu_leaf_avail <- all(sfu_info$Presence[c(1,3)])
    } else {
      sfu_leaf_avail <- all(sfu_info$Presence[c(1:3)])
    }
    sfu_leaf_transf <- 'sapf_units_to_leaf_area'

    # sfu_info_leaf <- sfu_info
    # sfu_leaf_transf <- 'sapf_units_to_leaf_area'
    # sfu_leaf_avail <- all(sfu_info_leaf$Presence)

    # STEP 4
    # VPD calculation
    vpd_info <- transf_info %>%
      dplyr::filter(Transformation == 'vpd_and_rh_calc')
    vpd_transf <- 'VPD_calculation'

    if (vpd_info[3, 'Presence']) {
      vpd_avail <- FALSE
    } else {
      if (!vpd_info[1, 'Presence'] | !vpd_info[2, 'Presence']) {
        vpd_avail <- FALSE
      } else {
        vpd_avail <- TRUE
      }
    }

    # STEP 5
    # rh calculation
    rh_info <- vpd_info
    rh_transf <- 'rh_calculation'

    if (rh_info[1, 'Presence']) {
      rh_avail <- FALSE
    } else {
      if (!rh_info[2, 'Presence'] | !rh_info[3, 'Presence']) {
        rh_avail <- FALSE
      } else {
        rh_avail <- TRUE
      }
    }

    # STEP n
    # build res data frame and return it
    transf <- c(rad_transf, exr_trasnf, vpd_transf, rh_transf, sfu_plant_transf,
                sfu_sapw_transf, sfu_leaf_transf)
    avail <- c(rad_avail, exr_avail, vpd_avail, rh_avail, sfu_plant_avail,
               sfu_sapw_avail, sfu_leaf_avail)

    res <- data.frame(
      Transformation = transf,
      Available = avail,
      stringsAsFactors = FALSE
    )

    return(res)

    # END FUNCTION
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger,
                                                        'qc_transf_list',
                                                        sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger,
                                                       'qc_transf_list',
                                                       sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger,
                                                        'qc_transf_list',
                                                        sep = '.'))})
}

################################################################################
#' Units process
#'
#' This function checks for available transformations and perform them if needed
#'
#' List of available transformations are obtained from \code{\link{qc_transf_list}}
#'
#' @family Unit conversion
#'
#' @param sfndata SfnData object to perform the conversions
#'
#' @return An SfnData object with the newly calculated variables included
#'
#' @export

# START FUNCTION
# Function declaration
qc_units_process <- function(sfndata, parent_logger = 'test') {

  # using calling handlers to manage errors
  withCallingHandlers({
    # STEP 0
    # Argument checks
    if (!is(sfndata, "SfnData")) {
      stop('Data provided is not a SfnData object')
    }

    # progress message
    message(
      'Unit conversion for ', get_si_code(sfndata)[1]
    )

    # STEP 1
    # Get the transformation list
    transf_list <- qc_transf_list(
      qc_transformation_vars(sfndata, parent_logger = parent_logger),
      parent_logger = parent_logger
    )

    rownames(transf_list) <- transf_list[['Transformation']]

    # STEP 2
    # Radiation conversion
    if (transf_list['radiation_conversion', 'Available']) {

      # progress message
      message(
        'Radiation units'
      )

      env_data <- get_env(sfndata)
      env_modf <- qc_rad_conversion(env_data, parent_logger = parent_logger)
      env_flags <- get_env_flags(sfndata)
      vars_names <- names(env_modf)[!(names(env_modf) %in% names(env_flags))]
      vars_to_create <- as.list(rep('CALCULATED', length(vars_names)))
      names(vars_to_create) <- vars_names
      env_flags_modf <- env_flags %>%
        dplyr::mutate(!!! vars_to_create) %>%
        dplyr::select(names(env_modf))

      get_env(sfndata) <- env_modf[,-1]
      get_env_flags(sfndata) <- env_flags_modf[,-1]
    }

    # STEP 3
    # VPD
    if (transf_list['VPD_calculation', 'Available']) {

      # progress message
      message(
        'VPD'
      )

      env_data <- get_env(sfndata)
      env_modf <- qc_vpd(env_data, parent_logger = parent_logger)
      env_flags <- get_env_flags(sfndata)
      vars_names <- names(env_modf)[!(names(env_modf) %in% names(env_flags))]
      vars_to_create <- as.list(rep('CALCULATED', length(vars_names)))
      names(vars_to_create) <- vars_names
      env_flags_modf <- env_flags %>%
        dplyr::mutate(!!! vars_to_create) %>%
        dplyr::select(names(env_modf))

      # 3.1 modify the env_data from the sfndata
      get_env(sfndata) <- env_modf[,-1]
      get_env_flags(sfndata) <- env_flags_modf[,-1]
    }

    # STEP 4
    # rh
    if (transf_list['rh_calculation', 'Available']) {

      # progress message
      message(
        'Relative humidity units'
      )

      env_data <- get_env(sfndata)
      env_modf <- qc_rh(env_data, parent_logger = parent_logger)
      env_flags <- get_env_flags(sfndata)
      vars_names <- names(env_modf)[!(names(env_modf) %in% names(env_flags))]
      vars_to_create <- as.list(rep('CALCULATED', length(vars_names)))
      names(vars_to_create) <- vars_names
      env_flags_modf <- env_flags %>%
        dplyr::mutate(!!! vars_to_create) %>%
        dplyr::select(names(env_modf))

      # 4.1 modify the env_data from the sfndata
      get_env(sfndata) <- env_modf[,-1]
      get_env_flags(sfndata) <- env_flags_modf[,-1]
    }

    # STEP 5
    # Solar Time
    if (transf_list['solar_time', 'Available']) {

      # progress message
      message(
        'Extraterrestrial radiation and solarTIMESTAMP'
      )

      env_data <- get_env(sfndata)
      site_md <- get_site_md(sfndata)
      env_modf <- qc_ext_radiation(
        env_data, site_md, add_solar_ts = TRUE,
        parent_logger = parent_logger
      )

      env_flags <- get_env_flags(sfndata)
      env_flags_modf <- env_flags %>%
        dplyr::mutate(ext_rad = 'CALCULATED')

      # 5.1 add the solar timestamp to the SfnData
      get_solar_timestamp(sfndata) <- env_modf[['solarTIMESTAMP']]

      # 5.2 modify the env_data from the sfndata
      get_env(sfndata) <- env_modf %>%
        dplyr::select(-TIMESTAMP, -solarTIMESTAMP) %>%
        as.data.frame(stringsAsFactors = FALSE)

      get_env_flags(sfndata) <- env_flags_modf %>%
        dplyr::select(-TIMESTAMP)
    }

    # STEP 6
    # sapf_units
    # 6.1 get the sapwood metadata
    sapw_md <- get_plant_md(sfndata) %>%
      qc_get_sapw_md(parent_logger = parent_logger) %>%
      qc_sapw_area_calculator(parent_logger = parent_logger)

    # 6.2 to plant
    if (transf_list['sapf_units_to_plant', 'Available']) {

      # progress message
      message(
        'Sapflow plant level'
      )

      # 6.2.1 get the sapf_modif
      sapf_modf <- get_sapf(sfndata) %>%
        qc_sapw_conversion(
          sapw_md, output_units = 'plant', parent_logger = parent_logger
        )

      # 6.2.2 get the plant_md
      plant_md <- get_plant_md(sfndata)

      # 6.2.3 modify the sapf data and the plant md to add the units
      sfndata_plant <- sfndata

      get_sapf(sfndata_plant) <- sapf_modf %>%
        dplyr::select(-TIMESTAMP) %>%
        as.data.frame(stringsAsFactors = FALSE)

      get_plant_md(sfndata_plant) <- plant_md %>%
        dplyr::mutate(pl_sap_units_orig = pl_sap_units,
                      pl_sap_units = "“cm3 h-1”")

      # 6.2.4 write the plant SfnData object
      df_write_SfnData(sfndata_plant, 'unit_trans', 'plant',
                       parent_logger = parent_logger)
    }

    # 6.3 to sapwood
    if (transf_list['sapf_units_to_sapwood', 'Available']) {

      # progress message
      message(
        'Sapflow sapwood level'
      )

      # 6.3.1 get the sapf_modif
      sapf_modf <- get_sapf(sfndata) %>%
        qc_sapw_conversion(
          sapw_md, output_units = 'sapwood', parent_logger = parent_logger
        )

      # 6.3.2 get the plant md
      plant_md <- get_plant_md(sfndata)

      # 6.3.3 modify the sapf data from the sfndata
      sfndata_sapwood <- sfndata

      get_sapf(sfndata_sapwood) <- sapf_modf %>%
        dplyr::select(-TIMESTAMP) %>%
        as.data.frame(stringsAsFactors = FALSE)

      get_plant_md(sfndata_sapwood) <- plant_md %>%
        dplyr::mutate(pl_sap_units_orig = pl_sap_units,
                      pl_sap_units = "“cm3 cm-2 h-1”")

      # 6.3.4 write the plant SfnData object
      df_write_SfnData(sfndata_sapwood, 'unit_trans', 'sapwood',
                       parent_logger = parent_logger)
    }

    # 6.4 to leaf
    if (transf_list['sapf_units_to_leaf', 'Available']) {

      # progress message
      message(
        'Sapflow leaf level'
      )

      # 6.4.1 get the sapf_modif
      sapf_modf <- get_sapf(sfndata) %>%
        qc_sapw_conversion(
          sapw_md, output_units = 'leaf', parent_logger = parent_logger
        )

      # 6.4.2 get the plant md
      plant_md <- get_plant_md(sfndata)

      # 6.4.2 modify the sapf data from the sfndata
      sfndata_leaf <- sfndata

      get_sapf(sfndata_leaf) <- sapf_modf %>%
        dplyr::select(-TIMESTAMP) %>%
        as.data.frame(stringsAsFactors = FALSE)

      get_plant_md(sfndata_leaf) <- plant_md %>%
        dplyr::mutate(pl_sap_units_orig = pl_sap_units,
                      pl_sap_units = "“cm3 cm-2 h-1”")

      # 6.4.3 write the plant SfnData object
      df_write_SfnData(sfndata_leaf, 'unit_trans', 'leaf',
                       parent_logger = parent_logger)
    }
  },

  # handlers
  warning = function(w){logging::logwarn(w$message,
                                         logger = paste(parent_logger,
                                                        'qc_units_process',
                                                        sep = '.'))},
  error = function(e){logging::logerror(e$message,
                                        logger = paste(parent_logger,
                                                       'qc_units_process',
                                                       sep = '.'))},
  message = function(m){logging::loginfo(m$message,
                                         logger = paste(parent_logger,
                                                        'qc_units_process',
                                                        sep = '.'))})

}