suppress effect of submitButton on startup of shiny app - r

I have a shiny app with a reactive bit of UI which is used to filter my data. I then use the data for plotting. My reactive bit of UI checks all possible values of a variable, offers them as choices in a selectizeInput and starts with all of the choices selected. In my actual app changes in the filter can take quite a bit of time to run so I have submitButton to prevent the app from constantly updating. The only problem is on the initial startup of the app: It loads the choices in to the dynamic UI and selects them, but because further reactivity is blocked by the submitButton, this information doesn't reach the plot and so it shows an empty plot. All that's needed to get the desired result is hit the sumbitButton once. Once this is done the app works as desired.
I'm looking for a way to make the plot show initially without having to press the submitButton. In my following toy example this could probably be done quite easily by replacing the submitButton with an actionButton so that not all reactivity is frozen, which seems to be the solution in a lot of problems involving submitButtons in other question. However, in my actual app there are numerous inputs and sources of reactivity so configuring the actionButton and capturing all desired effects in observeEvents would be quite tedious when the submitButton does all of this with the only problem being the startup. Are there any other ways I can make the plot show on the first startup but follow the submitButton behavior from then on?
An example app:
library(shiny)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("Cylselectui"),
submitButton("Apply changes")
),
mainPanel(
plotOutput("Carsplot")
)
)
)
server <- function(input, output) {
output$Carsplot <- renderPlot({
plotdata <- subset(mtcars, cyl %in% input$Cylselection) #Filter based on cyl
ggplot(plotdata, aes(x = mpg, y = hp, colour = factor(cyl))) + #Create plot
geom_point()
})
output$Cylselectui <- renderUI({ #Create the cyl selectize ui based on the values of cyl that are in the data
selectizeInput(
'Cylselection', 'Select by Cylinder',
choices = sort(unique(mtcars$cyl)),
selected = sort(unique(mtcars$cyl)),
multiple = TRUE
)
})
}
shinyApp(ui = ui, server = server)

You can use a reactive to check whether the input is null (first time) and then provide your defaults values:
Cylselection <- reactive({
if(is.null(input$Cylselection))
sort(unique(mtcars$cyl))
else
input$Cylselection})
output$Carsplot <- renderPlot({
plotdata <- subset(mtcars, cyl %in% Cylselection()) #Filter based on cyl
ggplot(plotdata, aes(x = mpg, y = hp, colour = factor(cyl))) + #Create plot
geom_point()
})
More elegant is to put your data subset in the reactive:
plotdata <- reactive({
if(is.null(input$Cylselection))
mtcars
else
subset(mtcars, cyl %in% input$Cylselection)})
output$Carsplot <- renderPlot({
ggplot(plotdata(), aes(x = mpg, y = hp, colour = factor(cyl))) + #Create plot
geom_point()
})

Related

Shiny: selectInput based on previous selectInput resetting the selected value

There are several questions on this issue, including here, but I am still not sure what I need to change to get this right.
The selectInput choices are working as expected, other than when I change the second selectInput, it temporarily changes to the desired selection but then automatically goes back to the first filtered selection.
For example, if "gear" is chosen for Variable 1, then the Variable 1 choices correctly display "3, 4, 5" for possible gear choices. If I select "5" for gear, it briefly shows up and then goes back to gear "3" as a choice. I am not sure how to prevent that reactive behavior.
Here is a simple reproducible example using the mtcars built-in data set:
library(tidyverse)
library(shiny)
# Variables interested in selecting
my_vars <- c("cyl", "gear", "carb")
# UI
ui <- fluidPage(
# Title
titlePanel("Reprex"),
# Sidebar
sidebarLayout(
sidebarPanel(
selectInput("sel_1",
"Variable 1",
choices = my_vars,
selected = my_vars[[1]],
multiple = FALSE
),
selectInput("sel_2",
"Variable 1 choices",
choices = unique(mtcars[[ my_vars[[1]] ]]),
multiple = FALSE
)
), # sidebarPanel close
# Plot
mainPanel(
plotOutput("plot_out")
) # mainPanel close
) # sidebarLayout close
) # UI close
# Server
server <- function(input, output, session) {
output$plot_out <- renderPlot({
# Assign inputs
sel_1 <- input$sel_1
sel_2 <- input$sel_2
# Make drop-down choice of sel_2 dependent upon user input of sel_1
# *** Must put "shiny::observe" instead of "observe" since "observe" is masked by the Tidy infer package ***
shiny::observe({
updateSelectInput(session,
"sel_2",
choices = sort(unique(mtcars[[sel_1]]))
)
})
# Data to plot
my_data <- mtcars %>%
filter(.data[[sel_1]] == sel_2)
# Plot
p <- ggplot(my_data, aes(x = factor(.data[[sel_1]]), y = hp)) + geom_point()
p
})
}
# Run the application
shinyApp(ui = ui, server = server)
That's because your observer is inside the renderPlot. It has nothing to do here.
server <- function(input, output, session) {
# Make drop-down choice of sel_2 dependent upon user input of sel_1
observeEvent(input$sel_1, {
updateSelectInput(session,
"sel_2",
choices = sort(unique(mtcars[[input$sel_1]]))
)
})
output$plot_out <- renderPlot({
# Assign inputs
sel_1 <- input$sel_1
sel_2 <- input$sel_2
# Data to plot
my_data <- mtcars %>%
filter(.data[[sel_1]] == sel_2)
# Plot
ggplot(my_data, aes(x = factor(.data[[sel_1]]), y = hp)) + geom_point()
})
}
Here the observeEvent instead of observe is not necessary, since input$sel_1 is the only reactive value inside the observer, but I find that observeEvent is more readable.
Also, avoid to load tidyverse. That loads a ton of packages you don't need. Here dplyr and ggplot2 are enough

