在图表中选择活动跟踪并在 R 闪亮的数据表中显示

Posted 2023-02-18

【中文标题】在图表中选择活动跟踪并在 R 闪亮的数据表中显示

【英文标题】：Selection of activity trace in a chart and display in a data table in R shiny

【发布时间】：2018-06-05 16:27:54

【问题描述】：

如果您运行下面的 R Shiny 脚本，您会在 R Shiny 仪表板中看到两个框，左侧的图表显示事件日志数据“patients_eventlog”中发生的所有跟踪或活动集的图。 “患者2”是脚本中的数据，用于解释出现在“a1”列中的每个病例，相应的活动基于“a2”列。我的要求是，当我单击左侧图表中特定轨迹上的任意位置时，我应该获得相关列“a1”、“a2”和“a3”，其中的数据仅具有且仅具有其中活动的那些情况痕迹正在发生。例如。比方说 左侧图表中的跟踪具有活动“注册”和“分类和评估”，通过单击跟踪，我想查看只有这两个活动的案例。这只需要在“output$sankey_table”服务器组件中稍作调整。请帮忙，谢谢。

## app.R ##
library(shiny)
library(shinydashboard)
library(bupaR)
library(lubridate)
library(dplyr)
library(xml2)
library(ggplot2)
library(ggthemes)
library(glue)
library(tibble)
library(miniUI)
library(tidyr)
library(shinyWidgets)
library(plotly)
library(DT)
library(splitstackshape)
library(scales)
patients$patient = as.character(patients$patient)
a1 = patients$patient
a2 = patients$handling
a3 = patients$time
a123 = data.frame(a1,a2,a3)
patients_eventlog = simple_eventlog(a123, case_id = "a1",activity_id = "a2", 
timestamp = "a3")
dta <- reactive(
tr <- data.frame(traces(patients_eventlog, output_traces = T, output_cases = 
F))
tr.df <- cSplit(tr, "trace", ",")
tr.df$af_percent <-
percent(tr.df$absolute_frequency/sum(tr.df$absolute_frequency))
pos <- c(1,4:ncol(tr.df))
tr.df <- tr.df[,..pos]
tr.df <- melt(tr.df, id.vars = c("trace_id","af_percent"))
tr.df
)
Purchase_Final <- reactive(
patients1 <- arrange(patients_eventlog, a1)
patients2 <- patients1 %>% arrange(a1, a3,a2)
patients2 %>%
group_by(a1) %>%
mutate(a3 = as.POSIXct(a3, format = "%m/%d/%Y %H:%M"),diff_in_sec = a3 - 
lag(a3)) %>% 
mutate(diff_in_sec = ifelse(is.na(diff_in_sec),0,diff_in_sec)) %>% 
mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>% 
mutate(diff_in_days = as.numeric(diff_in_hours/24))
)
ui <- dashboardPage(
dashboardHeader(title = "Trace Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Trace Chart", status = "primary",height = "455" ,solidHeader = 
T,
    plotlyOutput("trace_plot"),style = "height:420px; overflow-y: 
scroll;overflow-x: scroll;"),

box( title = "Trace Summary", status = "primary", height = "455",solidHeader 
= T, 
     dataTableOutput("sankey_table"))
)
)
server <- function(input, output) 
 
