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

################################################################################
# libraries
library(flexdashboard)
library(sapfluxnetQC1)
library(readr)
library(dplyr)
library(tidyr)
library(dygraphs)
library(stringr)
library(leaflet)
library(ggplot2)
library(ggiraph)
# library(plotly)

################################################################################
# events and reactives

## QC button
observeEvent(
  eventExpr = input$qc_button,
  handlerExpr = source('main_script.R')
)

## Update_files button
observeEvent(
  eventExpr = input$update_button,
  handlerExpr = df_copy_templates()
)

## Refresh button (sites and reports)
sites <- eventReactive(
  eventExpr = input$refresh_button,
  valueExpr = list.dirs('Data', full.names = FALSE, recursive = FALSE)
)

report_list <- eventReactive(
  eventExpr = input$refresh_button,
  valueExpr = list.files('Reports', full.names = TRUE, recursive = TRUE)
)

## number of sites stored in LVL1 (QC passed)
qc_ran_n <- reactive({
  qc_ran <- 0

  statuses <- purrr::map(sites(), ~ sapfluxnetQC1::df_get_status(.x, NULL))

  for (status in statuses) {
    if (!is.logical(status)) {
      if (status[['LVL1']][['STORED']]) {qc_ran <- qc_ran + 1}
    }
  }

  # for (si in sites()) {
  #   status <- sapfluxnetQC1::df_get_status(si, parent_logger = NULL)
  #   if (status$LVL1$STORED) {qc_ran <- qc_ran + 1}
  # }

  qc_ran
})

## number of sites stored in LVL2 (QC ok)
qc_ok_n <- reactive({
  qc_ok <- 0

  statuses <- purrr::map(sites(), ~ sapfluxnetQC1::df_get_status(.x, NULL))

  for (status in statuses) {
    if (!is.logical(status)) {
      if (status[['LVL2']][['STORED']]) {qc_ok <- qc_ok + 1}
    }
  }

  # for (si in sites()) {
  #   status <- sapfluxnetQC1::df_get_status(si, parent_logger = NULL)
  #   if (status$LVL2$STORED) {qc_ok <- qc_ok + 1}
  # }

  qc_ok
})

## Log
log_lines <- reactiveFileReader(1000, session = getDefaultReactiveDomain(),
                                filePath = file.path('Logs', 'sapfluxnet.log'),
                                readFunc = read_csv, col_names = c('Entries'))

## Get data (SfnData)
load_sfn_data <- reactive({
  load(file.path('Data', input$site_sel, input$level_sel,
                 paste0(input$site_sel, '.RData')))
  sfn_data <- eval(as.name(input$site_sel))
  return(sfn_data)
})

load_sfn_data_vs <- reactive({
  load(file.path('Data', input$site_sel_vs, input$level_sel_vs,
                 paste0(input$site_sel_vs, '.RData')))
  sfn_data_vs <- eval(as.name(input$site_sel_vs))
  return(sfn_data_vs)
})

################################################################################
## Helper functions
# dyCrosshair plugin

# NOT NEEDED ANYMORE AS DYGRAPHS HAS NOW ITS OWN METHOD FOR CROSSHAIRS!!!!!

# dyCrosshair <- function(dygraph, 
#                         direction = c("both", "horizontal", "vertical")) {
#   dyPlugin(
#     dygraph = dygraph,
#     name = "Crosshair",
#     path = system.file("examples/plugins/crosshair.js", 
#                        package = "dygraphs"),
#     options = list(direction = match.arg(direction))
#   )
# }

# load and bind
load_and_bind <- function(metadata) {
  code_list <- list.files(file.path("Data"))

  object_list <- lapply(
    code_list,
    function(x) {
      if (file.exists(file.path('Data', x, 'Lvl_1', paste0(x, '.RData')))) {
        load(file.path('Data', x, 'Lvl_1', paste0(x, '.RData')))
        return(eval(as.name(x)))
      }
    }
  )

  if (metadata == 'site_md') {
    res <- lapply(object_list[!vapply(object_list, is.null, logical(1))],
                  get_site_md) %>% bind_rows
  }
  if (metadata == 'stand_md') {
    res <- lapply(object_list[!vapply(object_list, is.null, logical(1))],
                  get_stand_md) %>% bind_rows
  }
  if (metadata == 'species_md') {
    res <- lapply(object_list[!vapply(object_list, is.null, logical(1))],
                  get_species_md) %>% bind_rows
  }
  if (metadata == 'plant_md') {
    res <- lapply(
      object_list[!vapply(object_list, is.null, logical(1))],
      function(x) {
        tmp <- get_plant_md(x)
        tmp$pl_name <- as.character(tmp$pl_name)
        tmp
      }
    ) %>% bind_rows
  }
  if (metadata == 'env_md') {
    res <- lapply(object_list[!vapply(object_list, is.null, logical(1))],
                  get_env_md) %>% bind_rows
  }

  return(res)
}

Control Panel {data-icon="ion-ios-settings-strong"}

Sidebar {.sidebar data-width=200}

Controls

Press Refresh! to start and update counts and report list. Log is autoupdated every second.

# refresh button
actionButton("refresh_button", "Refresh!",
             icon = icon("refresh", lib = "glyphicon"))

tags$br()
tags$br()
tags$br()

Press Do QC! button to run the Quality Control script.

# run QC button
actionButton('qc_button', 'Do QC!',
             icon = icon("record", lib = "glyphicon"))

tags$br()
tags$br()
tags$br()

Press Update files button to update templates and scripts files after an update in sapfluxnetQC1 package.

actionButton('update_button', 'Update files',
             icon = icon("download-alt", lib = "glyphicon"))

Row

Datasets received {.value-box}

# render the valueBox with the sites
renderValueBox({
  number_of_sites <- length(sites())
  valueBox(
    number_of_sites,
    icon = 'ion-archive',
    color = if (number_of_sites < 50) {"danger"} else {
      if (number_of_sites < 100) {"warning"} else {
        "success"
      }
    }
  )
})

