R Shiny 中的 Reactive Plotly 正在生成看起来很奇怪的数据

问题描述 投票：0回答：1

我正在尝试从每小时更新的 csv 文件创建几个变量的绘图。所得图表是 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 片段：

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'.
r shiny plotly reactive
1个回答
0
投票

在上面的代码中，

add_trace
调用的 y 参数不符合数据集的列名称：

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)

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.