具有反应性闪亮 R 的 reactiveValues

Question

我试图通过单击从绘图图中消除一些点，我的代码运行良好，但是在处理之前应用过滤器并返回输入数据帧时，反应对象抛出以下错误:

Warning: Error in : Operation not allowed without an active reactive context.
* You tried to do something that can only be done from inside a reactive consumer.

我的理解是 reactiveValues 中不能有 reactive 对象，但我需要它是反应性的，因为它取决于用户制作的一些过滤器。

下面我展示了代码，我将不胜感激任何指导。谢谢！！

library(shiny)
library(plotly)
library(dplyr)

n <- 20
df <- data.frame(
  date = seq.Date(as.Date("01/01/2000", format = "%d/%m/%Y"), length.out = 20, by = "quarter"),
  cat  = sample(paste0("cat",1:3), n, replace = TRUE),
  filter1 = sample(paste0("f",1:2),n, replace = TRUE),
  var2  = runif(n,-10,10),
  var3  = c(1:n)^2,
  INDEX = 1:20

)


limits <- data.frame(limits = paste0("limit",1:3),
                     limit.value = c(-1,2,-3))




ui <- fluidPage(

  selectInput("var","select var", names(df)[4:5]),
  selectInput("cat","select cat", unique(df$cat),unique(df$cat)[1] ,multiple = TRUE),
  checkboxGroupInput("f","filter", c("f1","f2"), "f1"),
  verbatimTextOutput("print"),
  mainPanel(plotlyOutput("plot")),
  verbatimTextOutput("selection"),
  # eliminar puntos seleccionados 
  actionButton("delete","Delete", style = "display:inline-block;"), 
  # restaurar seleccion (antes de eliminar)
  actionButton("reset","Reset", style = "display:inline-block;"),
  # Restaurar puntos elminados
  actionButton("reset_all","Reset all", style = "display:inline-block;")

)

server <- function(input, output, session) {

  
  df <- reactive({
    
    
    df %>% filter(filter1 %in% input$f)
    
    
  })
  
  df_backup <- df()
  
  myData <- reactiveValues(df = df())


  output$plot <- renderPlotly({


    p0 <- list()
    g0 <- c()

    for(i in 1:length(input$cat)){



      g <- myData$df  %>%
        filter(cat %in% input$cat[i]) %>%
        plot_ly(x = ~date,
                y = ~get(input$var),
                type = "scatter",
                mode = 'lines+markers',
                name = ~cat,
                source = "A",
                text = ~cat,
                key = ~INDEX)


      g0 <- rbind(g0, paste0("g",i))
      p0[[paste("g",i)]] <- g


    }

    t2 <- tibble(x = g0,
                 p = p0 )


    t2 %>%
      subplot(nrows = 1,
              shareX = FALSE,
              shareY = TRUE,
              margin = 0.0001)

  })
  
  
  # Acumular clicks 

  p1 <- reactive({

    event_data("plotly_click", source = "A")

  })

  p2 <- reactiveValues(points = c())

  observeEvent(p1(),{

    p2$points <- c(p2$points,as.list(p1())$key[[1]])

  })

  observeEvent(input$reset,{

    p2$points <- c()

  })

  output$selection <- renderPrint({
    if(length(p2$points)<1){"Select data points to delete"}else{(p2$points)}
    #as.list(p1())$key[[1]]
    #matrix(p2$points, ncol = 2, byrow = TRUE)
    })
  
  # filtro de los puntos seleccionados
  
  observeEvent(input$delete,{
    # browser()
    myData$df <- myData$df %>%
      mutate(delete = ifelse(INDEX %in% c(p2$points),TRUE,FALSE)) %>%
      filter(!delete)

    # And clear input?
    p2$points <- c()
  })



  observeEvent(input$reset_all,{
    # browser()
    myData$df <- df_backup
  })




}

shinyApp(ui, server)

Answer 1

您可以使用 isolate 访问 reactive:

library(shiny)
library(plotly)
library(dplyr)

n <- 20
DF <- data.frame(
  date = seq.Date(
    as.Date("01/01/2000", format = "%d/%m/%Y"),
    length.out = 20,
    by = "quarter"
  ),
  cat  = sample(paste0("cat", 1:3), n, replace = TRUE),
  filter1 = sample(paste0("f", 1:2), n, replace = TRUE),
  var2  = runif(n, -10, 10),
  var3  = c(1:n) ^ 2,
  INDEX = 1:20
)

limits <- data.frame(limits = paste0("limit", 1:3),
                     limit.value = c(-1, 2, -3))

ui <- fluidPage(
  selectInput("var", "select var", names(df)[4:5]),
  selectInput("cat", "select cat", unique(df$cat), unique(df$cat)[1] , multiple = TRUE),
  checkboxGroupInput("f", "filter", c("f1", "f2"), "f1"),
  verbatimTextOutput("print"),
  mainPanel(plotlyOutput("plot")),
  verbatimTextOutput("selection"),
  # eliminar puntos seleccionados
  actionButton("delete", "Delete", style = "display:inline-block;"),
  # restaurar seleccion (antes de eliminar)
  actionButton("reset", "Reset", style = "display:inline-block;"),
  # Restaurar puntos elminados
  actionButton("reset_all", "Reset all", style = "display:inline-block;")
)

server <- function(input, output, session) {
  
  myData <- reactiveValues(df = NULL)
  
  observeEvent(input$f, {
    myData$df <- DF %>% filter(filter1 %in% input$f)
  })
  
  df_backup <- DF %>% filter(filter1 %in% isolate(input$f))
  
  output$plot <- renderPlotly({
    req(myData$df)
    
    p0 <- list()
    g0 <- c()
    
    for (i in 1:length(input$cat)) {
      g <- myData$df  %>%
        filter(cat %in% input$cat[i]) %>%
        plot_ly(
          x = ~ date,
          y = ~ get(input$var),
          type = "scatter",
          mode = 'lines+markers',
          name = ~ cat,
          source = "A",
          text = ~ cat,
          key = ~ INDEX
        )
      
      g0 <- rbind(g0, paste0("g", i))
      p0[[paste("g", i)]] <- g
    }
    
    t2 <- tibble(x = g0,
                 p = p0)
    
    t2 %>%
      subplot(
        nrows = 1,
        shareX = FALSE,
        shareY = TRUE,
        margin = 0.0001
      )
  })
  
  # Acumular clicks
  p1 <- reactive({
    event_data("plotly_click", source = "A")
  })
  
  p2 <- reactiveValues(points = c())
  
  observeEvent(p1(), {
    p2$points <- c(p2$points, as.list(p1())$key[[1]])
  })
  
  observeEvent(input$reset, {
    p2$points <- c()
  })
  
  output$selection <- renderPrint({
    if (length(p2$points) < 1) {
      "Select data points to delete"
    } else{
      (p2$points)
    }
    # as.list(p1())$key[[1]]
    # matrix(p2$points, ncol = 2, byrow = TRUE)
  })
  
  # filtro de los puntos seleccionados
  observeEvent(input$delete, {
    # browser()
    myData$df <- myData$df %>%
      mutate(delete = ifelse(INDEX %in% c(p2$points), TRUE, FALSE)) %>%
      filter(!delete)
    
    # And clear input?
    p2$points <- c()
  })
  
  observeEvent(input$reset_all, {
    # browser()
    myData$df <- df_backup
  })
}

shinyApp(ui, server)

具有反应性闪亮 R 的 reactiveValues

reactiveValues with a reactive shiny R

r

shiny

shinyapps

r-plotly