R 绘图 + Shiny 的 react 耦合事件 - 通过单击同一图表来刷新带有参数的图表

标签 r shiny plotly

我一整天都在努力解决这个问题，所以希望有人能为我解释一个可行的解决方案/指出我方法中的错误。

我有一个想要可视化的网络。 目标是仅显示直接连接到引用节点的节点。

当 1) 下拉列表中的引用节点发生更改或 2) 当我单击当前图中应作为新引用节点的外围节点之一时，我想更新此图表。 第一个选项有效，但我无法让 2) 正常工作。

enter image description here

在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"))

最佳答案

这里的技巧是避免循环 react 事件。当使用您注释掉的 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"))

我不确定响应式(Reactive) values$newvarid 是否真的有必要。

关于R 绘图 + Shiny 的 react 耦合事件 - 通过单击同一图表来刷新带有参数的图表，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/42877610/

上一篇：c - 如何从字符串中读取多位数字

下一篇：list - NetLogo:如何使用引用相应列表的标准来过滤列表？

相关文章：

r - 列出 R 中除一列之外的所有列

r - 约束间隙插值

r - 计算行意味着无需提供列名称并根据每列总和有选择地删除列

r - shiny:按下actionButton后应用shinycustomerloader

Python - 使用数据库中的图表创建 pdf 报告的过程是什么？

python - plotly.offline.iplot 在 Jupyter Notebook/Lab 中给出一个大的空白字段作为其输出

r - 计算每行 R 条件的实例数

r - 提取交互式图中鼠标单击的确切坐标

r - 如何减小 R Shiny Web 应用程序中侧边栏面板的宽度？

python - 如何在 Plotly (python) 中设置背景颜色、标题？

©2024 IT工具网  联系我们