Datasets QC ran {.value-box}

# render the valueBox with the sites
renderValueBox({
  valueBox(
    qc_ran_n(),
    icon = 'ion-ios-cog',
    color = if (qc_ran_n() < length(sites())) {"warning"} else {
      if (qc_ran_n() == length(sites())) {"success"} else {
        "danger"
      }
    }
  )
})

Datasets QC OK {.value-box}

# render the valueBox with the sites
renderValueBox({
  valueBox(
    qc_ok_n(),
    icon = 'ion-android-checkmark-circle',
    color = 'success'
  )
})

Row {.tabset .tabset-fade}

Reports

fillCol(width = '100%', flex = c(NA),
        uiOutput('reports_ui',
                 style = "overflow-y:scroll; max-height: 400px"))

output$reports_ui <- renderUI({
  rep_links <- vector()
  for (report in report_list()) {
    rep_i <- paste0('http://158.109.46.35:8787/file_show?path=/sapfluxnet/',
                    report)
    rep_links <- c(rep_links, rep_i)
  }

  link_list <- list(quote(tags$html))
  for (i in 1:length(rep_links)) {
    link_list <- c(link_list,
                   match.call(a, call("a", href = rep_links[i],
                                      report_list()[i])),
                   match.call(br, call("br")))
  }

  links_call <- as.call(link_list)
  eval(links_call)
})

Log

renderTable({
  log_lines()
})

Manual Changes Log

site_list <- list.dirs('Data', full.names = FALSE, recursive = FALSE)
fillCol(width = '100%', flex = c(NA),
        selectInput('site_sel_man', label = 'Select site by code:',
                    choices = site_list, selected = site_list[1]),
        uiOutput('include_txt', style = "overflow-y:scroll; max-height: 400px"))

output$include_txt <- renderUI(
  if (file.exists(file.path('Data', input$site_sel_man,
                            paste0(input$site_sel_man,
                                   '_manual_changes.txt')))) {
    pre(includeText(file.path('Data', input$site_sel_man,
                              paste0(input$site_sel_man,
                                     '_manual_changes.txt'))))
  } else {
    tags$h2('No manual changes file found for this site')
  }
)

Site Notes

fillRow(height = '100%', flex = c(1, 1),
        fillCol(width = '100%', flex = c(NA, NA, 1, NA),
                selectInput('site_sel_notes', label = 'Select site by code:',
                            choices = site_list, selected = site_list[1]),
                # textInput('notes', 'Notes to add', width = '100%'),
                tags$h4('Notes to add'),
                tags$textarea(id = 'notes', rows = 10, cols = 80),
                actionButton("write_button", "Add note",
                             icon = icon("pencil", lib = "glyphicon"))),
        uiOutput('site_notes', style = "overflow-y:scroll; max-height: 400px")
)

add_notes <- function(file, string) {
  write(string, file = file, append = TRUE)
}

observeEvent(
  eventExpr = input$write_button,
  handlerExpr = {
    add_notes(
      string = input$notes,
      file = file.path('Data', input$site_sel_notes,
                       paste0(input$site_sel_notes,
                              '_notes.txt'))
    )
  }
)

output$site_notes <- renderUI(
  if (file.exists(file.path('Data', input$site_sel_notes,
                            paste0(input$site_sel_notes,
                                   '_notes.txt')))) {
    pre(includeText(file.path('Data', input$site_sel_notes,
                              paste0(input$site_sel_notes,
                                     '_notes.txt'))))
  } else {
    tags$h2('No notes file found for this site')
  }
)

Global Overview {data-icon="ion-android-globe" .storyboard}

Contributions Map. See from where all this data comes!

# custom layout to allow call to output$contrb_map
fillRow(height = '100%', flex = 1,
  leafletOutput("contrb_map", width = "100%")
)

site_md_joined <- load_and_bind('site_md')

# color palette function for circleMarkers in map
color_data <- site_md_joined$si_country
pal <- colorFactor(viridis::viridis(length(unique(color_data))),
                   color_data)

# popup function
site_popup <- function(site, lat, lng) {
  selected_site <- site_md_joined[site_md_joined$si_code == site, ]
  popup_text <- as.character(tagList(
    tags$h4(selected_site$si_code),
    tags$strong(selected_site$si_country), tags$br(),
    # sprintf('Paper: %s', tags$a(href = selected_site$si_paper)), tags$br(),
    tags$a(selected_site$si_paper, href = selected_site$si_paper), tags$br(),
    sprintf('IGBP: %s', selected_site$si_igbp), tags$br(),
    sprintf('Elevation above sea level: %s', selected_site$si_elev), tags$br(),
    sprintf('In Dendroglobal? %s', selected_site$si_dendro_network), tags$br(),
    sprintf('In Fluxnet? %s', selected_site$si_flux_network), tags$br()
))
  leafletProxy('contrb_map') %>%
    addPopups(lng, lat, popup_text, layerId = site)
}

observe({
  leafletProxy('contrb_map') %>% clearPopups()

  event <- input$contrb_map_marker_click

  if (is.null(event)) {
    return()
  }

  isolate({
    site_popup(event$id, event$lat, event$lng)
  })
})

# render map
output$contrb_map <- renderLeaflet({
  leaflet(data = site_md_joined) %>%
    addTiles(urlTemplate = 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Imagery/MapServer/tile/{z}/{y}/{x}',
             attribution = 'Tiles &copy; Esri &mdash; Source: Esri, i-cubed, USDA, USGS, AEX, GeoEye, Getmapping, Aerogrid, IGN, IGP, UPR-EGP, and the GIS User Community',
             options = tileOptions(noWrap = FALSE)) %>%
    setView(lng = 15, lat = 35, zoom = 2) %>%
    # fitBounds(lng1 = -180, lng2 = 180, lat1 = -70, lat2 = 90) %>%
    # addCircleMarkers(lng = ~longitude, lat = ~latitude, layerId = ~site_name)
    clearMarkers() %>%
    addCircleMarkers(lng = ~si_long, lat = ~si_lat, layerId = ~si_code,
                     radius = 10,
                     fillOpacity = 0.7,
                     fillColor = "#FDE725",
                     stroke = FALSE)
  })

