R Shiny中的Reactive Plotly正在产生奇怪的数据

lokaqttq  于 11个月前  发布在  React
关注(0)|答案(1)|浏览(90)

我正试图从一个每小时更新一次的csv文件中创建一个包含一些变量的plotly图。结果图形是pm_cor系列的1:1直线,其他系列缺失。
我希望最终能够打开和关闭系列,但现在,我只想看到我的数据看起来像预期的那样。我确实需要对数据执行一些转换来纠正它,所以它使代码变得有点复杂,但下面是我所做的:

library(shinydashboard)
library(plotly)
library(readr)
library(xts)
library(lubridate)
library(tidyr)
library(dplyr)

ui <- dashboardPage(
    dashboardHeader(title = "Sensors", disable = T),
    dashboardSidebar(
        disable = T,
        sidebarMenu()
    ),
    dashboardBody(
        fluidRow(
            box(width= 9, title = "Sensors", background = "black", plotlyOutput("plot1"))
        ),
        shinyjs::useShinyjs()
    )
)

percentage_difference <- function(value, value_two) {
    abs((value - value_two) / ((value + value_two) / 2)) * 100
}

server <- function(input, output, session) {
    ez.read = function(file, ..., skip.rows=NULL, tolower=FALSE) {
        if (!is.null(skip.rows)) {
            tmp = readLines(file)
            tmp = tmp[-(skip.rows)]
            tmpFile = tempfile()
            on.exit(unlink(tmpFile))
            writeLines(tmp, tmpFile)
            file = tmpFile
        }
        result = read.csv(file, ...)
        if (tolower) names(result) = tolower(names(result))
        return(result)
    }
    
    data <- reactivePoll(1000 * 60 * 15, session,
                         checkFunc = function() { file.info("sensor.csv")$mtime},
                         valueFunc = function() {
                             data <- ez.read("sensor.csv", tolower = T)
                             data$time_stamp <- as_datetime(data$time_stamp)
                             names(data)[1] <- "date"
                             names(data)[5] <- "pm_a"
                             names(data)[6] <- "pm_b"
                             data$humidity <- as.numeric(data$humidity)

                             #only keep data where a and b are within 5, then perform correction factors based on the bin of their average
                             data <- data %>%
                                 mutate(pm_cor = case_when(
                                     abs(pm_a - pm_b) < 5 ~ 
                                         ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 30,
                                                0.524 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity + 5.75,
                                                ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 50,
                                                       (0.786 * ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 20) - 3/2) + 0.524 * (1 - ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 20) - 3/2))) * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity + 5.75,
                                                       ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 210,
                                                              0.786 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity + 5.75,
                                                              ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 260,
                                                                     (0.69 * ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50) - 21/5) + 0.786 * (1 - ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50) - 21/5))) * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity * (1 - ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50) - 21/5)) + 2.966 * (rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50 - 21/5) + 5.75 * (1 - (rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50 - 21/5)) + 8.84 * 10^-4 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE)^2 * (rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50 - 21/5),
                                                                     2.966 + 0.69 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) + 8.84 * 10^-4 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE)^2
                                                              )
                                                       )
                                                  )
                                                ),
                                                TRUE ~ NA_real_
                                         ))
                                     
                                     data$pdiff <- percentage_difference(data$pm_a,data$pm_b)
                                     data <- pivot_wider(data,names_from = sensor_index,values_from = c(humidity, temperature, pm_a, pm_b, pdiff,pm_cor))
                                     data
                         })
                            
                             output$table <- renderTable(data())
                             
                             
             
                             # Plot
                             output$plot1 <- renderPlotly({
                                 plot_data <- data()
                                 plot_data <- plot_data %>% arrange(date)
                                 fig <- plot_ly()
                                 
                               
                                 fig <- add_trace(fig, x = plot_data$date, y = plot_data$pm_a, name = "pm_a_93325", type = 'scatter', mode = 'lines')
                                 fig <- add_trace(fig, x = plot_data$date, y = plot_data$pm_b, name = "pm_b_93325", type = 'scatter', mode = 'lines')
                                 fig <- add_trace(fig, x = plot_data$date, y = plot_data$pdiff, name = "pdiff_93325", type = 'scatter', mode = 'lines')
                                 fig <- add_trace(fig, x = plot_data$date, y = plot_data$pm_cor, name = "pm_cor_93325", type = 'scatter', mode = 'lines')
                                 
                                 
                                 fig <- layout(fig, title = "Sensor 93325 Data", xaxis = list(title = "Date"), yaxis = list(title = "Values"))
                                 
                                 fig
                             })
}

shinyApp(ui, server)

sensor.csv snippet:

