Updated scripts for pargasite.org

HimesGroup · Nov 18, 2024 · a857802 · a857802
1 parent 788bbeb
commit a857802
Show file tree

Hide file tree

Showing 6 changed files with 97 additions and 81 deletions.
diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION
@@ -1,3 +1,3 @@
-Version: 2.1.0
-Date: 2024-04-22 21:27:45 UTC
-SHA: 42aba8848de5fe9bb5dcdc3fd7276f5df4119ef5
+Version: 2.1.1
+Date: 2024-11-16 15:38:04 UTC
+SHA: 788bbebed6b6465591143648a9fc8462089987f5
diff --git a/cran-comments.md b/cran-comments.md
@@ -1,20 +1,3 @@
-## Reviewer's comments:
-
-Please always write package names, software names and API (application
-programming interface) names in single quotes in title and description.
-e.g: --> 'Air Quality System' API
-Please note that package names are case sensitive. -> 'shiny'
-
-- We added single quotes for Air Quality System API
-- We changed 'Shiny' -> 'shiny'
-
-Please add a web reference for the API in the form <[https:.....]https:.....> to
-the description of the DESCRIPTION file with no space after 'https:' and angle
-brackets for auto-linking.
-
-- We added a web reference for the API with angle brackets in the DESCRIPTION
-  file.
-
 ## Test environments
 
 * Local
@@ -25,13 +8,7 @@ brackets for auto-linking.
   - Mac-latest: release
 * Win-builder
   - old-release, release, devel
-* Mac-builder
-  - release
 
 ## R CMD check results
 
-0 errors | 0 warnings | 1 note
-
-* Possibly misspelled words in DESCRIPTION:
-  - AQS, CBSA, NAAQS: acronyms used by the U.S Environmental Protection Agency
-  - Geospatial: capitalized to indicate the package full name
+0 errors | 0 warnings | 0 note
diff --git a/data-raw/web_hosting/draw_map.R b/data-raw/web_hosting/draw_map.R
@@ -5,61 +5,66 @@
 }
 
 ## Display pollutant estimates summarized by grids
-.draw_grid <- function(x, monitor_dat, year, month = NULL) {
+.draw_grid <- function(x, monitor_dat, year, month = NULL, unit = NULL) {
   min_val <- min(x[[1]], na.rm = TRUE) * 0.99 # small offset due to boundary
   max_val <- max(x[[1]], na.rm = TRUE) * 1.01
   if (is.null(month)) {
     if (length(year) > 1) {
       plist <- lapply(year, function(k) {
         y <- .dimsub(x, dim = "year", value = k, drop = TRUE)
         .draw_leaflet(y, monitor_dat, min_val, max_val,
-                      title = paste0("Year: ", k), grid = TRUE)
+                      title = paste0("Year: ", k, "<br>", unit), grid = TRUE)
       })
       do.call(sync, plist)
     } else {
-      .draw_leaflet(x, monitor_dat, min_val, max_val, grid = TRUE)
+      .draw_leaflet(x, monitor_dat, min_val, max_val, title = unit, grid = TRUE)
     }
   } else {
     if (length(month) > 1) {
       plist <- lapply(month, function(k) {
         y <- .dimsub(x, dim = "month", value = k, drop = TRUE)
-        .draw_leaflet(y, monitor_dat, min_val, max_val,
-                      title = paste0(month.abb[as.integer(k)], " ", year),
-                      grid = TRUE)
+        .draw_leaflet(
+          y, monitor_dat, min_val, max_val,
+          title = paste0(month.abb[as.integer(k)], " ", year, "<br>", unit),
+          grid = TRUE
+        )
       })
       do.call(sync, plist)
     } else {
-      .draw_leaflet(x, monitor_dat, min_val, max_val, grid = TRUE)
+      .draw_leaflet(x, monitor_dat, min_val, max_val, title = unit, grid = TRUE)
     }
   }
 }
 
+
 ## Display pollutant estimates summarized by geographical boundaries
