How to trigger a re-render of a plot when a column content of the plotted data changes with the use of reactive element
In the following app the user can select points in the plot by dragging, which should swap their Selected state between 0 and 1
points will get a shape and color depending on their 0 / 1 state, as a visual support for a user to select/deselect model parameters for the next model run.
in the version of the plots I had in my real app, the plotted data is a reactive variable values$RFImp_FP1 but I found out that the plot does not re-render when the content of column Selected of that data.table (or data.frame) changes.
Therefore I am trying to change it to a reactive object, but I'm failing to figure out how to change the Selected column of reactive data.table `RFImp
my attempts (comments in the code) so far produce either an assign error, or an infinite loop.
P.S.: Since i'm coding the stuff with lapply as I am using the code block several times in my app (identical "modules" with different serial number and using different data as the app takes the user through sequential stages of processing data), the second approach with values (app 2) has my preference as this allows me to do things like this:
lapply(c('FP1', 'FP2'), function(FP){
values[[paste('RFAcc', FP, sep = '_')]] <- ".... code to select a dataframe from model result list object values[[paste('RFResults', FP, sep = '_']]$Accuracy...."
which as far as I know can't be done with objectname <- reactive({....}) as you can't paste on the left side of the <- here
REACTIVE OBJECT APPROACH:
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)
PREVIOUS reactiveValues() approach:
as you can see, with this app, the plot does not update when selecting a region in the plot even though the code changes the content of column 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)
1 个答案:
答案 0 :(得分：0)
不确定这是否是您想要的（在选择点后，图表以随机数更新；-)有点奇怪，但是我希望它能帮上忙。
我使用observeEvent而不是普通的观察者，在选择图中的某些东西时会触发。我通常更喜欢observeEvent来捕获事件。这会触发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)
相关问题
- 当局部阵列发生变化时如何重新渲染流星火焰模板？
- 绘制在强度之上时的箭头图变化
- Ember：模型更改时重新渲染路径的模板
- 如何在内容更改后将hyperHTML重新渲染到同一元素
- 如何在Promise值更改时重新生成componet
- 如何在属性更改时重新生成反应组件
- How to trigger a re-render of a plot when a column content of the plotted data changes with the use of reactive element
- 值更改时如何更新Dom（重新渲染元素）？
- 当列表的顺序发生变化时，如何重新呈现ListView？
- 如何编辑DT列并将更改保存到相关列中以触发计算？
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？