When I run this R shiny script below, I get two plots with a chart for activity path derived from the patients dataset of the bupaR library called trace explorer on the left and a data table to display the activity/trace details. The chart on the left is such,that we observe various paths with sequence of horizontal traces of activities which occur one after the other. When clicked on any box in a particular trace, the trace details are presented on the right table. My requirement is that, when clicked on any box in a particular trace, the "y" or fourth column value should be taken dynamically, and I should get just one column displaying all the activities that occur in the trace. E.g. in the attached image, when clicked anywhere on the bottom most path, I should get one column with activities "Registration", "Triage and Assessment". Please help and thanks.
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)
Second Part:
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))
Upon running this code above, you get the patients data from the bupaR library such that there are 500 cases in the data given under the "patient" column, the activities in every case are in the "handling" column and are arranged in ascending order of the time of their occurrence. My requirement is that I want to compare the "value" column obtained from the previous solution in the DT table and compare with 'unique(handling)' i.e. unique activities in every case "patient" in the patients3 dataset. The cases where the "value" column finds an exact match, I want to display the entire corresponding rows in the DT table. E.g. when clicked anywhere on the bottom most path, the trace with activities "Registration", "Triage and Assessment", the "value" column should be compared with unique of activities in every case from 1 to 500, if match found i.e. cases with activities "Registration", "Triage and Assessment", those cases with corresponding rows should be displayed, similarly for all traces. Thank you and please help.
Third Part:
I want to fix the data table in the second box by giving it a suitable pageLength, such that it should not overshoot from below and from the right. Please find the consolidated code below, some possible syntax I know to integrate in the plot to achieve this are as follows:
Possible syntax:
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)
Please help.
See Question&Answers more detail:
os