Question

将Shiny brushing选项与igraph库集成的最佳方法是什么？现在，我知道在ggplot2中使用brushedPoints效果最佳，但是有没有办法与igraph一起使用？有没有一种方法可以将网络转换为ggplot2对象，以便可以使用panelvar1和panelvar = NONE？

我创建了Shiny应用程序以可视化网络。抱歉，数据框稍大（它们来自https://kateto.net/network-visualization教程）。请先创建数据框，因为Shiny应用程序依赖于它们。应用程序包含刷牙选项。

# nodes for network
id <- c('s01', 's02', 's03', 's04', 's05', 's06', 's07', 's08', 's09', 's10', 's11', 's12', 's13', 's14', 's15', 's16', 's17')
media <- c('NY Times', 'Washington Post', 'Wall Street Journal', 'USA Today', 'LA Times', 'New York Post', 'CNN', 'MSNBC', 'FOX News', 'ABC', 'BBC', 'Yahoo News', 'Google News', 'Reuters.com', 'NYTimes.com', 'WashingtonPost.com', 'AOL.com')
media.type <- c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3)
type.label <- c('Newspaper', 'Newspaper', 'Newspaper', 'Newspaper', 'Newspaper', 'Newspaper', 'TV', 'TV', 'TV', 'TV', 'TV', 'Online', 'Online', 'Online', 'Online', 'Online', 'Online')
audience.size <- c(20, 25, 30, 32, 20, 50, 56, 34, 60, 23, 34, 33, 23, 12, 24, 28, 33)
nodes <- data.frame(id, media, media.type, type.label, audience.size)
str(nodes)

# edges for network
from <- c('s01', 's01', 's01', 's01', 's02', 's02', 's02', 's02', 's03', 's03', 's03', 's03', 's03', 's03', 's03', 's04', 's04', 's04', 's04', 's04', 's05', 's05', 's05', 's05', 's06', 's06', 's06', 's07', 's07', 's07', 's07', 's08', 's08', 's08', 's09', 's10', 's12', 's12', 's12', 's13', 's13', 's14', 's14', 's15', 's15', 's15', 's16', 's16', 's17')
to <- c('s02', 's03', 's04', 's15', 's01', 's03', 's09', 's10', 's01', 's04', 's05', 's08', 's10', 's11', 's12', 's03', 's06', 's11', 's12', 's17', 's01', 's02', 's09', 's15', 's06', 's16', 's17', 's03', 's08', 's10', 's14', 's03', 's07', 's09', 's10', 's03', 's06', 's13', 's14', 's12', 's17', 's11', 's13', 's01', 's04', 's06', 's06', 's17', 's04')
type <- c('hyperlink', 'hyperlink', 'hyperlink', 'mention', 'hyperlink', 'hyperlink', 'hyperlink', 'hyperlink', 'hyperlink', 'hyperlink', 'hyperlink', 'hyperlink', 'mention', 'hyperlink', 'hyperlink', 'hyperlink', 'mention', 'mention', 'hyperlink', 'mention', 'mention', 'hyperlink', 'hyperlink', 'mention', 'hyperlink', 'hyperlink', 'mention', 'mention', 'mention', 'hyperlink', 'mention', 'hyperlink', 'mention', 'mention', 'mention', 'hyperlink', 'mention', 'hyperlink', 'mention', 'hyperlink', 'mention', 'mention', 'mention', 'hyperlink', 'hyperlink', 'hyperlink', 'hyperlink', 'mention', 'hyperlink')
weight <- c(22, 22, 21, 20, 23, 21, 1, 5, 21, 22, 1, 4, 2, 1, 1, 23, 1, 22, 3, 2, 1, 21, 2, 21, 1, 21, 21, 1, 22, 21, 4, 2, 21, 23, 21, 2, 2, 22, 22, 21, 1, 1, 21, 22, 1, 4, 23, 21, 4)
links <- data.frame(from, to, type, weight)
str(links)

# Shiny App

