Shiny: selectInput based on previous selectInput resetting the selected value - r

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

Related

How to arrange or align the output of renderUI

I am learning how to use renderUI to dynamically generate multiple plots. Here is an example app I designed (https://yuchenw.shinyapps.io/Format_UI_Example/). The idea is to design an app that allows users to select one or more parameters in the mtcars data set and plot the row index and the value as a scatter plot dynamically.
The example app works, but all the plots are aligned in one column. As the users selected more parameters, the number of plots increases, and the length of the web page also increases. In addition, there are lots of white space. If possible, I would like to arrange or align the multiple plots as a two columns or three columns structure to reduce the length of the web page and to reduce the white space.
I usually used the column function and set the width argument to achieve this. But I don't how to do it using renderUI. I would appreciate any help.
Here is the code.
### This script creates an R shiny app that plot mpg, disp, and hp, from the mtcars data set
# Load packages
library(shiny)
library(tidyverse)
# Load data
data("mtcars")
# Add row id
mtcars2 <- mtcars %>% mutate(ID = 1:n())
# ui
ui <- fluidPage(
sidebarPanel(
selectInput(inputId = "sel", label = "Select one or more parameters",
choices = names(mtcars), multiple = TRUE)
),
mainPanel(
uiOutput("plots")
)
)
# server
server <- function(input, output, session){
# Create plot tag list
output$plots <- renderUI({
plot_output_list <- lapply(input$sel, function(par) {
plotname <- paste("plot", par, sep = "_")
plotOutput(plotname)
})
do.call(tagList, plot_output_list)
})
# Dynamically generate the plots based on the selected parameters
observe({
req(input$sel)
lapply(input$sel, function(par){
output[[paste("plot", par, sep = "_")]] <- renderPlot({
ggplot(mtcars2, aes_string(x = "ID", y = par)) +
geom_point() +
ggtitle(paste("Plot: ", par))
},
width = 250,
height = 250)
})
})
}
# Run app
shinyApp(ui, server)
Try this :
plotOutput(plotname, height = '250px', inline=TRUE)
It will give you the following output:

Creating hover info box and reactive dropdown menu in Shiny

This is my first Shiny app, and I just got the basics working to where it allows the user to select from a dropdown menu of clients, then a dropdown menu of test codes to receive a plot of the results for the selected test.
I'd like the second dropdown menu to be updated with the available test codes for that client (all are not present for each client). Also, I would like to be able to hover over the point in the plot and receive more information from the row in the original dataframe.
I've looked into tooltips and the nearPoints() function, but I'm not sure if these can be used on this data since it is manipulated. I'm not sure if at this point it would be easier to import the data in a different way (it will ultimately need to accept either excel files or .csv). Thanks for any help that you would be able to provide, please let me know if there is any other supporting info I can give.
Here is my code:
library(shiny)
library(scales)
library(ggplot2)
labData <-
read.table("MockNLData.csv",
header=TRUE, sep=",")
#convert '<10' and '<20' results
labData$ModResult <- labData$Result
levels(labData$ModResult)[levels(labData$ModResult)=="<10"]
<- "0"
levels(labData$ModResult)[levels(labData$ModResult)=="<20"]
<- "0"
#convert results to scientific notation
SciNotResult <-
formatC(as.numeric(as.character(labData$ModResult)),
format="e", digits=2)
ui <- fluidPage(
headerPanel("Dilution History"),
sidebarLayout(
sidebarPanel(
selectInput(inputId="client", label="Select Client
Name", choices=levels(labData$Client.Name)
),
selectInput(inputId="test", label="Select Test Code",
choices=levels(labData$Analysis))
),
mainPanel(
plotOutput("line", hover="plot_hov"),
verbatimTextOutput("info"))
)
)
server <- function(input, output) {
#selected client into data frame
selDF <- reactive({labData[labData[,1]==input$client,]
})
#selected test code into data frame
subsetDF <- reactive({selDF()[selDF()[,5]==input$test,]
})
#points to be plotted
points <-
reactive({as.numeric(levels(subsetDF()$ModResult))
[subsetDF()$ModResult]
})
#plot
output$line <- renderPlot({
qplot(seq_along(points()), points(), xlab ="Index",
ylab ="Result")
})
#hover information
output$info <- renderText({
paste0("x=", input$plot_hov$x, "\ny=",
input$plot_hov$y)
})
}
shinyApp(ui = ui, server = server)
Here is what the data looks like:
MockNLData.csv
EDIT: I figured out updating the menu with updateSelectInput()
In the future, make sure you share a reproducible example :)
Since your code is not reproducible please find below something you can understand and adapt to your case.
On your first question, if I understand correctly, you want to programatically generate a dropdown (selectInput) which is perfectly do-able. *Inputs are, in essence, just HTML content which you can dynamically generate, just like your plots. You do so with uiOutput (in your ui) and renderUI in your server.
library(shiny)
ui <- fluidPage(
selectInput("dataset", "Select a dataset", choices = c("cars", "mtcars")),
uiOutput("column"), # dynamic column selector
verbatimTextOutput("selected_column")
)
server <- function(input, output, session){
data <- reactive({
if(input$dataset == "cars")
return(cars)
else
return(mtcars)
})
output$column <- renderUI({
# build your selectInput as you normally would
selectInput("column_selector", "Select a column", choices = colnames(data()))
})
output$selected_column <- renderPrint({
# use input$column_selector!
print(input$column_selector)
})
}
shinyApp(ui, server)
On your second question, what you want is an interactive plot. There are numerous packages that will let you do that in R and Shiny. Below are some examples, by no means a comprehensive list:
plotly which will also let you make your ggplot2 charts interactive
highcharter another great, well tested library
echarts4r ECharts for R.
billboarder billboard.js for R and Shiny
Below is an example using highcharter. They all follow the same principle within Shiny, an *Output function coupled with a render* function.
library(shiny)
library(highcharter)
ui <- fluidPage(
highchartOutput("chart")
)
server <- function(input, output, session){
output$chart <- renderHighchart({
hchart(mpg, "scatter", hcaes(x = displ, y = hwy, group = class))
})
}
shinyApp(ui, server)
EDIT
Following your question on the flashing error. You need to require (req) the required input. When launching the app below the error will flash, uncomment the req(input$y) line and it'll go away.
library(shiny)
ui <- fluidPage(
uiOutput("sel"),
plotOutput("plot")
)
server <- function(input, output){
output$sel <- renderUI({
numericInput("y", "N:", value = 200, min = 5, max = 1000, step = 100)
})
output$plot <- renderPlot({
# req(input$y)
hist(runif(input$y, 1, 10))
})
}
shinyApp(ui, server)
In essence, since your plot relies on a dynamically generating input for a fraction of second that input is not available as it is being rendered, using req prevents that.
What I understand from your problem above are:
You want to make next dropdown menu based on what the user have chosen from previous dropdown menu.
When the mouse over the point on the plot, it will show row value.
So, here i will give you reproducible example and i hope it is useful for you.
In this example I use Rabbit dataset from library MASS.
To filter data for next dropdown menu, I use filter from library
dplyr (See line 30).
I use reactive expression to manage next dropdown menu (See line
29).
I use nearPoints() to manage hover point (See line 55).
library(shiny)
library(MASS)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
titlePanel("Rabbit dataset from MASS library"),
fluidRow(
column(4, selectInput("var",
"Animal:",
unique(sort(Rabbit$Animal)))),
column(4, uiOutput("selected_var")),
column(4, uiOutput("selected_var1")),
column(12, plotOutput("selected_var2", hover = "plot_hover")),
column(12, verbatimTextOutput("info"))
)
)
server <- function(input, output) {
###FILTER NEXT DROPDOWN MENU BASED ON PREVIOUS SELECTED BY USER
dataset3 <- reactive({
unique(Rabbit %>% filter(Animal == input$var) %>% select(Treatment))
})
output$selected_var <- renderUI({
selectInput("var1", "Treatment:", c(dataset3()))
})
dataset4 <- reactive({
Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% select(Run)
})
output$selected_var1 <- renderUI({
selectInput("var2", "Run:", c(dataset4()))
})
####
output$selected_var2 <- renderPlot({
ggplot(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), aes(x = BPchange, y = Dose)) + geom_point()
})
###HOVER POINT USING nearPoints()
output$info <- renderPrint({
nearPoints(Rabbit %>% filter(Animal == input$var) %>% filter(Treatment == input$var1) %>% filter(Run == input$var2), input$plot_hover)
})
}
shinyApp(ui = ui, server = server)

