在R Shiny中显示sankey图表中的表详细信息 [英] Displaying the table details from sankey chart in R shiny

问题描述

下面的脚本处理bupaR软件包中的患者数据，并创建一个sankey图，列出了雇员"列中的资源与患者数据中处理"列中涉及的活动之间的关系.除了图解外，DT还提供了一个数据表，该数据表提供了单击时每个sankey图解路径的详细信息.我想要一种功能，以便当我单击任何路径(例如，连接"r1"雇员和注册"处理活动的路径)时，我希望来自患者数据的所有行以及图中的这两个字段均可用，类似于所有其他路径，这应该是动态的，因为我会将功能应用于较大的数据集.附加快照以供参考.谢谢，请帮忙.

The script below works on the patients data from bupaR package,and creates a sankey plot listing the relation between a resource from the "employee" column with the activity he is involved in from the "handling" column in the patients data. Besides the plot there is a data table available from DT which gives details of every sankey plot path when clicked. I want a functionality such that when I click on any path, say path connecting "r1" employee and "Registration" handling activity, I want all the rows from patients data with both these fields available in the plot besides, similarly for all other paths, this should be dynamic as I shall apply the functionality on larger datasets. Attaching the snapshot for reference. Thanks and please help.

## app.R ##
library(shiny)
library(shinydashboard)
library(devtools)
library(ggplot2)
library(plotly)
library(proto)
library(RColorBrewer)
library(gapminder)
library(stringr)
library(broom)
library(mnormt)
library(DT)
library(bupaR)

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) 
 { 
 output$sankey_plot <- renderPlotly({
 sankeyData <- patients %>% 
  group_by(employee,handling) %>% 
  count()
 sankeyNodes <- list(label = c(sankeyData$employee,sankeyData$handling))
 trace2 <- list(
  domain = list(
    x = c(0, 1), 
    y = c(0, 1)
  ), 
  link = list(
    label = paste0("Case",1:nrow(sankeyData)), 
    source = sapply(sankeyData$employee,function(e) {which(e == 
  sankeyNodes$label) }, USE.NAMES = FALSE) - 1, 
    target = sapply(sankeyData$handling,function(e) {which(e == 
  sankeyNodes$label) }, USE.NAMES = FALSE) - 1, 
    value = sankeyData$n
  ), 
  node = list(label = sankeyNodes$label), 
  type = "sankey"
  )
  data2 <- list(trace2)
  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")
  d
  })
  }
  shinyApp(ui, server)

推荐答案

我将event_data的输出解释为pointNumber是链接的索引，但是我在这里可能是错误的.无论如何，这是我的解决方案，适用于此数据

Hi I interpreted the output from event_data as such that pointNumber is the index of the link but I might be wrong here. Any way this is my Solution and it works for this data

library(shiny)
library(shinydashboard)
library(devtools)
library(ggplot2)
library(plotly)
library(proto)
library(RColorBrewer)
library(gapminder)
library(stringr)
library(broom)
library(mnormt)
library(DT)
library(bupaR)
library(dplyr)

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 <- patients %>% 
      group_by(employee,handling) %>% 
      count()
    sankeyNodes <- list(label = c(sankeyData$employee,sankeyData$handling) %>% unique())
    trace2 <- list(
      domain = list(
        x = c(0, 1), 
        y = c(0, 1)
      ), 
      link = list(
        label = paste0("Case",1:nrow(sankeyData)), 
        source = sapply(sankeyData$employee,function(e) {which(e == 
                                                                 sankeyNodes$label) }, USE.NAMES = FALSE) - 1, 
        target = sapply(sankeyData$handling,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]
    patients %>% filter(employee == Source & handling == Target)


  })
}
shinyApp(ui, server)

希望有帮助！

这篇关于在R Shiny中显示sankey图表中的表详细信息的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！