为什么即使数据已更改,地块也不会更新

时间:2019-06-01 14:42:40

标签: r shiny plotly render reactive

在下面的演示应用程序中,用户可以通过单击Selected或在图中选择一个区域来更改数据行的input$Go1状态。

选择图中的区域是我想要的功能。

但是,由于我不明白的原因,即使这两种方法具有相同的效果,也就是{{1}列中的值发生了变化,该按钮的确会导致图形的重新渲染,而select却不会。 } of data.table Selected

为什么在图中选择点时不起作用?

RFImp_FP1

选择vs按钮结果: enter image description here

1 个答案:

答案 0 :(得分:0)

不要问我为什么,但是在重新分配更改后的数据表之前,我设法使其与const Form = () => { const [fullName, setFullName] = React.useState(""); const [is18, setOver18] = React.useState(false); return ( <form> <input type="text" name="fullName" value={fullName} onChange={event => setFullName(event.target.value)} /> <input type="checkbox" name="over18" checked={is18} onChange={() => setOver18(!is18)} /> </form> ); }; 一起使用并将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, 1-Selected, Selected)]
        values$RFImp_FP1 <- NULL
        values$RFImp_FP1 <- data_df
      }

  })

进入

observeEvent(event_data("plotly_selected", source = 'RFAcc_FP1')$y