R plotly +有光泽的反应耦合事件 - 从同一图表上点击参数刷新图表
我整天都在苦苦挣扎，所以希望有人可以为我解释一个有用的解决方案/指出我的方法中的错误。
我有这个想要可视化的网络。 目标是仅显示直接连接到参考节点的节点。
我希望在以下情况下更新此图表：1）更改下拉列表中的参考节点;或者2）当我单击当前图中应该是新参考节点的其中一个外围节点时。 第一个选项有效，但我无法正常工作。
在输出$选择中，我目前评论了我认为应该做的工作。当我激活这个但是奇怪的循环行为发生时，我不明白。
我应该添加什么才能获得上述功能？ 下面是一个可重复的例子。
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"))
1 个答案:
答案 0 :(得分：3)
这里的诀窍是避免循环反应事件。使用您注释掉的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是否真的有必要。
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？