time_stamp,sensor_index,humidity,temperature,pm2.5_atm_a,pm2.5_atm_b
1697000400,93325,67.867,52.7,6.048,5.279
1697004000,93325,67.5,53.6,5.442,4.786
1697040000,93325,42.5,73.067,4.239,3.941
1697011200,93325,62.267,54.666,5.662,5.16
1696399200,93325,68.267,65.0,8.456,8.181
1696377600,93325,57.633,74.25,9.389,8.784
1696122000,93325,71.334,72.467,21.392,19.959
1696176000,93325,46.567,83.733,10.662,9.479
1696168800,93325,66.8,72.667,15.885,14.849
1696338000,93325,72.867,67.966,15.727,14.604
1696374000,93325,46.058,79.342,7.748,7.088
1696294800,93325,66.534,71.7,20.221,18.643
1696546800,93325,77.867,68.966,18.733,17.2
1696492800,93325,62.733,71.7,17.677,16.736
1696222800,93325,72.566,66.534,14.466,13.815
1696230000,93325,75.3,64.2,15.539,14.407
1696010400,93325,43.1,90.8,11.642,11.361
1695924000,93325,98.6,67.2,17.668,16.203
1696593600,93325,78.233,66.434,20.581,19.08
1696690800,93325,49.3,57.0,0.814,0.725
1696644000,93325,47.067,62.466,1.255,0.933
1696658400,93325,53.2,53.8,1.522,1.256
1696089600,93325,47.534,84.433,16.819,15.394
1696060800,93325,80.0,65.066,24.43,21.921
1696068000,93325,80.0,63.966,21.581,19.63
1696734000,93325,61.034,49.767,1.782,1.402
1696806000,93325,40.267,61.034,2.359,2.224
1696759200,93325,76.0,41.3,6.032,5.632
1696784400,93325,32.466,68.8,0.494,0.325
1696824000,93325,63.0,51.233,2.014,1.639
1696874400,93325,35.5,78.1,3.917,3.566
1696816800,93325,65.5,51.067,3.525,3.069
1696834800,93325,62.067,50.133,1.827,1.571
1696888800,93325,35.341,73.966,2.612,2.024
1697029200,93325,56.5,59.833,5.155,4.486

我在控制台中得到一个警告:

Warning: Unknown or uninitialised column: 'pm_a'.
Warning: Unknown or uninitialised column :'pm_b'.
Warning: Unknown or uninitialised column :'pdiff'.
Warning: Unknown or uninitialised column :'pm_cor'.
hivapdat

hivapdat1#

在上面的代码中,add_trace调用的y参数不符合数据集(plot_data)的列名。此外,在您的结果图中,其他系列并没有丢失-它们被覆盖了。尝试单击图例项以查看它们。

library(shinydashboard)
library(plotly)
library(readr)
library(xts)
library(lubridate)
library(tidyr)
library(dplyr)

ui <- dashboardPage(
  dashboardHeader(title = "Sensors", disable = T),
  dashboardSidebar(
    disable = T,
    sidebarMenu()
  ),
  dashboardBody(
    fluidRow(
      box(width= 9, title = "Sensors", background = "black", plotlyOutput("plot1"))
    ),
    shinyjs::useShinyjs()
  )
)

percentage_difference <- function(value, value_two) {
  abs((value - value_two) / ((value + value_two) / 2)) * 100
}

server <- function(input, output, session) {
  ez.read = function(file, ..., skip.rows=NULL, tolower=FALSE) {
    if (!is.null(skip.rows)) {
      tmp = readLines(file)
      tmp = tmp[-(skip.rows)]
      tmpFile = tempfile()
      on.exit(unlink(tmpFile))
      writeLines(tmp, tmpFile)
      file = tmpFile
    }
    result = read.csv(file, ...)
    if (tolower) names(result) = tolower(names(result))
    return(result)
  }
  
  data <- reactivePoll(1000 * 60 * 15, session,
                       checkFunc = function() { file.info("sensor.csv")$mtime},
                       valueFunc = function() {
                         data <- ez.read("sensor.csv", tolower = T)
                         data$time_stamp <- as_datetime(data$time_stamp)
                         names(data)[1] <- "date"
                         names(data)[5] <- "pm_a"
                         names(data)[6] <- "pm_b"
                         data$humidity <- as.numeric(data$humidity)
                         
                         #only keep data where a and b are within 5, then perform correction factors based on the bin of their average
                         data <- data %>%
                           mutate(pm_cor = case_when(
                             abs(pm_a - pm_b) < 5 ~ 
                               ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 30,
                                      0.524 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity + 5.75,
                                      ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 50,
                                             (0.786 * ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 20) - 3/2) + 0.524 * (1 - ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 20) - 3/2))) * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity + 5.75,
                                             ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 210,
                                                    0.786 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity + 5.75,
                                                    ifelse(rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) < 260,
                                                           (0.69 * ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50) - 21/5) + 0.786 * (1 - ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50) - 21/5))) * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) - 0.0862 * humidity * (1 - ((rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50) - 21/5)) + 2.966 * (rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50 - 21/5) + 5.75 * (1 - (rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50 - 21/5)) + 8.84 * 10^-4 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE)^2 * (rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) / 50 - 21/5),
                                                           2.966 + 0.69 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE) + 8.84 * 10^-4 * rowMeans(cbind(pm_a, pm_b), na.rm = TRUE)^2
                                                    )
                                             )
                                      )
                               ),
                             TRUE ~ NA_real_
                           ))
                         
                         data$pdiff <- percentage_difference(data$pm_a,data$pm_b)
                         data <- pivot_wider(data,names_from = sensor_index,values_from = c(humidity, temperature, pm_a, pm_b, pdiff,pm_cor))
                         data
                       })
  
  output$table <- renderTable(data())
  
  # Plot
  output$plot1 <- renderPlotly({
    plot_data <- data()
    plot_data <- plot_data %>% arrange(date)
    fig <- plot_ly(data = plot_data, type = 'scatter', mode = 'lines')
    
    fig <- add_trace(fig, x = ~ date, y = ~ pm_a_93325, name = "pm_a_93325")
    fig <- add_trace(fig, x = ~ date, y = ~ pm_b_93325, name = "pm_b_93325")
    fig <- add_trace(fig, x = ~ date, y = ~ pdiff_93325, name = "pdiff_93325")
    fig <- add_trace(fig, x = ~ date, y = ~ pm_cor_93325, name = "pm_cor_93325")
    
    
    fig <- layout(fig, title = "Sensor 93325 Data", xaxis = list(title = "Date"), yaxis = list(title = "Values"))
    
    fig
  })
}

shinyApp(ui, server)

顺便说一句,你可以通过plotlyProxyInvoke修改它,而不是重新渲染图,这更快。请看我的相关回答here

相关问题