闪亮的数据表中显示

闪亮的数据表中显示

关注
发信
关注(28)粉丝(399)

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

本文介绍了在图表中选择活动跟踪并在 R 闪亮的数据表中显示的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

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

If you run the R shiny script below, you get two boxes in an R shiny dashboard, The chart on the left displays a plot for all the traces or set of activities that occur in the eventlog data "patients_eventlog". "patients2" is a data in the script that explains each and every case appearing in column "a1", and corresponding activities basides in column "a2". My requirement is that when I click anywhere on a particular trace in the chart on left, I should get the relevant columns "a1","a2" and "a3" with the data having only and only those cases in which the activities in that trace are occurring. E.g. Let's saya trace in the chart on left has activites "Registration" and "Triage and Assessment", the by clicking on the trace, I want to see the cases with only and only those two activities. This just needs a minor tweak in the "output$sankey_table" server component. Please help and thanks.

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

推荐答案

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

Since you have given such a huge example and its hard to decode each and every line in your code, I have removed some code to get the rows for your selected event.

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

Instead of event_data("plotly_click")[["y"]]) I am using the x as vent_data("plotly_click")$x and getting the trace_id by using paste0 function.

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

The part of the code that I have modified to get the rows is:

 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)

希望对你有帮助！

这篇关于在图表中选择活动跟踪并在 R 闪亮的数据表中显示的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！

07-31 02:16
Powered by LMLPHP ©2024 闪亮的数据表中显示 0.038647