ggplot not working properly inside eventReactive() in shiny

I wasted hours to find out why my plot is automatically updating itself when I change inputs while it was supposed to wait for the Run button but it simply ignored that step and I ended up finally finding ggplot as the trouble maker!!! This is my minimal code:
library(ggplot2)
library(tidyverse)
varnames <- names(cars)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(
width = 12,
# Variables Inputs:
varSelectInput("variables", "Select Input Variables", cars, multiple = TRUE),
selectizeInput("outvar", "Select Output Variable", choices = varnames, "speed", multiple = F),
# Run Button
actionButton(inputId = "run", label = "Run")
)
)
),
# Main panel for displaying outputs ----
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
df <- reactive({
cars %>% dplyr::select(!!!input$variables, input$outvar)
})
plt <- eventReactive(input$run, {
#Just creating lm formula
current_formula <- paste0(input$outvar, " ~ ", paste0(input$variables, collapse = " + "))
current_formula <- as.formula(current_formula)
#Fitting lm
fit <- lm(current_formula, data = df())
pred <- predict(fit, newdata = df())
#Plotting
ggplot(df(), aes(df()[, input$outvar], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
#plot(df()[, input$outvar], pred) #This one works fine!!!!
})
output$plot <- renderPlot({
plt()
})
}
# Run the application
shinyApp(ui = ui, server = server)
If you run this, you'll notice that ggplot doesn't care anymore about the Run button after the 1st run and it keeps updating as you change the inputs!! However, if you use the simple base plot function (which I put in a comment in the code) there wouldn't be any problems and that works just fine! Sadly I need ggplot in my app because base plot is ugly. I am seeing suggestion for using isolate() to solve this issue but I have no clue where isolate() should be put to fix my problem also it doesn't make sense to use isolate() when base plot function works fine without it and it's the ggplot that makes the problem. Any explanation would be appreciated.
The issue is that ggplot aesthetics are lazy evaluated. You really want to put symbols into the aes() rather that reactive data values. Change your plotting code to
ggplot(df(), aes(.data[[input$outvar]], pred)) +
labs(x = "Observed", y = "Predicted") +
geom_point() +
theme_bw()
With ggplot you use the .data pronoun to access the current data source rather than trigger the reactive df() object again.

Adding checkboxInput to RShiny

I'm really new to using RShiny and I'm struggling to add a Checkbox. There are a few stages to the task I've been given but I'm currently stuck on this step. My aim currently is to create a webapp which displays a boxplot graph with the x-axis (categorical) and y-axis (numerical) variables being dependent on a selectInput. So far I've gotten this to work but now I need to add a checkbox such that when it is clicked on, the boxplots split up into separate plots by categorical level. I've tried a few variations of code but I'm not really getting anywhere and the best I've come up with I think is the following:
library(shiny)
library(palmerpenguins)
library(dplyr)
library(ggplot2)
data <- penguins[,-2]
colnames(data) <- c("Species",
"Bill Length (mm)",
"Bill Depth (mm)",
"Flipper Length (mm)",
"Body Mass (g)",
"Sex",
"Year")
data.numeric <- data[, c(2:5, 7)]
data.categorical <- data[, c(1,6)]
ui <- fluidPage(
headerPanel("Penguin boxplots"),
selectInput("ycol",
"Numeric Variable",
names(data.numeric),
selected = names(data.numeric)[3]),
selectInput("xcol",
"Categorical Variable",
names(data.categorical),
selected = names(data.categorical)[2]),
checkboxInput("split",
"Split Levels",
value = FALSE),
mainPanel(
plotOutput("plot1")
))
server <- function(input, output){
reactive({ if (input$split){
output$plot1 <- renderPlot({
selectedData <- reactive({
data[, c(input$xcol, input$ycol)]
})
plot(selectedData())
})
} else {
output$plot1 <- renderPlot({
par(mar = c(20, 4.1, 0, 1))
selectedData <- reactive({
data[, c(input$xcol, input$ycol)]
})
plot(selectedData())
})
}
})
}
shinyApp(ui = ui, server = server)
as you'll see, the code here isn't intended to actually split the graphs up, it's just there for me to be able to test the code until I can get the if and else statements working - then i'll facet the plots appropriately. So really, my issue is getting the if and else statement to work.
Any help would be really appreciated! Thanks folks
You can try something like this for server.
I would recommend avoiding nesting output and reactive expressions inside other reactive expressions, and duplicating output$plot1.
Instead, you can simplify, and include an if/else inside your renderPlot to show different visualizations depending on checkbox. I added a bit to demonstrate differences in plotting with different checkbox states.
Certainly, additional reactive expressions could be helpful, depending on what else you may want to include in your app.
Edit: Replaced plot with ggplot geom_boxplot and uses facet_wrap.
server <- function(input, output){
output$plot1 <- renderPlot({
selectedData <- data[, c(input$xcol, input$ycol)]
if (input$split) {
ggplot(data = selectedData, aes(y = .data[[input$ycol]])) +
geom_boxplot() +
facet_wrap(~.data[[input$xcol]])
} else {
ggplot(data = selectedData, aes(x = .data[[input$xcol]], y = .data[[input$ycol]])) +
geom_boxplot()
}
})
}

Displaying only those x values selected by the user

I'm new to R. I have a large dataset that I want the user to be able to select the x values plotted on a graph. To make it easier, I've done the same thing using the mpg dataset:
library(shiny)
ui <- fluidPage(
selectInput(
inputId= "manuf",
label= "Manufacturer",
choices= mpg$manufacturer,
multiple= TRUE
),
plotOutput("graph1")
)
server <- function(input, output) {
output$graph1 <- renderPlot({
ggplot() +
geom_point (
mapping = aes (
x= input$manuf,
y= ???
)
)
})
}
shinyApp(ui = ui, server = server)
I can't for the life of me figure out what the correct syntax is for the 'y' input. I have been googling my heart out and can't figure it out, and I'm sure it's relatively simple. I want it to only output the data for whatever you've selected in the drop down.
putting in y= mpg$hwy shows ALL hwy datapoints when one manufacturer is selected and throws an error ("Aesthetics must be either length 1 or the same as the data") with more. I think the errors are self-explanatory, but that doesn't help me figure out the correct code for 'y'. Ideas? Thanks in advance.
The aesthetic mappings for ggplot (like aes(x = ...)) should be column names, but you aren't giving the user a choice of column names, you give the user the choice of manufacturer values---which correspond to rows. If you want the user to select certain rows to plot based on the manufacturer, you should subset/filter the data that you give to ggplot, perhaps like this:
library(shiny)
library(ggplot2)
ui <- fluidPage(
selectInput(
inputId = "manuf",
label = "Manufacturer",
choices = mpg$manufacturer,
multiple = TRUE
),
plotOutput("graph1")
)
server <- function(input, output) {
output$graph1 <- renderPlot({
ggplot(data = mpg[mpg$manufacturer %in% input$manuf, ]) +
geom_point (
mapping = aes (
x = manufacturer,
y = hwy
)
)
})
}
shinyApp(ui = ui, server = server)
Let's forget about Shiny for a moment and focus on how you would filter a dataset for plotting with ggplot(). The tidyverse approach is to use dplyr::filter:
library(dplyr)
library(ggplot2)
mpg %>%
filter(manufacturer == "audi") %>%
ggplot(aes(manufacturer, hwy)) +
geom_point()
So your server function would look something like this (untested):
server <- function(input, output) {
output$graph1 <- renderPlot({
mpg %>%
filter(manufacturer == input$manuf) %>%
ggplot(aes(manufacturer, hwy)) +
geom_point()
)}
}

dynamic ggplot layers in shiny with nearPoints()

I'm familiar with the basics of shiny but struggling with something here. I would like to be able to add a ggplot layer when a point is clicked to highlight that point. I know this is possible with ggvis and there is a nice example in the gallery, but I would like to be able to use nearPoints() to capture the click as ui input.
I have tried something (see below) which works apart from the ggplot layer appears and then disappears. I have tried all kinds of edits to this with reactive(), eventReactive() and so on.
Any help is much appreciated...
library(shiny)
library(ggplot2)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
output$plot <- renderPlot({
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = nearPoints(mtcars, input$clicked), colour = "red", size = 5)
})
})
)
I think I understand conceptually why this doesn't work. The plot has a dependency on input$clicked which means that when input$clicked changes the plot re-renders but this in turn resets input$clicked. Bit of a catch 22 situation.
Please, try this:
Approach 1 (recommended)
library(shiny)
library(ggplot2)
# initialize global variable to record selected (clicked) rows
selected_points <- mtcars[0, ]
str(selected_points)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
selected <- reactive({
# add clicked
selected_points <<- rbind(selected_points, nearPoints(mtcars, input$clicked))
# remove _all_ duplicates if any (toggle mode)
# http://stackoverflow.com/a/13763299/3817004
selected_points <<-
selected_points[!(duplicated(selected_points) |
duplicated(selected_points, fromLast = TRUE)), ]
str(selected_points)
return(selected_points)
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = selected(), colour = "red", size = 5)
})
})
)
If you click a point one time it is highlighted. If you click it a second time the highlight is turned off again (toggling).
The code uses a global variable selected_points to store the actually highlighted (selected) points and an reactive expression selected() which updates the global variable whenever a point is clicked.
The str(selected_points) may help to visualize the working but can be removed.
Approach 2 (alternative)
There is a slightly different approach which uses observe() instead of reactive() and references the global variable selected_points directly instead of returning the object from a function:
library(shiny)
library(ggplot2)
selected_points <- mtcars[0, ]
str(selected_points)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
observe({
# add clicked
selected_points <<- rbind(selected_points, nearPoints(mtcars, input$clicked))
# remove _all_ duplicates (toggle)
# http://stackoverflow.com/a/13763299/3817004
selected_points <<-
selected_points[!(duplicated(selected_points) |
duplicated(selected_points, fromLast = TRUE)), ]
str(selected_points)
})
output$plot <- renderPlot({
# next statement is required for reactivity
input$clicked
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = selected_points, colour = "red", size = 5)
})
})
)
Of course, you can use the global variable selected_points directly in the ggplot call instead of calling the reactive function selected(). However, you have to ensure that renderPlot() is executed whenever input$clicked is changed. Therefore, the dummy reference to input$clicked has to be included in the code within renderPlot().
Now, the reactive function selected() is no longer needed and can be replaced by an observe() expression. As opposed to reactive(), observe() doesn't return a value. It just updates the global variable selected_points whenever input$clicked is modified.
Approach 3 (reactive values)
This approach avoids a global variable. Instead, it uses reactiveValues to create a list-like object rvwith special capabilities for reactive programming (see ?reactiveValues).
library(shiny)
library(ggplot2)
shinyApp(
ui = shinyUI(
plotOutput("plot", click = "clicked")
),
server = shinyServer(function(input, output) {
rv <- reactiveValues(selected_points = mtcars[0, ])
observe({
# add clicked
rv$selected_points <- rbind(isolate(rv$selected_points),
nearPoints(mtcars, input$clicked))
# remove _all_ duplicates (toggle)
# http://stackoverflow.com/a/13763299/3817004
rv$selected_points <- isolate(
rv$selected_points[!(duplicated(rv$selected_points) |
duplicated(rv$selected_points, fromLast = TRUE)), ])
str(rv$selected_points)
})
output$plot <- renderPlot({
ggplot(mtcars, aes(x = mpg, y = wt)) +
geom_point() +
geom_point(data = rv$selected_points, colour = "red", size = 5)
})
})
)
Please, note that in the observer part references to rv need to be encapsulated in isolate() to ensure that only changes to input$clicked will trigger execution of the code in observer. Otherwise, we'll get an endless loop. Execution of renderPlot is triggered whenever the reactive value rv is changed.
Conclusion
Personally, I prefer approach 1 using reactive functions which make the dependencies (reactivity) more explicit. I find the dummy call to input$clicked in approach 2 less intuitive. Approach 3 requires a thorough understanding of reactivity and using isolate() in the right places.

Resources