Почему сюжет не обновляется, хотя данные изменились?

Question

В демонстрационном приложении ниже пользователь может изменить состояние Selected строк данных, нажав input$Go1 или выбрав область на графике.

Выбор региона на графике является моей предполагаемой функциональностью.

Однако, по причине, которую я не понимаю, кнопка вызывает повторный рендеринг графика, а выбор - нет, даже если оба подхода имеют одинаковый эффект, то есть изменение значений в столбце Selected data.table RFImp_FP1

Почему это не работает, когда я выбираю точки на графике?

ui <- fluidPage(
  actionButton(inputId = 'Go', label = 'Go'),
  actionButton(inputId = 'Go2', label = 'Go2'),
  plotlyOutput('RFAcc_FP1',  width = 450)

)

server <- function(input, output, session) {
  values <- reactiveValues()


  observeEvent(input$Go, { 
    values$RFImp_FP1 <- data.table(MeanDecreaseAccuracy =  runif(10, min = 0, max = 1), Variables = letters[1:10])
    values$RFImp_FP1$Selected <- 1
  })

observeEvent(input$Go2,{

  values$RFImp_FP1$Selected[1:4] <- 1-values$RFImp_FP1$Selected[1:4] 
  print(values$RFImp_FP1$Selected)
})

observe({
  if(!is.null(values$RFImp_FP1)) {
    parsToChange <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
    if(!is.null(event_data("plotly_selected", source = 'RFAcc_FP1'))){
      data_df <- values$RFImp_FP1
      data_df <- data_df %>% .[, Selected := if_else(Variables %in% parsToChange, 1-Selected, Selected)]
      values$RFImp_FP1$Selected <- data_df$Selected
    print(values$RFImp_FP1)
      }
  }
})
observeEvent(values$RFImp_FP1, { 
  print('seeing change')
  })


output$RFAcc_FP1 <- renderPlotly({

  values$RFImp_FP1
  if(!is.null(values$RFImp_FP1)) {

    RFImp_score <- values$RFImp_FP1[order(MeanDecreaseAccuracy)]
    plotheight <- length(RFImp_score$Variables) * input$testme
    p <- plot_ly(data = RFImp_score,
                 source = 'RFAcc_FP1',
                 height = plotheight,
                 width = 450)  %>%
      add_trace(x = RFImp_score$MeanDecreaseAccuracy,
                y = RFImp_score$Variables,
                type = 'scatter',
                mode = 'markers',
                color = factor(RFImp_score$Selected),
                colors = c('#1b73c1', '#797979'),
                symbol = factor(RFImp_score$Selected),
                symbols = c('circle','x'),
                marker = list(size  = 6),
                hoverinfo = "text",
                text = ~paste ('<br>', 'Parameter: ', RFImp_score$Variables,
                               '<br>',  'Mean decrease accuracy: ', format(round(RFImp_score$MeanDecreaseAccuracy*100, digits = 2), nsmall = 2),'%',
                               sep = '')) %>%
      layout(
        margin = list(l = 160, r= 20, b = 70, t = 50),
        hoverlabel = list(font=list( color = '#1b73c1'), bgcolor='#f7fbff'),
        xaxis =  list(title = 'Mean decrease accuracy index (%)',
                      tickformat = "%",
                      showgrid = F,
                      showline = T,
                      zeroline = F,
                      nticks = 5,
                      font = list(size = 8),
                      ticks = "outside",
                      ticklen = 5,
                      tickwidth = 2,
                      tickcolor = toRGB("black")
        ),
        yaxis =  list(categoryarray = RFImp_score$Variables,
                      autorange = T,
                      showgrid = F,
                      showline = T,
                      autotick = T,
                      font = list(size = 8),
                      ticks = "outside",
                      ticklen = 5,
                      tickwidth = 2,
                      tickcolor = toRGB("black")
        ),
        dragmode =  "select"
      ) %>%  add_annotations(x = 0.5,
                             y = 1.05,
                             textangle = 0,
                             font = list(size = 14,
                                         color = 'black'),
                             text = "Contribution to accuracy",
                             showarrow = F,
                             xref='paper',
                             yref='paper')


    p$elementId <- NULL   ## to surpress warning of widgetid
    p <- p %>% config(displayModeBar = F)
    p

  } else {
    p <- plot_ly( type = 'scatter', mode = 'markers',  height = '400px', width = 450) %>% layout(
      margin = list(l = 160, r= 20, b = 70, t = 50),
      xaxis = list(title = 'Mean decrease accuracy index', range= c(0,1), nticks = 2, showline = TRUE),
      yaxis = list(title = 'Model input variables', range = c(0,1), nticks = 2, showline = TRUE)) %>%
      add_annotations(x = 0.5, y = 1.1, textangle = 0, font = list(size = 14, color = 'black'),
                      text = 'Contribution to accuracy',
                      showarrow = F, xref='paper', yref='paper')
    p$elementId <- NULL
    p <- p %>% config(displayModeBar = F)
    p}
})


}
shinyApp(ui, server)

