在 R 闪亮的数据 table 中显示 activity 详细信息
Diplaying activity details in a data table in R shiny
当我 运行 下面的这个 R shiny 脚本时，我得到了两个图，其中有一个图表 activity 路径来自 bupaR 库的患者数据集，左侧称为 trace explorer 和一个数据table 以显示 activity/trace 详细信息。左边的图表是这样的，我们观察到各种路径，这些路径具有一个接一个发生的水平活动轨迹序列。单击特定轨迹中的任何框时，轨迹详细信息将显示在右侧 table。我的要求是，当单击特定跟踪中的任何框时，应该动态获取 "y" 或第四列值，并且我应该只得到一列显示跟踪中发生的所有活动。例如。在附图中，当单击最底部路径的任意位置时，我应该得到一列活动 "Registration"、"Triage and Assessment"。请帮助和感谢。
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(edeaR)
library(scales)
library(splitstackshape)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", 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({
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"))
mp1 = ggplot(data = tr.df, 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 = 380, width = 605)
})
output$sankey_table <- renderDataTable({
tp2 = event_data("plotly_click")
})
}
shinyApp(ui, server)
第二部分:
library(lubridate)
patients1 <<- arrange(patients, patient)
patients2 <<- patients1 %>% arrange(patient, time)
patients3 <<- patients2 %>%
group_by(patient) %>%
mutate(diff_in_sec = as.POSIXct(time, format = "%m/%d/%Y %H:%M") -
lag(as.POSIXct(time, format = "%m/%d/%Y %H:%M"),
default=first(as.POSIXct(time, format = "%m/%d/%Y %H:%M"))))%>%
mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>% mutate(diff_in_days
= as.numeric(diff_in_hours/24))
在 运行 上面的代码中，您从 bupaR 库中获取患者数据，因此 "patient" 列下给出的数据中有 500 个案例，每个案例中的活动是在 "handling" 列中，并按出现时间的升序排列。我的要求是我想比较从 DT table 中的先前解决方案获得的 "value" 列，并与 'unique(handling)' 进行比较，即 patients3 中每种情况下的独特活动 "patient"数据集。在 "value" 列找到完全匹配的情况下，我想显示 DT table 中的整个对应行。例如。当单击最底部路径上的任意位置时，如果找到匹配项，则具有活动 "Registration"、"Triage and Assessment"、"value" 列的跟踪应与从 1 到 500 的每种情况下的唯一活动进行比较即，具有活动 "Registration"、"Triage and Assessment" 的案例，应显示具有相应行的案例，所有跟踪都类似。谢谢，请帮忙。
第三部分:
我想通过给它一个 suitable pageLength 来修复第二个框中的数据 table，这样它就不会从下方和右侧超过。请在下面找到合并代码，我知道一些可能的语法可以集成到情节中以实现这一点，如下所示：
可能的语法:
datatable(Data, options = list(
searching = TRUE,
pageLength = 9
))
**and**
box( title = "Case Details", status = "primary", height = "575",solidHeader
= T,width = "6",
div(DT::dataTableOutput("Data_table"), style = "font-size: 84%; width:
65%"))
**Here is the consolidated final code to be updated**
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "455" ,solidHeader = T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", solidHeader
= T,
dataTableOutput("sankey_table"),
width = 6)
)
)
server <- function(input, output)
{
#Plot for Trace Explorer
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 <- patients1 %>% 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))
})
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() %>%
filter(patient %in% currentPatient)
})
}
shinyApp(ui, server)
请帮忙。
我添加了包 dplyr
library(dplyr)
因为你已经完成了从 plotly 中捕获事件的所有艰苦工作，所以我在将 tr.df 的计算移动到单独的反应中之后更改了服务器，以便我可以再次将它用于 table以及 y 值之后的过滤器 plotly 事件。
server <- function(input, output)
{
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
})
output$sankey_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 = 380, width = 605)
})
output$sankey_table <- renderDataTable({
req(event_data("plotly_click"))
dta() %>%
filter(trace_id == event_data("plotly_click")[["y"]]) %>%
select(value)
})
}
** 第二部分 **
对于 server.r 我是否添加了以下反应函数
patients3 <- reactive({
patients1 <- arrange(patients, patient)
patients2 <- patients1 %>% arrange(patient, time,handling_id)
patients2 %>%
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))
})
并相应地更改了 renderDataTable
output$sankey_table <- renderDataTable({
req(event_data("plotly_click"))
Values <- dta() %>%
filter(trace_id == event_data("plotly_click")[["y"]]) %>%
select(value)
patient <- patients3()[["patient"]] %>% unique()
result = NULL
for(p in patient){
handlings <- patients3() %>%
filter(patient == p) %>%
`$`(handling) %>%
unique()
if(sum(!is.na(Values)) == length(handlings) &&
all(handlings %in% Values[[1]])){
result <- rbind(result,
patients3() %>%
filter(patient == p))
}
}
result
})
因为你的新 table 大得多，我也可以将 table 的框更改为这样的东西
box( title = "Case Summary", status = "primary", solidHeader
= T,
dataTableOutput("sankey_table"),
width = 8)
总而言之，它看起来像这样
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "455" ,solidHeader = T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", solidHeader
= T,
dataTableOutput("sankey_table"),
width = 8)
)
)
server <- function(input, output)
{
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
})
patients3 <- reactive({
patients1 <- arrange(patients, patient)
patients2 <- patients1 %>% arrange(patient, time,handling_id)
patients2 %>%
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))
})
output$sankey_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 = 380, width = 605)
})
output$sankey_table <- renderDataTable({
req(event_data("plotly_click"))
Values <- dta() %>%
filter(trace_id == event_data("plotly_click")[["y"]]) %>%
select(value)
patient <- patients3()[["patient"]] %>% unique()
result = NULL
for(p in patient){
handlings <- patients3() %>%
filter(patient == p) %>%
`$`(handling) %>%
unique()
if(sum(!is.na(Values)) == length(handlings) &&
all(handlings %in% Values[[1]])){
result <- rbind(result,
patients3() %>%
filter(patient == p))
}
}
result
})
}
希望对您有所帮助！
** 加速 **
数据计算中的 foor 循环table 花费了相当长的时间，这里加快了计算速度
output$sankey_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 = patients3(), FUN = function(y){paste0(unique(y),collapse = "")})
currentPatient <- agg$patient[agg$handling == valueText]
patients3() %>%
filter(patient %in% currentPatient) %>%
DT::datatable(options = list(scrollX = TRUE))
})
当我 运行 下面的这个 R shiny 脚本时，我得到了两个图，其中有一个图表 activity 路径来自 bupaR 库的患者数据集，左侧称为 trace explorer 和一个数据table 以显示 activity/trace 详细信息。左边的图表是这样的，我们观察到各种路径，这些路径具有一个接一个发生的水平活动轨迹序列。单击特定轨迹中的任何框时，轨迹详细信息将显示在右侧 table。我的要求是，当单击特定跟踪中的任何框时，应该动态获取 "y" 或第四列值，并且我应该只得到一列显示跟踪中发生的所有活动。例如。在附图中，当单击最底部路径的任意位置时，我应该得到一列活动 "Registration"、"Triage and Assessment"。请帮助和感谢。
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(edeaR)
library(scales)
library(splitstackshape)
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", 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({
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"))
mp1 = ggplot(data = tr.df, 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 = 380, width = 605)
})
output$sankey_table <- renderDataTable({
tp2 = event_data("plotly_click")
})
}
shinyApp(ui, server)
第二部分:
library(lubridate)
patients1 <<- arrange(patients, patient)
patients2 <<- patients1 %>% arrange(patient, time)
patients3 <<- patients2 %>%
group_by(patient) %>%
mutate(diff_in_sec = as.POSIXct(time, format = "%m/%d/%Y %H:%M") -
lag(as.POSIXct(time, format = "%m/%d/%Y %H:%M"),
default=first(as.POSIXct(time, format = "%m/%d/%Y %H:%M"))))%>%
mutate(diff_in_hours = as.numeric(diff_in_sec/3600)) %>% mutate(diff_in_days
= as.numeric(diff_in_hours/24))
在 运行 上面的代码中，您从 bupaR 库中获取患者数据，因此 "patient" 列下给出的数据中有 500 个案例，每个案例中的活动是在 "handling" 列中，并按出现时间的升序排列。我的要求是我想比较从 DT table 中的先前解决方案获得的 "value" 列，并与 'unique(handling)' 进行比较，即 patients3 中每种情况下的独特活动 "patient"数据集。在 "value" 列找到完全匹配的情况下，我想显示 DT table 中的整个对应行。例如。当单击最底部路径上的任意位置时，如果找到匹配项，则具有活动 "Registration"、"Triage and Assessment"、"value" 列的跟踪应与从 1 到 500 的每种情况下的唯一活动进行比较即，具有活动 "Registration"、"Triage and Assessment" 的案例，应显示具有相应行的案例，所有跟踪都类似。谢谢，请帮忙。
第三部分:
我想通过给它一个 suitable pageLength 来修复第二个框中的数据 table，这样它就不会从下方和右侧超过。请在下面找到合并代码，我知道一些可能的语法可以集成到情节中以实现这一点，如下所示：
可能的语法:
datatable(Data, options = list(
searching = TRUE,
pageLength = 9
))
**and**
box( title = "Case Details", status = "primary", height = "575",solidHeader
= T,width = "6",
div(DT::dataTableOutput("Data_table"), style = "font-size: 84%; width:
65%"))
**Here is the consolidated final code to be updated**
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "455" ,solidHeader = T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", solidHeader
= T,
dataTableOutput("sankey_table"),
width = 6)
)
)
server <- function(input, output)
{
#Plot for Trace Explorer
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 <- patients1 %>% 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))
})
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() %>%
filter(patient %in% currentPatient)
})
}
shinyApp(ui, server)
请帮忙。
我添加了包 dplyr
library(dplyr)
因为你已经完成了从 plotly 中捕获事件的所有艰苦工作，所以我在将 tr.df 的计算移动到单独的反应中之后更改了服务器，以便我可以再次将它用于 table以及 y 值之后的过滤器 plotly 事件。
server <- function(input, output)
{
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
})
output$sankey_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 = 380, width = 605)
})
output$sankey_table <- renderDataTable({
req(event_data("plotly_click"))
dta() %>%
filter(trace_id == event_data("plotly_click")[["y"]]) %>%
select(value)
})
}
** 第二部分 ** 对于 server.r 我是否添加了以下反应函数
patients3 <- reactive({
patients1 <- arrange(patients, patient)
patients2 <- patients1 %>% arrange(patient, time,handling_id)
patients2 %>%
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))
})
并相应地更改了 renderDataTable
output$sankey_table <- renderDataTable({
req(event_data("plotly_click"))
Values <- dta() %>%
filter(trace_id == event_data("plotly_click")[["y"]]) %>%
select(value)
patient <- patients3()[["patient"]] %>% unique()
result = NULL
for(p in patient){
handlings <- patients3() %>%
filter(patient == p) %>%
`$`(handling) %>%
unique()
if(sum(!is.na(Values)) == length(handlings) &&
all(handlings %in% Values[[1]])){
result <- rbind(result,
patients3() %>%
filter(patient == p))
}
}
result
})
因为你的新 table 大得多，我也可以将 table 的框更改为这样的东西
box( title = "Case Summary", status = "primary", solidHeader
= T,
dataTableOutput("sankey_table"),
width = 8)
总而言之，它看起来像这样
ui <- dashboardPage(
dashboardHeader(title = "My Chart"),
dashboardSidebar(
width = 0
),
dashboardBody(
box(title = "Data Path", status = "primary",height = "455" ,solidHeader = T,
plotlyOutput("sankey_plot")),
box( title = "Case Summary", status = "primary", solidHeader
= T,
dataTableOutput("sankey_table"),
width = 8)
)
)
server <- function(input, output)
{
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
})
patients3 <- reactive({
patients1 <- arrange(patients, patient)
patients2 <- patients1 %>% arrange(patient, time,handling_id)
patients2 %>%
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))
})
output$sankey_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 = 380, width = 605)
})
output$sankey_table <- renderDataTable({
req(event_data("plotly_click"))
Values <- dta() %>%
filter(trace_id == event_data("plotly_click")[["y"]]) %>%
select(value)
patient <- patients3()[["patient"]] %>% unique()
result = NULL
for(p in patient){
handlings <- patients3() %>%
filter(patient == p) %>%
`$`(handling) %>%
unique()
if(sum(!is.na(Values)) == length(handlings) &&
all(handlings %in% Values[[1]])){
result <- rbind(result,
patients3() %>%
filter(patient == p))
}
}
result
})
}
希望对您有所帮助！
** 加速 **
数据计算中的 foor 循环table 花费了相当长的时间，这里加快了计算速度
output$sankey_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 = patients3(), FUN = function(y){paste0(unique(y),collapse = "")})
currentPatient <- agg$patient[agg$handling == valueText]
patients3() %>%
filter(patient %in% currentPatient) %>%
DT::datatable(options = list(scrollX = TRUE))
})