根据R shiny中的plotly_click显示图表中的数据 [英] Displaying data in the chart based on plotly_click in R shiny

问题描述

请在下面运行这个脚本，下面的R脚本给出了一个有两个框的闪亮的仪表板。我想减少两个框之间的宽度并在右侧图表中显示数据。数据应该基于我们在ggplotly函数中看到的点击事件。我猜也可以用来做这项工作。

  ## app.R ## 
 library（闪亮）
库（shinydashboard）
库（bupaR）
库（eventdataR）
库（lubridate）
库（dplyr）
库（XML） 
库（edeaR）
库（xml2）
库（data.table）
库（ggplot2）
库（ggthemes）
库（glue） 
 library（tibble）
 library（miniUI）
 library（tidyr）
 library（shinyTime）
 library（magrittr）
 library（plotly）
图书馆（DT）
图书馆（splitstackshape）
图书馆（比例）
 
患者$ patient = as.character（患者$患者）
 a1 =患者$患者
 a2 =患者$处理
 a3 =患者$时间
 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 
}）
患者10 < - 反应性（{
 patients11 < -  arrange（ （a1，a2，a3）
患者12％>％
 group_by（a1）％>％
患者_活动日志a1）
患者12 < - 患者11％> mutate（time = as.POSIXct（a2，format =％m /％d /％Y％H：％M），diff_in_sec = a2  -  
 lag（a2））％>％
 （diff_in_sec = 0，diff_in_sec））％>％
 mutate（diff_in_hours = = as.numeric（diff_in_hours / 24））
}）
 ui<  -  dashboardPage（
 dashboardHeader（title =跟踪图表），
 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））
）
）
服务器<  - 函数（输入，输出）
 {
输出$ 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，br> Actuals： af_percent）））+ 
 geom_tile（color =white）+ 
 geom_text（color =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）
}）
输出$ trace_table<  -  renderDataTable（{ 
 req（event_data（plotly_click））
值< -dta（）％>％
 filter（trace_id == event_data（plotly_click）[[y]] ）％>％
 select（value）
 
 valueText<  -  paste0（Values [[1]]％>％na.omit（），collapse =）$ b （a3〜a1，data = patients10（），FUN = function（y）{paste0（unique（y），collapse =）}）
 
 currentPatient< -  agg $ a1 [agg $ a3 == valueText] 
 
 patients10_final < -  patients10（）％>％
过滤器（％currentPatient中的a1％）
数据表（patient10_final ，options = list（paging = FALSE，searching = FALSE））
}）
} 
 shinyApp（ui，server）
  

解决方案

我已经创建了一个简单的示例，您可以如何使用中的耦合事件plotly 一些样本数据接近您的需求：

 库（闪亮）
库（绘图）$ b （a）= sample（c（'a1'，'a2'，'a3'），10，替换= 
 B = 1：10，
 C = 11：20，
 D = 21：30）
 shinyApp（
 ui = fluidPage（
 plotlyOutput（trace_plot），
 DT :: dataTableOutput（'tbl'）），
 server = function（输入，输出）{
 
输出$ trace_plot< -  renderPlotly（{
 plot_ly（data，x =〜A，y =〜B，z =〜C，source =subset）％>％add_histogram2d（）}）
 
输出$ 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值），此外，您还可以使用它来合并主要数据以显示时间戳等。

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)

解决方案

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)])
    })

  }
)

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. .

这篇关于根据R shiny中的plotly_click显示图表中的数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！