Отображение сведений о таблице из диаграммы Санки в R Shiny

Приведенный ниже сценарий работает с данными о пациентах из пакета bupaR и создает график sankey, отображающий взаимосвязь между ресурсом из столбца «сотрудник» и деятельностью, в которой он участвует, из столбца «обработка» в данных о пациентах. Помимо графика есть таблица данных, доступная в DT, которая дает подробную информацию о каждом пути графика Санки при нажатии. Мне нужна такая функциональность, чтобы, когда я нажимаю на любой путь, скажем, на путь, соединяющий сотрудника «r1» и операцию «Регистрация», я хочу, чтобы все строки из данных пациентов с обоими этими полями были доступны на графике, кроме того, аналогично для всех других путей , это должно быть динамическим, так как я буду применять эту функциональность к большим наборам данных. Прикрепляю снимок для ознакомления. Спасибо и, пожалуйста, помогите.

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

Снимок


r plotly shiny sankey-diagram ggplotly
person Ashmin Kaul    schedule 17.12.2017    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Привет, я интерпретировал вывод event_data так, что pointNumber является индексом ссылки, но здесь я могу ошибаться. В любом случае это мое решение, и оно работает для этих данных

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)

Надеюсь, поможет!

person Bertil Baron    schedule 17.12.2017
comment
работает отлично, однако этот точечный индекс я также реализовал немного по-другому, мой вопрос в том, что если я реализую это, скажем, с 1000 случаев и 1000 действий, где несколько случаев связаны с несколькими действиями, получу ли я рабочее решение? - person Ashmin Kaul; 17.12.2017
comment
Я так считаю. Но не уверен на 100%. Я попробовал небольшой пример с перекрестными ссылками, и это решение работает. - person Bertil Baron; 17.12.2017
comment
Конечно, позвольте мне проверить это. - person Ashmin Kaul; 17.12.2017
comment
Эй, я попробовал ваш код, но когда я запускаю ваш код для других данных с двумя столбцами ресурса и активности, график выдает ошибку: нечисловой аргумент для бинарного оператора. Возьмем простой пример, такой как ресурс ‹- c(A,B,C) и активность ‹- c(m,n,o) и фрейм данных a12 ‹- data.frame(ресурс, активность). Пожалуйста помоги. - person Ashmin Kaul; 18.12.2017
comment
Я все еще сталкиваюсь с проблемами, пожалуйста, помогите. - person Ashmin Kaul; 19.12.2017
comment
Я посмотрю на это, как только мой компьютер снова заработает. На данный момент он даже не загружается. - person Bertil Baron; 19.12.2017
comment
в приведенном выше коде столбец сотрудника и обработки, когда я заменяю столбцы двумя другими столбцами из другого набора данных, он просто не запускается, пожалуйста, помогите мне, когда ваша проблема будет решена. - person Ashmin Kaul; 21.12.2017
comment
@AshminKaul Я думаю, проблема может быть в этой строке sankeyNodes <- list(label = c(sankeyData$employee,sankeyData$handling)) попробуйте изменить ее на sankeyNodes <- list(label = c(sankeyData$employee,sankeyData$handling) %>% unique() ) Также важно, чтобы на графике не было кругов, у вас не может быть что-то вроде a -> b и в то же время есть b -> a надеюсь, это поможет - person Bertil Baron; 22.12.2017
comment
теперь все работает нормально, большое спасибо, не могли бы вы объяснить, в чем была проблема и что здесь уникального? - person Ashmin Kaul; 22.12.2017
comment
Мне нужна ваша серьезная помощь с другими данными журнала событий, в которых мне нужно требование. Ваш код идеален, но вам нужна ваша помощь с функциональностью по щелчку. Большое спасибо. «отображение сведений об активности в таблице данных в rshiny»> stackoverflow.com/questions/47433655/ - person Ashmin Kaul; 22.12.2017