output$trace_plot <- renderPlotly(


  mp1 = ggplot(data = dta(), aes(x = variable,y = trace_id, fill = value,
                               label = value,
                               text=paste("Variable:",variable,"<br> Trace 
                                          ID:",trace_id,"<br> 
 Value:",value,"<br> Actuals:",af_percent))) +
  geom_tile(colour = "white") +
  geom_text(colour = "white", fontface = "bold", size = 2) +
  scale_fill_discrete(na.value="transparent") +
  theme(legend.position="none") + labs(x = "Traces", y = "Activities")
  ggplotly(mp1, tooltip=c("text"), height = 1226, width = 1205)

 )
 output$sankey_table <- renderDataTable(
 d = event_data("plotly_click")
 d
 )

 
 shinyApp(ui, server)

插件脚本供参考

app.R

library(shiny)
library(shinydashboard)
library(bupaR)
library(lubridate)
library(dplyr)
library(xml2)
library(ggplot2)
library(ggthemes)
library(glue)
library(tibble)
library(miniUI)
library(tidyr)
library(shinyWidgets)
library(plotly)
library(DT)
library(splitstackshape)
library(scales)
dta <- reactive(
tr <- data.frame(traces(patients, output_traces = T, output_cases = F))
tr.df <- cSplit(tr, "trace", ",")
tr.df$af_percent <-
percent(tr.df$absolute_frequency/sum(tr.df$absolute_frequency))
pos <- c(1,4:ncol(tr.df))
tr.df <- tr.df[,..pos]
tr.df <- melt(tr.df, id.vars = c("trace_id","af_percent"))
tr.df
)
patients10 <- reactive(
patients11 <- arrange(patients, patient)
patients12 <- patients11 %>% arrange(patient, time,handling_id)
patients12 %>%
group_by(patient) %>%
mutate(time = as.POSIXct(time, format = "%m/%d/%Y %H:%M"),diff_in_sec = time 
- lag(time)) %>% 
mutate(diff_in_sec = ifelse(is.na(diff_in_sec),0,diff_in_sec)) %>% 
mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>% 
mutate(diff_in_days = as.numeric(diff_in_hours/24))
)
ui <- dashboardPage(
dashboardHeader(title = "Sankey Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader = 
T,
    plotlyOutput("trace_plot")),

box( title = "Case Summary", status = "primary", height = "455",solidHeader 
= T, 
     dataTableOutput("trace_table"))
)
)
server <- function(input, output) 
 
output$trace_plot <- renderPlotly(
mp1 = ggplot(data = dta(), aes(x = variable,y = trace_id, fill = value,
                               label = value,
                               text=paste("Variable:",variable,"<br> Trace 
                                          ID:",trace_id,"<br> 
Value:",value,"<br> Actuals:",af_percent))) +
  geom_tile(colour = "white") +
  geom_text(colour = "white", fontface = "bold", size = 2) +
  scale_fill_discrete(na.value="transparent") +
  theme(legend.position="none") + labs(x = "Traces", y = "Activities")
ggplotly(mp1, tooltip=c("text"), height = 516, width = 605)

)
output$trace_table <- renderDataTable(
req(event_data("plotly_click"))
Values <- dta() %>% 
  filter(trace_id == event_data("plotly_click")[["y"]]) %>% 
  select(value)

valueText <- paste0(Values[[1]] %>% na.omit(),collapse = "")
agg <- aggregate(handling~patient, data = patients10(), FUN = function(y)
paste0(unique(y),collapse = ""))

currentPatient <- agg$patient[agg$handling == valueText]

patients10_final <- patients10() %>%
  filter(patient %in% currentPatient)
datatable(patients10_final, options = list(paging = FALSE, searching = 
FALSE))
)

shinyApp(ui, server)

【问题讨论】：

请提供minimal reproducible example.

@ClausWilke，我现在让我们的生活变得非常简单，请检查“参考插件脚本”下完美运行的脚本。它让您全面了解我的要求。现在它只是关于数据，请帮助我，因为我多年来一直在努力。

当您加载 28 个包时，很难相信这是一个最小的示例。

@ClausWilke，看我得到了最小的例子，我在这里会很清楚，要求是表格中的细节取决于左侧跟踪图的点击.所以放整个脚本是必要的。我很遗憾，但我不知道如何用更少的代码提出这样的要求。请检查一下。

@ClausWilke，为了您的清楚，我减少了一些包，请检查。

【参考方案1】：

由于您给出了如此庞大的示例并且很难解码代码中的每一行，因此我删除了一些代码来获取所选事件的行。

我使用 x 作为 vent_data("plotly_click")$x 而不是 event_data("plotly_click")[["y"]])，并使用 paste0 函数获取 trace_id。

我为获取行而修改的代码部分是：

 output$trace_table <- renderDataTable(
      req(event_data("plotly_click"))
       trace = event_data("plotly_click")$x
      Values <- dta() %>% 
        filter(variable == paste0("trace_",trace))# %>% 
        #select(value)


      datatable(Values)
      # valueText <- paste0(Values[[1]] %>% na.omit(),collapse = "")
      # agg <- aggregate(handling~patient, data = patients10(), FUN = function(y)
      # paste0(unique(y),collapse = ""))
      # 
      # currentPatient <- agg$patient[agg$handling == valueText]
      # 
      # patients10_final <- patients10() %>%
      #   filter(patient %in% currentPatient)
      # 
      # datatable(patients10_final, options = list(paging = FALSE, searching = 
      #                                              FALSE))
    )

编辑： 完整代码如下：

  library(shiny)
  library(shinydashboard)
  library(bupaR)
  library(lubridate)
  library(dplyr)
  library(xml2)
  library(ggplot2)
  library(ggthemes)
  library(glue)
  library(tibble)
  library(miniUI)
  library(tidyr)
  library(shinyWidgets)
  library(plotly)
  library(DT)
  library(splitstackshape)
  library(scales)
  dta <- reactive(
    tr <- data.frame(traces(patients, output_traces = T, output_cases = F))
    tr.df <- cSplit(tr, "trace", ",")
    tr.df$af_percent <-
      percent(tr.df$absolute_frequency/sum(tr.df$absolute_frequency))
    pos <- c(1,4:ncol(tr.df))
    tr.df <- tr.df[,..pos]
    tr.df <- melt(tr.df, id.vars = c("trace_id","af_percent"))
    tr.df
  )
  patients10 <- reactive(
    patients11 <- arrange(patients, patient)
    patients12 <- patients11 %>% arrange(patient, time,handling_id)
    patients12 %>%
      group_by(patient) %>%
      mutate(time = as.POSIXct(time, format = "%m/%d/%Y %H:%M"),diff_in_sec = time 
             - lag(time)) %>% 
      mutate(diff_in_sec = ifelse(is.na(diff_in_sec),0,diff_in_sec)) %>% 
      mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>% 
      mutate(diff_in_days = as.numeric(diff_in_hours/24))
  )
  ui <- dashboardPage(
    dashboardHeader(title = "Sankey Chart"),
    dashboardSidebar(
      width = 0
    ),
    dashboardBody(
      box(title = "Sankey Chart", status = "primary",height = "455" ,solidHeader = 
            T,
          plotlyOutput("trace_plot")),

      box( title = "Case Summary", status = "primary", height = "455",solidHeader 
           = T, 
           dataTableOutput("trace_table"))
    )
  )
  server <- function(input, output) 
   
    output$trace_plot <- renderPlotly(
      mp1 = ggplot(data = dta(), aes(x = variable,y = trace_id, fill = value,
                                     label = value,
                                     text=paste("Variable:",variable,"<br> Trace 
                                                ID:",trace_id,"<br> 
                                                Value:",value,"<br> Actuals:",af_percent))) +
        geom_tile(colour = "white") +
        geom_text(colour = "white", fontface = "bold", size = 2) +
        scale_fill_discrete(na.value="transparent") +
        theme(legend.position="none") + labs(x = "Traces", y = "Activities")
      ggplotly(mp1, tooltip=c("text"), height = 516, width = 605)

    )
    output$trace_table <- renderDataTable(
      req(event_data("plotly_click"))
       trace = event_data("plotly_click")$x
      Values <- dta() %>% 
        filter(variable == paste0("trace_",trace))# %>% 
        #select(value)


      datatable(Values)
      # valueText <- paste0(Values[[1]] %>% na.omit(),collapse = "")
      # agg <- aggregate(handling~patient, data = patients10(), FUN = function(y)
      # paste0(unique(y),collapse = ""))
      # 
      # currentPatient <- agg$patient[agg$handling == valueText]
      # 
      # patients10_final <- patients10() %>%
      #   filter(patient %in% currentPatient)
      # 
      # datatable(patients10_final, options = list(paging = FALSE, searching = 
      #                                              FALSE))
    )
  
  shinyApp(ui, server)

希望对你有帮助！

【讨论】：

非常感谢您的回复，我非常非常感谢，但是请您给我一个合并的脚本，我遇到了运行这个问题。

你好，我试过了，这里的小问题，你修改的代码是我提供的，仅供参考。该代码没有问题，我需要您帮助更新“供参考的附加脚本”上方的脚本，当我单击活动跟踪中的任何位置时，我可以看到相关案例中只有并且只有那些活动整个轨迹，而不是单独的。例如。带有两个活动的跟踪应该显示两个活动，类似于 3,4 请检查。

您可以在之前的代码中使用相同的概念。

看看这就是为什么我一直在追逐社区，这个代码已经被制作成可以很好地处理“患者”数据集，当我使用现实生活中的事件日志时，它是没有给出好的结果，我需要帮助，使解决方案有点通用化以使其适用于任何数据，还有其他内置的事件日志，如脓毒症和 bpic15_1，它们没有给出正确的结果。