作者:gloriamm_520 | 来源:互联网 | 2023-10-11 18:49
对于我当前的需求,我需要绘制一些我从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,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
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
我尝试了很多组合,但未能成功获得预期的结果。任何建议都会有很大帮助。
上面显示的代码是完全正确的并且可以正常运行。如果我们在ui.R中使用SubmitButton,则嵌套的reactPoll停止运行,这是SubmitButton的内部问题。我只是将submitButton更改为actionButton,事情开始按预期正常工作。