代码之家  ›  专栏  ›  技术社区  ›  firmo23

选择并存储绘图点击事件的值,然后在按下actionButton()后使用它们

plotly shiny r
  •  1
  • firmo23  · 技术社区  · 3 年前

    在 shiny 我使用下面的应用程序 plotly_click_event 在3个折线图中的一个上选择一个点,然后根据该点对其他2个折线图进行子集设置。然后我使用 RESET 按钮我想改进的是能够选择多个点,然后在按下另一个点后决定何时子集 actionButton() 调用 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)
    0 回复  |  直到 3 年前
        1
  •  1
  •   thothal    3 年前

    到目前为止,你的例子还不算少,所以我创建了一个如何实现这一点的POC。

    其想法如下:

    1. 每次单击时,您都会将数据添加到 reactiveValues 列表
    2. 点击 subset 您可以使用此列表来选择相关点。
    3. 点击 reset 重置此 reactiveList 并且返回所有数据。

    由于不清楚应该如何处理不同图形上的点击,我决定采用以下逻辑:点击任何图形面板中的某个点都会将该点添加到过滤标准中。在上面 子集 所有数据都是这个过滤准则的子集w.r.t。 

    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)
    推荐文章
    关于   移动版
    代码之家 - 一站式码农服务社区
    沪ICP备11025650号