I have this shiny app that generates a network graph from a 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)
I want to update the graph by the minimum number of nodes (described as freq
in the nodes_d3
dataframe) that the user chooses (on the input$nos
)
I've tried filtering the nodes_d3
and the edges_d3
by the number of frequencies but it return the error Warning: Error in $<-.data.frame: replacement has 1 row, data has 0 [No stack trace available]
any ideas how to do it?
I've tried using reactiveValues as well, but it wouldn't do. I don't know if in this kind of situation I have to subset the original dataframe and generate the network, or simply subsetting the dfs used in the forcenetwork (which I think I did but still didn't work.)
Once you've created your data, you need to filter both the edges_d3
and the nodes_d3
data frames, and then you need to re-adjust the from
and to
values in the filtered edges_d3
data frame to reflect the new positions of the nodes they refer to in the nodes_d3
data frame.
# 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)