Merge pull request #26 from uace-azmet/battery

WIP: Add battery diagnostics tab

app/R/check_battery.R

@@ -0,0 +1,69 @@
+check_battery_daily <- function(daily) {
+  #Calculate 10 timestep rolling mean of mean voltage (less than 10 days is
+  #allowed at start of timeseries) and anomaly (absolute difference) from that
+  #rolling mean.
+  daily <- 
+    daily |> 
+    arrange(desc(datetime)) |> 
+    mutate(
+      meta_bat_mean_rollmean = slide_dbl(meta_bat_volt_mean, mean, .after = 10),
+      meta_bat_volt_anomaly = abs(meta_bat_volt_mean - meta_bat_mean_rollmean),
+      .by = meta_station_id
+    ) 
+
+  #initialize report
+  report <- data.validator::data_validation_report()
+
+  #validation
+  data.validator::validate(daily, name = "Daily") |>
+    validate_if(btwn(meta_bat_volt_mean, meta_bat_volt_min, meta_bat_volt_max),
+                description = "`meta_bat_volt_*` (min ≤ mean ≤ max)") |> 
+    validate_if(meta_bat_volt_min >= 9.6, "`meta_bat_volt_min` ≥ 9.6") |> 
+    validate_if(meta_bat_volt_max <= 16, "`meta_bat_volt_max` ≤ 16") |> 
+    validate_if(lte(meta_bat_volt_anomaly, 1, na_pass = TRUE), "∆ voltage from 10-day mean ≤ 1") |> 
+    add_results(report)
+
+  get_results(report) |> 
+    # make `bad_rows` list-column with slices of original data where there are problems
+    mutate(bad_rows = map(error_df, \(.x){
+      if(length(.x$index) > 0) {
+        daily |> 
+          dplyr::slice(.x$index)
+      } else {
+        NA
+      }
+    }))
+}
+
+
+check_battery_hourly <- function(hourly) {
+  hourly <- 
+    hourly |> 
+    arrange(desc(date_datetime)) |> 
+    mutate(
+      meta_bat_volt_rollmean = slide_dbl(meta_bat_volt, mean, .after = 10),
+      meta_bat_volt_anomaly = abs(meta_bat_volt - meta_bat_volt_rollmean),
+      .by = meta_station_id
+    )
+
+  #initialize report
+  report <- data.validator::data_validation_report()
+
+  #validation
+  data.validator::validate(hourly, "Hourly") |> 
+    validate_if(meta_bat_volt >= 9.6, "`meta_bat_volt` ≥ 9.6") |> 
+    validate_if(meta_bat_volt <= 16, "`meta_bat_volt` ≤ 16") |> 
+    validate_if(lte(meta_bat_volt_anomaly, 2, na_pass = TRUE), "∆ voltage from 10-hr mean ≤ 2") |> 
+    add_results(report)
+
+  get_results(report) |> 
+    # make `bad_rows` list-column with slices of original data where there are problems
+    mutate(bad_rows = map(error_df, \(.x){
+      if(length(.x$index) > 0) {
+        hourly |> 
+          dplyr::slice(.x$index)
+      } else {
+        NA
+      }
+    }))
+}

app/app.R

@@ -9,6 +9,8 @@ library(bslib)
 library(bsicons)
 library(shinycssloaders)
 library(shinyWidgets)
+library(plotly)
+library(slider)
 
 source("R/helpers.R")
 source("R/check_daily.R")
@@ -57,6 +59,10 @@ ui <- page_navbar(
     conditionalPanel(
       "input.navbar === 'Forecast-based'",
       uiOutput("fc_range")
+    ),
+    conditionalPanel(
+      "input.navbar === 'Battery'",
+      uiOutput("battery_range")
     )
   ), 
   ## Daily ----
@@ -181,6 +187,44 @@ ui <- page_navbar(
         )
       )
     )