Here you can:

Zoom in or out with the mouse wheel or in screen buttons.
Drag the map to move it.
Click any site (the yellow dots!) to obtain site name and a little info.

Why these tiles for the map?
I'm glad you asked. Try to zoom in to the max in any site of your interest. Can you see the little mark you leave four years ago in that tree? Yes?
That's why ;)

Species Info. Are you a species info junkie? Here you have a feast!

# custom layout to allow call to put more things
fillRow(height = '100%', flex = 1,
  ggiraphOutput("sp_bar", width = "100%"),
  fillCol(width = "100%", flex = 1,
          ggiraphOutput("sp_leaf_habit", height = "100%"),
          ggiraphOutput("sp_genus", height = "100%"))
)

# data frame with all species metadatas
species_md_joined <- load_and_bind('species_md')

# barplot of species
sp_bar_plot <- species_md_joined %>%
  group_by(sp_name, si_code) %>%
  summarise(n = sum(sp_ntrees)) %>%
  ggplot(aes(x = reorder(sp_name, n, sum), y = n, fill = si_code)) +
  geom_bar_interactive(aes(tooltip = si_code, data_id = si_code),
                       stat = 'identity') +
  viridis::scale_fill_viridis(discrete = TRUE) +
  labs(x = '', y = 'Number of plants', title = 'Species') +
  coord_flip() +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    legend.position = 'none'
  )

# barplot of leaf habit
sp_leaf_plot <- species_md_joined %>%
  group_by(sp_leaf_habit, sp_name) %>%
  summarise(n = sum(sp_ntrees)) %>%
  ggplot(aes(x = reorder(sp_leaf_habit, n, sum), y = n, fill = sp_name)) +
  geom_bar_interactive(aes(tooltip = sp_name, data_id = sp_name),
                       stat = 'identity') +
  viridis::scale_fill_viridis(discrete = TRUE) +
  labs(x = '', y = 'Number of plants', title = 'Leaf habit') +
  coord_flip() +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    legend.position = 'none'
  )

# genus plot
sp_genus_plot <- species_md_joined %>%
  mutate(sp_genus = str_trim(str_extract(sp_name, '([^\\s]+)'))) %>%
  group_by(sp_genus, si_code) %>%
  summarise(n = sum(sp_ntrees)) %>%
  ggplot(aes(x = reorder(sp_genus, n, sum), y = n, fill = si_code)) +
  geom_bar_interactive(aes(tooltip = si_code, data_id = si_code),
                        stat = 'identity') +
  viridis::scale_fill_viridis(discrete = TRUE) +
  labs(x = '', y = 'Number of plants', title = 'Genus') +
  coord_flip() +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    legend.position = 'none'
  )