R shiny brushed points table blank NA rows

I am working on a shiny app where I allow a user to select the plotting criteria and then also allow them to brush the plot and see their selection in a table below. I have some NA values in my data. I have noticed that these NAs end up in my brushed point table as full rows of NA. I can remove these manually with something like this. However, I was wondering if I perhaps was doing something wrong on my brush that was causing this.
Code with a working example is below. I have also included an image of a brush selection demonstrating what I mean.
library(shiny)
library(tidyverse)
# replace some random values in mtcars with NA
set.seed(1)
mtnew <-
as.data.frame(lapply(mtcars, function(m)
m[sample(
c(TRUE, NA),
prob = c(0.8, 0.2),
size = length(m),
replace = TRUE
)]))
# set up UI that allows user to pick x and y variables, see a plot,
# brush the plot, and see a table based on the brush
ui <- fluidPage(
titlePanel("Shiny Test"),
sidebarLayout(
sidebarPanel(
selectInput("xvar",
"pick x",
choices = names(mtnew)),
selectInput("yvar",
"pick y",
choices = names(mtnew))),
mainPanel(
plotOutput("myplot",
brush = brushOpts(id = "plot_brush")),
tableOutput("mytable")
)
)
)
server <- function(input, output) {
output$myplot <- renderPlot({
ggplot(data = mtnew) +
geom_point(aes(x = !!rlang::sym(input$xvar),
y = !!rlang::sym(input$yvar)))
})
output$mytable <- renderTable({
brush_out <- brushedPoints(mtnew, input$plot_brush)
})
}
# Complete app with UI and server components
shinyApp(ui, server)
I guess that you'll have to establish which data you want to represent.
You may want to have only defined record without NAs, in that case I would suggest to use the complete.cases function. Yet this solution will highly reduce your data set (below I've applied to your code).
Another option is to preserve all your records but without the NAs. In that case you should consider using imputation methods to set proper values in replacement. Take a look at this post which provides an example.
library(shiny)
library(tidyverse)
# replace some random values in mtcars with NA
set.seed(1)
mtnew <-
as.data.frame(lapply(mtcars, function(m)
m[sample(
c(TRUE, NA),
prob = c(0.8, 0.2),
size = length(m),
replace = TRUE
)]))
mtnew_complete <- mtnew[complete.cases(mtnew),]
# set up UI that allows user to pick x and y variables, see a plot,
# brush the plot, and see a table based on the brush
ui <- fluidPage(
titlePanel("Shiny Test"),
sidebarLayout(
sidebarPanel(
selectInput("xvar",
"pick x",
choices = names(mtnew)),
selectInput("yvar",
"pick y",
choices = names(mtnew))),
mainPanel(
plotOutput("myplot",
brush = brushOpts(id = "plot_brush")),
tableOutput("mytable")
)
)
)
server <- function(input, output) {
output$myplot <- renderPlot({
#ggplot(data = mtnew) +
ggplot(data = mtnew_complete) +
geom_point(aes(x = !!rlang::sym(input$xvar),
y = !!rlang::sym(input$yvar)))
})
output$mytable <- renderTable({
#brush_out <- brushedPoints(mtnew, input$plot_brush)
brush_out <- brushedPoints(mtnew_complete, input$plot_brush)
})
}
# Complete app with UI and server components
shinyApp(ui, server)

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.

suppress effect of submitButton on startup of shiny app

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()
})

Resources