diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index c4bcc4b..57e0781 100644 --- 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 index 5832799..d42ae17 100644 --- 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 index 72de89b..51873ba 100644 --- a/data-raw/web_hosting/draw_map.R +++ b/data-raw/web_hosting/draw_map.R @@ -5,7 +5,7 @@ } ## 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)) { @@ -13,29 +13,32 @@ 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, "
", 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, "
", 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)) { @@ -43,23 +46,25 @@ 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, "
", 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, "
", 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 index 3a607cc..ba7b6fc 100644 --- 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/m3)", + "PM10" = "(\u03bcg/m3)" + ) +} diff --git a/data-raw/web_hosting/server.R b/data-raw/web_hosting/server.R index 05db328..f6675a5 100644 --- 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,9 +116,7 @@ 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, { @@ -104,7 +124,7 @@ server <- function(input, output, session) { 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 index fb43490..ea714a6 100644 --- 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(