Introduction

In this excercise, I’m going to show how to automate some aspects of coding in shiny to speed up development. Traditionally, in user interface development, one has to explicitly type out each individual input argument. For small applications, this is justified and probably isn’t worth the time to automate the task. The first part goes over using functional programming to loop through data and utilize its characteristics to create the inputs. These same concepts will be used in the second part to do the same with the outputs of in the server file that one wants to manipulate. This requires a little more tweaking because of the nature of the logic in shiny, but you will see how greatly you can reduce the amount of code that needs to be written.

Looping Inputs

Below I’m using the diamonds dataset from the ggplot2 package. This dataset has several different data types in the data.frame where you can use base R functions to find the data types. Using control logic, it is easy to specify different shiny input funtions that you will only have to write once. I’ve included the id argument as a way to name the inputs and be able to call them later. mapply allows me to apply the build_shiny_input function to each column in the data.frame and tag the input with the name. Hint: When using mapply on shiny inputs, you need to specify SIMPLIFY = FALSE.

library(shiny)
library(shinythemes)
library(ggplot2)
library(trstyles) # to run code replace theme_tr()
data("diamonds")
set.seed(311)
diamonds[['randomGroups']] <- sample(as.character(1:5), 
                                     nrow(diamonds), 
                                     replace = TRUE)
build_shiny_input <- function(x, id) {
  if (is.double(x)) {
    sliderInput(id, id, min = min(x), max = max(x), value = c(min(x), max(x)))
  } else if (is.ordered(x)) {
    selectInput(id, id, choices = unique(sort(x)),
                selected = as.character(unique(sort(x))), multiple = TRUE)
  } else if (is.factor(x) | is.character(x)) {
    checkboxGroupInput(id, id, choices = sort(unique(x)),
                       selected = sort(unique(x)))
  } else if (is.integer(x)) {
    sliderInput(id, id, value = c(min(x),max(x)), 
                step = 1, min = min(x), max = max(x))
  } else {
    NULL
  }
}
shinyInputs <- mapply(diamonds, 
                      id = names(diamonds), 
                      FUN = build_shiny_input,
                      SIMPLIFY = FALSE)

UI

The above code can be rendered outside of the UI allowing the app to only have to render it once. Now I can put all 11 of the shiny inputs with one line of code which greatly reduces the complexity seen in the ui.

ui <- fluidPage(theme = 'flatly',
   
   titlePanel("Dynamic Shiny UI"),
   
   sidebarLayout(
      sidebarPanel(
         tagList(shinyInputs)
      ),
      
      mainPanel(
         h5("Generated Inputs"),
         textOutput("inputNames"),
         h5("Generated Outputs"),
         uiOutput("plots")
         
      )
   )
)

The next part is a little trickier. You can once again specify different plot types based on the data type from the diamonds dataset. I’m using the tagList function to encapsulate the plot and break tags. I’m using a little bit of rlang magic as well to convert the text id to a symbol and evaluating in the geom_ call.

Looping Outputs

render_plot_data <- function(inputName, shinyInput) {
  x <- diamonds[[inputName]]
  if (is.double(x)) {
    i <- x >= shinyInput[[inputName]][1] & x <= shinyInput[[inputName]][2]
    g <- ggplot(diamonds[i, ]) +
      geom_density(aes(!!sym(inputName))) +
      theme_tr() +
      theme(panel.background = element_rect(fill = 'transparent'),
            plot.background = element_rect(fill = 'transparent',
                                           color = NA))
    tagList(renderPlot(g), br())
  } else if (is.character(x) | is.factor(x)) {
    i <- x %in% shinyInput[[inputName]]
    g <- ggplot(diamonds[i, ]) +
      geom_bar(aes(!!sym(inputName))) +
      theme_tr() +
      theme(panel.background = element_rect(fill = 'transparent'),
            plot.background = element_rect(fill = 'transparent',
                                           color = NA))
    tagList(renderPlot(g), br())
  } else NULL
}

Server

To show that the input naming ids worked. The first part just renders the ids of the shiny inputs into text. renderUI can be used to not only create dynamic inputs but dynamic outputs as well. Using lapply now, you only need to pass in the shiny input id to be able to call to it in the render_plot_data function. Once again, you see how much you are able to hide the underlying complexity in the server.

server <- function(input, output) {
   reactDiamonds <- reactive({
     names(input)
   })
   output$inputNames <- renderText(reactDiamonds())
   observe({
     output$plots <- renderUI({
       lapply(names(input),
              shinyInput = input,
              render_plot_data)
     })
   })
}

End Product

And thats it! With just a little bit of code, you can do some powerful things with shiny. Let the data do the work. Resources for learning more are listed below with the full code to try out as well. Here’s a snapshot of the end product:

Further Reading

Creating a UI from a loop

Shiny Dynamic Number of Output Element Plots

Full Code

library(shiny)
library(shinythemes)
library(ggplot2)
data("diamonds")
set.seed(311)
diamonds[['randomGroups']] <- sample(as.character(1:5), 
                                     nrow(diamonds), 
                                     replace = TRUE)

build_shiny_input <- function(x, id) {
  if (is.double(x)) {
    sliderInput(id, id, min = min(x), max = max(x), value = c(min(x), max(x)))
  } else if (is.ordered(x)) {
    selectInput(id, id, choices = unique(sort(x)),
                selected = as.character(unique(sort(x))), multiple = TRUE)
  } else if (is.factor(x) | is.character(x)) {
    checkboxGroupInput(id, id, choices = sort(unique(x)),
                       selected = sort(unique(x)))
  } else if (is.integer(x)) {
    sliderInput(id, id, value = c(min(x),max(x)), 
                step = 1, min = min(x), max = max(x))
  } else {
    NULL
  }
}

render_plot_data <- function(inputName, shinyInput) {
  x <- diamonds[[inputName]]
  if (is.double(x)) {
    i <- x >= shinyInput[[inputName]][1] & x <= shinyInput[[inputName]][2]
    g <- ggplot(diamonds[i, ]) +
      geom_density(aes(!!sym(inputName))) +
      theme_bw() +
      theme(panel.background = element_rect(fill = 'transparent'),
            plot.background = element_rect(fill = 'transparent',
                                           color = NA))
    tagList(renderPlot(g), br())
  } else if (is.character(x) | is.factor(x)) {
    i <- x %in% shinyInput[[inputName]]
    g <- ggplot(diamonds[i, ]) +
      geom_bar(aes(!!sym(inputName))) +
      theme_bw() +
      theme(panel.background = element_rect(fill = 'transparent'),
            plot.background = element_rect(fill = 'transparent',
                                           color = NA))
    tagList(renderPlot(g), br())
  } else NULL
}

shinyInputs <- mapply(diamonds, 
                      id = names(diamonds), 
                      FUN = build_shiny_input,
                      SIMPLIFY = FALSE)

ui <- fluidPage(theme = 'flatly',
   
   titlePanel("Dynamic Shiny UI"),
   
   sidebarLayout(
      sidebarPanel(
         tagList(shinyInputs)
      ),
      
      mainPanel(
         h3("Generated Inputs"),
         textOutput("inputNames"),
         uiOutput("plots")
         
      )
   )
)

server <- function(input, output) {
   reactDiamonds <- reactive({
     names(input)
   })
   output$inputNames <- renderText(reactDiamonds())
   observe({
     output$plots <- renderUI({
       lapply(names(input),
              shinyInput = input,
              render_plot_data)
     })
   })
}

shinyApp(ui = ui, server = server)