-.draw_geoshape <- function(x, monitor_dat, year, month) {
+.draw_geoshape <- function(x, monitor_dat, year, month, unit = NULL) {
   min_val <- min(x$value, na.rm = TRUE) * 0.99
   max_val <- max(x$value, na.rm = TRUE) * 1.01
   if (is.null(month)) {
     if (length(year) > 1) {
       plist <- lapply(year, function(k) {
         y <- x[x$year == k, ]
         .draw_leaflet(y, monitor_dat, min_val, max_val,
-                      title = paste0("Year: ", k), grid = FALSE)
+                      title = paste0("Year: ", k, "<br>", unit), grid = FALSE)
       })
       do.call(sync, plist)
     } else {
-      .draw_leaflet(x, monitor_dat, min_val, max_val, grid = FALSE)
+      .draw_leaflet(x, monitor_dat, min_val, max_val, title = unit, grid = FALSE)
     }
   } else {
     if (length(month) > 1) {
       plist <- lapply(month, function(k) {
         y <- x[x$month == k, ]
-        .draw_leaflet(y, monitor_dat, min_val, max_val,
-                      title = paste0(month.abb[as.integer(k)], " ", year),
-                      grid = FALSE)
+        .draw_leaflet(
+          y, monitor_dat, min_val, max_val,
+          title = paste0(month.abb[as.integer(k)], " ", year, "<br>", unit),
+          grid = FALSE
+        )
       })
       do.call(sync, plist)
     } else {
-      .draw_leaflet(x, monitor_dat, min_val, max_val, grid = FALSE)
+      .draw_leaflet(x, monitor_dat, min_val, max_val, title = unit, grid = FALSE)
     }
   }
 }

diff --git a/data-raw/web_hosting/helpers.R b/data-raw/web_hosting/helpers.R
@@ -131,3 +131,15 @@ aqi_draw_multi <- function(x, stat, year) {
   plist <- lapply(year, function(k) aqi_draw(x, stat, k))
   do.call(sync, plist)
 }
