This vignette derives from the RStudio article on Shiny modules.

library("shinypod")

Structure of a server module

Within a server-module function, we keep a certain order of elements within the module. This order was determined by looking over the shoulders at Andee Kaplan and Eric Hare's shiny code (thanks to both!).

  1. Formals By definition these come first.

  2. Reactives We arrange the reactives so that reactives that are depended-upon by other reactives are placed above the reactives that "do the depending". Reactives that validate data passed-in by the formals are put at the beginning. Keep in mind that code within reactives are called only on demand - if something downstream calls the reactive.

  3. Observers Observers are always called if anything being observed changes. This is a handy place to put any code that changes the UI. This might be code to update an input, or it might be some shinyjs code to show or hide inputs.

  4. Outputs One thing to keep in mind about outputs is that the code is run only if the output is visible in the UI. This is why it can be useful to put code that needs to run into observers.

  5. Return value We are still figuring this one out. For something like a dygraph, it will ultimately be an output; perhaps you expect it to be returned as an output. However, because a dygraph can be customized, it can be useful to return the dygraph as a reactive, allowing you to customize it and put it into an output yourself.

Formals

dygraph_server <- function(
  input, output, session,
  data)

The first three arguments are the standard server arguments: input, output, and session.

Any additional arguments are passed from the server when callModule is invoked. By putting some extra logic in to the reactive that validates the data, we can allow additional arguments to be static or reactive.

In this case, we expect data to be either:

Reactives

Data

The implementation to allow you to send either a dataframe or a reactive that returns a dataframe is inspired by ggvis (thanks!).

# dataset
rct_data <- reactive({

  # the `data` argument can contain either:
  #  - a reactive that returns a data frame
  #  - a data frame 
  #
  # in either case, we want to examine the dataframe
  #
  if (shiny::is.reactive(data)) {
    static_data <- data()
  } else {
    static_data <- data
  }

  # make sure this is a data frame
  shiny::validate(
    shiny::need(is.data.frame(static_data), "Cannot display graph: no data")
  )

  # this reactive returns the data frame
  static_data
})

This reactive, rct_data, is the only function or expression that uses the data argument; anything "downstream" will use rct_data().

Available variables

The inputs for this shinypod need to know what are the variables available in the dataframe - be they datetime or numeric.

# names of time variables
rct_var_time <- reactive({

  var_time <- df_names_inherits(rct_data(), c("POSIXct"))

  shiny::validate(
    shiny::need(var_time, "Cannot display graph: dataset has no time variables")
  )

  var_time
})

# names of numeric variables
rct_var_num <- reactive({

  var_num <- df_names_inherits(rct_data(), c("numeric", "integer"))

  shiny::validate(
    shiny::need(var_num, "Cannot display graph: dataset has no numeric variables")
  )

  var_num
})

The function df_names_inherits() returns a vector of names; these are the names of columns in the dataframe that inherit from the supplied classes.

We use the functions here to find what are the available time and numeric variables, so as to populate the choices for the inputs.

One thing to keep in mind is that if a variable is chosen for the y1 axis, it should not be available to the y2 axis. Hence, we have reactives that supply the names of the variables available to each axis.

# names of variables available to y1-axis control
rct_choice_y1 <- reactive({
  choice_y1 <- setdiff(rct_var_num(), input[["y2"]])

  choice_y1
})

# names of variables available to y2-axis control
rct_choice_y2 <- reactive({
  choice_y2 <- setdiff(rct_var_num(), input[["y1"]])

  choice_y2
})

Dygraph

The reactive that returns the dygraph has two main parts: validate the inputs, create a dygraph.

The reason we validate the inputs again is that it is possible for rct_data() and the axis inputs to "get out of sync". This is our chance to offer a validation message, rather than an error, while the reactives and inputs catch up with each other.

