在图表中选择活动轨迹并在R闪亮的数据表中显示 [英] Selection of activity trace in a chart and display in a data table in R shiny
本文介绍了在图表中选择活动轨迹并在R闪亮的数据表中显示的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
如果您在下面运行R闪亮脚本，则会在R闪亮仪表板中显示两个框。左侧的图表显示事件日志数据patients_eventlog中发生的所有跟踪或一组活动的图表。 患者2是脚本中的一个数据，用于解释出现在列a1中的每个病例，相应的活动在列a2中。我的要求是，当我点击左侧图表中某个特定轨迹上的任意位置时，我应该得到相关的列a1，a2和a3，其中的数据只有且只有那些情况下的活动痕迹正在发生。例如。比方说，左边图表中的
跟踪具有激活注册和分类和评估的功能，通过点击跟踪，我只想看到只有这两种活动的案例。这只需要在输出$ 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 say a 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 < h2>
Addon Script for reference
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 c $ c> 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))
})
编辑：
这里是完整的代码：
Here is the full code:
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闪亮的数据表中显示的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
