networkD3 и Shiny - фильтр по количеству узлов - PullRequest
Новая
       49

networkD3 и Shiny - фильтр по количеству узлов

0 голосов
/ 11 апреля 2019

У меня есть это блестящее приложение, которое генерирует сетевой график из df. 

library(shiny)
library(dplyr)
library(tibble)
library(networkD3)

ui <- fluidPage(
  sidebarPanel(
    fluidRow(selectInput("nos","Mínimo de orientações",c(1:10),selected=c(1)))
    ),
  fluidRow(simpleNetworkOutput(
    "redes", width = "100%", height = "800px"
  ))
)
server <- function(input, output, session) {
  df_orientadores <- data.frame(orientador=c("Chet Baker","Bill Evans","Miles Davis","Miles Davis","Dizzy Gillespie","Miles Davis"),
                                autor=c("Clifford Brown","Freddie Hubbard","Kenny Dorham","Kenny Burrell","Arturo Sandoval","Goku"))
  output$redes <- renderSimpleNetwork({
    sources <- df_orientadores %>%
      select(orientador) %>%
      dplyr::rename(label = orientador)
    destination <- df_orientadores %>%
      select(autor) %>%
      dplyr::rename(label = autor)

    nodes <- full_join(sources, destination, by = "label")
    nodes <- nodes %>% group_by(label) %>% count(label) %>% rename(freq=n)

    nodes <- nodes %>% rowid_to_column("id")
    nodes$peso <- ((nodes$freq)^3)

    orientacoes_network <- df_orientadores %>%  
      group_by(orientador, autor) %>%
      dplyr::summarise(weight = n()) %>% 
      ungroup()
    edges <- orientacoes_network %>% 
      left_join(nodes, by = c("orientador" = "label")) %>% 
      dplyr::rename(from = id)

    edges <- edges %>% 
      left_join(nodes, by = c("autor" = "label")) %>% 
      dplyr::rename(to = id)
    edges <- select(edges, from, to, weight)
    nodes_d3 <- mutate(nodes, id = id - 1)
    edges_d3 <- mutate(edges, from = from - 1, to = to - 1) 
    filtro_nos <- nodes_d3

    edges_d3$value <- 1  
    forceNetwork(Links = edges_d3, Nodes = nodes_d3, Source = "from", Target = "to", 
                 NodeID = "label", Group = "id", Value = "value", 
                 opacity = 1, fontSize = 20, zoom = TRUE, Nodesize = "peso",
                 arrows = TRUE)
  })
}
shinyApp(ui, server)

Я хочу обновить график по минимальному количеству узлов (описывается как freq в кадре данных nodes_d3), который пользователь выбирает (на input$nos)

Я пытался отфильтровать nodes_d3 и edges_d3 по количеству частот, но он возвращает ошибку Warning: Error in $<-.data.frame: replacement has 1 row, data has 0 [No stack trace available]

есть идеи, как это сделать?

Я тоже пытался использовать реактивные значения, но это не сработало.Я не знаю, нужно ли в подобной ситуации подналичивать исходный фрейм данных и генерировать сеть, или просто поднаправлять dfs, используемые в forcenetwork (которые, я думаю, я сделал, но все еще не работал.)

1 Ответ

0 голосов
/ 12 апреля 2019

После того, как вы создали свои данные, вам нужно отфильтровать и фреймы данных edges_d3 и nodes_d3, а затем вам необходимо заново отрегулировать значения from и to в отфильтрованных edges_d3 фрейм данных для отражения новых позиций узлов, к которым они относятся в nodes_d3 фрейме данных. 

# determine the nodes that have at least the minimum freq
nodes_d3_min_freq <-
  nodes_d3 %>% 
  filter(freq >= input$nos)

# filter the edge list to contain only links to or from the nodes that have
# the minimum or more freq
edges_d3_filtered <-
  edges_d3 %>% 
  filter(from %in% nodes_d3_min_freq$id | to %in% nodes_d3_filtered$id)

# filter the nodes list to contain only nodes that are in or are linked to 
# nodes in the filtered edge list
nodes_d3_filtered <-
  nodes_d3 %>% 
  filter(id %in% unlist(select(edges_d3_filtered, from, to)))

# re-adjust the from and to values to reflect the new positions of nodes in
# the filtered nodes list
edges_d3_filtered$from <- match(edges_d3_filtered$from, nodes_d3_filtered$id) - 1
edges_d3_filtered$to <- match(edges_d3_filtered$to, nodes_d3_filtered$id) - 1

forceNetwork(Links = edges_d3_filtered, Nodes = nodes_d3_filtered, 
             Source = "from", Target = "to", NodeID = "label", 
             Group = "id", Value = "value", opacity = 1, fontSize = 20, 
             zoom = TRUE, Nodesize = "peso", arrows = TRUE)
...