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

# root folder
knitr::opts_knit$set(root.dir = params$wd)
knitr::opts_chunk$set(error = TRUE, echo = FALSE)

# log setup
logger_name <- paste(
  'LVL2', params$code, 'qc_units_process', 'rep_sfn_render',
  sep = '.'
)

sapfluxnetQC1::log_sapfluxnet_setup(
  'Logs/sapfluxnet.log',
  logger = logger_name,
  level = 'DEBUG'
)

---

SITE: r params$code

---

# libraries
library(sapfluxnetQC1)
library(dplyr)
library(DT)

# data rem
sfndata_rem <- df_read_SfnData(
  params$code,
  level = 'out_rem', units = NULL,
  parent_logger = logger_name
)

# transformation list
transf_list <- qc_transf_list(
  qc_transformation_vars(sfndata_rem, parent_logger = logger_name),
  parent_logger = logger_name
)

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

if (transf_list['sapf_units_to_plant', 'Available']) {

  # data
  sfndata_plant <- df_read_SfnData(
    params$code,
    level = 'unit_trans', units = 'plant',
    parent_logger = logger_name
  )
} else {
  sfndata_plant <- NULL
}

if (transf_list['sapf_units_to_sapwood', 'Available']) {

  # data
  sfndata_sapwood <- df_read_SfnData(
    params$code,
    level = 'unit_trans', units = 'sapwood',
    parent_logger = logger_name
  )
} else {
  sfndata_sapwood <- NULL
}

if (transf_list['sapf_units_to_leaf', 'Available']) {

  # data
  sfndata_leaf <- df_read_SfnData(
    params$code,
    level = 'unit_trans', units = 'leaf',
    parent_logger = logger_name
  )
} else {
  sfndata_leaf <- NULL
}