# render plotly elements
output$sp_bar <- renderggiraph({
  ggiraph(code = {print(sp_bar_plot)},
          width = 0.95, width_svg = 5.5, height_svg = 5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$sp_leaf_habit <- renderggiraph({
  ggiraph(code = {print(sp_leaf_plot)},
          width = 0.95, width_svg = 5.5, height_svg = 2.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$sp_genus <- renderggiraph({
  ggiraph(code = {print(sp_genus_plot)},
          width = 0.95, width_svg = 5.5, height_svg = 2.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

Here you can:

Select an area to zoom it (double click to reset).
Hover the bars to obtain info from site/species and number of trees.
Click in the name of a site/species to remove it from the plot, click it again to add it.

Why this color palette?
This palette is called viridis, and it was developed by matplotlib. This color map is "designed in such a way that they will analytically be perfectly perceptually-uniform, both in regular form and also when converted to black-and-white. They are also designed to be perceived by readers with the most common form of color blindness" (extracted from viridis package description in CRAN)

Stand Info. Interested on stand level? This is the place.

fillCol(width = '100%', flex = 1,
  ggiraphOutput("st_height_soil_depth", height = "100%"),
  fillRow(height = "100%", flex = 1,
          ggiraphOutput("st_aspect_terrain", width = "100%"),
          ggiraphOutput("st_density_basal", width = "100%"))
)

# data frame with all stand metadatas
stand_md_joined <- load_and_bind('stand_md')

# height and soil depth plot
st_height_depth_plot <- stand_md_joined %>%
  ggplot(aes(x = si_code)) +
  # geom_ribbon(aes(ymax = st_height, ymin = 0), fill = 'green') +
  geom_bar_interactive(aes(y = st_height, tooltip = st_height, data_id = si_code),
                       stat = 'identity', fill = '#440154FF',
                       position = 'dodge') +
  # geom_ribbon(aes(ymax = st_soil_depth*(-1/100), ymin = 0), fill = 'brown') +
  geom_bar_interactive(aes(y = st_soil_depth*(-1/100),
                           tooltip = abs(st_soil_depth*(-1/100)), data_id = si_code),
                       stat = 'identity', fill = '#FDE725FF',
                       position = 'dodge') +
  labs(x = 'Site', y = 'meters', title = 'Height and Soil Depth') +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    axis.text.x = element_text(angle = 30)
  )

# aspect and terrain plot
st_aspect_terrain_plot <- stand_md_joined %>%
  group_by(st_aspect, st_terrain) %>%
  summarise(n = n()) %>%
  ggplot(aes(x = factor(st_aspect, levels = c('Flat', 'N', 'E', 'S', 'W')),
             y = st_terrain, size = n)) +
  geom_point_interactive(aes(tooltip = n), colour = viridis::viridis(1)) +
  labs(x = 'Aspect', y = 'Terrain', title = 'Aspect and Terrrain') +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    axis.text.x = element_text(angle = 30),
    axis.text.y = element_text(angle = 30),
    panel.grid = element_blank()
  )

# density and basal area plot
st_density_basal_area_plot <- stand_md_joined %>%
  ggplot(aes(x = st_density, y = st_basal_area, colour = si_code)) +
  geom_point_interactive(aes(tooltip = si_code, data_id = si_code)) +
  viridis::scale_color_viridis(discrete = TRUE) +
  labs(x = 'Density', y = 'Basal area', title = 'Density and Basal area') +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    legend.position = 'none'
    # axis.text.x = element_text(angle = 30),
    # axis.text.y = element_text(angle = 30),
  )

# plotly objects
output$st_height_soil_depth <- renderggiraph({
  ggiraph(code = {print(st_height_depth_plot)},
          width = 0.95, width_svg = 11, height_svg = 2.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_aspect_terrain <- renderggiraph({
  ggiraph(code = {print(st_aspect_terrain_plot)},
          width = 0.95, width_svg = 5.5, height_svg = 2.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_density_basal <- renderggiraph({
  ggiraph(code = {print(st_density_basal_area_plot)},
          width = 0.95, width_svg = 5.5, height_svg = 2.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4",
          selected_css = "stroke:black;r:4pt;")
})

Here you can:

Select an area to zoom it (double click to reset).
Hover the bars to obtain info from site/species and number of trees.
Click in the name of a site/species to remove it from the plot, click it again to add it.

Plant Info. Where all the plants feel like home!

plant_md_joined <- load_and_bind('plant_md')

fillCol(
  width = '100%', flex = c(NA, 1),
  inputPanel(
    selectInput('pl_var', 'Variable',
                choices = c('pl_age', 'pl_bark_thick', 'pl_height', 'pl_leaf_area',
                            'pl_sapw_area', 'pl_sapw_depth', 'pl_sens_hgt',
                            'pl_sens_length', 'pl_sens_timestep'),
                selected = 'pl_height'),
    selectInput('pl_factor', 'Colour',
                choices = c('pl_azimut_int', 'pl_code', 'pl_name', 'pl_radial_int',
                            'pl_sap_units', 'pl_sens_calib', 'pl_sens_cor_grad',
                            'pl_sens_cor_zero', 'pl_sens_man', 'pl_sens_meth',
                            'pl_social', 'pl_species', 'pl_treatment', 'si_code'),
                selected = 'si_code')
  ),
  ggiraphOutput('dbh', height = "100%")
)

output$dbh <- renderggiraph({
  dbh_plot <- plant_md_joined %>%
    ggplot(aes_string(x = 'pl_dbh', y = input$pl_var,
                      colour = input$pl_factor)) +
    geom_point_interactive(aes_string(tooltip = input$pl_factor,
                                      data_id = input$pl_factor),
                           size = 2) +
    viridis::scale_color_viridis(discrete = TRUE) +
    labs(x = 'DBH', y = input$pl_var, title = 'DBH') +
    theme_bw() +
    theme(
      legend.title = element_blank(),
      legend.position = 'none'
      # axis.text.x = element_text(angle = 30),
      # axis.text.y = element_text(angle = 30),
    )

  ggiraph(code = {print(dbh_plot)},
          width = 0.95, width_svg = 11, height_svg = 5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4",
          selected_css = "stroke:black;r:4pt;")
})

Here you can:

Select the y variable from the list to compare with the diameter (DBH).
Select the grouping (colour) variable to show in the legend.
Select an area to zoom it (double click to reset).
Hover the bars to obtain info from site/species and number of trees.
Click in the name of a site/species to remove it from the plot, click it again to add it.

Environmental Info. Worried about environmental metadata? Here you'll find the answers

# data frame with all plant metadatas
env_md_joined <- load_and_bind('env_md')

env_vars_plot <- env_md_joined %>%
  select(si_code, env_netrad, env_ppfd_in, env_precip, env_rh, env_sw_in,
         env_ta, env_vpd, env_ws) %>%
  gather(Variable, Value, starts_with('env_')) %>%
  mutate(n = 1) %>%
  ggplot(aes(x = Value, fill = si_code)) +
  geom_bar_interactive(aes(tooltip = si_code, data_id = si_code),
                       stat = 'count', position = 'stack') +
  facet_grid(~Variable) +
  scale_x_discrete(breaks = c('Above canopy', 'Within canopy', 'Clearing',
                              'Off-site', 'Not provided')) +
  viridis::scale_fill_viridis(discrete = TRUE) +
  labs(x = '', y = 'Number of sites', title = 'Environmental variables') +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    legend.position = 'none',
    axis.text.x = element_text(angle = 90)
    # axis.text.y = element_text(angle = 30)
  )

env_swc_plot <- env_md_joined %>%
  select(si_code, env_swc_shallow_depth, env_swc_deep_depth) %>%
  gather(Deep, Value, starts_with('env_')) %>%
  ggplot(aes(x = Value, fill = si_code)) +
  geom_bar_interactive(aes(tooltip = si_code, data_id = si_code),
                       stat = 'bin', position = 'stack',
                       binwidth = 10) +
  facet_grid(~Deep) +
  viridis::scale_fill_viridis(discrete = TRUE) +
  labs(x = 'Deep in cm', y = 'Count', title = 'Soil water content deep') +
  theme_bw() +
  theme(
    legend.title = element_blank(),
    legend.position = 'none'
    # axis.text.x = element_text(angle = 30)
    # axis.text.y = element_text(angle = 30)
  )

fillCol(
  width = '100%', flex = 1,
  ggiraphOutput('env_vars'),
  ggiraphOutput('swc')
)

output$env_vars <- renderggiraph({
  ggiraph(code = {print(env_vars_plot)},
          width = 0.95, width_svg = 11, height_svg = 2.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")

})

output$swc <- renderggiraph({
  ggiraph(code = {print(env_swc_plot)},
          width = 0.95, width_svg = 11, height_svg = 2.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

Here you can:

Select an area to zoom it (double click to reset).
Hover the bars to obtain info from site and env variables.
Click in the name of a site to remove it from the plot, click it again to add it.

Biomes Info. Concerned about the climatic and biogeographic range of the data sets? Just take a look here!

# data frame with all site metadata
si_biomes_df <- load_and_bind('site_md')

si_biomes_plot <-  vis_location_biome(si_biomes_df)

fillCol(
  width = '100%', flex = 1,
  ggiraphOutput('si_biomes')
)

output$si_biomes <- renderggiraph({
  ggiraph(code = {print(si_biomes_plot)},
          width = 0.95, width_svg = 11, height_svg = 5.5, zoom_max = 5,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4",
          selected_css = "stroke:black;r:4pt;")
})

Here you can:

Select an area to zoom it (double click to reset).
Hover the dots to obtain info from site (code, MAT and MAP).
Click in the name of a biome to remove it from the plot, click it again to add it.

Metadata {data-icon="ion-clipboard" data-navmenu="Site Inspector"}

Sidebar {.sidebar data-width=200}

Data selection

Select the site code and data level

site_list <- list.dirs('Data', full.names = FALSE, recursive = FALSE)

selectInput('md_site_sel', label = 'Select site by code:',
            choices = site_list, selected = site_list[1])

radioButtons('md_level_sel', label = 'Select data level:',
             choices = c('Level 1' = 'Lvl_1', 'Level 2' = 'Lvl_2'),
             selected = 'Lvl_1')

# radioButtons('data_sel', label = 'Select sapflow data type:',
#              choices = c('Sapflow data leaf' = 'sapflow_data_leaf.csv',
#                          'Sapflow data plant' = 'sapflow_data_plant.csv',
#                          'Sapflow data sapwood' = 'sapflow_data_sapwood.csv'),
#              selected = 'sapflow_data_plant.csv')

tags$br()

Row {.tabset .tabset-fade}

Site and stand metadata

fillCol(width = '100%', flex = 1,
        fillRow(height = '100%', flex = 1,
                ggiraphOutput('si_elev_plot', width = "100%"),
                ggiraphOutput('st_age_plot', width = "100%"),
                ggiraphOutput('st_height_plot', width = "100%")),
        fillRow(height = '100%',flex = 1,
                ggiraphOutput('st_density_plot', width = "100%"),
                ggiraphOutput('st_basal_area_plot', width = "100%"),
                ggiraphOutput('st_lai_plot', width = "100%")),
        fillRow(height = '100%',flex = 1,
                ggiraphOutput('st_soil_depth_plot', width = "100%"),
                NULL,
                NULL)
        )

site_md_joined <- load_and_bind('site_md')

site_md_data_plot <- site_md_joined %>%
  select(si_code, si_elev)

stand_md_data_plot <- stand_md_joined %>%
  select(si_code, st_age, st_height, st_density,
         st_basal_area, st_lai, st_soil_depth)

site_stand_md <- full_join(site_md_data_plot, stand_md_data_plot,
                           by = 'si_code') %>%
  gather("Var", "Value", si_elev:st_soil_depth)

output$si_elev_plot <- renderggiraph({

  si_elev_data <- site_stand_md %>%
    mutate(colour = as.character(si_code == input$md_site_sel))

  si_elev_plot <- si_elev_data %>%
  filter(Var == 'si_elev') %>%
  ggplot(aes(x = Var, y = Value)) +
    geom_violin(aes(data_id = Var, tooltip = Var),
                             fill = '#FDE3A7', alpha = 0.3,
                             outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                               tooltip = si_code,
                               colour = colour,
                               alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[m]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
    scale_alpha_manual(values = c(0.15, 1)) +
    guides(alpha = FALSE) +
    theme_sfn()

  ggiraph(code = {print(si_elev_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_age_plot <- renderggiraph({

  st_age_data <- site_stand_md %>%
    mutate(colour = as.character(si_code == input$md_site_sel))

  st_age_plot <- st_age_data %>%
  filter(Var == 'st_age') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                             outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                               tooltip = si_code,
                               colour = colour,
                               alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[years]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
    scale_alpha_manual(values = c(0.15, 1)) +
    guides(alpha = FALSE) +
    theme_sfn()

  ggiraph(code = {print(st_age_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_height_plot <- renderggiraph({

  st_height_data <- site_stand_md %>%
    mutate(colour = as.character(si_code == input$md_site_sel))

  st_height_plot <- st_height_data %>%
  filter(Var == 'st_height') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                             outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                               tooltip = si_code,
                               colour = colour,
                               alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[m]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
    scale_alpha_manual(values = c(0.15, 1)) +
    guides(alpha = FALSE) +
    theme_sfn()

  ggiraph(code = {print(st_height_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_density_plot <- renderggiraph({

  st_density_data <- site_stand_md %>%
    mutate(colour = as.character(si_code == input$md_site_sel))

  st_density_plot <- st_density_data %>%
  filter(Var == 'st_density') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                             outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                               tooltip = si_code,
                               colour = colour,
                               alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[stems/ha]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
    scale_alpha_manual(values = c(0.15, 1)) +
    guides(alpha = FALSE) +
    theme_sfn()

  ggiraph(code = {print(st_density_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_basal_area_plot <- renderggiraph({

  st_basal_area_data <- site_stand_md %>%
    mutate(colour = as.character(si_code == input$md_site_sel))

  st_basal_area_plot <- st_basal_area_data %>%
  filter(Var == 'st_basal_area') %>%
  ggplot(aes(x = Var, y = Value)) +
    geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                             outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                               tooltip = si_code,
                               colour = colour,
                               alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[m²/ha]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
    scale_alpha_manual(values = c(0.15, 1)) +
    guides(alpha = FALSE) +
    theme_sfn()

  ggiraph(code = {print(st_basal_area_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_lai_plot <- renderggiraph({

  st_lai_data <- site_stand_md %>%
    mutate(colour = as.character(si_code == input$md_site_sel))

  st_lai_plot <- st_lai_data %>%
  filter(Var == 'st_lai') %>%
  ggplot(aes(x = Var, y = Value)) +
    geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                               tooltip = si_code,
                               colour = colour,
                               alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[m²/m²]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
    scale_alpha_manual(values = c(0.15, 1)) +
    guides(alpha = FALSE) +
    theme_sfn()

  ggiraph(code = {print(st_lai_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$st_soil_depth_plot <- renderggiraph({

  st_soil_depth_data <- site_stand_md %>%
    mutate(colour = as.character(si_code == input$md_site_sel))

  st_soil_depth_plot <- st_soil_depth_data %>%
  filter(Var == 'st_soil_depth') %>%
  ggplot(aes(x = Var, y = Value)) +
    geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                               tooltip = si_code,
                               colour = colour,
                               alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[cm]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
    scale_alpha_manual(values = c(0.15, 1)) +
    guides(alpha = FALSE) +
    theme_sfn()

  ggiraph(code = {print(st_soil_depth_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

Species and plant metadata

fillCol(width = '100%', flex = 1,
        fillRow(height = '100%', flex = 1,
                ggiraphOutput('sp_basal_area_perc_plot', width = "100%"),
                ggiraphOutput('pl_age_plot', width = "100%"),
                ggiraphOutput('pl_bark_thick_plot', width = "100%"),
                ggiraphOutput('pl_dbh_plot', width = "100%")),
        fillRow(height = '100%',flex = 1,
                ggiraphOutput('pl_height_plot', width = "100%"),
                ggiraphOutput('pl_leaf_area_plot', width = "100%"),
                ggiraphOutput('pl_sapw_area_plot', width = "100%"),
                ggiraphOutput('pl_sapw_depth_plot', width = "100%")),
        fillRow(height = '100%',flex = 1,
                ggiraphOutput('pl_sens_hgt_plot', width = "100%"),
                ggiraphOutput('pl_sens_length_plot', width = "100%"),
                ggiraphOutput('pl_sens_timestep_plot', width = "100%"),
                NULL)
        )


species_md_data_plot <- species_md_joined %>%
  select(si_code, sp_name, sp_basal_area_perc) %>%
  gather("Var", "Value", sp_basal_area_perc)

plant_md_data_plot <- plant_md_joined %>%
  select(si_code, pl_code, pl_age, pl_bark_thick, pl_dbh, pl_height,
         pl_leaf_area, pl_sapw_area, pl_sapw_depth, pl_sens_hgt,
         pl_sens_length, pl_sens_timestep) %>%
  gather("Var", "Value", pl_age:pl_sens_timestep)

output$sp_basal_area_perc_plot <- renderggiraph({

  sp_basal_area_perc_plot <- species_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'sp_basal_area_perc') %>%
  ggplot(aes(x = Var, y = Value)) +
    geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
    geom_point_interactive(aes(data_id = si_code,
                             tooltip = sp_name,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[%]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(sp_basal_area_perc_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_age_plot <- renderggiraph({

  pl_age_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_age') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[years]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_age_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_bark_thick_plot <- renderggiraph({

  pl_bark_thick_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_bark_thick') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[mm]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_bark_thick_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_dbh_plot <- renderggiraph({

  pl_dbh_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_dbh') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[cm]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_dbh_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_height_plot <- renderggiraph({

  pl_height_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_height') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[m]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_height_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_leaf_area_plot <- renderggiraph({

  pl_leaf_area_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_leaf_area') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[m²]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_leaf_area_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_sapw_area_plot <- renderggiraph({

  pl_sapw_area_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_sapw_area') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[cm²]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_sapw_area_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_sapw_depth_plot <- renderggiraph({

  pl_sapw_depth_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_sapw_depth') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[cm]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_sapw_depth_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_sens_hgt_plot <- renderggiraph({

  pl_sens_hgt_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_sens_hgt') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +

    labs(x = '', y = '[m]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_sens_hgt_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_sens_length_plot <- renderggiraph({

  pl_sens_length_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_sens_length') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[mm]') +
  scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_sens_length_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

output$pl_sens_timestep_plot <- renderggiraph({

  pl_sens_timestep_plot <- plant_md_data_plot %>%
  mutate(colour = as.character(si_code == input$md_site_sel)) %>%
  filter(Var == 'pl_sens_timestep') %>%
  ggplot(aes(x = Var, y = Value)) +
  geom_violin(aes(data_id = Var, tooltip = Var),
                           fill = '#FDE3A7', alpha = 0.3,
                           outlier.size = 0) +
  geom_point_interactive(aes(data_id = si_code,
                             tooltip = pl_code,
                             colour = colour,
                             alpha = colour),
                           position = position_jitter(width = 0.2, height = 0),
                           size = 4) +
    labs(x = '', y = '[min]') +
    scale_colour_manual(values = c('#6C7A89', 'red'),
                        labels = c('Others', input$md_site_sel)) +
  scale_alpha_manual(values = c(0.15, 1)) +
  guides(alpha = FALSE) +
  theme_sfn()

  ggiraph(code = {print(pl_sens_timestep_plot)},
          width = 0.95, width_svg = 4.4, height_svg = 2,
          tooltip_extra_css = "background-color:black;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;color:white",
          hover_css = "fill-opacity:.4")
})

Data & TimeSeries {data-icon="ion-ios-search-strong" data-navmenu="Site Inspector"}

Sidebar {.sidebar data-width=200}

Data selection

Select the site code and data level

site_list <- list.dirs('Data', full.names = FALSE, recursive = FALSE)

selectInput('site_sel', label = 'Select site by code:',
            choices = site_list, selected = site_list[1])

radioButtons('level_sel', label = 'Select data level:',
             choices = c('Level 1' = 'Lvl_1', 'Level 2' = 'Lvl_2'),
             selected = 'Lvl_1')

# radioButtons('data_sel', label = 'Select sapflow data type:',
#              choices = c('Sapflow data leaf' = 'sapflow_data_leaf.csv',
#                          'Sapflow data plant' = 'sapflow_data_plant.csv',
#                          'Sapflow data sapwood' = 'sapflow_data_sapwood.csv'),
#              selected = 'sapflow_data_plant.csv')

tags$br()

Click in the column of the plant or environmental variable to show/hide it from the timeseries plot.

Row {.tabset .tabset-fade}

Sapflow Data Table

fillRow(height = '100%', flex = 1,
  # dygraphOutput("sapf_ts", width = "100%"),
  DT::dataTableOutput("sapf_dt", width = "100%", height = '100%')
)

output$sapf_dt <- DT::renderDataTable({

  sapf_data_table <- get_sapf(load_sfn_data()) %>%
    mutate(TIMESTAMP = as.character(TIMESTAMP))

  DT::datatable(sapf_data_table,
                extensions = c('Scroller', 'FixedColumns'),
                filter = 'none',
                class = 'display compact',
                options = list(
                  deferRender = TRUE,
                  scrollY = 300,
                  scrollX = TRUE,
                  fixedColumns = TRUE,
                  scroller = TRUE,
                  # pageLength = 250,
                  dom = 'ti'
                  # searchCols = list(
                  #   NULL,
                  #   list(search = paste(t0, tf, sep = ' ... '))
                  # )
                ),
                selection = list(target = 'column',
                                 selected = 2)
  )
})

Environmental Data Table

fillRow(height = '100%', flex = 1,
  # dygraphOutput("sapf_ts", width = "100%"),
  DT::dataTableOutput("env_dt", width = "100%", height = '100%')
)

output$env_dt <- DT::renderDataTable({

  env_data_table <- get_env(load_sfn_data()) %>%
    mutate(TIMESTAMP = as.character(TIMESTAMP))

  DT::datatable(env_data_table,
                extensions = c('Scroller', 'FixedColumns'),
                filter = 'none',
                class = 'display compact',
                options = list(
                  deferRender = TRUE,
                  scrollY = 300,
                  scrollX = TRUE,
                  fixedColumns = TRUE,
                  scroller = TRUE,
                  # pageLength = 250,
                  dom = 'ti'
                  # searchCols = list(
                  #   NULL,
                  #   list(search = paste(t0, tf, sep = ' ... '))
                  # )
                ),
                selection = list(target = 'column',
                                 selected = 2)
  )
})

Row {.tabset .tabset-fade data-height=350}

Sapflow Time Series

fillRow(height = '100%', flex = 1,
  dygraphOutput("sapf_ts", width = "100%")
  # DT::dataTableOutput("sapf_dt", width = "100%")
)

output$sapf_ts <- renderDygraph({

  sapf_plot_data <- get_sapf(load_sfn_data())
  columns <- input$sapf_dt_columns_selected

  sapf_plot <- sapf_plot_data %>%
    select(TIMESTAMP, columns)

  sapf_plot <- xts::xts(sapf_plot[,-1],
                        order.by = sapf_plot$TIMESTAMP,
                        tz = attr(sapf_plot$TIMESTAMP, 'tzone'))

  dygraph(sapf_plot, ylab = get_plant_md(load_sfn_data())$pl_sap_units[1]) %>%
    dyHighlight(highlightCircleSize = 5,
                highlightSeriesBackgroundAlpha = 0.5,
                hideOnMouseOut = FALSE,
                highlightSeriesOpts = list(
                  strokeWidth = 3
                )) %>%
    dyCrosshair(direction = 'both') %>%
    dyOptions(useDataTimezone = TRUE, retainDateWindow = TRUE,
              colors = stringr::str_sub(viridis::viridis(length(columns)), 1, -3),
              drawGrid = FALSE) %>%
    dyLegend(width = 1000) %>%
    dyRoller(rollPeriod = 1) %>%
    dyRangeSelector()
})

Environmental Time Series

fillRow(height = '100%', flex = 1,
  dygraphOutput("env_ts", width = "100%")
  # DT::dataTableOutput("sapf_dt", width = "100%")
)

output$env_ts <- renderDygraph({

  env_plot_data <- get_env(load_sfn_data())
  columns_env <- input$env_dt_columns_selected

  env_plot <- env_plot_data %>%
    select(TIMESTAMP, columns_env)

  env_plot <- xts::xts(env_plot[,-1],
                       order.by = env_plot$TIMESTAMP,
                       tz = attr(env_plot$TIMESTAMP, 'tzone'))

  dygraph(env_plot) %>%
    dyHighlight(highlightCircleSize = 5,
                highlightSeriesBackgroundAlpha = 0.5,
                hideOnMouseOut = FALSE,
                highlightSeriesOpts = list(
                  strokeWidth = 3
                )) %>%
    dyCrosshair(direction = 'both') %>%
    dyOptions(useDataTimezone = TRUE, retainDateWindow = TRUE,
              colors = stringr::str_sub(viridis::viridis(length(columns_env)), 1, -3),
              drawGrid = FALSE) %>%
    dyLegend(width = 1000) %>%
    dyRoller(rollPeriod = 1) %>%
    dyRangeSelector()
})

Sapflow vs. Environmental {data-icon="ion-ios-analytics" data-navmenu="Site Inspector"}

Sidebar {.sidebar data-width=200}

Data selection

Select the site code, data level and data units

site_list <- list.dirs('Data', full.names = FALSE, recursive = FALSE)

selectInput('site_sel_vs', label = 'Select site by code:',
            choices = site_list, selected = site_list[1])

radioButtons('level_sel_vs', label = 'Select data level:',
             choices = c('Level 1' = 'Lvl_1', 'Level 2' = 'Lvl_2'),
             selected = 'Lvl_1')

# radioButtons('data_sel_vs', label = 'Select sapflow data type:',
#              choices = c('Sapflow data leaf' = 'sapflow_data_leaf.csv',
#                          'Sapflow data plant' = 'sapflow_data_plant.csv',
#                          'Sapflow data sapwood' = 'sapflow_data_sapwood.csv'),
#              selected = 'sapflow_data_plant.csv')

uiOutput('tree_controls')
uiOutput('env_controls')

Row

output$tree_controls <- renderUI({
  tree_names <- names(get_sapf(load_sfn_data_vs())[,-1])
  checkboxGroupInput('tree_names', "Choose plants:",
                     choices = tree_names, selected = tree_names[1])
})

output$env_controls <- renderUI({
  load_sfn_data_vs()
  env_names <- names(get_env(load_sfn_data_vs())[,-1])
  checkboxGroupInput('env_names', "Choose env variables:",
                     choices = env_names, selected = env_names[1])
})

Sapflow

fillRow(height = '100%', flex = 1,
  dygraphOutput("sapf_ts_vs", width = "100%")
  # DT::dataTableOutput("sapf_dt", width = "100%")
)

output$sapf_ts_vs <- renderDygraph({

  sapf_plot_data_vs <- get_sapf(load_sfn_data_vs())

  sapf_plot_vs <- sapf_plot_data_vs %>%
    select(one_of(c('TIMESTAMP', input$tree_names)))

  sapf_plot_vs <- xts::xts(sapf_plot_vs[,-1],
                           order.by = sapf_plot_vs$TIMESTAMP,
                           tz = attr(sapf_plot_vs$TIMESTAMP, 'tzone'))

  dygraph(sapf_plot_vs, group = 'vs',
          ylab = get_plant_md(load_sfn_data_vs())$pl_sap_units[1]) %>%
    dyHighlight(highlightCircleSize = 5,
                highlightSeriesBackgroundAlpha = 0.5,
                hideOnMouseOut = FALSE,
                highlightSeriesOpts = list(
                  strokeWidth = 3
                )) %>%
    dyCrosshair(direction = 'both') %>%
    dyOptions(useDataTimezone = TRUE, retainDateWindow = TRUE,
              colors = stringr::str_sub(viridis::viridis(length(input$tree_names)),
                                        1, -3),
              drawGrid = FALSE) %>%
    dyLegend(width = 1000) %>%
    dyRoller(rollPeriod = 1) %>%
    dyRangeSelector()
})

Row

Environmental

fillRow(height = '100%', flex = 1,
  dygraphOutput("env_ts_vs", width = "100%")
  # DT::dataTableOutput("sapf_dt", width = "100%")
)

output$env_ts_vs <- renderDygraph({

  env_plot_data_vs <- get_env(load_sfn_data_vs())

  env_plot_vs <- env_plot_data_vs %>%
    select(one_of(c('TIMESTAMP', input$env_names)))

  env_plot_vs <- xts::xts(env_plot_vs[,-1],
                          order.by = env_plot_vs$TIMESTAMP,
                          tz = attr(env_plot_vs$TIMESTAMP, 'tzone'))

  dygraph(env_plot_vs, group = 'vs') %>%
    dyHighlight(highlightCircleSize = 5,
                highlightSeriesBackgroundAlpha = 0.5,
                hideOnMouseOut = FALSE,
                highlightSeriesOpts = list(
                  strokeWidth = 3
                )) %>%
    dyCrosshair(direction = 'both') %>%
    dyOptions(useDataTimezone = TRUE, retainDateWindow = TRUE,
              colors = stringr::str_sub(viridis::viridis(length(input$env_names)),
                                        1, -3),
              drawGrid = FALSE) %>%
    dyLegend(width = 1000) %>%
    dyRoller(rollPeriod = 1) %>%
    dyRangeSelector()
})

Ready to Level 2 {data-icon="ion-ios-analytics" data-navmenu="Apps"}

Ready to Level 2 App

Select the sites ready for Level 2 QC

df_flag_to_lvl2_app()

Outliers App {data-icon="ion-ios-analytics" data-navmenu="Apps"}

Outliers flagging

Process the desired outliers

out_app()

Outliers Confirmation App {data-icon="ion-ios-analytics" data-navmenu="Apps"}

Outliers confirmation

Confirm outliers removing

out_confirmation_app()

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

rdrr.io home R language documentation Run R code online

CRAN packages Bioconductor packages R-Forge packages GitHub packages

Note that we can't provide technical support on individual packages. You should contact the package authors for that.

sapfluxnet/sapfluxnetQC1 Package with functions related to sapfluxnet project data

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

Control Panel {data-icon="ion-ios-settings-strong"}

Sidebar {.sidebar data-width=200}

Controls

Row

Datasets received {.value-box}

Datasets QC ran {.value-box}

Datasets QC OK {.value-box}

Row {.tabset .tabset-fade}

Reports

Log

Manual Changes Log

Site Notes

Global Overview {data-icon="ion-android-globe" .storyboard}

Contributions Map. See from where all this data comes!

Species Info. Are you a species info junkie? Here you have a feast!

Stand Info. Interested on stand level? This is the place.

Plant Info. Where all the plants feel like home!

Environmental Info. Worried about environmental metadata? Here you'll find the answers

Biomes Info. Concerned about the climatic and biogeographic range of the data sets? Just take a look here!

Metadata {data-icon="ion-clipboard" data-navmenu="Site Inspector"}

Sidebar {.sidebar data-width=200}

Data selection

Row {.tabset .tabset-fade}

Site and stand metadata

Species and plant metadata

Data & TimeSeries {data-icon="ion-ios-search-strong" data-navmenu="Site Inspector"}

Sidebar {.sidebar data-width=200}

Data selection

Row {.tabset .tabset-fade}

Sapflow Data Table

Environmental Data Table

Row {.tabset .tabset-fade data-height=350}

Sapflow Time Series

Environmental Time Series

Sapflow vs. Environmental {data-icon="ion-ios-analytics" data-navmenu="Site Inspector"}

Sidebar {.sidebar data-width=200}

Data selection

Row

Sapflow

Row

Environmental

Ready to Level 2 {data-icon="ion-ios-analytics" data-navmenu="Apps"}

Ready to Level 2 App

Outliers App {data-icon="ion-ios-analytics" data-navmenu="Apps"}

Outliers flagging

Outliers Confirmation App {data-icon="ion-ios-analytics" data-navmenu="Apps"}

Outliers confirmation

R Package Documentation

Browse R Packages

We want your feedback!

sapfluxnet/sapfluxnetQC1
Package with functions related to sapfluxnet project data