# basic dygraph
rct_dyg <- reactive({

  var_time <- input[["time"]]
  var_y1 <- input[["y1"]]
  var_y2 <- input[["y2"]]

  shiny::validate(
    shiny::need(
      var_time %in% names(rct_data()),
      "Graph cannot display without a time-variable"
    ),
    shiny::need(
      c(var_y1, var_y2) %in% names(rct_data()),
      "Graph cannot display without any y-variables"
    )
  )

  dyg <- .dygraph(rct_data(), var_time, var_y1, var_y2)

  dyg
})

The second part is to call a function that returns a dygraph, given the validated inputs. It can be useful to write such functions outside of a reactive context, so that you can build and test them interactively.

# function that builds basic dygraph
# .dygraph(wx_ames, "date", "temp", "hum")
.dygraph <- function(data, var_time, var_y1, var_y2){

  # create the mts object
  vec_time <- data[[var_time]]
  df_num <- data[c(var_y1, var_y2)]

  # if no tz, use UTC
  tz <- lubridate::tz(vec_time)
  if (identical(tz, "")) {
    tz <- "UTC"
  }

  dy_xts <- xts::xts(df_num, order.by = vec_time, tzone = tz)

  dyg <- dygraphs::dygraph(dy_xts)
  dyg <- dygraphs::dyAxis(dyg, "x", label = var_time)
  dyg <- dygraphs::dyAxis(dyg, "y", label = paste(var_y1, collapse = ", "))
  dyg <- dygraphs::dyAxis(dyg, "y2", label = paste(var_y2, collapse = ", "))

  # put stuff on y2 axis
  for(i in seq_along(var_y2)) {
    dyg <- dygraphs::dySeries(dyg, var_y2[i], axis = "y2")
  }

  dyg
}

Observers

We have one observer manage the showing/hiding of inputs, depending on the availability of variables in the data frame.

# shows and hides controls based on the availabilty and nature of data
shiny::observe({

  has_time <- length(df_names_inherits(rct_data(), c("POSIXct"))) > 0
  has_num <- length(df_names_inherits(rct_data(), c("numeric", "integer")) > 0)

  shinyjs::toggle("time", condition = has_time)
  shinyjs::toggle("y1", condition = has_num)
  shinyjs::toggle("y2", condition = has_num)

})

We have another set of observers to update the choices and selection for each of the selectInputs.

# update choices for time variable
shiny::observeEvent(
  eventExpr = rct_var_time(),
  handlerExpr = {
    updateSelectInput(
      session,
      inputId = "time",
      choices = rct_var_time(),
      selected = update_selected(input[["time"]], rct_var_time(), index = 1)
    )
  }
)

The purpose of update_selected() is to propose a selection, given an existing value and set of choices; it takes three arguments:

The first step is to determine the members of value that appear in choices. If this result is not empty, it is returned.

If this result is empty, then index is used to return that index of choices.

Some examples:

choices <- c("a", "b", "c")

update_selected(value = "b", choices = choices, index = 1)
update_selected(value = "d", choices = choices, index = 1)
update_selected(value = NULL, choices = choices, index = 1)

update_selected(value = "d", choices = choices, index = NULL)
update_selected(value = NULL, choices = choices, index = NULL)

update_selected(value = "b", choices = NULL, index = 1)
update_selected(value = "b", choices = NULL, index = NULL)

Outputs & return value

One of the design choices made here was to return the dygraph as a reactive to be returned rather than as an output to be displayed.

This forces a little more responsibility to the user, but there can be a benefit.

A server function might contain lines like these:

rct_dyg <- callModule(dygraph_server, "dyg", data = rct_data)

output$csv_dyg <- renderDygraph({
  rct_dyg()
})

If you wanted to add some customization to the dygraph, you could do so easily in the server function.

output$csv_dyg <- renderDygraph({
  rct_dyg() %>%
    dyOptions(useDataTimezone = TRUE)
})


ijlyttle/shinypod documentation built on May 18, 2019, 3:41 a.m.