From a17635b658b45dcfa792cbb6989a32b840c3e01b Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Mon, 4 Mar 2024 14:05:54 -0500 Subject: [PATCH 1/8] Update Figures.R Add bin # options --- R/Figures.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/R/Figures.R b/R/Figures.R index 8d7e7b58..64007462 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -418,9 +418,17 @@ TADA_OverviewMap <- function(.data) { site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) + + bins_n <- dplyr::case_when(max(sumdat$Parameter_Count) == 1 ~ 1, + max(sumdat$Parameter_Count) == 2 ~ 2, + max(sumdat$Parameter_Count) == 3 ~ 3, + max(sumdat$Parameter_Count) == 4 ~ 4, + max(sumdat$Parameter_Count) > 4 ~ 5) + pal <- leaflet::colorBin( palette = "Blues", - domain = sumdat$Parameter_Count + domain = sumdat$Parameter_Count, + n = bins_n ) # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset From aa5052ed21a93c2a4a116f433ac63b89e4060782 Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Mon, 4 Mar 2024 14:58:08 -0500 Subject: [PATCH 2/8] Update Figures.R --- R/Figures.R | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/R/Figures.R b/R/Figures.R index 64007462..766c74a4 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -425,11 +425,31 @@ TADA_OverviewMap <- function(.data) { max(sumdat$Parameter_Count) == 4 ~ 4, max(sumdat$Parameter_Count) > 4 ~ 5) + + if (bins_n < 5) { + values_cut <- dplyr::case_when(bins_n == 1 ~ c(0,1), + bins_n == 2 ~ c(0,1,2), + bins_n == 3 ~ c(0,1,2,3), + bins_n == 4 ~ c(0,1,2,3,4), + bins_n == 5 ~ c(0,1,2,3,4,5)) + sumdat %>% + dplyr::mutate(bins_cat = cut(Parameter_Count, breaks = c(0,1,2))) + + + pal <- + + } + + if (bins_n >= 5) { + pal <- leaflet::colorBin( palette = "Blues", domain = sumdat$Parameter_Count, - n = bins_n + 2 ) + } + + # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset # They can be toggled on and off using a button (all layers work together and can't be turned on/off individually). From b53c20feb5db5cb324b83b5ffd207356ce429faf Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Mon, 4 Mar 2024 15:42:01 -0500 Subject: [PATCH 3/8] Update Figures.R --- R/Figures.R | 35 ++++++----------------------------- 1 file changed, 6 insertions(+), 29 deletions(-) diff --git a/R/Figures.R b/R/Figures.R index 766c74a4..5372a1be 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -417,38 +417,15 @@ TADA_OverviewMap <- function(.data) { site_size <- data.frame(Sample_n = pt_labels, Point_size = c(5, 10, 15, 20, 30)) site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) - - - bins_n <- dplyr::case_when(max(sumdat$Parameter_Count) == 1 ~ 1, - max(sumdat$Parameter_Count) == 2 ~ 2, - max(sumdat$Parameter_Count) == 3 ~ 3, - max(sumdat$Parameter_Count) == 4 ~ 4, - max(sumdat$Parameter_Count) > 4 ~ 5) - - if (bins_n < 5) { - values_cut <- dplyr::case_when(bins_n == 1 ~ c(0,1), - bins_n == 2 ~ c(0,1,2), - bins_n == 3 ~ c(0,1,2,3), - bins_n == 4 ~ c(0,1,2,3,4), - bins_n == 5 ~ c(0,1,2,3,4,5)) - sumdat %>% - dplyr::mutate(bins_cat = cut(Parameter_Count, breaks = c(0,1,2))) - - - pal <- - - } - - if (bins_n >= 5) { + # set breaks to occur only at integers + pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) + # set color palette pal <- leaflet::colorBin( - palette = "Blues", - domain = sumdat$Parameter_Count, - 2 - ) - } - + palette = "Blues", + bins = pretty.breaks + ) # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset From 4821cb5e8bfc6122e8105806d836fcd7424979f3 Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Tue, 5 Mar 2024 08:53:07 -0500 Subject: [PATCH 4/8] Update Figures.R --- R/Figures.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/Figures.R b/R/Figures.R index a969217d..fdfc7d98 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -419,7 +419,8 @@ TADA_OverviewMap <- function(.data) { site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) # set breaks to occur only at integers - pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) + #pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) + pretty.breaks <- unique(pretty(sumdat$Parameter_Count)) # set color palette pal <- leaflet::colorBin( From e19002a91a4918f463d23fa1df4c25dda110c401 Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Tue, 5 Mar 2024 09:20:46 -0500 Subject: [PATCH 5/8] Update Figures.R --- R/Figures.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/Figures.R b/R/Figures.R index fdfc7d98..5372a1be 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -399,7 +399,7 @@ TADA_OverviewMap <- function(.data) { dplyr::group_by(MonitoringLocationIdentifier, MonitoringLocationName, TADA.LatitudeMeasure, TADA.LongitudeMeasure) %>% dplyr::summarise("Sample_Count" = length(unique(ResultIdentifier)), "Visit_Count" = length(unique(ActivityStartDate)), "Parameter_Count" = length(unique(TADA.CharacteristicName)), "Organization_Count" = length(unique(OrganizationIdentifier))) - pt_sizes <- round(unique(stats::quantile(sumdat$Sample_Count, probs = c(0.1, 0.25, 0.5, 0.75)), 0)) + pt_sizes <- round(stats::quantile(sumdat$Sample_Count, probs = c(0.1, 0.25, 0.5, 0.75)), 0) pt_labels <- c( paste0("<=", pt_sizes[1]), paste0(">", pt_sizes[1]), @@ -419,8 +419,7 @@ TADA_OverviewMap <- function(.data) { site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) # set breaks to occur only at integers - #pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) - pretty.breaks <- unique(pretty(sumdat$Parameter_Count)) + pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) # set color palette pal <- leaflet::colorBin( From ea7348b15b6010ac2cbdfe276217b7aefb313fae Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Tue, 5 Mar 2024 09:21:07 -0500 Subject: [PATCH 6/8] Update Figures.R --- R/Figures.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/Figures.R b/R/Figures.R index 5372a1be..61d3f476 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -427,7 +427,6 @@ TADA_OverviewMap <- function(.data) { bins = pretty.breaks ) - # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset # They can be toggled on and off using a button (all layers work together and can't be turned on/off individually). # Colors and icons are as discussed previously (orange/tan colors and open triangle icons for points) but can be changed to match HMW if desired. From 2981ba265558998e268f23a824ba2c2c4763a3e3 Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Tue, 5 Mar 2024 11:14:28 -0500 Subject: [PATCH 7/8] Update Figures.R --- R/Figures.R | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/R/Figures.R b/R/Figures.R index 61d3f476..f0548339 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -398,6 +398,10 @@ TADA_OverviewMap <- function(.data) { sumdat <- .data %>% dplyr::group_by(MonitoringLocationIdentifier, MonitoringLocationName, TADA.LatitudeMeasure, TADA.LongitudeMeasure) %>% dplyr::summarise("Sample_Count" = length(unique(ResultIdentifier)), "Visit_Count" = length(unique(ActivityStartDate)), "Parameter_Count" = length(unique(TADA.CharacteristicName)), "Organization_Count" = length(unique(OrganizationIdentifier))) + + param_counts <- sort(unique(sumdat$Parameter_Count)) + param_length <- length(param_counts) + param_diff <- diff(param_counts) pt_sizes <- round(stats::quantile(sumdat$Sample_Count, probs = c(0.1, 0.25, 0.5, 0.75)), 0) pt_labels <- c( @@ -418,14 +422,27 @@ TADA_OverviewMap <- function(.data) { site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) - # set breaks to occur only at integers - pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) + # set color palette - pal <- leaflet::colorBin( - palette = "Blues", - bins = pretty.breaks - ) + if (length(unique(param_diff)) == 1 & param_length < 10) { + + pal <- leaflet::colorFactor( + palette = "Blues", + levels = param_counts + ) + } + + else { + + # set breaks to occur only at integers + pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) + + pal <- leaflet::colorBin( + palette = "Blues", + bins = pretty.breaks + ) + } # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset # They can be toggled on and off using a button (all layers work together and can't be turned on/off individually). From 4b474623141bd6f253aac7e0fdf11e61c1329ff7 Mon Sep 17 00:00:00 2001 From: hillarymarler Date: Tue, 5 Mar 2024 11:15:47 -0500 Subject: [PATCH 8/8] Update Figures.R --- R/Figures.R | 32 ++++++++++++++------------------ 1 file changed, 14 insertions(+), 18 deletions(-) diff --git a/R/Figures.R b/R/Figures.R index f0548339..61334335 100644 --- a/R/Figures.R +++ b/R/Figures.R @@ -398,7 +398,7 @@ TADA_OverviewMap <- function(.data) { sumdat <- .data %>% dplyr::group_by(MonitoringLocationIdentifier, MonitoringLocationName, TADA.LatitudeMeasure, TADA.LongitudeMeasure) %>% dplyr::summarise("Sample_Count" = length(unique(ResultIdentifier)), "Visit_Count" = length(unique(ActivityStartDate)), "Parameter_Count" = length(unique(TADA.CharacteristicName)), "Organization_Count" = length(unique(OrganizationIdentifier))) - + param_counts <- sort(unique(sumdat$Parameter_Count)) param_length <- length(param_counts) param_diff <- diff(param_counts) @@ -421,29 +421,25 @@ TADA_OverviewMap <- function(.data) { site_size <- data.frame(Sample_n = pt_labels, Point_size = c(5, 10, 15, 20, 30)) site_legend <- subset(site_size, site_size$Point_size %in% unique(sumdat$radius)) - - - + + + # set color palette if (length(unique(param_diff)) == 1 & param_length < 10) { - pal <- leaflet::colorFactor( palette = "Blues", levels = param_counts - ) + ) + } else { + # set breaks to occur only at integers + pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) + + pal <- leaflet::colorBin( + palette = "Blues", + bins = pretty.breaks + ) } - - else { - - # set breaks to occur only at integers - pretty.breaks <- unique(round(pretty(sumdat$Parameter_Count))) - - pal <- leaflet::colorBin( - palette = "Blues", - bins = pretty.breaks - ) - } - + # Tribal layers will load by default in the overview map, restricted by the bounding box of the current dataset # They can be toggled on and off using a button (all layers work together and can't be turned on/off individually). # Colors and icons are as discussed previously (orange/tan colors and open triangle icons for points) but can be changed to match HMW if desired.