renderUI+lapply: trying to build a better code

Question

I'm building a new Shiny app and I although it works, the code is too extensive and it is not as reactive as I wanted. Right now I have at server.R

dayData <- reactive({...})
pday <- function(data){...}
output$distPlotday <- renderPlot(function() {print(pday(dayData)) })

and at ui.R

plotOutput("distPlotday")

for each variable in

checkboxGroupInput("checkGroup", "Dataset Features:", 
   choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))

But I wish I could do something more fancy like this:

shinyServer(function(input, output, session) {
... 

output$sliders <- renderUI({
lapply(input$checkGroup, function(i) {
fluidRow(                          
  column(4, 
         selectInput(paste0('trans',i), i,
                     choices = c('linear','quadratic','sine')) ,
         conditionalPanel(
           condition = "input[[paste0('trans',i)]]== 'sine'",
           withMathJax(),
           h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
           textInput3(paste0('trans',i,'a'), h5('A:'), 
                      value = 10),
           textInput3(paste0('trans',i,'b'), h5('C:'), 
                      value = 1),
           textInput3(paste0('trans',i,'c'), h5('D:'), 
                      value = 0.1),
           helpText("Note: B has already been picked up")
         ),
         plotOutput(paste0('distPlot',i))
  ))
  })

 })

 ...

 }))

.

 shinyUI(navbarPage("",
               tabPanel("Data",
                        sidebarLayout(
                          sidebarPanel(
                            checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
                                               choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
                                               selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
                          ),
                          mainPanel(
                            numericInput("obs", label = h5("Number of observations to view"), 15, min = 10, max = 20, step = 1),
                            tableOutput("view")
                          )
                        )
               ),
               tabPanel("Variable transformation", uiOutput(outputId = "sliders"))
               ))

Using lapply and renderUI. But

plotOutput(paste0('distPlot',i))

is not ploting anything, and the

conditionalPanel(condition = "input[[paste0('trans',i)]]== 'sine'",...)

don't show up conditionally, instead it's always there.

Any suggestions? Thanks for the help!

Answer 1

I wasn't sure what you wanted to do with the plotOutput call, since as far as I can tell there wasn't any example code included that linked to it. However, I managed to put together a working example for dynamically showing/hiding the selection boxes and text fields for the sine parameters.

I found it easier to implement by moving the ui generation from the server into the ui. This gets around the problem of conditions being evaluated for input that doesn't exist yet, since on the ui side the functions are just writing html.

An additional benefit is that this way the input fields don't get re-rendered every time the checkbox input changes - this means that their values persist through toggling them on and off, and that enabling or disabling a single variable won't cause the others' values to reset.

The code:

library(shiny)

vars <- c("day","hour","source","service","relevancy",
          "tollfree","distance","similarity")

ui <- shinyUI(navbarPage("",
  tabPanel("Data",
    sidebarLayout(
      sidebarPanel(
        checkboxGroupInput("checkGroup", label = h5("Dataset Features:"), 
          choices = c("day","hour","source","service","relevancy",
                      "tollfree","distance","similarity"), inline = F,
          selected = c("day", "hour","source","service","relevancy",
                       "tollfree","distance","similarity")
        )
      ),

      mainPanel(
        numericInput("obs", label = h5("Number of observations to view"),
                     value = 15, min = 10, max = 20, step = 1),
        tableOutput("view")
      )
    )
  ),

  tabPanel("Variable transformation",
    fluidRow(                          
      column(4,
        lapply(vars, function(i) {
           div(
             conditionalPanel(
               condition =
                 # javascript expression to check that the box for 
                 # variable i is checked in the input
                 paste0("input['checkGroup'].indexOf('", i,"') != -1"),

               selectInput(paste0('trans',i), i,
                           choices = c('linear','quadratic','sine'))
             ),

             conditionalPanel(
               condition =
                 paste0("input['trans", i, "'] == 'sine' ",
                    " && input['checkGroup'].indexOf('", i,"') != -1"),

               withMathJax(),
               h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
               textInput(paste0('trans',i,'a'), h5('A:'), value = 10),
               textInput(paste0('trans',i,'b'), h5('C:'), value = 1),
               textInput(paste0('trans',i,'c'), h5('D:'), value = 0.1),
               helpText("Note: B has already been picked up")
             )
           )
        })
      )
    )
  )
))

server <- shinyServer(function(input, output, session) {})

shinyApp(ui, server)

PS. For dynamically showing/hiding or enabling/disabling objects, the package shinyjs by Dean Attali (link) has some nice tools that allow you to call basic javascript by using only R syntax.