Блог

Я работаю над блестящим приложением, в котором я хочу углубиться в сюжет с несколькими уровнями. Мне трудно заставить функцию reactiveValues работать, чтобы я мог обновить сюжет. Если я установлю selections lt;- reactiveVal() , я не получу ошибок, но ничего не произойдет, когда я нажму на сюжет. С другой стороны, если я использую selections lt;- reactiveValues() , я получаю ошибку «Ошибка в выборе: не удалось найти функцию «выбор»»

Основываясь на чтении других сообщений, похоже, что моя проблема, скорее всего, связана с тем, как именно я установил обновление для переменной, но я не могу понять, как это исправить / где проблема в моем коде.

Вот воспроизводимый пример:

 library(bs4Dash) library(plotly) library(tidyverse)  fake_data_wide lt;- 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 lt;- fake_data_wide %gt;%   pivot_longer(level_1:level_3, names_to = "level_of_specificity",  values_to = "group_name")  one_level_down lt;- fake_data_wide %gt;%   select(group_name = level_1,   one_down = level_2) %gt;%   bind_rows(fake_data_wide %gt;%   select(group_name = level_2,  one_down = level_3)) %gt;% distinct()    ui lt;- dashboardPage(  header = dashboardHeader(title = "test"),  sidebar = dashboardSidebar(),  body = dashboardBody(fluidRow(box(plotlyOutput("drill_down_plot"),  id = "test_box"),  uiOutput("back"))) )   server lt;- function(input, output){    selections lt;- reactiveValues()    observeEvent(event_data("plotly_selected", source = "drill_down_plot"), {  new lt;- event_data("plotly_selected")$customdata[[1]]  old lt;- selections()  selections(c(old, new))  })    output$drill_down_plot lt;- renderPlotly({    if(length(selections() == 0)){  fake_data_long %gt;%   filter(level_of_specificity == "level_1") %gt;%   group_by(group_name) %gt;%   summarise(g_sent_mean = mean(sent),  g_total_mean = mean(number)) %gt;% ungroup() %gt;%   plot_ly(x = ~g_sent_mean, y = ~g_total_mean,  size = ~g_total_mean, customdata = ~group_name)  } else {    one_level_down %gt;%   filter(group_name %in% selections_test) %gt;%   mutate(group_name = one_down) %gt;% select(-one_down) %gt;%   inner_join(fake_data_long) %gt;%   group_by(group_name) %gt;%   summarise(g_sent_mean = mean(sent),  g_total_mean = mean(number)) %gt;% ungroup() %gt;%   plot_ly(x = ~g_sent_mean, y = ~g_total_mean,  size = ~g_total_mean, customdata = ~group_name)    }        })    output$back lt;- renderUI({  if (length(selections()))   actionButton("clear", "Back", icon("chevron-left"))  })     }  shinyApp(ui = ui, server = server)  

Вам должно помочь следующее.

 library(bs4Dash) library(plotly) library(tidyverse)  fake_data_wide lt;- 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 lt;- fake_data_wide %gt;%   pivot_longer(level_1:level_3, names_to = "level_of_specificity",  values_to = "group_name")  one_level_down lt;- fake_data_wide %gt;%   dplyr::select(group_name = level_1, one_down = level_2) %gt;%   bind_rows(fake_data_wide %gt;%   dplyr::select(group_name = level_2, one_down = level_3)) %gt;% distinct()    ui lt;- dashboardPage(  header = dashboardHeader(title = "test"),  sidebar = dashboardSidebar(),  body = dashboardBody(fluidRow(box(plotlyOutput("drill_down_plot"),  id = "test_box"),  uiOutput("back"))) )   server lt;- function(input, output){    my lt;- reactiveValues(selections=NULL)    observeEvent(event_data("plotly_selected", source = "drill_down_plot", priority = "event"), {  my$selections lt;- event_data("plotly_selected", priority = "event")$customdata[[1]]  old lt;- my$selections  #print(my$selections) # c(old, new)  }, ignoreNULL = FALSE)    output$drill_down_plot lt;- renderPlotly({    select_data lt;- event_data("plotly_selected", priority = "event")  my$selections lt;- select_data$customdata  print(select_data)  if (is.null(select_data)) {  print("hello1")  df1 lt;- fake_data_long %gt;%   dplyr::filter(level_of_specificity == "level_1") %gt;%   group_by(group_name) %gt;%   dplyr::summarise(g_sent_mean = mean(sent),  g_total_mean = mean(number)) %gt;% ungroup() # %gt;%   # plot_ly(x = ~g_sent_mean, y = ~g_total_mean,  # size = ~g_total_mean, customdata = ~group_name)  } else {  print("hello2")  df1 lt;- one_level_down %gt;%   dplyr::filter(group_name %in% select_data$customdata) %gt;%   mutate(group_name = one_down) %gt;% dplyr::select(-one_down) %gt;%   inner_join(fake_data_long) %gt;%   group_by(group_name) %gt;%   dplyr::summarise(g_sent_mean = mean(sent),  g_total_mean = mean(number)) %gt;% ungroup() #%gt;%   # 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) %gt;% layout(dragmode = "lasso")    })    output$back lt;- renderUI({  if (!is.null(my$selections)) actionButton("clear", "Back", icon("chevron-left"))  })     }  shinyApp(ui = ui, server = server)