有没有办法在 reactive/observe 中使用嵌套的 reactivePoll 来渲染依赖于 DB 和 UI 两者的变化的图

Question

根据我当前的要求，我需要绘制一些我从 mongodb 获取的数据的图表，并且我正在使用 reactivePoll 观察数据库中的变化。除此之外，我现在想在 UI 上添加一个日期过滤器，根据该日期过滤器，情节会发生变化，因为我需要输入日期的 reactiveValue 但我无法实现它。在调试时，我发现嵌套的反应式可能无法在内部使用 reactivePoll，因为 reactivePoll 不会离开进程，因此输入值的变化不会影响 reactivePoll 正在监视的数据。这是我试过的代码的必需部分：

ui.R

shinyUI(fluidPage(

    # Application title
    titlePanel("ML API DASHBOARD"),

    fluidRow(
      column(6, h4("API Status"),
             textOutput("checkAPIStatus")),

      column(6, h4("Daily Batch Count By Status"),
             dateRangeInput(inputId="daterange", label="Pick a Date Range:", start = Sys.Date()-30, end = Sys.Date()),
             plotOutput("BatchPlotByStatus"))
    )
)

server.R

## COMPONENT 2: BatchPlotByStatus
  checkNewBatchPlot <- function(){
    coll = mongo(collection = mongocollection, url = mongourl)
    # coll$count()
    req(input$daterange)
    print(input$daterange)
    strWatch <- paste(as.character(coll$find('{}',fields = '{"_id":0,"End":1}',sort = '{"End":-1}',limit = 1)), 
                      as.character(input$daterange[1]), as.character(input$daterange[2]))
# here originially db change was supposed to get rerurned, 
# but I am returning values of daterange input along with change in db just to check change in date here itself, 
# but it was a bad idea and didn't work
    print(strWatch)
    strWatch
  }

  getFilteredData <- function(df){
    print(colnames(df))
    return(subset(df,
                  as.Date.character(Date, format = "%m/%d/%Y") > as.character(format(input$daterange[1]), "%m/%d/%Y"), ))
# currently only using startdate to check change in value
  }

  getNewBatchCompleted <- function(){
    coll = mongo(collection = mongocollection, url = mongourl)
    df = processBatchStatusData(coll$find())
    df = df[,c('BatchNo', 'StartDate_IST', 'EndDate_IST', 'Status')]
    df$StartDate_IST = format(as.Date(df$StartDate_IST), '%m/%d/%Y')
    df2 = df %>%
      group_by(Status, StartDate_IST) %>%
      summarise(Count = n())

    names(df2) = c('Status', 'Date', 'Count')
    print(nrow(df2))

    df2 <- getFilteredData(df2)
    print(nrow(df2))
    df2
  }

  plotData <- reactivePoll(intervalMillis = 5000, session = session,
                     checkFunc = checkNewBatchPlot, valueFunc = getNewBatchCompleted)

  batchPlot <- reactiveValues(
    data = reactivePoll(intervalMillis = 5000, session = session,
                        checkFunc = checkNewBatchPlot, valueFunc = getNewBatchCompleted)
    )

  observe({
    print("observe")
    req(input$daterange)
    print(batchPlot$data())
    #batchPlot$data() <- batchPlot$data()
    batchPlot$data()
  })

  #checkDateFilter <- function(){
  #  return(as.integer(input$daterange[1]) + as.integer(input$daterange[2]))
  #}

  output$BatchPlotByStatus <- renderPlot({
    ggplot(batchPlot$data(), aes(x = Date, y = Count, group = Status)) + 
      geom_point(aes(color = Status)) +
      geom_line(aes(color = Status)) +
      geom_label(aes(label=Count, fill = Status)) + 
      # geom_text_repel(aes(label=Count)) + 
      theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
      xlab('Date(MM/DD/YYYY)')+
      ylab('No.of Batches')
  })

要绘制的最终数据如下所示：

Status  Date       Count
   <chr>   <chr>      <int>
 1 FAILURE 10/14/2019     2
 2 FAILURE 10/15/2019     1
 3 FAILURE 10/16/2019     4
 4 FAILURE 10/22/2019     1
 5 FAILURE 10/29/2019     3
 6 FAILURE 10/30/2019     1
 7 FAILURE 11/12/2019     4
 8 SUCCESS 10/16/2019     1
 9 SUCCESS 10/30/2019     5
10 SUCCESS 10/31/2019    12
11 SUCCESS 11/01/2019    20
12 SUCCESS 11/04/2019    22
13 SUCCESS 11/05/2019    12

我尝试了很多组合，但未能成功达到预期的效果。任何建议都会有很大帮助。

Answer 1

上面的代码完全正确并且运行正常。如果我们在 ui.R 中使用 submitButton，则嵌套的 reactivePoll 将停止运行，这是 submitButton 的内部问题。我刚刚将 submitButton 更改为 actionButton，事情开始按预期正常工作。

有没有办法在 reactive/observe 中使用嵌套的 reactivePoll 来渲染依赖于 DB 和 UI 两者的变化的图

Is there a way to use nested reactivePoll inside a reactive/observe to render a plot dependent on changes in DB and on UI both

dashboard

r

shiny

shinydashboard

reactive