请在下面运行这个脚本，下面的 R 脚本给出了一个带有两个框的闪亮仪表板.我想减小两个框之间的宽度并在右侧图表中显示数据.数据应该基于我们在 ggplotly 函数中看到的点击事件.我猜也可以用 plotly 来完成这项工作.我希望代码同时快速高效.

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)

推荐答案

我创建了一个简单的示例，您可以如何将 plotly 中的耦合事件与一些接近您需求的示例数据一起使用:

I have created an easy example how You can use coupled events from plotly with some sample data that is close to Your needs:

library(shiny)
library(plotly)
library(DT)
set.seed(100)
data <- data.frame(A=sample(c('a1','a2','a3'),10,replace=T),
                   B=1:10,
                   C=11:20,
                   D=21:30)
shinyApp(
  ui = fluidPage(
plotlyOutput("trace_plot"),
  DT::dataTableOutput('tbl')),
  server = function(input, output) {

    output$trace_plot <- renderPlotly({
      plot_ly(data, x=~A,y=~B,z=~C, source = "subset") %>% add_histogram2d()})

    output$tbl <- renderDataTable({
      event.data <- event_data("plotly_click", source = "subset")

      if(is.null(event.data) == T) return(NULL)
      print(event.data[ ,c(3:4)])
    })

  }
)

正如您在第一个图上看到的那样，我们在表格中获得了下面的数据子集(x 和 y 值)，您还可以使用它与主要数据合并以显示时间戳等. .

As You can see by pressing on the first plot we get the subset of data below in the table (x and y values), further you can use it to merge with the primary data to display timestamps etc. .