Варианты чистки с помощью igraph объекта в Shiny - PullRequest
Новая
       24

Варианты чистки с помощью igraph объекта в Shiny

2 голосов
/ 02 мая 2019

Как лучше всего интегрировать блестящую кисть с библиотекой igraph? Теперь я знаю, что использование brushedPoints лучше всего работает с ggplot2, но есть ли способ использовать с 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 из кисти.

1 Ответ

0 голосов
/ 08 мая 2019

Вот попытка использования 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)

enter image description here

Сначала вы создаете ggraph макет data.frame (с использованием create_layout), который содержит исходные данные узла, а также некоторые дополнительные переменные построения, а затем вы поднастраиваете этот фрейм данных с помощью brushedPoints. Затем установите подмножество исходного nodes фрейма данных на основе переменных, присутствующих в очищенном фрейме данных.

РЕДАКТИРОВАТЬ: обновил код сервера, поскольку я обнаружил, что он не работал в новом сеансе R из-за неуместных переменных.

...