# env_data only once, but we dont know a priori from where, so ifs
if (!is.null(sfndata_plant)) {

  if (transf_list['radiation_conversion', 'Available']) {

    old_ppfd_in <- get_env(sfndata_rem)[['ppfd_in']]
    if (is.null(old_ppfd_in)) {old_ppfd_in <- NA}

    old_sw_in <- get_env(sfndata_rem)[['sw_in']]
    if (is.null(old_sw_in)) {old_sw_in <- NA}

    radiation <- data.frame(
      old_ppfd_in = old_ppfd_in,
      old_sw_in = old_sw_in,
      new_ppfd_in = get_env(sfndata_plant)[['ppfd_in']],
      new_sw_in = get_env(sfndata_plant)[['sw_in']]
    )
  } else {
    radiation <- data.frame(
      old_ppfd_in = old_ppfd_in,
      old_sw_in = old_sw_in
    )
  }

  if (transf_list['VPD_calculation', 'Available']) {
    vpd <- data.frame(
      new_vpd = get_env(sfndata_plant)[['vpd']]
    )
  } else {
    vpd <- data.frame(
      old_vpd = get_env(sfndata_rem)[['vpd']],
      new_vpd = get_env(sfndata_plant)[['vpd']]
    )
  }

  if (transf_list['rh_calculation', 'Available']) {
    rh <- data.frame(
      new_rh = get_env(sfndata_plant)[['rh']]
    )
  } else {
    rh <- data.frame(
      old_rh = get_env(sfndata_rem)[['rh']],
      new_rh = get_env(sfndata_plant)[['rh']]
    )
  }

  if (transf_list['solar_time', 'Available']) {
    timestamp <- data.frame(
      TIMTESTAMP = get_timestamp(sfndata_plant),
      solarTIMESTAMP = get_solar_timestamp(sfndata_plant),
      new_ext_rad = get_env(sfndata_plant)[['ext_rad']]
    )
  } else {
    timestamp <- data.frame(
      TIMTESTAMP = get_timestamp(sfndata_plant)
    )
  }
} else {
  if (!is.null(sfndata_sapwood)) {

    if (transf_list['radiation_conversion', 'Available']) {

      old_ppfd_in <- get_env(sfndata_rem)[['ppfd_in']]
      if (is.null(old_ppfd_in)) {old_ppfd_in <- NA}

      old_sw_in <- get_env(sfndata_rem)[['sw_in']]
      if (is.null(old_sw_in)) {old_sw_in <- NA}

      radiation <- data.frame(
        old_ppfd_in = old_ppfd_in,
        old_sw_in = old_sw_in,
        new_ppfd_in = get_env(sfndata_sapwood)[['ppfd_in']],
        new_sw_in = get_env(sfndata_sapwood)[['sw_in']]
      )
    } else {
      radiation <- data.frame(
        old_ppfd_in = old_ppfd_in,
        old_sw_in = old_sw_in
      )
    }

    if (transf_list['VPD_calculation', 'Available']) {
      vpd <- data.frame(
        new_vpd = get_env(sfndata_sapwood)[['vpd']]
      )
    } else {
      vpd <- data.frame(
        old_vpd = get_env(sfndata_rem)[['vpd']],
        new_vpd = get_env(sfndata_sapwood)[['vpd']]
      )
    }

    if (transf_list['rh_calculation', 'Available']) {
      rh <- data.frame(
        new_rh = get_env(sfndata_sapwood)[['rh']]
      )
    } else {
      rh <- data.frame(
        old_rh = get_env(sfndata_rem)[['rh']],
        new_rh = get_env(sfndata_sapwood)[['rh']]
      )
    }

    if (transf_list['solar_time', 'Available']) {
      timestamp <- data.frame(
        TIMTESTAMP = get_timestamp(sfndata_sapwood),
        solarTIMESTAMP = get_solar_timestamp(sfndata_sapwood),
        new_ext_rad = get_env(sfndata_sapwood)[['ext_rad']]
      )
    } else {
      timestamp <- data.frame(
        TIMTESTAMP = get_timestamp(sfndata_sapwood)
      )
    }
  } else {
    if (!is.null(sfndata_leaf)) {

      if (transf_list['radiation_conversion', 'Available']) {

        old_ppfd_in <- get_env(sfndata_rem)[['ppfd_in']]
        if (is.null(old_ppfd_in)) {old_ppfd_in <- NA}

        old_sw_in <- get_env(sfndata_rem)[['sw_in']]
        if (is.null(old_sw_in)) {old_sw_in <- NA}

        radiation <- data.frame(
          old_ppfd_in = old_ppfd_in,
          old_sw_in = old_sw_in,
          new_ppfd_in = get_env(sfndata_leaf)[['ppfd_in']],
          new_sw_in = get_env(sfndata_leaf)[['sw_in']]
        )
      } else {
        radiation <- data.frame(
          old_ppfd_in = old_ppfd_in,
          old_sw_in = old_sw_in
        )
      }

      if (transf_list['VPD_calculation', 'Available']) {
        vpd <- data.frame(
          new_vpd = get_env(sfndata_leaf)[['vpd']]
        )
      } else {
        vpd <- data.frame(
          old_vpd = get_env(sfndata_rem)[['vpd']],
          new_vpd = get_env(sfndata_leaf)[['vpd']]
        )
      }

      if (transf_list['rh_calculation', 'Available']) {
        rh <- data.frame(
          new_rh = get_env(sfndata_leaf)[['rh']]
        )
      } else {
        rh <- data.frame(
          old_rh = get_env(sfndata_rem)[['rh']],
          new_rh = get_env(sfndata_leaf)[['rh']]
        )
      }

      if (transf_list['solar_time', 'Available']) {
        timestamp <- data.frame(
          TIMTESTAMP = get_timestamp(sfndata_leaf),
          solarTIMESTAMP = get_solar_timestamp(sfndata_leaf),
          new_ext_rad = get_env(sfndata_leaf)[['ext_rad']]
        )
      } else {
        timestamp <- data.frame(
          TIMTESTAMP = get_timestamp(sfndata_leaf)
        )
      }
    }
  }
}

summary_table <- dplyr::bind_cols(
  timestamp, radiation, vpd, rh
)

Available transformations

transf_list %>%
  DT::datatable(class = 'display compact', rownames = FALSE, filter = 'none',
                extensions = c('Scroller'),
                caption = 'Available transformations',
                options = list(dom = 'ti',
                               columnDefs = list(list(className = 'dt-right',
                                                      targets = 0),
                                                 list(className = 'dt-center',
                                                      targets = 1)),
                               scroller = TRUE, scrollY = 450,
                               scrollCollapse = TRUE)) %>%
  DT::formatStyle('Available',
                  backgroundColor = styleEqual(c('FALSE', 'TRUE'),
                                               c('#d91e18', '#26a65b')))

Summary of transformations

summary_table %>%
  DT::datatable(class = 'display compact', rownames = FALSE, filter = 'none',
                extensions = c('Scroller'),
                caption = 'Summary',
                options = list(dom = 'ti',
                               scroller = TRUE, scrollY = 450,
                               scrollCollapse = TRUE))

sapfluxnet/sapfluxnetQC1 documentation built on May 29, 2019, 1:50 p.m.