library(shiny)
library(igraph)
# ui----
ui <- fluidPage(
  tabsetPanel(
    tabPanel("tab", #tab ----
             sidebarLayout(
               sidebarPanel("text",
                            helpText("Submit for Analysis"),
                            actionButton("button1", "Submit")
               ),
               mainPanel(
                 verbatimTextOutput("info_n_head"),
                 verbatimTextOutput("info_e_head"),
                 plotOutput("graph_1", brush = "plot_brush", width = "100%", height = '600px'),
                 verbatimTextOutput("info")
               )
             )

    )
  )
)
# server----
server <- function(input, output) {

  observeEvent(input$generate, {
    net <- graph_from_data_frame(d=links(), vertices=nodes(), directed=F)
  })

  output$info_n_head <- renderPrint({
    # Shows peview of Data.
    head(nodes)
  })
  output$info_e_head <- renderPrint({
    # Shows peview of Data.
    head(links)
  })

  observeEvent(input$button1, {
    output$graph_1 <- renderPlot({
      #---For Graph creation----
      net <- graph_from_data_frame(d=links, vertices=nodes, directed=F)

      plot(net, edge.arrow.size=.2, edge.curved=0,
           vertex.color="orange", vertex.frame.color="#555555",
           vertex.label=V(net)$media, vertex.label.color="black",
           vertex.label.cex=.7)
      # The second way to set attributes is to add them to the igraph object.

      # Generate colors based on media type:
      colrs <- c("gray50", "tomato", "gold")
      V(net)$color <- colrs[V(net)$media.type]


      # Compute node degrees (#links) and use that to set node size:
      deg <- degree(net, mode="all")
      V(net)$size <- deg*3
      # Alternatively, we can set node size based on audience size:
      V(net)$size <- V(net)$audience.size*0.7

      # The labels are currently node IDs.
      # Setting them to NA will render no labels:
      V(net)$label.color <- "black"
      V(net)$label <- NA

      # Set edge width based on weight:
      E(net)$width <- E(net)$weight/6

      #change arrow size and edge color:
      E(net)$arrow.size <- .2
      E(net)$edge.color <- "gray80"

      # We can even set the network layout: layout_with_lgl, layout_with_kk
      graph_attr(net, "layout") <- layout_with_lgl
      plot(net)
    })

  })

  output$info <- renderPrint({
    brushedPoints(nodes, input$plot_brush, panelvar1 = "media", panelvar2 = NULL)
  })

}

shinyApp(ui, server)

我的目标是通过画笔工具为选定的节点提供数据洞察。在当前示例中，当将刷牙方块放在节点上时，将产生以下错误：brushedPoints中的错误：brushedPoints：无法自动从笔刷中推断xvar。

Answer 1

以下是StéphaneLaurent在评论中建议的使用ggraph的尝试。我省略了诸如节点颜色，大小等图形美感。

library(shiny)
library(igraph)
library(ggraph)

ui与您的相同：

ui <- fluidPage(
  tabsetPanel(
    tabPanel("tab", #tab ----
             sidebarLayout(
               sidebarPanel("text",
                            helpText("Submit for Analysis"),
                            actionButton("button1", "Submit")
               ),
               mainPanel(
                 verbatimTextOutput("info_n_head"),
                 verbatimTextOutput("info_e_head"),
                 plotOutput("graph_1", brush = "plot_brush", width = "100%", height = '600px'),
                 verbatimTextOutput("info")
               )
             )

    )
  )
)

server <- function(input, output) {
 output$info_n_head <- renderPrint({
    # Shows peview of Data.
    head(nodes)
  })
  output$info_e_head <- renderPrint({
    # Shows peview of Data.
    head(links)
  })

  net <- graph_from_data_frame(d = links,
                               vertices = nodes,
                               directed = F)
  set.seed(1)
  net_lay <- ggraph::create_layout(net,
                                   layout = "nicely")

  observeEvent(input$button1, {
    output$graph_1 <- renderPlot({
      ggraph(net_lay) +
        geom_edge_link() +
        geom_node_point() 
    })
  })

  output$info <- renderPrint({
    brush_net <- brushedPoints(net_lay,
                               input$plot_brush)
      nodes[as.character(nodes$id) %in%  as.character(brush_net$name),]
  })

}

shinyApp(ui, server)

首先，创建一个ggraph布局data.frame（使用create_layout），其中包含原始节点数据以及一些其他绘图变量，然后使用{{ 1}}。然后根据刷数据帧中存在的变量对原始brushedPoints数据帧进行子集化。

编辑：更新了服务器代码，因为我发现由于变量放置错误而无法在新的R会话中工作。

使用Shiny中的igraph对象进行刷洗选项

1 个答案: