动态更新变量，而无需重新绘制整个图（代理）

Question

library(shiny)
library(echarts4r)
library(dplyr)


set.seed(123)
df <- data.frame(
  Date = seq(as.Date("2023-01-01"), by = "week", length.out = 104),
  Cas = sample(50:500, 52, replace = TRUE),
  Cas_A = sample(20:100, 52, replace = TRUE),
  Cas_B = sample(5:50, 52, replace = TRUE),
  Cas_C = sample(1:20, 52, replace = TRUE),
  Threshold = rep(200, 52) # Valeur initiale du seuil
)

ui <- fluidPage(
  titlePanel("TEST"),
  
  sidebarLayout(
    sidebarPanel(
      sliderInput("Percentile", "Threshold Value:", min = 1, max = 99, value = 50, step = 1)
    ),
    
    mainPanel(
      echarts4rOutput("Graph")
    )
  )
)
server <- function(input, output, session) {
 
   reactive_threshold <- reactive({
  perc <- input$Percentile

  perc_threshold <- quantile(df$Cas, probs = perc / 100, na.rm = TRUE)
  
  cdc_nat_threshold <- df %>%
    mutate(Threshold = perc_threshold)  
  return(cdc_nat_threshold)
  
})
  

  output$Graph <- renderEcharts4r({
    reactive_threshold() |>
      e_charts(Date) |>
      e_line(Cas, name = "Cas", lineStyle = list(color = "#ff8000", width = 2, opacity = 0.4)) |>
      e_bar(Cas_A, name = "Cas_A", stack = "group", itemStyle = list(color = "#C1D8C3")) |>
      e_bar(Cas_B, name = "Cas_B", stack = "group", itemStyle = list(color = "#6A9C89")) |>
      e_bar(Cas_C, name = "Cas_C", stack = "group", itemStyle = list(color = "#d63e0b")) |>
      e_line(Threshold, name = "Threshold", lineStyle = list(color = "#f02b2b", width = 1, type = "dashed", opacity = 0.8)) |>
      e_legend(show = TRUE) |>
      e_axis_labels(y = "Weekly") |>
      e_tooltip(trigger = "axis") |>
      e_datazoom(x_index = 0, toolbox = FALSE, start = 20, end = 50) |>
      e_group("shared_zoom") |>
      e_connect_group("shared_zoom")
  })
  

  observeEvent(input$Percentile, {
    echarts4rProxy("Graph") |>

      e_line(
 Threshold) |>
      e_execute()
  })
}

shinyApp(ui, server)

谢谢你

我不确定，但是如果您将图形和更新功能分开，我认为它可能会解决。喜欢：

server <- function(input, output, session) {
  # Reactive for threshold data
  reactive_threshold <- reactive({
    perc <- input$Percentile
    perc_threshold <- quantile(df$Cas, probs = perc / 100, na.rm = TRUE)
    df %>% mutate(Threshold = perc_threshold)
  })
  
  # Function to draw initial chart
  draw_chart <- function(data) {
    data %>%
      e_charts(Date) %>%
      e_line(Cas, name = "Cas", lineStyle = list(color = "#ff8000", width = 2, opacity = 0.4)) %>%
      e_bar(Cas_A, name = "Cas_A", stack = "group", itemStyle = list(color = "#C1D8C3")) %>%
      e_bar(Cas_B, name = "Cas_B", stack = "group", itemStyle = list(color = "#6A9C89")) %>%
      e_bar(Cas_C, name = "Cas_C", stack = "group", itemStyle = list(color = "#d63e0b")) %>%
      e_line(Threshold, name = "Threshold", lineStyle = list(color = "#f02b2b", width = 1, type = "dashed", opacity = 0.8)) %>%
      e_legend(show = TRUE) %>%
      e_axis_labels(y = "Weekly") %>%
      e_tooltip(trigger = "axis") %>%
      e_datazoom(x_index = 0, toolbox = FALSE, start = 20, end = 50) %>%
      e_group("shared_zoom") %>%
      e_connect_group("shared_zoom")
  }
  
  # Function to update threshold only
  update_threshold <- function(percentile) {
    perc_threshold <- quantile(df$Cas, probs = percentile / 100, na.rm = TRUE)
    echarts4rProxy("Graph") %>%
      e_line(Threshold = rep(perc_threshold, nrow(df)), name = "Threshold")) %>%
      e_execute()
  }
  
  # Initial chart render
  output$Graph <- renderEcharts4r({
    draw_chart(reactive_threshold())
  })
  
  # Update threshold when slider changes
  observeEvent(input$Percentile, {
    update_threshold(input$Percentile)
  })
}