firmo23
Reputation: 8404
Select and store values of plotly click event and then use them after pressing actionButton()
In the shiny app below I use plotly_click_event on one of the 3 linecharts to pick a point and then subset the other 2 linecharts based on that point. Then I reset using the RESET button. What I would like to improve is to be able to pick more than one points and then decide when to subset after pressing another actionButton() called SUBSET.
library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)
library(ggplot2)
library(bupaR)
pr59<-structure(list(case_id = c("WC4120721", "WC4120667", "WC4120689",
"WC4121068", "WC4120667", "WC4120666", "WC4120667", "WC4121068",
"WC4120667", "WC4121068"), lifecycle = c(110, 110, 110, 110,
120, 110, 130, 120, 10, 130), action = c("WC4120721-CN354877",
"WC4120667-CN354878", "WC4120689-CN356752", "WC4121068-CN301950",
"WC4120667-CSW310", "WC4120666-CN354878", "WC4120667-CSW308",
"WC4121068-CSW303", "WC4120667-CSW309", "WC4121068-CSW308"),
activity = c("Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)",
"Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)",
"BBH-1&2", "Forged Wire, Medium (Sport)", "TCE Cleaning",
"SOLO Oil", "Tempering", "TCE Cleaning"), resource = c("3419",
"3216", "3409", "3201", "C3-100", "3216", "C3-080", "C3-030",
"C3-090", "C3-080"), timestamp = structure(c(1606964400,
1607115480, 1607435760, 1607568120, 1607630220, 1607670780,
1607685420, 1607710800, 1607729520, 1607744100), tzone = "", class = c("POSIXct",
"POSIXt")), .order = 1:10), row.names = c(NA, -10L), class = c("eventlog",
"log", "tbl_df", "tbl", "data.frame"), spec = structure(list(
cols = list(case_id = structure(list(), class = c("collector_character",
"collector")), lifecycle = structure(list(), class = c("collector_double",
"collector")), action = structure(list(), class = c("collector_character",
"collector")), activity = structure(list(), class = c("collector_character",
"collector")), resource = structure(list(), class = c("collector_character",
"collector")), timestamp = structure(list(), class = c("collector_character",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), delim = ";"), class = "col_spec"), case_id = "case_id", activity_id = "activity", activity_instance_id = "action", lifecycle_id = "lifecycle", resource_id = "resource", timestamp = "timestamp")
ui <- tags$body(
dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(
actionButton("sub","SUBSET"),
actionButton("res","RESET")
),
body = dashboardBody(
plotlyOutput("plot1"),
plotlyOutput("plot2"),
plotlyOutput("plot3")
)
)
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
if (!is.null(myPlotEventData2())) {
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData2()$customdata))
} else if (!is.null(myPlotEventData3())){
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData3()$customdata))
} else {
displaydat <- pr59
}
dat <- displaydat |> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x = date, y = n_cases, customdata = date)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "Cases")
ggplotly(p, source = "myPlotSource1")
})
output$plot2 <- renderPlotly({
if (!is.null(myPlotEventData1())) {
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData1()$customdata))
} else if (!is.null(myPlotEventData3())){
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData3()$customdata))
} else {
displaydat <- pr59
}
dat <- displaydat|> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x = date, y = n_cases, customdata = date)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "events")
ggplotly(p, source = "myPlotSource2")
})
output$plot3 <- renderPlotly({
if (!is.null(myPlotEventData1())) {
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData1()$customdata))
} else if (!is.null(myPlotEventData2())){
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData2()$customdata))
} else {
displaydat <- pr59
}
dat <- displaydat |> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x =date, y = n_cases, customdata = date)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "objects")
ggplotly(p, source = "myPlotSource3")
})
myPlotEventData1 <- reactiveVal()
myPlotEventData2 <- reactiveVal()
myPlotEventData3 <- reactiveVal()
observe({
myPlotEventData1(event_data(event = "plotly_click", source = "myPlotSource1"))
})
observe({
myPlotEventData2(event_data(event = "plotly_click", source = "myPlotSource2"))
})
observe({
myPlotEventData3(event_data(event = "plotly_click", source = "myPlotSource3"))
})
observeEvent(input$res, {
myPlotEventData1(NULL)
myPlotEventData2(NULL)
myPlotEventData3(NULL)
})
}
shinyApp(ui, server)
Upvotes: 1
Views: 1069
Answers (1)
thothal
Reputation: 20329
Your example is by far not minimal, so I created a POC of how this can be achieved.
The idea is as follows:
- On each click you add the data to a
reactiveValueslist. - On a click to
subsetyou use this list to select the relevant points. - A click to
resetresets thisreactiveListand all data is returned.
As it was not clear how clicks on different graphs should be handled, I decided on the follwoing logic: a click to a point in any graph panel adds this point to the filter criterion. Upon subset all data are subset w.r.t. to this filter criterion.
library(shiny)
library(dplyr)
library(plotly)
## sample data
sample_dat <- expand.grid(
when = seq.Date(as.Date("2022-1-1"), as.Date("2022-1-31"), by = "days"),
grp = factor(paste("Group", 1:3))
) %>%
as_tibble() %>%
mutate(y = scales::rescale((9496.5 - as.numeric(when)), c(-2, 2)) ^
as.numeric(grp))
make_plotly <- function(dat, wh = levels(dat$grp)) {
wh <- match.arg(wh)
dat %>%
filter(grp == wh) %>%
plot_ly(source = sub(" ", "_", wh)) %>%
add_trace(x = ~ when, y = ~ y, type = "scatter", mode = "lines+markers")
}
grph_ht <- "300px"
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("reset", "RESET"),
actionButton("subset", "SUBSET"),
verbatimTextOutput("dbg")
),
mainPanel(
plotlyOutput("plot1", height = grph_ht),
plotlyOutput("plot2", height = grph_ht),
plotlyOutput("plot3", height = grph_ht)
)
)
)
server <- function(input, output, session) {
get_clicked_points <- reactive({
res <- Reduce(rbind, reactiveValuesToList(clicked_points))
if (!is.null(res)) {
res %>%
distinct()
} else {
res
}
})
get_rel_data <- reactive({
clicked_pts <- get_clicked_points()
dat <- sample_dat
if (!is.null(clicked_pts)) {
dat <- dat %>%
inner_join(clicked_pts %>%
transmute(when = as.Date(x)),
"when")
}
dat
})
## store clicked points in reactive
clicked_points <- reactiveValues(Group_1 = NULL,
Group_2 = NULL,
Group_3 = NULL)
trigger_regraph <- reactive({
list(input$reset, input$subset)
})
## In this loop we create the render functions and the click observers
for (idx in 1:3) {
local({
idx <- idx
## Render plotly
output[[paste0("plot", idx)]] <<- renderPlotly({
trigger_regraph()
make_plotly(isolate(get_rel_data()), paste("Group", idx))
})
## Click handler
nm <- paste0("Group_", idx)
observe({
trg <- event_data("plotly_click", nm, priority = "event") %>%
req() %>%
mutate(src = nm)
op <- isolate(clicked_points[[nm]])
clicked_points[[nm]] <<- rbind(op, trg) %>%
distinct()
})
})
}
## clear selected points
observeEvent(input$reset, {
nms <- names(clicked_points)
for (nm in nms) {
local({
nm <- nm
clicked_points[[nm]] <<- NULL
})
}
})
output$dbg <- renderPrint(get_clicked_points())
}
shinyApp(ui, server)
Upvotes: 2
Related Questions
- R Shiny error: How to work with the click events incase of two plotly plots?
- Apply plotly_click to more than 2 plots in a shiny app
- plotly click events from anywhere on the plot
- How to get data point label using click in plotly
- R shiny: How to copy data derived from plotly_selection events into a data frame/table and update each time by pressing an actionButton?
- ggplotly get data values of clicks
- How to display many points from plotly_click in R Shiny?
- Extract all click event plots from Shiny, Plotly - R
- Removing plotly click event data
- R plotly + shiny reactive coupled event - Refresh chart with argument from click on same chart