From 00eefaa4288f20653b22997072e1df8c8bb17e27 Mon Sep 17 00:00:00 2001 From: fawda123 Date: Fri, 25 Oct 2024 09:49:47 -0400 Subject: [PATCH] add area to map popup for show_fibmatmap, show_fibmap, show_enteromap --- DESCRIPTION | 2 +- R/anlz_enteromap.R | 2 +- R/anlz_fibmap.R | 2 +- R/show_fibmatmap.R | 30 +++++++++++++++++++----------- 4 files changed, 22 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 653a9001..56554037 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: tbeptools Title: Data and Indicators for the Tampa Bay Estuary Program Version: 3.0.0.9000 -Date: 2024-10-20 +Date: 2024-10-25 Authors@R: c( person(given = "Marcus", family = "Beck", diff --git a/R/anlz_enteromap.R b/R/anlz_enteromap.R index ac31433e..88c19935 100644 --- a/R/anlz_enteromap.R +++ b/R/anlz_enteromap.R @@ -134,7 +134,7 @@ anlz_enteromap <- function (fibdata, yrsel = NULL, mosel = NULL, areasel = NULL, out <- tomap %>% dplyr::mutate( grp = factor(grp, levels = levs), - lab = paste0('Station Number: ', station, '
Sample Condition: ', wet_sample, '
Category: ', cat, ' (', conc, '/100mL)') + lab = paste0('Station Number: ', station, '
Area: ', long_name, '
Sample Condition: ', wet_sample, '
Category: ', cat, ' (', conc, '/100mL)') ) %>% dplyr::select(-colnm, -indnm) diff --git a/R/anlz_fibmap.R b/R/anlz_fibmap.R index b56609ee..0096f276 100644 --- a/R/anlz_fibmap.R +++ b/R/anlz_fibmap.R @@ -179,7 +179,7 @@ anlz_fibmap <- function(fibdata, yrsel = NULL, mosel = NULL, areasel = NULL, ass out <- tomap %>% dplyr::mutate( grp = factor(grp, levels = levs), - lab = paste0('Station Number: ', station, '
Class: ', cls, ' (', ind, ')
Category: ', cat, ' (', conc, '/100mL)') + lab = paste0('Station Number: ', station, '
Area: ', area, '
Class: ', cls, ' (', ind, ')
Category: ', cat, ' (', conc, '/100mL)') ) %>% dplyr::select(-colnm, -indnm) diff --git a/R/show_fibmatmap.R b/R/show_fibmatmap.R index 053ba5bb..7cd93d23 100644 --- a/R/show_fibmatmap.R +++ b/R/show_fibmatmap.R @@ -65,17 +65,17 @@ show_fibmatmap <- function(fibdata, yrsel, areasel, indic, threshold = NULL, dplyr::filter(yr == !!yrsel) %>% dplyr::inner_join(tbsegdetail, ., by = c('bay_segment' = 'grp')) %>% dplyr::mutate( - lab = paste0('Bay segment: ', long_name, '
Category: ', cat), + lab = paste0('Area: ', long_name, '
Category: ', cat), col = as.character(cols[cat]) ) stas <- fibdata %>% dplyr::filter(bay_segment %in% !!areasel) %>% dplyr::filter(yr <= !!yrsel & yr >= (!!yrsel - !!lagyr)) %>% - dplyr::pull(station) %>% - unique() + dplyr::select(grp = station, area = long_name) %>% + dplyr::distinct() - tomapsta <- anlz_fibmatrix(fibdata, yrrng = c(yrsel - lagyr, yrsel), stas = stas, bay_segment = NULL, + tomapsta <- anlz_fibmatrix(fibdata, yrrng = c(yrsel - lagyr, yrsel), stas = stas$grp, bay_segment = NULL, indic = indic, threshold = threshold, lagyr = lagyr, subset_wetdry = subset_wetdry, precipdata = precipdata, temporal_window = temporal_window, wet_threshold = wet_threshold, @@ -99,10 +99,10 @@ show_fibmatmap <- function(fibdata, yrsel, areasel, indic, threshold = NULL, stas <- fibdata %>% dplyr::filter(area %in% !!areasel) %>% dplyr::filter(yr <= !!yrsel & yr >= (!!yrsel - !!lagyr)) %>% - dplyr::pull(epchc_station) %>% - unique() + dplyr::select(grp = epchc_station, area) %>% + dplyr::distinct() - tomapsta <- anlz_fibmatrix(fibdata, yrrng = c(yrsel - lagyr, yrsel), stas = stas, bay_segment = NULL, + tomapsta <- anlz_fibmatrix(fibdata, yrrng = c(yrsel - lagyr, yrsel), stas = stas$grp, bay_segment = NULL, indic = indic, threshold = threshold, lagyr = lagyr, subset_wetdry = subset_wetdry, precipdata = precipdata, temporal_window = temporal_window, wet_threshold = wet_threshold, @@ -128,10 +128,10 @@ show_fibmatmap <- function(fibdata, yrsel, areasel, indic, threshold = NULL, stas <- fibdata %>% dplyr::filter(area %in% !!areasel) %>% dplyr::filter(yr <= !!yrsel & yr >= (!!yrsel - !!lagyr)) %>% - dplyr::pull(manco_station) %>% - unique() + dplyr::select(grp = manco_station, area) %>% + dplyr::distinct() - tomapsta <- anlz_fibmatrix(fibdata, yrrng = c(yrsel - lagyr, yrsel), stas = stas, bay_segment = NULL, + tomapsta <- anlz_fibmatrix(fibdata, yrrng = c(yrsel - lagyr, yrsel), stas = stas$grp, bay_segment = NULL, indic = indic, threshold = threshold, lagyr = lagyr, subset_wetdry = subset_wetdry, precipdata = precipdata, temporal_window = temporal_window, wet_threshold = wet_threshold, @@ -147,14 +147,22 @@ show_fibmatmap <- function(fibdata, yrsel, areasel, indic, threshold = NULL, # FIB levels levs <- util_fiblevs() + # make character to join + stas <- stas %>% + dplyr::mutate( + grp = as.character(grp) + ) + # subset year, remove NA cat, add labels tomapsta <- tomapsta %>% dplyr::filter(!is.na(cat)) %>% dplyr::filter(yr == !!yrsel) %>% + dplyr::mutate(grp = as.character(grp)) %>% + dplyr::left_join(stas, by = 'grp') %>% sf::st_as_sf(coords = c("Longitude", "Latitude"), crs = 4326, remove = FALSE) %>% dplyr::mutate( cat = factor(cat, levels = levs$fibmatlev), - lab = paste0('Station Number: ', grp, '
Category: ', cat) + lab = paste0('Station Number: ', grp, '
Area: ', area, '
Category: ', cat) ) # return data instead of leaflet