I'm creating a Shiny app with various plots. Some of them need different UI widgets, which I create using renderUI. For one of the plots, in order to get the labels to subset correctly (geom_label_repel), I think I need to use an input as an eventReactive dependency. The problem is, this input is only rendered for one particular plot and won't even exist for all the other plots. When I try putting it in the eventReactive, everything breaks.
I've tried putting it in the eventReactive conditionally, but either that isn't valid or I just don't know how to do it correctly. I've tried something like this:
eventReactive({
if(exists(input$sel_name)) {
input$button
input$sel_name
} else {
input$button
}},{
handlerExp
})
Here is my rather extensive example. I've embedded more specific explanation into the app - I thought that would be more convenient than in the post. Hopefully that isn't bad form, if it is, please let me know:
library(ggplot2)
library(ggrepel)
library(shiny)
library(dplyr)
library(stringr)
# Sample Data ####
orgid <- c(rep(1, 3),
rep(2, 3),
rep(3, 2),
rep(4, 2),
rep(5, 3),
rep(6, 2),
rep(7, 3),
rep(8, 2),
rep(9, 3))
year <- c(2012, 2013, 2014,
2012, 2013, 2014,
2012, 2013,
2013, 2014,
2012, 2013, 2014,
2013, 2014,
2012, 2013, 2014,
2012, 2013,
2012, 2013, 2014)
y <- c(10, 20, 30,
60, 70, 50,
100, 90,
55, 65,
5, 15, 30,
200, 180,
65, 95, 130,
170, 155,
140, 130, 190
)
label <- c(rep("Tom" , 3),
rep("Dick" , 3),
rep("Harry", 2),
rep("Ed" , 2),
rep("Sam" , 3),
rep("Hank" , 2),
rep("Dan" , 3),
rep("Trey" , 2),
rep("Steve", 3))
df <- data.frame(orgid, year, y, label)
#####
ui <- pageWithSidebar(
headerPanel('Plot Label Reactivity Problem'),
sidebarPanel(width=3,
selectInput(inputId = "plot_selector",
label = "Plot Selector",
choices = c("Other Plots" = "a","The Plot in Question" = "b"),
selected = "a"),
uiOutput(outputId = "react_ui"),
actionButton(inputId = 'button', label = "Submit")
),
mainPanel(plotOutput('plot'),
h5("-Problem: The labels on 'The Plot in Question' don't behave as desired.
I'll explain below, but if you play around with the plot,
it will become obvious that they aren't working"),
h5("-Desired Behavior:"),
tags$div(
tags$ul(
tags$li("'The Plot in Question' is just one of many plots available in this tool and is the only one that uses the 'Select Name:' multiple selectInput"),
tags$li("When it is selected some filters (here, just one checkboxGroupInput) and a multiple selectInput are rendered"),
tags$li("The user can filter the dataset down as desired and submit. Two things should happen:"),
tags$ol(tags$li("The data (as filtered) is plotted"),
tags$li("The choices of the 'Select Name:' selectInput initialize to the unique values of names in the filtered data")),
tags$li("As the user selects names from the selectInput, they are highlighted based on the ggplot aesthetics"),
tags$li("Also, and this is where the problem is, I want the right-most (latest year for which data exists) point to receive a label"),
tags$ul(tags$li("I'm doing this using geom_label_repel and using a dplyr call to the data argument to subset the labels")),
tags$li("While the aesthetics work as desired, the labels only appear if you submit again, which is undesired, plus it reinitializes the UI and clears the aesthetics")),
h5("-I think I have a decent understanding of why this is happening:"),
tags$ul(
tags$li("The plot object is in an eventReactive dependent on the submit button so it doesn't react to the selectInput being changed (although, it makes me wonder why the
plot aesthetics react to the selectInput)")),
h5("-The only thing I can think to do is add input$sel_name (the selectInput) to the eventReactive dependency for the plot, but the issue is that other plots use the button
but don't have input$sel_name even rendered"),
h5("-When I try this, the plot doesn't work at all"),
h5("-I've tried things like putting an if statement in the eventReactive that creates the plot object that checks whether input$sel_name exists, but no luck"),
h5("-At one point I had this thing working as desired - I had the entire ggplot call in the renderPlot, however, I need to store the ggplot object to an object so I can
send it to a downloadHandler and download the plot as a .pdf"),
h5("-I realize this is a fairly involved example app, but I really need to get this working. I hope I've explained the problem and desired behavior sufficiently. I'd be happy
to clarify anything."),
h4("Thank you!"))))
server <- function(input,output,session) {
# List for storing user inputs
userInputs <- list(initial = c("D", "E", "H", "S", "T"))
# observeEvent to update list to carry user input over when input re-rendered
observeEvent({input$initial}, {
userInputs$initial <<- input$initial
})
# Render Dynamic UI
output$react_ui <- renderUI({
if(input$plot_selector == "b") {
tagList(
checkboxGroupInput(inputId = "initial",
label = "Show Names Beginning With:",
choices = c("D", "E", "H", "S", "T"),
selected = userInputs$initial),
selectInput(inputId = 'sel_name',
label = 'Select Name:',
choices = if(input$button==0) {
c("")
} else {
unique(sort(filtered_data()$label))
},
multiple = TRUE)
)}
})
# Reactive function to apply filters (just one in the example: initial of the name) to the data
filtered_data <- eventReactive(input$button,{
df %>% filter(str_sub(label,1,1) %in% input$initial)
})
# Reactive function to create the ggplot object
plot <- eventReactive({
input$button
#input$sel_name
}, {
plt <- filtered_data() %>%
ggplot(aes(x = year,
y = y,
group = orgid,
label = label)) +
geom_line(aes(size = label %in% input$sel_name,
color = label %in% input$sel_name,
alpha = label %in% input$sel_name)) +
geom_point(aes(shape = label %in% input$sel_name,
color = label %in% input$sel_name,
alpha = label %in% input$sel_name),
size = 4) +
geom_label_repel(data = df %>%
filter(label %in% input$sel_name) %>%
group_by(orgid) %>%
filter(year == max(year))) +
scale_color_manual(values = c("FALSE" = "black",
"TRUE" = "red"),
guide = FALSE) +
scale_size_manual(values = c("FALSE" = 1,
"TRUE" = 2),
guide = FALSE) +
scale_shape_manual(values = c("FALSE" = 1,
"TRUE" = 24),
guide = FALSE) +
scale_alpha_manual(values = c("FALSE" = 0.1,
"TRUE" = 1),
guide = FALSE) +
labs(title = "The Plot in Question",
y = "Fictitious Variable of Interest",
x = "Year") +
scale_x_continuous(breaks = unique(filtered_data()$year))
return(plt)
})
# Render the Plot
output$plot <- renderPlot(plot())
}
shinyApp(ui=ui, server=server)