plotly_clickに基づくRの画像を表示するshiny

Question

このスクリプトを実行してください。次のスクリプトは、2つのボックスが付いた光沢のあるダッシュボードを示しています。私は、2つのボックスの間の幅を減らし、右側のグラフにデータを表示したいと考えています。データは、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の値）、を取得して、それを使用してプライマリデータとマージして、タイムスタンプなどを表示することができます。。