When I try to feed to uiOutput to renderUI while using tabPanel in shiny I get an error in the first run. After switching tabs, the app runs ok.
Here is a minimal example that reproduces the error
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("Data",
uiOutput("moreControls")
),
tabPanel("Research",
uiOutput("moreControls2")
)
),
plotOutput("plot1")
)
server <- function(input, output) {
output$moreControls <- renderUI({
tagList(
sliderInput("mean", "Mean", -10, 10, 1),
textInput("label", "Label")
)
})
output$moreControls2 <- renderUI({
tagList(
sliderInput("sd", "SD", 1, 50, 10),
textInput("label2", "Label2")
)
})
output$plot1 <- renderPlot({
hist(rnorm(n = 100,input$mean, input$sd) , xlim = c(-100, 100) )
})
}
shinyApp(ui, server)
#Vivek's answer is nice but here is another way:
server <- function(input, output) {
output$moreControls <- renderUI({
tagList(
sliderInput("mean", "Mean", -10, 10, 1),
textInput("label", "Label")
)
})
output$moreControls2 <- renderUI({
tagList(
sliderInput("sd", "SD", 1, 50, 10),
textInput("label2", "Label2")
)
})
outputOptions(output, "moreControls2", suspendWhenHidden = FALSE)
output$plot1 <- renderPlot({
req(input$mean, input$sd)
hist(rnorm(n = 100, input$mean, input$sd) , xlim = c(-100, 100) )
})
}
shinyApp(ui, server)
The input$mean is not available before the uiOutput renders, and input$sd too, but in addition input$sd is not available until you switch to the second tab, because the sliderInput is hidden.
The reason it doesn't work is because Shiny hasn't evaluated those values when your app runs. As such, the input values aren't actually available to renderPlot()
A good way to pass in values for the plot would be to use a reactive expression. In the code below I have used plot_params() and inside the reactive, I make a list which stores the parameters of producing your plot.
I'd also recommend using shiny::validate() to ensure that the input values are valid before rendering output. (See use below)
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("Data",
uiOutput("moreControls")
),
tabPanel("Research",
uiOutput("moreControls2")
)
),
plotOutput("plot1")
)
server <- function(input, output) {
output$moreControls <- renderUI({
tagList(
sliderInput("mean", "Mean", -10, 10, 1),
textInput("label", "Label")
)
})
output$moreControls2 <- renderUI({
tagList(
sliderInput("sd", "SD", 1, 50, 10),
textInput("label2", "Label2")
)
})
# Reactive expression for plot parameters.
plot_params <- reactive({
list(
mean = input$mean,
sd = input$sd
)
})
output$plot1 <- renderPlot({
validate(
need(input$mean, 'Please check that mean is set!'),
need(input$sd, 'Please check that sd is set.')
)
hist(rnorm(n = 100, plot_params()$mean, plot_params()$sd) , xlim = c(-100, 100) )
})
}
shinyApp(ui, server)
Related
I wonder how we can track changes when the user modifies the input in R Shiny. For example, I want to count the number of times the user changes the x input in the following code, but it seems not to be working.
library(shiny)
ui <- fluidPage(
selectInput(inputId = "x", label = "X", choices = names(mtcars), selected = names(mtcars)[1]),
br(),
br(),
verbatimTextOutput("out")
)
server <- function(input, output, session) {
r <- reactiveVal(0)
y <- eventReactive(input$x,{
r() + 1
})
output$out <- renderPrint({
y()
})
}
shinyApp(ui, server)
Setting the value for a reactiveVal is done by assigning it like this:
r() = 0
r(1) = 1, etc.
So adjust your code like this:
library(shiny)
ui <- fluidPage(
selectInput(inputId = "x", label = "X", choices = names(mtcars), selected = names(mtcars)[1]),
br(),
br(),
verbatimTextOutput("out")
)
server <- function(input, output, session) {
r <- reactiveVal(0)
y <- eventReactive(input$x,{
r(r() + 1)
return(r())
})
output$out <- renderPrint({
y()
})
}
shinyApp(ui, server)
I have a ui and a server module in shiny just like in an example in 'Mastering Shiny' by Hadley Wickham:
histogramUI <-
function(id){
tagList(
selectInput(NS(id, "var"), "Variable", choices = names(mtcars)),
numericInput(NS(id, "bins"), "bins", value = 10, min = 1),
plotOutput(NS(id, "hist"))
)
}
histogramServer <-
function(id){
moduleServer(id, function(input, output, session){
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = input$bins, main = input$var)
}, res = 96)
})
}
Now I want to create the app with two inputs and outputs named by "hist1" and "hist2".
That works fine with the following code:
histogrammApp <-
function(){
ui <- fluidPage(
histogramUI("hist1"),
histogramUI("hist2")
)
server <- function(input, output, session){
histogramServer("hist1")
histogramServer("hist2")
}
shinyApp(ui, server)
}
Each plot has its own input parameters.
Let's say I want to have a general input bins instead so that both plots will have the same amount of breaks in a numericInput. How could I achieve this?
My first attempt was to remove the line numericInput(NS(id, "bins"), "bins", value = 10, min = 1), and place the line tagList(numericInput("bins", "bins", value = 10, min = 1)), before the line histogramUI("hist1"), but this did not work. I get the following error: Invalid breakpoints produced by 'breaks(x)': NULL. input$bins is NULL, I guess. I think because it is in a different namespace? How could I come up with the problem?
You should consider passing the input$bins as a reactive to histogramServer("hist1",reactive(input$bins)). Try this
histogramUI <- function(id){
tagList(
selectInput(NS(id, "var"), "Variable", choices = names(mtcars)),
#numericInput(NS(id, "bins"), "bins", value = 10, min = 1),
plotOutput(NS(id, "hist"))
)
}
histogramServer <- function(id,bins){
moduleServer(id, function(input, output, session){
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = bins(), main = input$var)
}, res = 96)
})
}
#histogrammApp <- function(){
ui <- fluidPage(
numericInput("bins", "Bins", value = 10, min = 1),
histogramUI("hist1"),
histogramUI("hist2")
)
server <- function(input, output, session){
histogramServer("hist1",reactive(input$bins))
histogramServer("hist2",reactive(input$bins))
}
shinyApp(ui, server)
# }
#
# histogrammApp()
I want an event to be triggered for the first time only by clicking a button. After that I want it to be reactive to the slider input.
I tried the following:
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
activate = reactive({FALSE})
activate = eventReactive(input$go, {
isolate(TRUE)
})
samples = eventReactive(activate(), {
rnorm(input$n)
})
output$samples <- renderPlot({ hist(samples()) })
}
shinyApp(ui = ui, server = server)
I hoped it would make it reactive to input$n after input$go has been clicked once. But it isn't and still needs input$go to be clicked every time.
There are several ways to achieve that.
One way would be to store the value in a reactiveValues() or just use req(), see below.
The problem with using eventReactive(activate(), ... is that it only triggers the code inside if activate() is executed, which only happens if you click input$go.
Reproducible example with req():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
output$samples <- renderPlot({
req(input$go > 0)
hist(rnorm(input$n))
})
}
shinyApp(ui = ui, server = server)
Reproducible example with reactiveValues():
ui <- fluidPage(
actionButton("go", "Go"),
sliderInput("n", label = "Sample size", min = 1, max = 100, value = 10),
plotOutput('samples')
)
server <- function(input, output, session){
global <- reactiveValues(showPlot = FALSE)
observeEvent(input$go, {
global$showPlot <- TRUE
})
samples = reactive({
rnorm(input$n)
})
output$samples <- renderPlot({
req(global$showPlot)
hist(samples())
})
}
shinyApp(ui = ui, server = server)
I have a small Shiny app that generates some data whenever the New data button is pressed. The Show plot button shows a hidden plot. I would like the plot to be hidden again automatically whenever the New data button is pressed to make a new data set. A bonus would be for the plot to be hidden also as soon as the slider is changed. I am not looking for a toggle action.
I tried adapting this example that uses conditional panel but I could not successfully figure out how to correctly change the values$show between TRUE and FALSE.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
p <- eventReactive(input$show_plot, {
plot(cars)
})
output$car_plot <- renderPlot({
p()
})
}
shinyApp(ui = ui, server = server)
You can use a reactive value and a if to control the plot.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(FALSE)
t <- eventReactive(input$new_data, {
showPlot(FALSE)
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$number, {
showPlot(FALSE)
})
observeEvent(input$show_plot, {
showPlot(TRUE)
})
output$car_plot <- renderPlot({
if (showPlot())
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Alternate solution using shinyjs which is handy in these situations.
library(shiny)
library(shinyjs)
ui <- fluidPage( shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "number",
label = "Pick a number",
min = 6,
max = 12,
value = 8),
actionButton("new_data",
"New data"),
actionButton("show_plot",
"Show plot")
),
mainPanel(
tableOutput("char_table"),
plotOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
t <- eventReactive(input$new_data, {
hide("car_plot")
r <- input$number
c <- r - 1
mat <- matrix(sample(0:1,r*c, replace=TRUE),r,c)
})
output$char_table <- renderTable({
t()
})
observeEvent(input$show_plot, {
show("car_plot")
})
output$car_plot <- renderPlot({
plot(cars)
})
}
shinyApp(ui = ui, server = server)
Is there an elegant way to append plots to a render stack/array in Shiny instead of overwriting the existing plot? I want new plots to appear at the bottom of a page, so that the user can scroll upwards to view their previous work. Here's a starting point:
require(shiny)
server = function(input, output, session) {
observeEvent(input$execute, {
x = sort(rnorm(input$input))
output$plot = renderPlot( plot(x, type='l') )
})
}
ui = fluidPage(
sidebarPanel(width=4,
numericInput('input', 'Enter positive number and click \'Go\'. Then repeat with other numbers', value = NA, min = 1),
actionButton('execute', 'Go')
),
mainPanel( plotOutput('plot') )
)
shinyApp(ui, server)
Will something like this do?
require(shiny)
ui = fluidPage(
sidebarPanel(width=4,
numericInput('input', 'Enter positive number and click \'Go\'. Then repeat with other numbers', value = 123, min = 1),
actionButton('execute', 'Go')
),
mainPanel(tags$div(id="rowLabel",mainPanel()))
)
server = function(input, output, session) {
observeEvent(input$execute, {
insertUI(
selector = "#rowLabel",
where = "afterEnd",
ui = column(8,"Example2",plotOutput(paste0("Plot", input$execute)))
)
})
observeEvent(input$execute, {
plotname <- paste0("Plot", input$execute)
x = sort(rnorm(input$input))
output[[plotname]] = renderPlot( plot(x, type='l') )
})
}
shinyApp(ui, server)