Updating an input and triggering an action button inside an observer - r

I have an application which utilizes an actionButton to apply a filter selection to a plot. The application also contains a reset actionButton which resets the drop-down selector to its original value, in this instance mpg.
I would like to know whether it is possible to have the reset button not only update the selector itself, but then trigger the apply button so that the plot is reverts back to showing mpg as the y-axis value as it did at initialization.
Please note that the application must utilize the reactiveValues construct shown below as that is present in the actual business use case.
library(shiny)
library(plotly)
ui <- fluidPage(
## input and output ui elements and apply/reset buttons
selectInput("var", "Select Y-Axis Variable", c("mpg", "hp", "wt", "am")),
actionButton("apply", "Apply"),
actionButton("reset", "Reset"),
plotlyOutput("plot")
)
server <- function(input, output, session) {
## stored default values
plot_vals <- reactiveValues(y = "mpg")
observeEvent(input$apply, {
plot_vals$y <- input$var
})
## render plot
output$plot <- renderPlotly(
mtcars %>%
plot_ly(x = ~disp,
y = ~get(plot_vals$y),
type = "scatter",
mode = "markers")
)
## update selectors (how can I have this segment not only update the drop down, but also trigger the apply button?)
observeEvent(input$reset, {
updateSelectInput(session = session, "var", selected = "mpg")
})
}
shinyApp(ui, server)

Just update the reactiveVal on reset:
library(shiny)
library(plotly)
ui <- fluidPage(
## input and output ui elements and apply/reset buttons
selectInput("var", "Select Y-Axis Variable", c("mpg", "hp", "wt", "am")),
actionButton("apply", "Apply"),
actionButton("reset", "Reset"),
plotlyOutput("plot")
)
server <- function(input, output, session) {
## stored default values
plot_vals <- reactiveValues(y = "mpg")
observeEvent(input$apply, {
plot_vals$y <- input$var
})
## render plot
output$plot <- renderPlotly({
mtcars %>%
plot_ly(x = ~disp,
y = ~get(plot_vals$y),
type = "scatter",
mode = "markers")
})
## update selectors (how can I have this segment not only update the drop down, but also trigger the apply button?)
observeEvent(input$reset, {
updateSelectInput(session = session, "var", selected = "mpg")
plot_vals$y <- "mpg"
})
}
shinyApp(ui, server)

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

Autoplot in shiny with Select Input not working

I'm trying to create an autoplot that will show a plot based on what variable the user selects, but it just shows up as a straight line even though the name on the y axis does change depening on what the user chooses. Here is a basic version of the code:
library(shiny)
library(fpp3)
ui <- fluidPage(
selectInput("select", "Choose variable", choices = names(aus_production)),
plotOutput("plot")
)
server <- function(input,output){
output$plot <- renderPlot({
aus_production %>% autoplot(input$select)
})
}
shinyApp(ui = ui,server = server)
You are calling ?autoplot.tbl_ts and that method requires an expressio for the variable, not a string which is what input$select returns. Instead you can use the .data pronoun
server <- function(input,output){
output$plot <- renderPlot({
aus_production %>% autoplot(.data[[input$select]])
})
}

Creating several selectInputs from same variable in Shiny & calling in plot

