有没有一种方法可以在反应/观察中使用嵌套的reactPoll来绘制依赖于DB和UI的变化的图

Question

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

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，则嵌套的reactPoll停止运行，这是SubmitButton的内部问题。我只是将submitButton更改为actionButton，事情开始按预期正常工作。