[英]R plotly + shiny reactive coupled event - Refresh chart with argument from click on same chart
我整天都在苦苦挣扎,所以希望有人可以为我解释一个可行的解决方案/指出我的方法中的错误。
我想直观地看到这个网络。 目的是仅显示直接连接到参考节点的节点。
我想在以下情况下更新此图表:1)下拉列表中的参考节点已更改,或者2)单击当前图中应为新参考节点的外围节点之一时。 第一个选项有效,但我无法2)正常工作。
在output $ selection中,我目前评论了我认为应该做的工作。 当我激活时,会发生奇怪的循环行为,这是我不理解的。
我应该添加什么才能获得上述功能? 下面是一个可重现的示例。
library(plotly)
library(shiny)
library(dplyr)
library(tidyr)
### Selectionlist
varidlist = data.frame(varid = c('VAR1', 'VAR2', 'VAR3'), stringsAsFactors = F)
derivedvaridlist = data.frame(derivedvarid = paste0('DERIVEDVAR', 1:18), stringsAsFactors = F)
chartlist = data.frame(charts = paste0('1.1.', 1:9), stringsAsFactors = F)
selectionOptions = c(varidlist$varid, derivedvaridlist$derivedvarid, chartlist$charts)
ui <- fluidPage(
mainPanel(
fixedRow(selectInput('selectedID', label = 'Select varid',
choices = selectionOptions,
selected = 'VAR1')),
fixedRow(plotlyOutput("network"))
),
verbatimTextOutput("selection")
)
server <- function(input, output, session) {
createGraph <- function(selectedID){
varidlist = data.frame(varid = c('VAR1', 'VAR2', 'VAR3'), stringsAsFactors = F)
derivedvaridlist = data.frame(derivedvarid = paste0('DERIVEDVAR', 1:18), stringsAsFactors = F)
chartlist = data.frame(charts = paste0('1.1.', 1:9), stringsAsFactors = F)
selectionOptions = c(varidlist$varid, derivedvaridlist$derivedvarid, chartlist$charts)
varid_derivedvarid = data.frame(varid = c('VAR1', 'VAR2', 'VAR3'),
derivedvarid = paste0('DERIVEDVAR', 1:18), stringsAsFactors = F)
chart_varidderivedvarid = data.frame(chart = c('1.1.1'),
varidderivedvarid = c('OAP1', 'DERIVEDVAR1', 'DERIVEDVAR2', 'DERIVEDVAR3', 'DERIVEDVAR4'),
stringsAsFactors = F)
# if selectedID is VAR
if(selectedID %in% varidlist$varid){
adjacencyMatrix = varid_derivedvarid %>%
filter(varid == selectedID) %>%
mutate(type = 'derivedvarid') %>%
bind_rows(chart_varidderivedvarid %>%
filter(varidderivedvarid == selectedID) %>%
rename(varid = varidderivedvarid,
derivedvarid = chart) %>%
mutate(type='chart')) %>%
select(derivedvarid, varid, type)
nodeMatrix = adjacencyMatrix %>%
select(derivedvarid, type) %>%
add_row(derivedvarid=selectedID, type='varid')
}
# if selectedID is DERIVEDVAR
if(selectedID %in% derivedvaridlist$derivedvarid){
adjacencyMatrix = varid_derivedvarid %>%
filter(derivedvarid == selectedID) %>%
mutate(type = 'varid') %>%
bind_rows(chart_varidderivedvarid %>%
filter(varidderivedvarid == selectedID) %>%
rename(varid = varidderivedvarid,
derivedvarid = chart) %>%
mutate(type='chart')) %>%
select(derivedvarid, varid, type)
nodeMatrix = adjacencyMatrix %>%
select(varid, type) %>%
add_row(varid=selectedID, type='derivedvarid')
}
# if selectedID is chart
if(selectedID %in% chartlist$charts) {
adjacencyMatrix = chart_varidderivedvarid %>%
filter(chart == selectedID) %>%
mutate(type = '',
type = replace(type, varidderivedvarid %in% varidlist$varid, 'varid'),
type = replace(type, varidderivedvarid %in% derivedvaridlist$derivedvarid, 'derivedvarid')) %>%
select(varidderivedvarid, chart, type)
nodeMatrix = adjacencyMatrix %>%
select(varidderivedvarid, type) %>%
add_row(varidderivedvarid=selectedID, type='chart')
}
# Create all vertices:
nrNodes = dim(adjacencyMatrix)[1]
# Reference node coordinates
x0 = 0
y0 = 0
r = 4
nodes = data.frame(angles = 2*pi / nrNodes * 1:nrNodes,
nodeKey = adjacencyMatrix[, 1]) %>%
mutate(angles = angles + rnorm(n(), mean = 0, sd = .15), # Add noise to angle to avoid overlap in x-coordinate
x = x0 + r * cos(angles),
y = y0 + r * sin(angles)) %>%
add_row(x=x0, y=y0, nodeKey = selectedID)
# Create edges
edges = nodes %>%
select(x, y, nodeKey) %>%
filter(nodeKey != selectedID) %>%
mutate(x0=x0, y0=y0)
edge_shapes <- list()
for(i in 1:dim(edges)[1]) {
edge_shape = list(
type = "line",
line = list(color = "#030303", width = 0.3),
x0 = edges$x0[i],
y0 = edges$y0[i],
x1 = edges$x[i],
y1 = edges$y[i]
)
edge_shapes[[i]] <- edge_shape
}
# Layout for empty background
emptyBackground = list(title = "",
showgrid = FALSE,
showticklabels = FALSE,
zeroline = FALSE)
# Plot plotly
p = plot_ly(nodes, source='networkplot') %>%
add_trace(x = ~x, y = ~y, type = 'scatter',
mode = 'text', text = ~nodeKey,
textposition = 'middle',
hoverinfo='text',
textfont = list(color = '#000000', size = 16)) %>%
layout(title='Network',
showlegend = FALSE,
shapes = edge_shapes,
xaxis = emptyBackground,
yaxis = emptyBackground)
return(p)
}
output$network <- renderPlotly({
selectedID = input$selectedID
createGraph(selectedID)
})
output$selection <- renderPrint({
s <- event_data("plotly_click", source = "networkplot")
if (length(s) == 0) {
"Click on a node to use it as reference node"
} else {
# Get id of clicked node
plotdata = plotly_data(createGraph(input$selectedID))
newvarid = plotdata$nodeKey[s$pointNumber + 1]
# updateSelectInput(session,
# inputId = 'selectedID',
# label = 'Select ID',
# choices = selectionOptions,
# selected = newvarid)
# Get chart coordinates
cat("You selected: \n\n")
# as.list(s)
newvarid
}
})
}
shinyApp(ui, server, options = list(display.mode = "showcase"))
这里的技巧是避免循环反应事件。 使用注释掉的updateSelectInput
函数时,由于更新的输入会触发renderPrint
函数,并且renderPrint
更新菜单,因此最终会导致循环。
您可以通过引入observe()
函数来打破此行为。 一种方法是将updateSelectInput()
函数粘贴到observeEvent()
函数中,该函数仅在用户单击绘图时触发,而在使用下拉菜单时才触发。 此功能将忽略来自input$selectedID
所有更新。 请参见下面的完整示例。 我在底部指出了部分代码。
library(plotly)
library(shiny)
library(dplyr)
library(tidyr)
### Selectionlist
varidlist = data.frame(varid = c('VAR1', 'VAR2', 'VAR3'), stringsAsFactors = F)
derivedvaridlist = data.frame(derivedvarid = paste0('DERIVEDVAR', 1:18), stringsAsFactors = F)
chartlist = data.frame(charts = paste0('1.1.', 1:9), stringsAsFactors = F)
selectionOptions = c(varidlist$varid, derivedvaridlist$derivedvarid, chartlist$charts)
ui <- fluidPage(
mainPanel(
fixedRow(selectInput('selectedID', label = 'Select varid',
choices = selectionOptions,
selected = 'VAR1')),
fixedRow(plotlyOutput("network"))
),
verbatimTextOutput("selection")
)
server <- function(input, output, session) {
createGraph <- function(selectedID){
varidlist = data.frame(varid = c('VAR1', 'VAR2', 'VAR3'), stringsAsFactors = F)
derivedvaridlist = data.frame(derivedvarid = paste0('DERIVEDVAR', 1:18), stringsAsFactors = F)
chartlist = data.frame(charts = paste0('1.1.', 1:9), stringsAsFactors = F)
selectionOptions = c(varidlist$varid, derivedvaridlist$derivedvarid, chartlist$charts)
varid_derivedvarid = data.frame(varid = c('VAR1', 'VAR2', 'VAR3'),
derivedvarid = paste0('DERIVEDVAR', 1:18), stringsAsFactors = F)
chart_varidderivedvarid = data.frame(chart = c('1.1.1'),
varidderivedvarid = c('OAP1', 'DERIVEDVAR1', 'DERIVEDVAR2', 'DERIVEDVAR3', 'DERIVEDVAR4'),
stringsAsFactors = F)
# if selectedID is VAR
if(selectedID %in% varidlist$varid){
adjacencyMatrix = varid_derivedvarid %>%
filter(varid == selectedID) %>%
mutate(type = 'derivedvarid') %>%
bind_rows(chart_varidderivedvarid %>%
filter(varidderivedvarid == selectedID) %>%
rename(varid = varidderivedvarid,
derivedvarid = chart) %>%
mutate(type='chart')) %>%
select(derivedvarid, varid, type)
nodeMatrix = adjacencyMatrix %>%
select(derivedvarid, type) %>%
add_row(derivedvarid=selectedID, type='varid')
}
# if selectedID is DERIVEDVAR
if(selectedID %in% derivedvaridlist$derivedvarid){
adjacencyMatrix = varid_derivedvarid %>%
filter(derivedvarid == selectedID) %>%
mutate(type = 'varid') %>%
bind_rows(chart_varidderivedvarid %>%
filter(varidderivedvarid == selectedID) %>%
rename(varid = varidderivedvarid,
derivedvarid = chart) %>%
mutate(type='chart')) %>%
select(derivedvarid, varid, type)
nodeMatrix = adjacencyMatrix %>%
select(varid, type) %>%
add_row(varid=selectedID, type='derivedvarid')
}
# if selectedID is chart
if(selectedID %in% chartlist$charts) {
adjacencyMatrix = chart_varidderivedvarid %>%
filter(chart == selectedID) %>%
mutate(type = '',
type = replace(type, varidderivedvarid %in% varidlist$varid, 'varid'),
type = replace(type, varidderivedvarid %in% derivedvaridlist$derivedvarid, 'derivedvarid')) %>%
select(varidderivedvarid, chart, type)
nodeMatrix = adjacencyMatrix %>%
select(varidderivedvarid, type) %>%
add_row(varidderivedvarid=selectedID, type='chart')
}
# Create all vertices:
nrNodes = dim(adjacencyMatrix)[1]
# Reference node coordinates
x0 = 0
y0 = 0
r = 4
nodes = data.frame(angles = 2*pi / nrNodes * 1:nrNodes,
nodeKey = adjacencyMatrix[, 1]) %>%
mutate(angles = angles + rnorm(n(), mean = 0, sd = .15), # Add noise to angle to avoid overlap in x-coordinate
x = x0 + r * cos(angles),
y = y0 + r * sin(angles)) %>%
add_row(x=x0, y=y0, nodeKey = selectedID)
# Create edges
edges = nodes %>%
select(x, y, nodeKey) %>%
filter(nodeKey != selectedID) %>%
mutate(x0=x0, y0=y0)
edge_shapes <- list()
for(i in 1:dim(edges)[1]) {
edge_shape = list(
type = "line",
line = list(color = "#030303", width = 0.3),
x0 = edges$x0[i],
y0 = edges$y0[i],
x1 = edges$x[i],
y1 = edges$y[i]
)
edge_shapes[[i]] <- edge_shape
}
# Layout for empty background
emptyBackground = list(title = "",
showgrid = FALSE,
showticklabels = FALSE,
zeroline = FALSE)
# Plot plotly
p = plot_ly(nodes, source='networkplot') %>%
add_trace(x = ~x, y = ~y, type = 'scatter',
mode = 'text', text = ~nodeKey,
textposition = 'middle',
hoverinfo='text',
textfont = list(color = '#000000', size = 16)) %>%
layout(title='Network',
showlegend = FALSE,
shapes = edge_shapes,
xaxis = emptyBackground,
yaxis = emptyBackground)
return(p)
}
###############################################################################################
### Updated part
# Define reactive data
values <- reactiveValues(newvarid = NULL) # ID = "VAR1"
# Observer for change in dropdown menu
# observeEvent(input$selectedID, {
# values$ID = input$selectedID
# })
# Update dropdown menue based on click event
observeEvent(event_data("plotly_click", source = "networkplot"), {
s <- event_data("plotly_click", source = "networkplot")
plotdata = plotly_data(createGraph(input$selectedID))
values$newvarid = plotdata$nodeKey[s$pointNumber + 1]
updateSelectInput(session,
inputId = 'selectedID',
label = 'Select ID',
choices = selectionOptions,
selected = values$newvarid)
})
# Render Plot
output$network <- renderPlotly({
createGraph(input$selectedID)
})
# Render text
output$selection <- renderPrint({
if (is.null(values$newvarid)) {
"Click on a node to use it as reference node"
} else {
# Get chart coordinates
cat("You selected: \n\n")
# as.list(s)
values$newvarid
}
})
}
shinyApp(ui, server, options = list(display.mode = "showcase"))
我不确定反应性values$newvarid
是否真的必要。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.