Please run this script below, the following R script gives a shiny dashboard with two boxes. I want to reduce the width between two boxes and display data in the right chart. The data should be based on the on click event that we see in the ggplotly function. Also plotly can be used to do the job, I guess. I want the code to fast and efficient at the same time.
## app.R ##
library(shiny)
library(shinydashboard)
library(bupaR)
library(eventdataR)
library(lubridate)
library(dplyr)
library(XML)
library(edeaR)
library(xml2)
library(data.table)
library(ggplot2)
library(ggthemes)
library(glue)
library(tibble)
library(miniUI)
library(tidyr)
library(shinyTime)
library(magrittr)
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
})
patients10 <- reactive({
patients11 <- arrange(patients_eventlog, a1)
patients12 <- patients11 %>% arrange(a1, a2,a3)
patients12 %>%
group_by(a1) %>%
mutate(time = as.POSIXct( a2, format = "%m/%d/%Y %H:%M"),diff_in_sec = a2 -
lag( a2)) %>%
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("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 = 1226, width = 1205)
})
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(a3~a1, data = patients10(), FUN = function(y){paste0(unique(y),collapse = "")})
currentPatient <- agg$a1[agg$a3 == valueText]
patients10_final <- patients10() %>%
filter(a1 %in% currentPatient)
datatable(patients10_final, options = list(paging = FALSE, searching = FALSE))
})
}
shinyApp(ui, server)
See Question&Answers more detail:
os