From cc0a49be5711b67f35f239bfcb9144a8ead49e41 Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 15:12:20 -0500 Subject: [PATCH 1/9] Respect color range min_value and max_value Respect supplied color range min_value and max_value even when data is zero-variance, such as single-row tables. --- R/color_tiles.R | 24 ++++-------------------- 1 file changed, 4 insertions(+), 20 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index 60d141bd..4fa1489c 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -482,26 +482,10 @@ color_tiles <- function(data, } else { - # standard normalization (no variance check) - if (is.numeric(value) & mean((data[[name]] - mean(data[[name]], na.rm=TRUE)) ^ 2, na.rm=TRUE) == 0) { - - normalized <- 1 - - } else { - - # user supplied min and max values - if (is.null(min_value)) { - min_value_normal <- min(data[[name]], na.rm = TRUE) - } else { min_value_normal <- min_value } - - if (is.null(max_value)) { - max_value_normal <- max(data[[name]], na.rm = TRUE) - } else { max_value_normal <- max_value } - - # standard normalization - normalized <- (value - min_value_normal) / (max_value_normal - min_value_normal) - - } + effective_min_value <- coalesce(c(min_value, min(data[[name]], na.rm = TRUE))) + effective_max_value <- coalesce(c(max_value, max(data[[name]], na.rm = TRUE))) + range <- effective_max_value - effective_min_value + normalized <- if (range > 0) (value - min_value_normal) / range else 1 if (!is.null(min_value) & isTRUE(min_value > min(data[[name]], na.rm = TRUE))) { From c4bb01a49e0249f2e8e60f34a15e99d164a96403 Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 15:19:31 -0500 Subject: [PATCH 2/9] Ensure range checking occurs before normalization --- R/color_tiles.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index 4fa1489c..a79984b8 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -482,11 +482,6 @@ color_tiles <- function(data, } else { - effective_min_value <- coalesce(c(min_value, min(data[[name]], na.rm = TRUE))) - effective_max_value <- coalesce(c(max_value, max(data[[name]], na.rm = TRUE))) - range <- effective_max_value - effective_min_value - normalized <- if (range > 0) (value - min_value_normal) / range else 1 - if (!is.null(min_value) & isTRUE(min_value > min(data[[name]], na.rm = TRUE))) { stop("`min_value` must be less than the minimum value observed in the data") @@ -496,7 +491,12 @@ color_tiles <- function(data, stop("`max_value` must be greater than the maximum value observed in the data") } - + + effective_min_value <- coalesce(c(min_value, min(data[[name]], na.rm = TRUE))) + effective_max_value <- coalesce(c(max_value, max(data[[name]], na.rm = TRUE))) + range <- effective_max_value - effective_min_value + normalized <- if (range > 0) (value - min_value_normal) / range else 1 + cell_color <- color_pal(normalized) cell_color <- suppressWarnings(grDevices::adjustcolor(cell_color, alpha.f = opacity)) font_color <- assign_color(normalized) From aedec5f990195842baba86fe26e3aa36fb7e7e8d Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 15:29:31 -0500 Subject: [PATCH 3/9] Update color_tiles.R --- R/color_tiles.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index a79984b8..078af577 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -492,8 +492,9 @@ color_tiles <- function(data, stop("`max_value` must be greater than the maximum value observed in the data") } - effective_min_value <- coalesce(c(min_value, min(data[[name]], na.rm = TRUE))) - effective_max_value <- coalesce(c(max_value, max(data[[name]], na.rm = TRUE))) + null_replace <- function(a, b) if (is.null(a)) b else a + effective_min_value <- null_replace(min_value, min(data[[name]], na.rm = TRUE))) + effective_max_value <- null_replace(max_value, max(data[[name]], na.rm = TRUE))) range <- effective_max_value - effective_min_value normalized <- if (range > 0) (value - min_value_normal) / range else 1 From 4a0700eae41aa7c8ea42fa7c530989045fec8327 Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 15:32:54 -0500 Subject: [PATCH 4/9] Syntax fix --- R/color_tiles.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index 078af577..0ebddf47 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -493,8 +493,8 @@ color_tiles <- function(data, } null_replace <- function(a, b) if (is.null(a)) b else a - effective_min_value <- null_replace(min_value, min(data[[name]], na.rm = TRUE))) - effective_max_value <- null_replace(max_value, max(data[[name]], na.rm = TRUE))) + effective_min_value <- null_replace(min_value, min(data[[name]], na.rm = TRUE)) + effective_max_value <- null_replace(max_value, max(data[[name]], na.rm = TRUE)) range <- effective_max_value - effective_min_value normalized <- if (range > 0) (value - min_value_normal) / range else 1 From 878bb251798f457293db8f59c8fa6f1547179955 Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 15:36:24 -0500 Subject: [PATCH 5/9] Fix renamed variable --- R/color_tiles.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index 0ebddf47..5424844f 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -496,7 +496,7 @@ color_tiles <- function(data, effective_min_value <- null_replace(min_value, min(data[[name]], na.rm = TRUE)) effective_max_value <- null_replace(max_value, max(data[[name]], na.rm = TRUE)) range <- effective_max_value - effective_min_value - normalized <- if (range > 0) (value - min_value_normal) / range else 1 + normalized <- if (range > 0) (value - effective_min_value) / range else 1 cell_color <- color_pal(normalized) cell_color <- suppressWarnings(grDevices::adjustcolor(cell_color, alpha.f = opacity)) From 2521a9511737c573512c171ae5b991d0bc2dcfe8 Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 15:47:26 -0500 Subject: [PATCH 6/9] Copy fix to similar section --- R/color_tiles.R | 26 +++++++------------------- 1 file changed, 7 insertions(+), 19 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index 5424844f..4588fd1d 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -451,25 +451,12 @@ color_tiles <- function(data, if (is.character(color_by)) { color_by <- which(names(data) %in% color_by) } - # if there is no variance in the column, assign the same color to each value - if (is.numeric(data[[color_by]]) & mean((data[[color_by]] - mean(data[[color_by]], na.rm=TRUE)) ^ 2, na.rm=TRUE) == 0) { - - normalized <- 1 - - } else { - - # user supplied min and max values - if (is.null(min_value)) { - min_value_color_by <- min(data[[color_by]], na.rm = TRUE) - } else { min_value_color_by <- min_value } - - if (is.null(max_value)) { - max_value_color_by <- max(data[[color_by]], na.rm = TRUE) - } else { max_value_color_by <- max_value } - - normalized <- (data[[color_by]][index] - min_value_color_by) / (max_value_color_by - min_value_color_by) - - } + # utilize min and and max values if supplied, otherwise use data extents + null_replace <- function(a, b) if (is.null(a)) b else a + effective_min_value <- null_replace(min_value, min(data[[color_by]], na.rm = TRUE)) + effective_max_value <- null_replace(max_value, max(data[[color_by]], na.rm = TRUE)) + range <- effective_max_value - effective_min_value + normalized <- if (range > 0) (data[[color_by]][index] - effective_min_value) / range else 1 cell_color <- color_pal(normalized) cell_color <- suppressWarnings(grDevices::adjustcolor(cell_color, alpha.f = opacity)) @@ -492,6 +479,7 @@ color_tiles <- function(data, stop("`max_value` must be greater than the maximum value observed in the data") } + # utilize min and and max values if supplied, otherwise use data extents null_replace <- function(a, b) if (is.null(a)) b else a effective_min_value <- null_replace(min_value, min(data[[name]], na.rm = TRUE)) effective_max_value <- null_replace(max_value, max(data[[name]], na.rm = TRUE)) From 2d7ed9a60e14c304ac21f6a3206910ceb425d46b Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 19:11:52 -0500 Subject: [PATCH 7/9] Allow data values to exceed color extents Clamp extreme data values to the extreme colors, rather than failing --- R/color_tiles.R | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index 4588fd1d..6ec0dbb6 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -457,6 +457,9 @@ color_tiles <- function(data, effective_max_value <- null_replace(max_value, max(data[[color_by]], na.rm = TRUE)) range <- effective_max_value - effective_min_value normalized <- if (range > 0) (data[[color_by]][index] - effective_min_value) / range else 1 + # clamp data to valid range. this can occur with user-provided range values + pclamp <- function(x, lower, upper) pmax(pmin(x, upper), lower) + normalized <- pclamp(normalized, 0, 1) cell_color <- color_pal(normalized) cell_color <- suppressWarnings(grDevices::adjustcolor(cell_color, alpha.f = opacity)) @@ -468,16 +471,6 @@ color_tiles <- function(data, } } else { - - if (!is.null(min_value) & isTRUE(min_value > min(data[[name]], na.rm = TRUE))) { - - stop("`min_value` must be less than the minimum value observed in the data") - } - - if (!is.null(max_value) & isTRUE(max_value < max(data[[name]], na.rm = TRUE))) { - - stop("`max_value` must be greater than the maximum value observed in the data") - } # utilize min and and max values if supplied, otherwise use data extents null_replace <- function(a, b) if (is.null(a)) b else a @@ -485,6 +478,10 @@ color_tiles <- function(data, effective_max_value <- null_replace(max_value, max(data[[name]], na.rm = TRUE)) range <- effective_max_value - effective_min_value normalized <- if (range > 0) (value - effective_min_value) / range else 1 + # clamp data to valid range. this can occur with user-provided range values + pclamp <- function(x, lower, upper) pmax(pmin(x, upper), lower) + normalized <- pclamp(normalized, 0, 1) + cell_color <- color_pal(normalized) cell_color <- suppressWarnings(grDevices::adjustcolor(cell_color, alpha.f = opacity)) From 5c4d9fc53418a86949cc300794dd7320494776fc Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 23:47:57 -0500 Subject: [PATCH 8/9] Update docs to reflect clamping behavior --- R/color_tiles.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index 6ec0dbb6..bcc66ffd 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -41,13 +41,9 @@ #' Default is NULL. #' #' @param min_value The minimum value used for the color assignments. -#' This value must expand the range of the data within the column. -#' Therefore, the value must be less than or equal to the minimum value within the column. #' Default is NULL. #' #' @param max_value The maximum value used for the color assignments. -#' This value must expand the range of the data within the column. -#' Therefore, the value must be greater than or equal to the maximum value within the column. #' Default is NULL. #' #' @param even_breaks Logical: if TRUE, the colors will be assigned to values in distinct quantile bins rather than on a normalized scale. From bc70309b1616517773c96f3c5ed134bb165b2818 Mon Sep 17 00:00:00 2001 From: mdoucleff <63509019+mdoucleff@users.noreply.github.com> Date: Thu, 3 Nov 2022 23:59:50 -0500 Subject: [PATCH 9/9] Reduce total change size Retain existing styling --- R/color_tiles.R | 50 ++++++++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 19 deletions(-) diff --git a/R/color_tiles.R b/R/color_tiles.R index bcc66ffd..8f8e9866 100644 --- a/R/color_tiles.R +++ b/R/color_tiles.R @@ -447,15 +447,22 @@ color_tiles <- function(data, if (is.character(color_by)) { color_by <- which(names(data) %in% color_by) } - # utilize min and and max values if supplied, otherwise use data extents - null_replace <- function(a, b) if (is.null(a)) b else a - effective_min_value <- null_replace(min_value, min(data[[color_by]], na.rm = TRUE)) - effective_max_value <- null_replace(max_value, max(data[[color_by]], na.rm = TRUE)) - range <- effective_max_value - effective_min_value - normalized <- if (range > 0) (data[[color_by]][index] - effective_min_value) / range else 1 - # clamp data to valid range. this can occur with user-provided range values - pclamp <- function(x, lower, upper) pmax(pmin(x, upper), lower) - normalized <- pclamp(normalized, 0, 1) + # user supplied min and max values + if (is.null(min_value)) { + min_value_color_by <- min(data[[color_by]], na.rm = TRUE) + } else { min_value_color_by <- min_value } + + if (is.null(max_value)) { + max_value_color_by <- max(data[[color_by]], na.rm = TRUE) + } else { max_value_color_by <- max_value } + + range <- max_value_color_by - min_value_color_by + + # range zero occurs for constant-valued columns (including single row tables) + normalized <- if (range > 0) (data[[color_by]][index] - min_value_color_by) / range else 1 + + # clamp data to [0,1] range + normalized <- pmax(pmin(normalized, 1), 0) cell_color <- color_pal(normalized) cell_color <- suppressWarnings(grDevices::adjustcolor(cell_color, alpha.f = opacity)) @@ -468,16 +475,21 @@ color_tiles <- function(data, } else { - # utilize min and and max values if supplied, otherwise use data extents - null_replace <- function(a, b) if (is.null(a)) b else a - effective_min_value <- null_replace(min_value, min(data[[name]], na.rm = TRUE)) - effective_max_value <- null_replace(max_value, max(data[[name]], na.rm = TRUE)) - range <- effective_max_value - effective_min_value - normalized <- if (range > 0) (value - effective_min_value) / range else 1 - # clamp data to valid range. this can occur with user-provided range values - pclamp <- function(x, lower, upper) pmax(pmin(x, upper), lower) - normalized <- pclamp(normalized, 0, 1) - + # user supplied min and max values + if (is.null(min_value)) { + min_value_normal <- min(data[[name]], na.rm = TRUE) + } else { min_value_normal <- min_value } + + if (is.null(max_value)) { + max_value_normal <- max(data[[name]], na.rm = TRUE) + } else { max_value_normal <- max_value } + + # range zero occurs for constant-valued columns (including single row tables) + range <- max_value_normal - min_value_normal + normalized <- if (range > 0) (value - min_value_normal) / range else 1 + + # clamp data to [0,1] range + normalized <- pmax(pmin(normalized, 1), 0) cell_color <- color_pal(normalized) cell_color <- suppressWarnings(grDevices::adjustcolor(cell_color, alpha.f = opacity))