r - 单击 R 中的 Sankey Chart 线时添加额外的标签值

Question

以下 R Shiny 脚本创建一个桑基图，如下面的快照所示。我的要求是，当我单击左右节点之间的任何链接(即“a1”和“a2”)时，我希望相应的“a3”的总和出现在标签中。例如，a1 中的“A”和 a2 中的“E”总共具有值 50 和 32。因此，我想在单击链接时在标签中看到 82，请帮助并感谢。所有其他 a1,a2 对也类似。下面的服务器代码中的 list() 函数需要一些调整。附上快照。

library(shiny)
library(shinydashboard)
library(plotly)
library(DT)
library(dplyr)
a1 = c("A","B","C","A","C","C","B")
a2 = c("E","F","G","E","G","G","F")
a3 = c(50,45,64,32,45,65,75)
a12 = data.frame(a1,a2,a3,stringsAsFactors = FALSE)
a12$a1 = as.character(a12$a1)
a12$a2 = as.character(a12$a2)
ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader = 
T,plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", height = "455",solidHeader 
= T, dataTableOutput("sankey_table"))
))
server <- function(input, output) 
{ 
sankeyData <- reactive({
sankeyData <- a12 %>% 
  group_by(a1,a2) %>% 
  count()
sankeyNodes <- list(label = c(sankeyData$a1,sankeyData$a2) %>% unique())
trace2 <- list(
  domain = list(
    x = c(0, 1), 
    y = c(0, 1)
  ), 
  link = list(
    label = paste0("Case",1:nrow(sankeyData)), 
    source = sapply(sankeyData$a1,function(e) {which(e == 
                                                       sankeyNodes$label) }, 
   USE.NAMES = FALSE) - 1, 
    target = sapply(sankeyData$a2,function(e) {which(e == 
                                                       sankeyNodes$label) }, 
    USE.NAMES = FALSE) - 1, 
    value = sankeyData$n
  ), 
  node = list(label = sankeyNodes$label), 
  type = "sankey"
  )
  trace2
  })
  output$sankey_plot <- renderPlotly({
  trace2 <- sankeyData()
  p <- plot_ly()
  p <- add_trace(p, domain=trace2$domain, link=trace2$link, 
               node=trace2$node, type=trace2$type)
  p
  })
  output$sankey_table <- renderDataTable({
  d <- event_data("plotly_click")
  req(d)
  trace2 <- sankeyData()
  sIdx <-  trace2$link$source[d$pointNumber+1]
  Source <- trace2$node$label[sIdx + 1 ]
  tIdx <- trace2$link$target[d$pointNumber+1]
  Target <- trace2$node$label[tIdx+1]
  a12 %>% filter(a1 == Source & a2 == Target)
  })
  }
  shinyApp(ui, server)

Answer 1

我猜你需要的解决方案是

value = apply(t(sankeyData),2, function(e, Vals){
           e <- data.frame(t(e), stringsAsFactors = FALSE)
           sum(Vals[which(e$a1 == Vals$a1 & e$a2 == Vals$a2),3])
         }, Vals = a12)

而不是

value = sankeyData$n

有了这个，你会得到这样的东西:

希望对你有帮助!