如何使用新数据自动更新闪亮的应用程序？

Question

我想强制使用闪亮的应用程序中的高位图表来绘制Mysql数据库中的新数据。我尝试了不同的方法，但似乎都没有用。首先，我通过globalR中的library（RMySQL）和library（pool）连接到sql

#--------Connect to SQL----------#

pool <- dbPool(
  drv = RMySQL::MySQL(),
  dbname = "xxx",
  host = "x.x.x.x",
  username = 'xxxx',
  password = 'xxxx'
)

sql1 <- 'SELECT * FROM `results` WHERE `datetime` >= NOW() - INTERVAL 1 DAY'

query1 <- sqlInterpolate(pool, sql1)

notifier1 <- dbGetQuery(pool, sqlInterpolate(pool,'SELECT * FROM `results` WHERE `datetime` >= NOW() - INTERVAL 1 DAY' ))

lapply(dbListConnections( dbDriver( drv = "MySQL")), dbDisconnect)

然后创建2个数据框

all1 <- as.data.frame(notifier1%>% group_by(datetime, customer) %>% count(ping) %>% filter(datetime > Sys.time()-14400) %>%
             mutate(percent = (round(100 * n/sum(n), 1))) %>% filter(ping=='1') %>% arrange(desc(datetime)))


 all1_new <- transform(all1,datetime=as.numeric(as.POSIXct(datetime))*1000)

在服务器中，我尝试过：

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

     observeEvent(invalidateLater(60000, session),{
             notifier1 <- dbGetQuery(pool, sqlInterpolate(pool,'SELECT * FROM `results` WHERE `datetime` >= NOW() - INTERVAL 1 DAY' ))

             all1 <- as.data.frame(notifier1%>% group_by(datetime, customer) %>% count(ping) %>% filter(datetime > Sys.time()-14400) %>% 
                                        mutate(percent = (round(100 * n/sum(n), 1))) %>% filter(ping=='1') %>% arrange(desc(datetime)))


             all1_new <- transform(all1,datetime= as.numeric(as.POSIXct(datetime))*1000)
     })

以及我每隔1分钟显示一次新数据所需的highchart代码：

output$Plot1 <- renderHighchart ({

        # invalidateLater(60000,session)



    highchart() %>%
         hc_chart(type = "container",
                  zoomType= "x"
         ) %>%
         #axis
         hc_xAxis(type='datetime',
                  # categories=c(min2$datetime),
                  labels = list(rotation = 90,
                                format = '{value:%e-%b %H:%M}'),
                  showLastLabel = TRUE
         ) %>% 
         hc_yAxis(opposite = FALSE, 
                  title = list(text = "Call Success"),
                  labels = list(format = "{value}%", style=list(fontSize='13px')), max = 100) %>% 
         hc_add_series(all1_new, "spline", hcaes(x=datetime, y=percent, group=customer)
         )%>%
      })

Answer 1

它可能看起来像：

check_db_update <- function() {
  dbGetQuery(pool, sqlInterpolate(pool, 
    'SELECT COUNT(*) FROM `results`' 
  ))
}

get_data_from_db <- function() {
  dbGetQuery(pool, sqlInterpolate(pool,
    'SELECT * FROM `results` WHERE `datetime` >= NOW() - INTERVAL 1 DAY' 
  ))
}

server <- function(input, output, session) {
  data_rx <- 
    reactivePoll(intervalMillis = 6e4, session = session,
                 checkFunc = check_db_update, valueFunc = get_data_from_db)

  data_wrangled_rx <- reactive({
    data_rx() %>% 
      group_by(datetime, customer) %>% 
      count(ping)
    # ...
  })

  output$Plot1 <- renderHighchart ({
    highchart() %>% 
      hc_add_series(data = data_wrangled_rx())
    # ...
  })

  # ...
}