I am challenged trying to implement a feature into my Shiny app. The problem is two-fold:
Is it possible to have 2 inputs from the same variable? I have one variable that is a list of indicators. I want the user to be able to select 2 indicators with selectInput, and then draw a scatter plot. There has to be 2 selectInputs because other parts of the app will rely on only the first selectInput. My data is long. I don't think it will work if I make it wide because my data includes latitude and longitude information so it wouldn't make sense to create a selectInput with names(data), for example.
If I can have 2 selectInputs from the same variable, how would I call the values in my plot, since the value is called 'value' for both the inputs?
EDIT: Following Gregor's suggestion to reference the inputs with aes_string, I would expect the following example of mtcars gathered into long format to work, but I instead get an aesthetics or object not found error. I think I probably need to filter the data, but I don't understand how I can do that since my variable indicators now refers to both 'indicators' and 'indicators2'. I.e., I can't have
filtered <-
cars %>%
filter(indicators == input$indicators,
indicators == input$indicators2)
Maybe I need to create a reactive expression that creates a new data frame instead? This is my non-working reproducible code with long-form mtcars:
library(ggplot2)
library(shiny)
cars <- mtcars %>%
gather(indicators, value, mpg:carb)
ui <- fluidPage(
# Application title
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
selectInput("indicators",
label = "select indicator:",
choices = c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
),
selectInput("indicators2",
label = "select indicator:",
choices = c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs", "am", "gear", "carb")
)
),
mainPanel(
plotOutput("carsPlot")
)
)
)
server <- function(input, output) {
output$carsPlot <- renderPlot({
ggplot(cars, aes_string(x = input$indicators, y = input$indicators2)) +
geom_point(shape = 1)
})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use aes_string to pass input$indicators and input$indicators2 to ggplot like this. There is no need to cast your data into wide format since ggplot can actually handle long data better.
library(ggplot2)
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
selectInput("indicators",
label = "select indicator:",
choices = names(mtcars)),
selectInput("indicators2",
label = "select indicator:",
choices = names(mtcars))
),
mainPanel(
plotOutput("carsPlot")
)
)
)
server <- function(input, output) {
output$carsPlot <- renderPlot({
ggplot(mtcars, aes_string(x = input$indicators, y = input$indicators2)) +
geom_point(shape = 1)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Here another solution with a selectInput in multiple mode.
library(dplyr)
library(tidyr)
library(ggplot2)
library(shiny)
cars <- mtcars %>%
gather(indicators, value, mpg:carb)
ui <- fluidPage(
titlePanel("mtcars"),
sidebarLayout(
sidebarPanel(
uiOutput("ui_indicators")
),
mainPanel(
plotOutput("carsPlot")
)
)
)
server <- function(input, output) {
output$ui_indicators <- renderUI({
choices <- unique(cars$indicators)
selectInput("indicators",
label = "select indicators :",
choices = choices,
multiple = TRUE)
})
output$carsPlot <- renderPlot({
filtered <- cars %>% filter(indicators %in% input$indicators)
ggplot(filtered, aes(x = indicators, y = value)) +
geom_point(shape=1)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Building on the tip from Gregor on aes_string, I managed to fix this. I ended up using the wide data and adding a proper reactive statement that creates a new data frame out of the selected indicators.
My server function now looks like this:
server <- function(input, output) {
selectedVars <- reactive({
cars[, c(input$indicators, input$indicators2)]
})
output$carsPlot <- renderPlot({
ggplot(selectedVars(), aes_string(x = input$indicators, y = input$indicators2)) +
geom_point(shape = 1)
})
}
All works beautifully, and I am beginning to learn more about the utility of reactive functions in Shiny :)
Gregor de Cillia provided the answer I was looking for.
The two inputs (which are not a problem) can be referenced using aes_string.

attempt to apply non-function

I'm trying to build a simple application that draws a histogram of a selected variable based on a subset filtered by the other input. I get the error in the line hist(dataX()$datasetInput()) which should return dataX$mpg. How can I fix it?
Full code:
library(shiny)
u <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(
selectInput("variable", "Variable:",
list("Milles/gallon",
"Horse power")
),
textInput("nc","Number of cylinders",value = 6)
),
mainPanel(
plotOutput("Plot")
)
))
s <- shinyServer(function(input, output)
{
dataX <- reactive({mtcars[mtcars$cyl==input$nc,,drop = FALSE]})
datasetInput <- reactive({
switch(input$variable,
"Milles/gallon" = mpg,
"Horse power" = hp)
})
output$Plot <- renderPlot({
hist(dataX()$datasetInput())
})
})
shinyApp(u,s)
You complicated the simple app.
You do not need to list all the columns in selectInput. You can just render it from the server side.
Same applies to the cylinders
Shortcuts like u and sare acceptable, but just stick to the naming conventions. It makes your life easy.
Below is a complete working app
library(shiny)
ui <- shinyUI(pageWithSidebar(
headerPanel("Staz w bezrobociu"),
sidebarPanel(uiOutput("SelectColname"),
uiOutput("Cylinders")),
mainPanel(plotOutput("Plot"))
))
server <- shinyServer(function(input, output){
# Create a reactive dataset
dataX <- reactive({
mtcars
})
# Output number cylinders as select box
output$Cylinders <- renderUI({
selectInput("cylinders", "cylinders:", unique(dataX()$cyl))
})
# Output column names as selectbox
output$SelectColname <- renderUI({
selectInput("variable", "Variable:", colnames(dataX()[,c(1,4)]))
})
# Based on the selection by user, create an eventreactive plotdata object
plotdata <- eventReactive(input$cylinders, {
plotdata = dataX()[dataX()$cyl == input$cylinders, , drop = FALSE]
})
# Render the plot, the plot changes when new cylinder is selected
output$Plot <- renderPlot({
if (is.null(plotdata()))
return(NULL)
hist(
plotdata()[, input$variable],
xlab = input$variable,
main = paste(
"Histogram of" ,
input$variable
)
)
})
})
shinyApp(ui, server)

Mouse click event in rshiny

I'm trying to use click events using the plot_click option in RShiny. What I want to do is:I want to select a particular bubble from the first chart and then the chart below should be populated only for the above selected car. How to do this? Here is my code :
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mt$wt, mt$mpg)
})
output$plot2 <- renderPlot({
test <- data.frame(nearPoints(mt, input$plot_click, xvar = "wt", yvar = "mpg"))
test2 <- filter(test,Car_name)
car <- test2[1,1]
mt2 <- filter(mt,Car_name == car)
plot(mt2$wt,mt2$mpg)
})
}
shinyApp(ui, server)
I rearranged your server-function a bit. I moved the selected points to a reactive Value, which can be used by print/plot outputs.
Furthermore, i am not exactly sure what you want to achievewith all that filtering. Maybe you could change your original question an make a reproducible example out of it with the mtcars-data, as it seems you are using that.
library(shiny)
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
verbatimTextOutput("info"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
selected_points <- reactiveValues(pts = NULL)
observeEvent(input$plot_click, {
x <- nearPoints(mtcars, input$plot_click, xvar = "wt", yvar = "mpg")
selected_points$pts <- x
})
output$info <- renderPrint({
selected_points$pts
})
output$plot2 <- renderPlot({
req(input$plot_click)
test <- selected_points$pts
plot(test$wt,test$mpg)
})
}
shinyApp(ui, server)
The clicked points are stored in the selected_points reactive Value, which is assigned in the observeEvent function.
If you filter a lot in the plot2-function, you would have to use req() or validate(), as it may be possible that no value is left over and therefore nothing can be plotted.
I hope that helps.

Resources