plotly_click in R을 기반으로 차트에 데이터 표시 shiny

Question

아래 스크립트를 실행하면 다음 R 스크립트가 두 개의 상자가있는 반짝이는 대시 보드를 제공합니다. 두 상자 사이의 너비를 줄이고 오른쪽 차트에 데이터를 표시하고 싶습니다. 데이터는 ggplotly 함수에서 볼 수있는 on click 이벤트를 기반으로해야합니다. 또한 음모를 꾸미는 일도 할 수 있습니다. 나는 코드를 빠르고 효율적으로 동시에 원한다.

## 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) 

Answer 1

나는 당신이 당신의 필요에 가까운 일부 샘플 데이터로 plotly에서 결합 된 이벤트를 사용할 수있는 방법을 쉬운 예를 만들었습니다 첫 번째 플롯에 눌러 볼 수 있듯이

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 값) 하위 집합을 얻으려면 을 사용하여 기본 데이터와 병합하여 타임 스탬프 등을 표시 할 수 있습니다..