выберите против кнопки результат:

Answer 1

Не спрашивайте меня, почему, но мне удалось заставить его работать с observeEvent и назначить NULL для the values$RFImp_FP1, прежде чем переназначить ему измененную таблицу данных.

  values$RFImp_FP1 <- NULL
  values$RFImp_FP1<- resDF

Полная версия:

library(shiny)
library(plotly)
library(dplyr)
library(data.table)

testDF <- data.table( MeanDecreaseAccuracy =  runif(10, min = 0, max = 1), Variables = letters[1:10])
testDF$Selected <- T

ui <- fluidPage(
  plotlyOutput('RFAcc_FP1',  width = 450)
)

server <- function(input, output, session) {

  values <- reactiveValues(RFImp_FP1 = testDF)




observeEvent(event_data("plotly_selected", source = 'RFAcc_FP1')$y, {
      parsToChange <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
      resDF <- values$RFImp_FP1 %>% .[, Selected := if_else(Variables %in% parsToChange, !Selected, Selected)]
      values$RFImp_FP1 <- NULL  ## without this line the plot does not react
      values$RFImp_FP1<- resDF ## re-assign the altered data.table to the reactiveValue
  })


  output$RFAcc_FP1 <- renderPlotly({

    RFImp_score <- values$RFImp_FP1[order(MeanDecreaseAccuracy)]
    plotheight <- length(RFImp_score$Variables) * 80
    p <- plot_ly(data = RFImp_score,
                 source = 'RFAcc_FP1',
                 height = plotheight,
                 width = 450)  %>%
      add_trace(x = RFImp_score$MeanDecreaseAccuracy,
                y = RFImp_score$Variables,
                type = 'scatter',
                mode = 'markers',
                color = factor(RFImp_score$Selected),
                colors = c('#F0F0F0', '#1b73c1'),
                symbol = factor(RFImp_score$Selected),
                symbols = c('x', 'circle'),
                marker = list(size  = 6),
                hoverinfo = "text",
                text = ~paste ('<br>', 'Parameter: ', RFImp_score$Variables,
                               '<br>',  'Mean decrease accuracy: ', format(round(RFImp_score$MeanDecreaseAccuracy*100, digits = 2), nsmall = 2),'%',
                               sep = '')) %>%
      layout(
        margin = list(l = 160, r= 20, b = 70, t = 50),
        hoverlabel = list(font=list( color = '#1b73c1'), bgcolor='#f7fbff'),
        xaxis =  list(title = 'Mean decrease accuracy index (%)',
                      tickformat = "%",
                      showgrid = F,
                      showline = T,
                      zeroline = F,
                      nticks = 5,
                      font = list(size = 8),
                      ticks = "outside",
                      ticklen = 5,
                      tickwidth = 2,
                      tickcolor = toRGB("black")
        ),
        yaxis =  list(categoryarray = RFImp_score$Variables,
                      autorange = T,
                      showgrid = F,
                      showline = T,
                      autotick = T,
                      font = list(size = 8),
                      ticks = "outside",
                      ticklen = 5,
                      tickwidth = 2,
                      tickcolor = toRGB("black")
        ),
        dragmode =  "select"
      ) %>%  add_annotations(x = 0.5,
                             y = 1.05,
                             textangle = 0,
                             font = list(size = 14,
                                         color = 'black'),
                             text = "Contribution to accuracy",
                             showarrow = F,
                             xref='paper',
                             yref='paper')

    p <- p %>% config(displayModeBar = F)
    p
  })


}
shinyApp(ui, server)

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

  observe({
    if(!is.null( values$RFImp_FP1)) {
      values$Selected <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
    }
  })


  observeEvent(values$Selected, {
      parsToChange <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
      if(!is.null(event_data("plotly_selected", source = 'RFAcc_FP1'))){
        data_df <- values$RFImp_FP1
        data_df <- data_df %>% .[, Selected := if_else(Variables %in% parsToChange, !Selected, Selected)]
        values$RFImp_FP1 <- NULL
        values$RFImp_FP1 <- data_df
      }

  })

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