rshinyplotlyreactive
Reactive Plotly in R Shiny is producing odd looking data
I'm trying to create a plotly plot of a few variables from a csv file that gets updated hourly. The resulting graph is a straight 1:1 line for the pm_cor series, the other series are missing.
I'd like to eventually be able to turn series on and off, but for now, I just want to see my data looking as expected. I do need to perform some transformations on the data to get it corrected, so it has complicated the code a bit, but here's what I have:
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
I do get a warning in the console:
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'.
Solution
In your above code the y parameters of your add_trace calls don't meet the column names of your dataset (plot_data). Furthermore, in your resulting graph the other series are not missing - they are covered. Try clicking the legend items to see them.
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)
Btw. instead of re-rendering the plot you could modify it via plotlyProxyInvoke, which is faster. Please see my related answer here.
- Rcpp Rf_warningcall compiler warnings
- Modify the name of factor variables in lm function(summary function)
- Extreme value analysis and quantile estimation using log Pearson type 3 (Pearson III) distribution - R vs Python
- How to hide NAs when using xlsx::saveWorkbook?
- How do I retrieve a simple numeric value from a named numeric vector in R?
- Matching pair-wise columns from left to right across rows in one dataframe to another dataframe and adding new columns with matching values
- Income to outcome flow chart in Sankey plotly R
- color mapping in geom_conn_bundle not showing correctly
- Print R package startup message AFTER automatic package conflict messages instead of before
- Summing a set of R dataframe rows (column-wise), while retaining the first n columns
- Added variable / partial regression plots for groups in an interaction?
- how to make a topoplot in R with coordinates variable distribution
- List of all functions in base R?
- Plotting multiple plots for different initial conditions in one graph
- Printing repetitively on the same line in R
- Generating UI/Server based on initial selection
- Subset dataframe based on pickerInput
- How to let user pick the data in R-shiny?
- Couldn't show my simple bar charts separately on Shiny R dashboardBody
- How to programmatically filter contents of a second shiny app displayed via iframe
- How to select specific interesting groups for the boxplot in R Shiny app?
- Crosstable and Plot grouping with reactive values
- Is there a way to make multiple Shiny picker inputs where the selections must be disjoint?
- Delay/avoid duplication of shiny server side functions until after credentials
- Predictions only returns value "1"
- How to display a busy indicator in a shiny app?
- Append doesn't work when writing to CSV in R
- Changing the start date of a gantt chart in DiagrammeR
- Check for installed packages before running install.packages()
- Compare two columns element-wise