Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
537 views
in Technique[技术] by (71.8m points)

ggplot2 - Displaying data in the chart based on plotly_click in R shiny

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

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


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...