当绘制数据的列内容随着使用反应元素发生变化时如何触发绘图的重新渲染
How to trigger a re-render of a plot when a column content of the plotted data changes with the use of reactive element
在下面的应用程序中，用户可以通过拖动在绘图中 select 点，这应该在 0 和 1
之间交换它们的 Selected 状态
点将根据其 0 / 1 状态获得形状和颜色，作为用户对下一个模型 select/deselect 模型参数 运行 的视觉支持。
在我的真实应用程序中的绘图版本中，绘制的数据是一个反应变量 values$RFImp_FP1 但我发现当列 [=12] 的内容时绘图不会重新呈现=] 的 data.table（或 data.frame）变化。
因此我试图将其更改为 reactive 对象，但我无法弄清楚如何更改 reactive data.table 的 Selected 列`RFImp
到目前为止，我的尝试（代码中的注释）产生了分配错误或无限循环。
P.S.: 因为我正在用 lapply 编码这些东西，因为我在我的应用程序中多次使用代码块（相同 "modules" 具有不同的序列号并使用不同的数据，因为应用程序将用户带入处理数据的顺序阶段），第二种方法 values （应用程序 2）有我的偏好，因为这允许我做类似的事情这个：
lapply(c('FP1', 'FP2'), function(FP){
values[[paste('RFAcc', FP, sep = '_')]] <-“....代码到select来自模型结果列表对象values[[paste('RFResults', FP, sep = '_']]$Accuracy的数据框....”
据我所知，objectname <- reactive({....}) 无法完成，因为您无法在此处 <- 的左侧粘贴
反应对象方法：
library(shiny)
library(plotly)
library(dplyr)
library(data.table)
ui <- fluidPage(
plotlyOutput('RFAcc_FP1', width = 450)
)
server <- function(input, output, session) {
values <- reactiveValues()
observe({
if(!is.null(RFImp_FP1()$Selected)) {
parsToChange <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
if(!is.null(event_data("plotly_selected", source = 'RFAcc_FP1'))){
data_df <- RFImp_FP1()
data_df <- data_df %>% .[, Selected := if_else(Variables %in% parsToChange, 1-Selected, Selected)]
# how to get the reactive Data frame to update the selected
# values$Selected <- data_df$Selected #creates infinite loop.....
# RFImp_FP1$Selected <- data_df$Selected # throws an error
}
}
})
RFImp_FP1 <- reactive({
# in real app the dataframe RFImp_FP1 is a part of a list with randomForest results,
RFImp_FP1 <- data.table( MeanDecreaseAccuracy = runif(10, min = 0, max = 1), Variables = letters[1:10])
RFImp_FP1$Selected <- 1
# RFImp_FP1$Selected <- if(!is.null(values$Selected)){
# values$Selected } else {1 }
RFImp_FP1
})
output$RFAcc_FP1 <- renderPlotly({
RFImp_FP1()[order(MeanDecreaseAccuracy)]
RFImp_score <- RFImp_FP1()
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('#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 <- p %>% config(displayModeBar = F)
p
})
}
shinyApp(ui, server)
先前的 reactiveValues() 方法：
如您所见，使用此应用程序，即使代码更改了 Selected
列的内容，当 selecting 绘图中的区域时绘图也不会更新
ui <- fluidPage(
actionButton(inputId = 'Go', label = 'Go'),
plotlyOutput('RFAcc_FP1', width = 450)
)
server <- function(input, output, session) {
values <- reactiveValues()
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 <- data_df
}
}
})
observeEvent(input$Go, {
values$RFImp_FP1 <- data.table(MeanDecreaseAccuracy = runif(10, min = 0, max = 1), Variables = letters[1:10])
values$RFImp_FP1$Selected <- 1
})
output$RFAcc_FP1 <- renderPlotly({
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)
不确定这是否是您想要的（选择点后绘图更新为随机数有点奇怪 ;-)），但我希望它能有所帮助。
我没有使用普通的观察者，而是使用 observeEvent 在情节中选择某些东西时触发。我通常更喜欢 observeEvent 来捕捉事件。这会触发更新 ob a reactiveValues 值，该值最初为 NULL
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(val = NULL)
observeEvent(event_data("plotly_selected", source = 'RFAcc_FP1')$y, {
values$val <- runif(1, min = 0, max = 1)
})
RFImp_FP1 <- reactive({
RFImp_FP1 <- testDF
if(!is.null(values$val)) {
parsToChange <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
RFImp_FP1 <- RFImp_FP1 %>% .[, Selected := if_else(Variables %in% parsToChange, 1-Selected, Selected)]
} else { }
# in real app the dataframe RFImp_FP1 is a part of a list with randomForest results,
RFImp_FP1
# RFImp_FP1$Selected <- if(!is.null(values$Selected)){
# values$Selected } else {1 }
})
output$RFAcc_FP1 <- renderPlotly({
RFImp_score <- 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('#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 <- p %>% config(displayModeBar = F)
p
})
}
shinyApp(ui, server)
在下面的应用程序中，用户可以通过拖动在绘图中 select 点，这应该在 0 和 1
之间交换它们的Selected 状态
点将根据其 0 / 1 状态获得形状和颜色，作为用户对下一个模型 select/deselect 模型参数 运行 的视觉支持。
在我的真实应用程序中的绘图版本中，绘制的数据是一个反应变量 values$RFImp_FP1 但我发现当列 [=12] 的内容时绘图不会重新呈现=] 的 data.table（或 data.frame）变化。
因此我试图将其更改为 reactive 对象，但我无法弄清楚如何更改 reactive data.table 的 Selected 列`RFImp
到目前为止，我的尝试（代码中的注释）产生了分配错误或无限循环。
P.S.: 因为我正在用 lapply 编码这些东西，因为我在我的应用程序中多次使用代码块（相同 "modules" 具有不同的序列号并使用不同的数据，因为应用程序将用户带入处理数据的顺序阶段），第二种方法 values （应用程序 2）有我的偏好，因为这允许我做类似的事情这个：
lapply(c('FP1', 'FP2'), function(FP){
values[[paste('RFAcc', FP, sep = '_')]] <-“....代码到select来自模型结果列表对象values[[paste('RFResults', FP, sep = '_']]$Accuracy的数据框....”
据我所知，objectname <- reactive({....}) 无法完成，因为您无法在此处 <- 的左侧粘贴
反应对象方法：
library(shiny)
library(plotly)
library(dplyr)
library(data.table)
ui <- fluidPage(
plotlyOutput('RFAcc_FP1', width = 450)
)
server <- function(input, output, session) {
values <- reactiveValues()
observe({
if(!is.null(RFImp_FP1()$Selected)) {
parsToChange <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
if(!is.null(event_data("plotly_selected", source = 'RFAcc_FP1'))){
data_df <- RFImp_FP1()
data_df <- data_df %>% .[, Selected := if_else(Variables %in% parsToChange, 1-Selected, Selected)]
# how to get the reactive Data frame to update the selected
# values$Selected <- data_df$Selected #creates infinite loop.....
# RFImp_FP1$Selected <- data_df$Selected # throws an error
}
}
})
RFImp_FP1 <- reactive({
# in real app the dataframe RFImp_FP1 is a part of a list with randomForest results,
RFImp_FP1 <- data.table( MeanDecreaseAccuracy = runif(10, min = 0, max = 1), Variables = letters[1:10])
RFImp_FP1$Selected <- 1
# RFImp_FP1$Selected <- if(!is.null(values$Selected)){
# values$Selected } else {1 }
RFImp_FP1
})
output$RFAcc_FP1 <- renderPlotly({
RFImp_FP1()[order(MeanDecreaseAccuracy)]
RFImp_score <- RFImp_FP1()
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('#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 <- p %>% config(displayModeBar = F)
p
})
}
shinyApp(ui, server)
先前的 reactiveValues() 方法：
如您所见，使用此应用程序，即使代码更改了 Selected
ui <- fluidPage(
actionButton(inputId = 'Go', label = 'Go'),
plotlyOutput('RFAcc_FP1', width = 450)
)
server <- function(input, output, session) {
values <- reactiveValues()
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 <- data_df
}
}
})
observeEvent(input$Go, {
values$RFImp_FP1 <- data.table(MeanDecreaseAccuracy = runif(10, min = 0, max = 1), Variables = letters[1:10])
values$RFImp_FP1$Selected <- 1
})
output$RFAcc_FP1 <- renderPlotly({
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)
不确定这是否是您想要的（选择点后绘图更新为随机数有点奇怪 ;-)），但我希望它能有所帮助。
我没有使用普通的观察者，而是使用 observeEvent 在情节中选择某些东西时触发。我通常更喜欢 observeEvent 来捕捉事件。这会触发更新 ob a reactiveValues 值，该值最初为 NULL
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(val = NULL)
observeEvent(event_data("plotly_selected", source = 'RFAcc_FP1')$y, {
values$val <- runif(1, min = 0, max = 1)
})
RFImp_FP1 <- reactive({
RFImp_FP1 <- testDF
if(!is.null(values$val)) {
parsToChange <- event_data("plotly_selected", source = 'RFAcc_FP1')$y
RFImp_FP1 <- RFImp_FP1 %>% .[, Selected := if_else(Variables %in% parsToChange, 1-Selected, Selected)]
} else { }
# in real app the dataframe RFImp_FP1 is a part of a list with randomForest results,
RFImp_FP1
# RFImp_FP1$Selected <- if(!is.null(values$Selected)){
# values$Selected } else {1 }
})
output$RFAcc_FP1 <- renderPlotly({
RFImp_score <- 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('#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 <- p %>% config(displayModeBar = F)
p
})
}
shinyApp(ui, server)