Skip to content

Instantly share code, notes, and snippets.

@FrissAnalytics
Created November 3, 2015 19:32
Show Gist options
  • Save FrissAnalytics/3567fb939590d55b108b to your computer and use it in GitHub Desktop.
Save FrissAnalytics/3567fb939590d55b108b to your computer and use it in GitHub Desktop.
using renderUI based input in a Shiny Module
library(shiny)
library(ggplot2)
# module UI function
scatterOuput <- function(id){
ns <- NS(id)
tagList(
br(),
fluidRow(
column(6,
# dynamic controls to select x and y in plot1, to be rendered via server
uiOutput(ns("dynamicControls")),
# plot 1
plotOutput(ns("plot1"))
),
column(6,
# dynamic controls to select x and y in plot2
fluidRow(
column(offset = 2, 4,
selectInput(ns("x2"),"x2",choices = names(mtcars), width = "100%")
),
column(4,
selectInput(ns("y2"),"y2",choices = names(mtcars), width = "100%")
)
),
# plot 2
plotOutput(ns("plot2"))
)
)
)
}
# module server function
scatter <- function(input, output, session, data) {
# set data
data <- mtcars
# dynamic controls
output$dynamicControls <- renderUI({
tagList(
fluidRow(
column(offset = 2, 4,
selectInput("x1","x1",choices = names(mtcars), width = "100%")
),
column(4,
selectInput("y1","y1",choices = names(mtcars), width = "100%")
)
)
)
})
# plot 1
output$plot1 <- renderPlot({
scatterPlot(data, c(input$x1,input$y1))
#scatterPlot(data, c("mpg","disp"))
})
# plot2
output$plot2 <- renderPlot({
scatterPlot(data, c(input$x2,input$y2))
})
}
# plot helper function
scatterPlot <- function(data, cols) {
ggplot(data, aes_string(x = cols[1], y = cols[2])) + geom_point()
}
# main ui
ui <- fixedPage(
scatterOuput("id1")
)
# main server
server <- function(input, output, session) {
callModule(scatter, "id1", data = mtcars)
}
# run app
shinyApp(ui, server)
@aquacalc
Copy link

aquacalc commented Mar 6, 2017

@cmdcolin:

As I learned from Joe Cheng's article on RStudio, wrap the id attributes of the selectInputs in the renderUI call with the session namespace assigned at the top of the server module function:


**ns <- session$ns**

  output$dynamicControls <- renderUI({
    tagList(
      fluidRow(
        column(offset = 2, 4,
               selectInput(**ns("x1")** ,"x1",choices = names(mtcars), width = "100%")
        ),
        column(4,
               selectInput(**ns("y1")** ,"y1",choices = names(mtcars), width = "100%")
        )
      )
    )
  })

(I've had namespace problems when rendering datatables in module server functions, too,)

@aquacalc
Copy link

aquacalc commented Mar 6, 2017

BTW, to get rid of red error message that flashes before plot #1 is displayed, modify output$plot1 ...

output$plot1 <- renderPlot({

 **req(input$x1, input$y1, cancelOutput = T)**

  scatterPlot(data, c(input$x1,input$y1))
  #scatterPlot(data, c("mpg","disp"))
})

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment