Anzeigen der Tabellendetails aus dem Sankey-Diagramm in R shiny

Question

Das folgende Skript arbeitet mit den Patientendaten aus dem bupar-Paket und erstellt ein sankey plot, in dem die Beziehung zwischen einer Ressource aus der Spalte "employee" und der Aktivität, aus der sie besteht, aufgelistet wird Spalte "Handling" in den Patientendaten. Neben dem Plot gibt es eine Datentabelle, die von DT zur Verfügung steht, die Einzelheiten zu jedem sankey-Plotpfad gibt, wenn er angeklickt wird. Ich möchte eine Funktionalität, dass, wenn ich auf einen Pfad, sagen Pfad Verbindung "r1" Mitarbeiter und "Registrierung" Handhabung Aktivität, ich möchte alle Zeilen von Patienten Daten mit diesen beiden Felder in der Handlung neben, ähnlich für alle anderen Pfade Dies sollte dynamisch sein, da ich die Funktionalität auf größere Datensätze anwenden soll. Anfügen des Snapshots zur Referenz Danke und bitte helfen Sie.

## 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) 

Answer 1

Hallo interpretierte ich die Ausgabe von event_data als solche, dass pointNumber der Index des Link ist, aber ich könnte hier falsch sein. Beliebige Weise das ist meine Lösung und es funktioniert für diese Daten

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) 

hoffe es hilft!