plotly shiny reactive values "error function not found" - r

Question

I'm working on a Shiny app in which I want to drill down into a plot with multiple levels. I am having difficulty getting the reactiveValues function to work so I can update the plot. If I set selections <- reactiveVal() I get no errors, but nothing happens when I click on the plot. On the other hand, if I use selections <- reactiveValues() I get the error "Error in selections: could not find function "selection""
Based on reading other posts, it seems like my problem is likely having to do with how exactly I set the update to the variable but I can't quite figure out how to fix it / where the issue is in my code.
Here is a reproducible example:
library(bs4Dash)
library(plotly)
library(tidyverse)
fake_data_wide <- tibble(level_1 = rep(c("A", "B", "C"), each = 50),
level_2 = rep(c(c("1", "2"), c("3", "4"), c("5", "6")), each = 25),
level_3 = c(rep("a", 40), rep("b", 10), rep("c", 30), rep("d", 20),
rep("e", 20), rep("f", 30)),
sent = rnorm(150),
number = rpois(150, lambda = 1))
fake_data_long <- fake_data_wide %>%
pivot_longer(level_1:level_3, names_to = "level_of_specificity",
values_to = "group_name")
one_level_down <- fake_data_wide %>%
select(group_name = level_1,
one_down = level_2) %>%
bind_rows(fake_data_wide %>%
select(group_name = level_2,
one_down = level_3)) %>% distinct()
ui <- dashboardPage(
header = dashboardHeader(title = "test"),
sidebar = dashboardSidebar(),
body = dashboardBody(fluidRow(box(plotlyOutput("drill_down_plot"),
id = "test_box"),
uiOutput("back")))
)
server <- function(input, output){
selections <- reactiveValues()
observeEvent(event_data("plotly_selected", source = "drill_down_plot"), {
new <- event_data("plotly_selected")$customdata[[1]]
old <- selections()
selections(c(old, new))
})
output$drill_down_plot <- renderPlotly({
if(length(selections() == 0)){
fake_data_long %>%
filter(level_of_specificity == "level_1") %>%
group_by(group_name) %>%
summarise(g_sent_mean = mean(sent),
g_total_mean = mean(number)) %>% ungroup() %>%
plot_ly(x = ~g_sent_mean, y = ~g_total_mean,
size = ~g_total_mean, customdata = ~group_name)
} else {
one_level_down %>%
filter(group_name %in% selections_test) %>%
mutate(group_name = one_down) %>% select(-one_down) %>%
inner_join(fake_data_long) %>%
group_by(group_name) %>%
summarise(g_sent_mean = mean(sent),
g_total_mean = mean(number)) %>% ungroup() %>%
plot_ly(x = ~g_sent_mean, y = ~g_total_mean,
size = ~g_total_mean, customdata = ~group_name)
}
})
output$back <- renderUI({
if (length(selections()))
actionButton("clear", "Back", icon("chevron-left"))
})
}
shinyApp(ui = ui, server = server)

Answer 1

The following should help you.
library(bs4Dash)
library(plotly)
library(tidyverse)
fake_data_wide <- tibble(level_1 = rep(c("A", "B", "C"), each = 50),
level_2 = rep(c(c("1", "2"), c("3", "4"), c("5", "6")), each = 25),
level_3 = c(rep("a", 40), rep("b", 10), rep("c", 30), rep("d", 20),
rep("e", 20), rep("f", 30)),
sent = rnorm(150),
number = rpois(150, lambda = 1))
fake_data_long <- fake_data_wide %>%
pivot_longer(level_1:level_3, names_to = "level_of_specificity",
values_to = "group_name")
one_level_down <- fake_data_wide %>%
dplyr::select(group_name = level_1, one_down = level_2) %>%
bind_rows(fake_data_wide %>%
dplyr::select(group_name = level_2, one_down = level_3)) %>% distinct()
ui <- dashboardPage(
header = dashboardHeader(title = "test"),
sidebar = dashboardSidebar(),
body = dashboardBody(fluidRow(box(plotlyOutput("drill_down_plot"),
id = "test_box"),
uiOutput("back")))
)
server <- function(input, output){
my <- reactiveValues(selections=NULL)
observeEvent(event_data("plotly_selected", source = "drill_down_plot", priority = "event"), {
my$selections <- event_data("plotly_selected", priority = "event")$customdata[[1]]
old <- my$selections
#print(my$selections) # c(old, new)
}, ignoreNULL = FALSE)
output$drill_down_plot <- renderPlotly({
select_data <- event_data("plotly_selected", priority = "event")
my$selections <- select_data$customdata
print(select_data)
if (is.null(select_data)) {
print("hello1")
df1 <- fake_data_long %>%
dplyr::filter(level_of_specificity == "level_1") %>%
group_by(group_name) %>%
dplyr::summarise(g_sent_mean = mean(sent),
g_total_mean = mean(number)) %>% ungroup() # %>%
# plot_ly(x = ~g_sent_mean, y = ~g_total_mean,
# size = ~g_total_mean, customdata = ~group_name)
} else {
print("hello2")
df1 <- one_level_down %>%
dplyr::filter(group_name %in% select_data$customdata) %>%
mutate(group_name = one_down) %>% dplyr::select(-one_down) %>%
inner_join(fake_data_long) %>%
group_by(group_name) %>%
dplyr::summarise(g_sent_mean = mean(sent),
g_total_mean = mean(number)) %>% ungroup() #%>%
# plot_ly(x = ~g_sent_mean, y = ~g_total_mean,
# size = ~g_total_mean, customdata = ~group_name)
}
plot_ly(df1, x = ~g_sent_mean, y = ~g_total_mean,
size = ~g_total_mean, customdata = ~group_name) %>% layout(dragmode = "lasso")
})
output$back <- renderUI({
if (!is.null(my$selections)) actionButton("clear", "Back", icon("chevron-left"))
})
}
shinyApp(ui = ui, server = server)