+  ),
+  ## Battery ----
+  nav_panel(
+    title = "Battery",
+    layout_column_wrap(
+      width = NULL,
+      height = "100%",
+      fill = FALSE,
+      style = css(grid_template_columns = "1fr 1.5fr"),
+      card(
+        full_screen = TRUE,
+        card_header(
+          "Daily Data"
+        ),
+        gt_output(outputId = "check_battery_daily") |> withSpinner(4)
+      ),
+      card(
+        full_screen = TRUE,
+        card_header(
+          "Daily Data"
+        ),
+        plotlyOutput(outputId = "plot_battery_daily", height = "300px") |> withSpinner(4)
+      ),
+      card(
+        full_screen = TRUE,
+        card_header(
+          "Hourly Data"
+        ),
+        gt_output(outputId = "check_battery_hourly") |> withSpinner(4)
+      ),
+      card(
+        full_screen = TRUE,
+        card_header(
+          "Hourly Data"
+        ),
+        plotlyOutput(outputId = "plot_battery_hourly", height = "300px") |> withSpinner(4)
+      )
+    )
   )
 )
 
@@ -191,12 +235,12 @@ server <- function(input, output, session) {
     myAirDatepickerInput(
       inputId = "dailyrange",
       label = "Date Range",
-      value = c(Sys.Date() - 14, Sys.Date()),
+      value = c(Sys.Date() - 15, Sys.Date() - 1),
       range = TRUE,
       separator = " – ",
       dateFormat = "MM/dd/yy",
       minDate = "2020-12-30",
-      maxDate = Sys.Date(),
+      maxDate = Sys.Date() - 1,
       update_on = "close",
       addon = "none"
     )
@@ -206,7 +250,7 @@ server <- function(input, output, session) {
     myAirDatepickerInput(
       inputId = "hourlyrange",
       label = "Date Range",
-      value = c(Sys.Date() - 2, Sys.Date()), #only 2 days because hourly
+      value = c(Sys.Date() - 7, Sys.Date()), #only 7 days because hourly
       range = TRUE,
       separator = " – ",
       dateFormat = "MM/dd/yy",
@@ -221,7 +265,22 @@ server <- function(input, output, session) {
     myAirDatepickerInput(
       inputId = "fcrange",
       label = "Date Range",
-      value = c(Sys.Date() - 14, Sys.Date()), #only 2 days because hourly
+      value = c(Sys.Date() - 15, Sys.Date() - 1),
+      range = TRUE,
+      separator = " – ",
+      dateFormat = "MM/dd/yy",
+      minDate = "2020-12-30",
+      maxDate = Sys.Date() - 1,
+      update_on = "close",
+      addon = "none"
+    )
+  })
+
+  output$battery_range <- renderUI({
+    myAirDatepickerInput(
+      inputId = "batteryrange",
+      label = "Date Range",
+      value = c(Sys.Date() - 7, Sys.Date()),
       range = TRUE,
       separator = " – ",
       dateFormat = "MM/dd/yy",
@@ -351,6 +410,78 @@ server <- function(input, output, session) {
       })
   })
 
+
+  # Battery tab -------------------------------------------------------------
+
+  observe({
+    if(input$navbar == "Battery") {
+      req(input$batteryrange)
+
+      start <- input$batteryrange[1] |> as.POSIXct() |> format_ISO8601() #to convert to datetime
+      end   <- input$batteryrange[2] |> as.POSIXct() |> format_ISO8601()
+
+      daily <- az_daily(start_date = start, end_date = end)
+      hourly <- az_hourly(start_date_time = start, end_date_time = end)
+
+      output$check_battery_daily <- gt::render_gt({
+        # force reload as soon as input changes
+        input$batteryrange
+
+        #do validation report
+        report_battery_daily <- check_battery_daily(daily)
+
+        #convert to gt table
+        format_report_gt(report_battery_daily, daily)
+      })
+
+      output$check_battery_hourly <- gt::render_gt({
+        # force reload as soon as input changes
+        input$batteryrange
+
+        #do validation report
+        report_battery_hourly <- check_battery_hourly(hourly)
+
+        #convert to gt table
+        format_report_gt(report_battery_hourly, hourly)
+      })
+
+      output$plot_battery_hourly <- renderPlotly({
+        h_time <-
+          ggplot(hourly, aes(x = date_datetime, y = meta_bat_volt)) +
+          geom_line(aes(color = meta_station_id)) +
+          geom_hline(aes(yintercept = 9.6), color = "red") +
+          geom_hline(aes(yintercept = 16), color = "orange") +
+          geom_hline(aes(yintercept = 20), color = "red") +
+          scale_y_continuous(limits = range(hourly$meta_bat_volt, na.rm = TRUE)) +
+          theme_bw() +
+          theme(legend.position = "none",  axis.title.x = element_blank())
+        ggplotly(h_time)
+      })
+
+      output$plot_battery_daily <- renderPlotly({
+        h_daily <-
+          daily |> 
+          ggplot(aes(x = datetime, y = meta_bat_volt_mean)) +
+          geom_ribbon(aes(ymin = meta_bat_volt_min,
+                          ymax = meta_bat_volt_max,
+                          fill = meta_station_id),
+                      alpha = 0.15) +
+          geom_line(aes(color = meta_station_id)) +
+          geom_hline(aes(yintercept = 9.6), color = "red") +
+          geom_hline(aes(yintercept = 16), color = "orange") +
+          geom_hline(aes(yintercept = 20), color = "red") +
+          scale_y_continuous(
+            limits = c(min(daily$meta_bat_volt_min, na.rm = TRUE),
+                       max(daily$meta_bat_volt_max, na.rm = TRUE))
+          ) +
+          theme_bw() +
+          theme(legend.position = "none", axis.title.x = element_blank())
+
+        ggplotly(h_daily)
+      })
+    }
+  })  
+
 }
 
 shinyApp(ui, server)

renv.lock

@@ -447,6 +447,19 @@
       ],
       "Hash": "e8a1e41acf02548751f45c718d55aa6a"
     },
