R/fSiteSelect.R

In ksmiff33/FluxSynthU: Suite of functions to analyze eddy covariance data

#' This Shiny application allows the user to select from a list of sites that have available data.

#' @export
#' @title User site selection for FluxSynthU data processing
#' @param db.and.sites a character vector containing site names and their associated database (e.g. 'FLX_US-NR1' or 'AMF_CA-Obs')
#' @param descrip a character string describing the current Shiny application (defaults to NULL)
#' @param multi logical, determines whether you want to select multiple sites (TRUE) or just one site from each array
#'
#' @importFrom shiny runApp fluidPage h3 h4 h5 hr em strong actionButton fluidRow column selectInput verbatimTextOutput tags reactiveVal observeEvent updateSelectInput renderPrint observe stopApp
#' @importFrom shinyTree shinyTree renderTree updateTree get_selected


# fSiteSelect
# Shiny app designed for the initial stages of file management and raw data processing

# Updated 201001 to have more flexibility with handling flux databases
# Now outputs user site selections with information about which database was selected (previous versions did not have this functionality)
fSiteSelect <- function(db.and.sites, descrip = NULL, multi = TRUE) {

  if (multi) {
    site.select.option <- "Hold 'command + click' to select multiple sites ('command + click' deselects sites as well)"
  } else  if (multi == FALSE) {
    site.select.option <- "Hold 'command + click' to deselect site"
  }



  # First split 'db.and.sites' into different lists according to their respective database
  db.and.sites.list <- list(`NEON` = substr(db.and.sites[grep(pattern = '\\NEO', db.and.sites)], start = 5,stop = 8),
                            `AMERIFLUX` = substr(db.and.sites[grep(pattern = '\\AMF', db.and.sites)], start = 5,stop = 10),
                            `FLUXNET2015` = substr(db.and.sites[grep(pattern = '\\FLX', db.and.sites)], start = 5,stop = 10))

  runApp(list(
    ui = fluidPage(
      h3(strong(paste(descrip))),
      h4(strong("Click to select site(s) for processing:")),
      h5(em(paste(site.select.option))),
      fluidRow(column(3, selectInput("amf", "Select AmeriFlux site(s):",
                                     db.and.sites.list[["AMERIFLUX"]],
                                     multiple = multi, selectize = FALSE, size = 15)),
               column(3, selectInput("flx", "Select FLUXNET2015 site(s):",
                                     db.and.sites.list[["FLUXNET2015"]],
                                     multiple = multi, selectize = FALSE, size = 15)),
               column(3, selectInput("neo", "Select NEON site(s):",
                                     db.and.sites.list[["NEON"]],
                                     multiple = multi, selectize = FALSE, size = 15)),

      ),
      verbatimTextOutput("result"),
      actionButton('reset2', 'Reset site selection'),
      tags$button(
        id = 'close',
        type = "button",
        class = "btn action-button btn-large btn-primary",
        onclick = "setTimeout(function(){window.close();},500);",  # close browser
        "(Click) to confirm site selection and exit"
      )
    ),
    server = function(input, output, session) {

      observeEvent(input$reset2, {
        updateSelectInput(session, "amf", choices = db.and.sites.list[["AMERIFLUX"]])
        updateSelectInput(session, "flx", choices = db.and.sites.list[["FLUXNET2015"]])
        updateSelectInput(session, "neo", choices = db.and.sites.list[["NEON"]])
      })


      output$result <- renderPrint({
        paste(c(input$amf, input$flx, input$neo))
      })

      observe({
        site.selection <- c(input$neo, input$amf, input$flx)
        if (input$close > 0) stopApp(list("AMF" = input$amf, "FLX" = input$flx, "NEO" = input$neo))
      })
    }
  ))
}