如何在Shiny上的networkD3中对数据进行子集化? [英] How to subset data in networkD3 on Shiny?

问题描述

以下是可重现的示例:

library(networkD3)

MyNodes<-data.frame(name= c("A", "B", "C", "D", "E", "F"),
                    size= c("1","1","1","1","1","1"),
        Team= c("Team1", "Team1", "Team1", "Team1", "Team2", "Team2"),
        group= c("Group1", "Group1", "Group2", "Group2", "Group1", "Group1"))

MyLinks<-data.frame(source= c("0","2","4"),
                    target= c("1","3","5"),
                    value= c("10","50","20"))

forceNetwork(Links = MyLinks, Nodes = MyNodes,
             Source = "source",
             Target = "target", Value = "value", NodeID = "name",
             Nodesize = 'size', radiusCalculation = " Math.sqrt(d.nodesize)+6",
             Group = "group", linkWidth = 1, linkDistance = JS("function(d){return d.value * 1}"), opacity = 5, zoom = T, legend = T, bounded = T) 

我想做的是让用户仅通过 selectInput 或类似方式查看不同 团队 的图.

What I want to do is letting the user see only the plots of different Teams as in my example via a selectInput or similar.

我在使用 visNetwork 时遇到了相同的问题，并设法通过以下技巧解决了该问题:

I had come across the same issue when I was using visNetwork and managed to solve it by using this trick:

MyNodes[MyNodes$"Team"=="Team2",]

以及以下使用 selectInput 的方式可以完美地与之配合使用:

and the way of using selectInput as below would work perfectly with that:

library(shiny)
library(networkD3)

server <- function(input, output) {
  output$force <- renderForceNetwork({
    forceNetwork(Links = MyLinks, Nodes = MyNodes[MyNodes$"Team"==input$TeamSelect,],
                 Source = "source",
                 Target = "target", Value = "value", NodeID = "name",
                 Nodesize = 'size', radiusCalculation = " Math.sqrt(d.nodesize)+6",
                 Group = "group", linkWidth = 1, linkDistance = JS("function(d){return d.value * 1}"), opacity = 5, zoom = T, legend = T, bounded = T) 
  })}

ui <- fluidPage(
  selectInput("TeamSelect", "Choose a Team:", MyNodes$Team, selectize=TRUE),
  forceNetworkOutput("force"))

shinyApp(ui = ui, server = server)

但是，对于networkD3，我猜想子集后面的节点的索引顺序的解释出了点问题，您也可以看到，我的 和 团队 ，但是当我选择一个时，它会返回一个空图.

However with networkD3, I guess something goes wrong with the interpretation of the index order of the nodes following the subset and as you can also see, I get my selectInput with my Teams but when I choose one, it returns an empty plot.

在我的案例中，我还尝试使用 reactive 调整解决方案的形状，但是它也不起作用:

I also tried to shape-shift the solution with reactive here for my case, but it didn't work either:

创建具有闪闪发亮的Sankey图的应用程序选择输入

从技术上讲，在networkD3中无法做到这一点吗?或者我离解决方案有多近?

Is it technically not possible to do this in networkD3, or how close was I to the solution?

谢谢！

推荐答案

根据您对此问题的评论:

Per your comment on this question: Create shiny app with sankey diagram that reacts to selectinput, here's the solution from the app in that question while using strings as factors and reactive objects.

代码将所有内容包装在反应对象中，并依赖字符串作为原始数据帧中的因素.节点和链接数据帧从那里开始.技巧是在将字符串转换为因数之前先过滤节点，以便链接引用和JavaScript可以使用一致的节点索引.

The code wraps everything in a reactive object and relies on the strings as factors in the original data frame. Node and link data frames follow from there. The trick is to filter the node prior to converting the strings to factors so the link references and the JavaScript can use a consistent node index.

代码在这里:

library(shiny)
library(networkD3)
library(dplyr)
ui <- fluidPage(
  selectInput(inputId = "school",
              label   = "School",
              choices =  c("alpha", "echo")),
  selectInput(inputId = "school2",
              label   = "School2",
              choices =  c("bravo", "charlie", "delta", "foxtrot"),
              selected = c("bravo", "charlie"),
              multiple = TRUE),

  sankeyNetworkOutput("diagram")
)

server <- function(input, output) {

  dat <- reactive({
    data.frame(schname = c("alpha", "alpha", "alpha", "echo"),
                    next_schname = c("bravo", "charlie", "delta", "foxtrot"),
                    count = c(1, 5, 3, 4),
                    stringsAsFactors = FALSE) %>%
      filter(next_schname %in% input$school2) %>%
      mutate(schname = factor(schname),
             next_schname = factor(next_schname))
  })

  links <- reactive({
    data.frame(source = dat()$schname,
                      target = dat()$next_schname,
                      value  = dat()$count)
  })

  nodes <- reactive({
    data.frame(name = c(as.character(links()$source),
                               as.character(links()$target)) %>%
                        unique) 
    })



  links2 <-reactive({
    links <- links()
    links$IDsource <- match(links$source, nodes()$name) - 1
    links$IDtarget <- match(links$target, nodes()$name) - 1

    links %>%
      filter(source == input$school)
  })


  output$diagram <- renderSankeyNetwork({
    sankeyNetwork(
      Links = links2(),
      Nodes = nodes(),
      Source = "IDsource",
      Target = "IDtarget",
      Value = "value",
      NodeID = "name",
      sinksRight = FALSE
    )
  })
}

shinyApp(ui = ui, server = server)

这篇关于如何在Shiny上的networkD3中对数据进行子集化?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！