-
Notifications
You must be signed in to change notification settings - Fork 23
763 updates to tada nearbysitesmap #783
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
base: develop
Are you sure you want to change the base?
Conversation
including switching to TADA prefixed cols as source for popup data, use internal functions to add markers
Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Remaining comments which cannot be posted as a review comment to avoid GitHub Rate Limit
air
[air] reported by reviewdog 🐶
Line 927 in b8305b7
| wqp_sites <- addWQPSites(sumdat, |
[air] reported by reviewdog 🐶
Lines 943 to 953 in b8305b7
| attains_au <- ifelse(any(c( | |
| "ATTAINS line features", | |
| "ATTAINS point features", | |
| "ATTAINS polygon features" | |
| ) %in% overlay_groups), | |
| TRUE, | |
| FALSE | |
| ) | |
| # attains missing | |
| attains_missing <- ifelse("not in ATTAINS" %in% overlay_groups, |
[air] reported by reviewdog 🐶
Line 958 in b8305b7
| # NHD catchments containing ATTAINS features |
[air] reported by reviewdog 🐶
Lines 960 to 963 in b8305b7
| nhd_attains <- ifelse("ATTAINS catchments" %in% overlay_groups, | |
| TRUE, | |
| FALSE | |
| ) |
[air] reported by reviewdog 🐶
Line 967 in b8305b7
| nhd_no_attains <- ifelse("missing ATTAINS catchment outlines" %in% overlay_groups, |
[air] reported by reviewdog 🐶
Line 972 in b8305b7
[air] reported by reviewdog 🐶
Lines 990 to 993 in b8305b7
| map <- addLayerControl( | |
| map = map, | |
| overlay_groups = overlay_groups | |
| ) |
[air] reported by reviewdog 🐶
Lines 528 to 530 in b8305b7
| na.cols <- .data |> | |
| purrr::keep(~ all(is.na(.x))) |> | |
| names() |
[air] reported by reviewdog 🐶
Lines 92 to 93 in b8305b7
| check_inv <- .data[ | |
| , |
[air] reported by reviewdog 🐶
Lines 323 to 325 in b8305b7
| tada.all <- tada.all |> | |
| dplyr::select(-CharUnit) |> | |
| dplyr::distinct() |
[air] reported by reviewdog 🐶
Line 2371 in b8305b7
| .data[[col.name]] <- switch(col.type, |
[air] reported by reviewdog 🐶
Lines 277 to 279 in b8305b7
| do.list <- do.data |> | |
| dplyr::select(ResultIdentifier) |> | |
| dplyr::pull() |
| ), | ||
| data = outsideusa | ||
| ) | ||
| map <- addFlaggedSitesMarkers(outsideusa, |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| map <- addFlaggedSitesMarkers(outsideusa, | |
| map <- addFlaggedSitesMarkers( | |
| outsideusa, |
| map <- addFlaggedSitesMarkers(lowres, | ||
| map = map, | ||
| flag_type = "lowres" | ||
| ) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| map <- addFlaggedSitesMarkers(lowres, | |
| map = map, | |
| flag_type = "lowres" | |
| ) | |
| map <- addFlaggedSitesMarkers(lowres, map = map, flag_type = "lowres") |
| TADA_NearbySitesMap <- function(.data, | ||
| dist_buffer = 100, | ||
| attains = TRUE, | ||
| catchment = FALSE) { |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| TADA_NearbySitesMap <- function(.data, | |
| dist_buffer = 100, | |
| attains = TRUE, | |
| catchment = FALSE) { | |
| TADA_NearbySitesMap <- function( | |
| .data, | |
| dist_buffer = 100, | |
| attains = TRUE, | |
| catchment = FALSE | |
| ) { |
| nearby.cols <- append(nearby.cols, c( | ||
| "ATTAINS.AssessmentUnitIdentifier", | ||
| "TADA.AURefSource" | ||
| )) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| nearby.cols <- append(nearby.cols, c( | |
| "ATTAINS.AssessmentUnitIdentifier", | |
| "TADA.AURefSource" | |
| )) | |
| nearby.cols <- append( | |
| nearby.cols, | |
| c("ATTAINS.AssessmentUnitIdentifier", "TADA.AURefSource") | |
| ) |
| dplyr::select( | ||
| LongitudeMeasure, | ||
| LatitudeMeasure, | ||
| TADA.MonitoringLocationIdentifier, | ||
| MonitoringLocationIdentifier, | ||
| MonitoringLocationName, | ||
| TADA.LatitudeMeasure, | ||
| TADA.LongitudeMeasure, | ||
| OrganizationIdentifier, | ||
| OrganizationFormalName, | ||
| TADA.NearbySiteGroup | ||
| dplyr::all_of(nearby.cols) | ||
| ) |> |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| dplyr::select( | |
| LongitudeMeasure, | |
| LatitudeMeasure, | |
| TADA.MonitoringLocationIdentifier, | |
| MonitoringLocationIdentifier, | |
| MonitoringLocationName, | |
| TADA.LatitudeMeasure, | |
| TADA.LongitudeMeasure, | |
| OrganizationIdentifier, | |
| OrganizationFormalName, | |
| TADA.NearbySiteGroup | |
| dplyr::all_of(nearby.cols) | |
| ) |> | |
| dplyr::select(dplyr::all_of(nearby.cols)) |> |
| silent = TRUE | ||
| ) | ||
|
|
||
|
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| dplyr::filter(assessmentunitidentifier %in% | ||
| unique(TADA_nearby$ATTAINS.AssessmentUnitIdentifier)) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| dplyr::filter(assessmentunitidentifier %in% | |
| unique(TADA_nearby$ATTAINS.AssessmentUnitIdentifier)) | |
| dplyr::filter( | |
| assessmentunitidentifier %in% | |
| unique(TADA_nearby$ATTAINS.AssessmentUnitIdentifier) | |
| ) |
| dplyr::filter(assessmentunitidentifier %in% | ||
| unique(TADA_nearby$ATTAINS.AssessmentUnitIdentifier)) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| dplyr::filter(assessmentunitidentifier %in% | |
| unique(TADA_nearby$ATTAINS.AssessmentUnitIdentifier)) | |
| dplyr::filter( | |
| assessmentunitidentifier %in% | |
| unique(TADA_nearby$ATTAINS.AssessmentUnitIdentifier) | |
| ) |
| icons = images | ||
| ) | ||
|
|
||
|
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| weight = 1, | ||
| # label = ~as.character(TADA.MonitoringLocationIdentifier), | ||
| popup = paste0( | ||
| popup = ~paste0( |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| popup = ~paste0( | |
| popup = ~ paste0( |
Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>
…om/USEPA/EPATADA into 763-updates-to-tada_nearbysitesmap
| } | ||
|
|
||
| #' addAllATTAINS | ||
| #' Internal function to add all ATTAINS assessment units (lines, points, or polygons) or |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
missing these args in documentation: ‘map’ ‘points_layer’ ‘polygons_layer’ ‘lines_layer’ ‘catchment_layer’
‘outline_layer’ ‘missing_raw_layer’
| #' @param .data A data frame created using prepATTAINSMapper (must contain a geometry | ||
| #' column). | ||
| #' | ||
| #' @param overlay_groups Initialized vector to add names of groups added to map. If |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I am not sure what to supply to this function for overlay_groups from reading this documenation. Can it be clarified?
| checkTADAColsForMap(ATTAINS_table, | ||
| attains = TRUE | ||
| ) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| checkTADAColsForMap(ATTAINS_table, | |
| attains = TRUE | |
| ) | |
| checkTADAColsForMap(ATTAINS_table, attains = TRUE) |
| ATTAINS_polygons$assessmentunitidentifier | ||
| ) | ||
| ), | ||
| missing_raw_features <- findATTAINSMissingRawFeatures(ATTAINS_catchments, |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| missing_raw_features <- findATTAINSMissingRawFeatures(ATTAINS_catchments, | |
| missing_raw_features <- findATTAINSMissingRawFeatures( | |
| ATTAINS_catchments, |
Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>
| epsg_codes, | ||
| by = "HorizontalCoordinateReferenceSystemDatumName" | ||
| ) |> |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| epsg_codes, | |
| by = "HorizontalCoordinateReferenceSystemDatumName" | |
| ) |> | |
| epsg_codes, | |
| by = "HorizontalCoordinateReferenceSystemDatumName" | |
| ) |> |
| # if data was spatial, remove for downstream leaflet dev: | ||
| try(ATTAINS_table <- ATTAINS_table |> sf::st_drop_geometry(), silent = TRUE) | ||
| #try( |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # if data was spatial, remove for downstream leaflet dev: | |
| try(ATTAINS_table <- ATTAINS_table |> sf::st_drop_geometry(), silent = TRUE) | |
| #try( | |
| # if data was spatial, remove for downstream leaflet dev: | |
| #try( |
| # create df to assign color based on ATTAINS overall status | ||
| colors <- getATTAINSColorsRef() |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # create df to assign color based on ATTAINS overall status | |
| colors <- getATTAINSColorsRef() | |
| # create df to assign color based on ATTAINS overall status | |
| colors <- getATTAINSColorsRef() |
| dark_col = c(tada.pal[12], tada.pal[6], tada.pal[11]), | ||
| priority = c(1, 2, 3) | ||
| ) | ||
|
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # prep ATTAINS assessment unit features | |
| au_mapper <- prepAllATTAINSMapper( | |
| color_ref = colors, | |
| lines_layer = ATTAINS_lines, | |
| points_layer = ATTAINS_points, | |
| polygons_layer = ATTAINS_polygons | |
| ) | |
| # prep ATTAINS assessment unit features | ||
| au_mapper <- prepAllATTAINSMapper( | ||
| color_ref = colors, | ||
| lines_layer = ATTAINS_lines, | ||
| points_layer = ATTAINS_points, | ||
| polygons_layer = ATTAINS_polygons | ||
| ) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # prep ATTAINS assessment unit features | |
| au_mapper <- prepAllATTAINSMapper( | |
| color_ref = colors, | |
| lines_layer = ATTAINS_lines, | |
| points_layer = ATTAINS_points, | |
| polygons_layer = ATTAINS_polygons | |
| ) | |
| # CATCHMENT FEATURES - try to pull missing feature AU data if it exists. Otherwise, move on... | |
| try( | |
| missing_raw_mapper <- missing_raw_features |> | |
| dplyr::left_join(colors, by = "overallstatus") |> | |
| dplyr::mutate(type = "Raw Feature Unavailable"), | |
| silent = TRUE | |
| ) |
| ) | ||
|
|
||
| leg.labels <- c(attains.labels, wqp.labels, catch.labels) | ||
|
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| nhd_no_attains <- ifelse( | |
| "missing ATTAINS catchment outlines" %in% overlay_groups, | |
| TRUE, | |
| FALSE | |
| ) | |
| # add TADA custom legend to map | ||
| map <- addTADAMapLegend( | ||
| map = map, | ||
| icons = images, | ||
| icon_labels = img.labels, | ||
| wqp = TRUE, | ||
| ref_icons = ref_icons, | ||
| attains_au = attains_au, | ||
| attains_missing = attains_missing, | ||
| nhd_attains = nhd_attains, | ||
| nhd_no_attains = nhd_no_attains | ||
| ) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # add TADA custom legend to map | |
| map <- addTADAMapLegend( | |
| map = map, | |
| icons = images, | |
| icon_labels = img.labels, | |
| wqp = TRUE, | |
| ref_icons = ref_icons, | |
| attains_au = attains_au, | |
| attains_missing = attains_missing, | |
| nhd_attains = nhd_attains, | |
| nhd_no_attains = nhd_no_attains | |
| ) | |
| # add TADA custom legend to map | |
| map <- addTADAMapLegend( | |
| map = map, | |
| icons = images, | |
| icon_labels = img.labels, | |
| wqp = TRUE, | |
| ref_icons = ref_icons, | |
| attains_au = attains_au, | |
| attains_missing = attains_missing, | |
| nhd_attains = nhd_attains, | |
| nhd_no_attains = nhd_no_attains | |
| ) |
| # add button to toggle map legend on/off | ||
| map <- addLegendToggle(map = map) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # add button to toggle map legend on/off | |
| map <- addLegendToggle(map = map) | |
| # add button to toggle map legend on/off | |
| map <- addLegendToggle(map = map) |
| # add layer control to map | ||
| map <- addLayerControl( | ||
| map = map, | ||
| overlay_groups = overlay_groups | ||
| ) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # add layer control to map | |
| map <- addLayerControl( | |
| map = map, | |
| overlay_groups = overlay_groups | |
| ) | |
| # add layer control to map | |
| map <- addLayerControl(map = map, overlay_groups = overlay_groups) |
| # remove intermediate objects | ||
| rm(images.ref, leg.labels) | ||
| # add button to toggle map legend on/off | ||
| map <- htmlwidgets::onRender( | ||
| map, | ||
| " | ||
| function(el, x) { | ||
| var button = document.createElement('button'); | ||
| button.innerHTML = 'Toggle Legend'; | ||
| button.style.position = 'absolute'; | ||
| button.style.top = '10px'; | ||
| button.style.right = '10px'; // Positioning in the top-right corner | ||
| button.style.zIndex = 1000; | ||
| button.style.padding = '5px 10px'; | ||
| button.style.backgroundColor = '#fff'; | ||
| button.style.border = '1px solid #ccc'; | ||
| button.style.borderRadius = '4px'; | ||
| button.onclick = function() { | ||
| var legend = el.querySelector('.leaflet-control.legend'); // Adjust this selector to target the legend only | ||
| if (legend) { | ||
| if (legend.style.display === 'none') { | ||
| legend.style.display = 'block'; | ||
| } else { | ||
| legend.style.display = 'none'; | ||
| } | ||
| } | ||
| }; | ||
| el.appendChild(button); | ||
| } | ||
| " | ||
| ) | ||
| # add layer control to map | ||
| if (length(overlay_groups) > 0) { | ||
| overlay_groups <- unique(overlay_groups) | ||
| map <- map |> | ||
| leaflet::addLayersControl( | ||
| baseGroups = c("World topo"), # Always include a base group | ||
| overlayGroups = overlay_groups, | ||
| position = "bottomleft", | ||
| options = leaflet::layersControlOptions(collapsed = TRUE) | ||
| ) | ||
| } | ||
| rm(sumdat, overlay_groups) | ||
| # Return leaflet map of TADA WQ and its associated ATTAINS data | ||
| return(map) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
| # remove intermediate objects | |
| rm(images.ref, leg.labels) | |
| # add button to toggle map legend on/off | |
| map <- htmlwidgets::onRender( | |
| map, | |
| " | |
| function(el, x) { | |
| var button = document.createElement('button'); | |
| button.innerHTML = 'Toggle Legend'; | |
| button.style.position = 'absolute'; | |
| button.style.top = '10px'; | |
| button.style.right = '10px'; // Positioning in the top-right corner | |
| button.style.zIndex = 1000; | |
| button.style.padding = '5px 10px'; | |
| button.style.backgroundColor = '#fff'; | |
| button.style.border = '1px solid #ccc'; | |
| button.style.borderRadius = '4px'; | |
| button.onclick = function() { | |
| var legend = el.querySelector('.leaflet-control.legend'); // Adjust this selector to target the legend only | |
| if (legend) { | |
| if (legend.style.display === 'none') { | |
| legend.style.display = 'block'; | |
| } else { | |
| legend.style.display = 'none'; | |
| } | |
| } | |
| }; | |
| el.appendChild(button); | |
| } | |
| " | |
| ) | |
| # add layer control to map | |
| if (length(overlay_groups) > 0) { | |
| overlay_groups <- unique(overlay_groups) | |
| map <- map |> | |
| leaflet::addLayersControl( | |
| baseGroups = c("World topo"), # Always include a base group | |
| overlayGroups = overlay_groups, | |
| position = "bottomleft", | |
| options = leaflet::layersControlOptions(collapsed = TRUE) | |
| ) | |
| } | |
| rm(sumdat, overlay_groups) | |
| # Return leaflet map of TADA WQ and its associated ATTAINS data | |
| return(map) | |
| # remove intermediate objects | |
| rm(sumdat, overlay_groups) | |
| # Return leaflet map of TADA WQ and its associated ATTAINS data | |
| return(map) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
EPATADA/R/GeospatialFunctions.R
Lines 2193 to 2216 in 08a4446
| if(nrow(catchments) > 0) { | |
| # get one catchment per WQP location | |
| catchments.cw <- filt.data |> | |
| dplyr::select( | |
| TADA.MonitoringLocationIdentifier, | |
| TADA.LatitudeMeasure, | |
| TADA.LongitudeMeasure, | |
| HorizontalCoordinateReferenceSystemDatumName | |
| ) |> | |
| dplyr::distinct() |> | |
| TADA_MakeSpatial() |> | |
| sf::st_join(catchments, join = sf::st_nearest_feature) |> | |
| dplyr::group_by(TADA.MonitoringLocationIdentifier) |> | |
| dplyr::mutate(catchCount = dplyr::n()) |> | |
| dplyr::select(TADA.MonitoringLocationIdentifier, nhdplusid) |> | |
| dplyr::distinct() |> | |
| sf::st_drop_geometry() | |
| catchments.filt <- catchments |> | |
| dplyr::filter(nhdplusid %in% catchments.cw$nhdplusid) | |
| catchments.no.geo <- catchments |> | |
| sf::st_drop_geometry() |> | |
| dplyr::distinct() |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
EPATADA/R/GeospatialFunctions.R
Lines 2218 to 2225 in 08a4446
| try( | |
| catchments <- catchments.filt |> | |
| dplyr::left_join( | |
| water_types, | |
| by = c("assessmentunitidentifier" = "assessmentUnitId") | |
| ), | |
| silent = TRUE | |
| ) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
[air] reported by reviewdog 🐶
Lines 806 to 812 in 08a4446
| # CATCHMENT FEATURES - try to pull missing feature AU data if it exists. Otherwise, move on... | |
| try( | |
| missing_raw_mapper <- missing_raw_features |> | |
| dplyr::left_join(colors, by = "overallstatus") |> | |
| dplyr::mutate(type = "Raw Feature Unavailable"), | |
| silent = TRUE | |
| ) |
This PR creates internal functions for preparing and adding ATTAINS geospatial data to TADA leaflet maps. It also (optionally) adds ATTAINS geospatial data to TADA_FindNearbySites.
I plan to do some additional refining of the internal functions, but wanted to get these current, working versions added to the develop branch.
Pull Request Checklist
Preparation
Update your branch from the latest
developand resolve any merge conflictsBefore creating a pull request trigger the format-update GitHub Action on your branch to format the code
Documentation
Add/update inline and/or block comments to clarify complexity, context and intent
Add/update function documentation (roxygen), include working examples, build docs locally using devtools::document(), and inspect added/updated help pages for content and format
Add/update vignettes for corresponding changes in functionality, list these under articles in _pkgdown.yml, and ensure added/updated vignettes run and build with proper formatting locally
Maintenance & Data Refresh
Add new dependencies to
DESCRIPTIONand document appropriatelyRun spelling maintenance in
requiredMaintenance.RIf changes affect other package or the shiny app functions, update those impacted functions accordingly
If columns were added/updated, add/update them in
RequiredCols.RRun
.TADA_UpdateRefFiles()and.TADA_UpdateExampleData()locally viaMaintenanceScheduled.Ror trigger the Component File Update GitHub ActionIf new example data files were added, document them in
ExampleData.Rand include them inMaintenanceScheduled.Rfor regular refreshTests and checks
Add/update tests in
tests/testthatto cover changesRun
devtools::test()to verify new and existing tests passRun
devtools::check()and address any errors, warnings or notesPull Request Description
Includes a summary of the changes made
Includes relevant context/motivation
Includes links to related issues or pull requests (keywords like "Closes #issue_number" automatically close related issues when pull request is merged)
Review
Review the bot-commented coverage-report generated by test-coverage to confirm all changes are covered by tests
Review/accept any bot-suggested format changes
Request review from at least one developer team member