+    "crosstalk": {
+      "Package": "crosstalk",
+      "Version": "1.2.0",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R6",
+        "htmltools",
+        "jsonlite",
+        "lazyeval"
+      ],
+      "Hash": "6aa54f69598c32177e920eb3402e8293"
+    },
     "curl": {
       "Package": "curl",
       "Version": "5.0.1",
@@ -1057,6 +1070,16 @@
       ],
       "Hash": "0b8a6d63c8770f02a8b5635f3c431e6b"
     },
+    "lazyeval": {
+      "Package": "lazyeval",
+      "Version": "0.2.2",
+      "Source": "Repository",
+      "Repository": "CRAN",
+      "Requirements": [
+        "R"
+      ],
+      "Hash": "d908914ae53b04d4c0c0fd72ecc35370"
+    },
     "lifecycle": {
       "Package": "lifecycle",
       "Version": "1.0.3",
@@ -1279,6 +1302,38 @@
       ],
       "Hash": "01f28d4278f15c76cddbea05899c5d6f"
     },
+    "plotly": {
+      "Package": "plotly",
+      "Version": "4.10.2",
+      "Source": "Repository",
+      "Repository": "RSPM",
+      "Requirements": [
+        "R",
+        "RColorBrewer",
+        "base64enc",
+        "crosstalk",
+        "data.table",
+        "digest",
+        "dplyr",
+        "ggplot2",
+        "htmltools",
+        "htmlwidgets",
+        "httr",
+        "jsonlite",
+        "lazyeval",
+        "magrittr",
+        "promises",
+        "purrr",
+        "rlang",
+        "scales",
+        "tibble",
+        "tidyr",
+        "tools",
+        "vctrs",
+        "viridisLite"
+      ],
+      "Hash": "6c00a09ba7d34917d9a3e28b15dd74e3"
+    },
     "prettyunits": {
       "Package": "prettyunits",
       "Version": "1.1.1",
@@ -1538,10 +1593,10 @@
     },
     "rstudioapi": {
       "Package": "rstudioapi",
-      "Version": "0.15.0",
+      "Version": "0.14",
       "Source": "Repository",
       "Repository": "RSPM",
-      "Hash": "5564500e25cffad9e22244ced1379887"
+      "Hash": "690bd2acc42a9166ce34845884459320"
     },
     "rvest": {
       "Package": "rvest",