Search code examples
rshinydashboardshinydashboardreactive

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


For my current requirement I need a plot on some data which I am fetching from mongodb, and I am watching for changes in db using reactivePoll to db. In addition to this I now want to add a date filter on the UI according to which the plot would change, for that I need reactiveValue on input date but I am not able to achieve it. On debugging I found that the nested reactive may not be possible with reactivePoll inside because the reactivePoll does not leaves the process so change in input value does not affects the data being watched by reactivePoll. Here is the required part of the code which I have tried:

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')
  })

The final data to be plotted looks like this:

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

I have tried a lot of combinations but couldn't succeed in achieving desired results. Any suggestions would be of great help.


Solution

  • The code present above is entirely correct and functioning correctly. If we use submitButton in the ui.R then nested reactivePoll stops functioning, this is an internal issue with submitButton. I just changed the submitButton to actionButton and things started working normally as expected.