+
+.get_pollutant_unit <- function(x) {
+  switch(
+    sub("^(.*?) (.*)", "\\1", x),
+    "CO" = "(ppm)",
+    "SO2" = "(ppb)",
+    "NO2" = "(ppb)",
+    "Ozone" = "(ppm)",
+    "PM25" = "(\u03bcg/m<sup>3</sup>)",
+    "PM10" = "(\u03bcg/m<sup>3</sup>)"
+  )
+}
diff --git a/data-raw/web_hosting/server.R b/data-raw/web_hosting/server.R
@@ -15,33 +15,41 @@ server <- function(input, output, session) {
 
   ## Render UI
   output$pollutant_ui <- renderUI(
-    tagList(pollutant_ui(pollutant_list, field_list, event_list, year_list,
-                         month_list))
+    tagList(pollutant_ui(pollutant_list, event_list, year_list, month_list))
   )
 
-  ## Pollutant information
-  observeEvent(input$pollutant, {
-    output$dat_src <- renderText(
-      if ("month" %ni% dimnames(getOption("pargasite.dat"))) {
-        "EPA's AQS API annualData service"
-      } else {
-        "EPA's AQS API dailyData service"
-      }
-    )
-    ## Select an appropriate field when NAAQS_statistic is given and update the
-    ## dropdown menu
+
+  rv <- reactiveValues(pollutant = NULL, field_list = NULL, data_field = NULL,
+                       unit = NULL, dat_grid = NULL, dat_geo = NULL)
+
+  output$dat_src <- renderText(
+    if ("month" %ni% dimnames(getOption("pargasite.dat"))) {
+      "EPA's AQS API annualData service"
+    } else {
+      "EPA's AQS API dailyData service"
+    }
+  )
+
+  observeEvent({
+    input$pollutant # initialized as NULL
+  }, {
+    if (!is.null(input$pollutant)) {
+      rv$pollutant <- input$pollutant
+    } else {
+      ## Get the first entry from a nested list
+      rv$pollutant <- unlist(pollutant_list)[1]
+    }
+    rv$unit <- .get_pollutant_unit(rv$pollutant)
     if ("NAAQS_statistic" %in% field_list) {
       idx <- match("NAAQS_statistic", field_list)
-      field_list[idx] <- .map_standard_to_field(input$pollutant)
-      ## If NAAQS statistic = arithmetic mean, drop duplicate
-      field_list <- unique(field_list)
+      field_list[idx] <- .map_standard_to_field(rv$pollutant)
     }
-    updateSelectizeInput(session, inputId = "data_field", choices = field_list)
-    ## List a selected pollutant information
+    ## If NAAQS statistic = arithmetic mean, drop duplicate
+    rv$field_list <- unique(field_list)
     pollutant_idx <- which(
-      .criteria_pollutants$pollutant_standard == input$pollutant
+      .criteria_pollutants$pollutant_standard == rv$pollutant
     )
-    output$pollutant_std <- renderText(input$pollutant)
+    output$pollutant_std <- renderText(rv$pollutant)
     output$pollutant_desc <- renderText(
       .criteria_pollutants$pollutant_standard_description[pollutant_idx]
     )
@@ -57,34 +65,48 @@ server <- function(input, output, session) {
     output$primary_level <- renderText(
       .criteria_pollutants$primary_standard_level[pollutant_idx]
     )
-  })
+  }, ignoreNULL = FALSE)
 
-  r <- reactiveValues(dat_grid = NULL, dat_geo = NULL)
+  observeEvent({
+    req(rv$pollutant)
+    input$data_field
+  }, {
+    if (is.null(input$data_field) || input$data_field %ni% rv$field_list) {
+      rv$data_field <- rv$field_list[1]
+      updateSelectizeInput(session, inputId = "data_field", choices = rv$field_list,
+                           selected = rv$data_field)
+    } else {
+      rv$data_field <- input$data_field
+      updateSelectizeInput(session, inputId = "data_field", choices = rv$field_list,
+                           selected = rv$data_field)
+    }
+  }, ignoreNULL = FALSE)
 
   observeEvent({
-    ## Ensure that it is triggered when non-NULL values are given.
-    req(input$summary)
-    req(input$pollutant)
-    req(input$data_field)
+    req(rv$pollutant)
+    req(rv$data_field)
     req(input$event)
     req(input$year)
-    input$month # exception; it can be NULL
+    req(input$summary)
+    input$month
   }, {
     ## Get monitor location data
-    monitor_dat <- .subset_monitor_data(input$pollutant, input$year)
+    monitor_dat <- .subset_monitor_data(rv$pollutant, input$year)
     ## Subset pargasite data
-    r$dat_grid <- .subset_pargasite_data(
-      getOption("pargasite.dat"), input$pollutant, input$data_field,
+    rv$dat_grid <- .subset_pargasite_data(
+      getOption("pargasite.dat"), rv$pollutant, rv$data_field,
       input$event, input$year, input$month
     )
     if (input$summary == "Grid") {
-      p <- .draw_grid(r$dat_grid, monitor_dat, input$year, input$month)
+      p <- .draw_grid(rv$dat_grid, monitor_dat, input$year, input$month,
+                      unit = rv$unit)
     } else {
-      r$dat_geo <- .summarize_pargasite_data(
-        r$dat_grid, us_map = getOption("pargasite.map")[[tolower(input$summary)]],
+      rv$dat_geo <- .summarize_pargasite_data(
+        rv$dat_grid, us_map = getOption("pargasite.map")[[tolower(input$summary)]],
         input$year, input$month
       )
-      p <- .draw_geoshape(r$dat_geo, monitor_dat, input$year, input$month)
+      p <- .draw_geoshape(rv$dat_geo, monitor_dat, input$year, input$month,
+                          unit = rv$unit)
     }
     if ((is.null(input$month) && length(input$year) == 1) ||
         (!is.null(input$month) && length(input$month) == 1)) {
@@ -94,17 +116,15 @@ server <- function(input, output, session) {
     } else {
       output$mmap <- renderUI(p)
     }
-  },
-  ignoreNULL = FALSE # set FALSE as input$month can be NULL
-  )
+  }, ignoreNULL = FALSE)
 
   ## Display pollutant value for a single-panel grid map
   observeEvent(input$smap_click, {
     if (!is.null(input$smap_click)) {
       if (input$summary == "Grid") {
         output$grid_val_ui <- renderUI(shiny::tableOutput("grid_val"))
         click_pos <- .get_click_pos(input$smap_click$lng, input$smap_click$lat)
-        tbl <- .extract_grid_value(r$dat_grid, click_pos)
+        tbl <- .extract_grid_value(rv$dat_grid, click_pos)
         output$grid_val <- shiny::renderTable(tbl)
       }
       ## is it necessary to display values for other summary types?
@@ -144,3 +164,4 @@ server <- function(input, output, session) {
   })
 
 }
+
diff --git a/data-raw/web_hosting/ui_functions.R b/data-raw/web_hosting/ui_functions.R
@@ -1,4 +1,4 @@
-pollutant_ui <- function(pollutant_list, field_list, event_list, year_list,
+pollutant_ui <- function(pollutant_list, event_list, year_list,
                          month_list = NULL) {
   ## Month full name
   if (!is.null(month_list)) {
@@ -27,7 +27,8 @@ pollutant_ui <- function(pollutant_list, field_list, event_list, year_list,
       selectizeInput(
         inputId = "data_field",
         label = "",
-        choice = field_list,
+        ## choice = field_list,
+        choice = NULL,
         multiple = FALSE
       ),
       helpText(