From c210d79556f92efa4c3198ad9ce06e0aa676a05d Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Mon, 21 Nov 2016 11:50:13 +0100 Subject: [PATCH 01/13] Minor Ano bugfix --- R/Ano.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/Ano.R b/R/Ano.R index a926144d..4b2b8767 100644 --- a/R/Ano.R +++ b/R/Ano.R @@ -4,6 +4,10 @@ Ano <- function(var, clim) { # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # dimvar <- dim(var) + + if (length(dim(clim)) <= 2) { + clim <- InsertDim(clim, 2, dimvar[2]) + } if ((length(dimvar) > length(dim(clim))) & (dim(clim)[2] != dimvar[2])) { clim <- InsertDim(clim, 2, dimvar[2]) } @@ -13,13 +17,13 @@ Ano <- function(var, clim) { if ((length(dimvar) > length(dim(clim))) & (dim(clim)[4] != dimvar[4])) { clim <- InsertDim(clim, 4, dimvar[4]) } - + # # Raw anomalies # ~~~~~~~~~~~~~~~ # ano <- var - clim - + # # Outputs # ~~~~~~~~~ -- GitLab From 1ec68aa5303b331fbbfb994b7e21c5211472625c Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Wed, 18 Jan 2017 11:03:32 +0100 Subject: [PATCH 02/13] Fix for issue #184 --- R/PlotEquiMap.R | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index dea625df..61d1feaa 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -136,11 +136,20 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, stop("Parameter 'colNA' must be a valid colour identifier.") } + varmin <- min(var, na.rm = TRUE) + if (is.null(bar_limits)) { + var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) + bar_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + } else if (varmin == bar_limits[1]) { + var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) + } else { + var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + } + # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks # draw_separators, triangle_ends_scale, label_scale, units, units_scale, # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup - var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, @@ -154,6 +163,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, col_inf <- colorbar$col_inf col_sup <- colorbar$col_sup bar_limits <- c(head(brks, 1), tail(brks, 1)) + # Check square if (!is.logical(square)) { -- GitLab From 0fc9c5a50e07bb0582a403136d19551279c66868 Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Wed, 18 Jan 2017 14:26:02 +0100 Subject: [PATCH 03/13] Color-blind friendly pallete in clim.colors --- R/clim.colors.R | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/R/clim.colors.R b/R/clim.colors.R index f5c8ee5b..bcda36ee 100644 --- a/R/clim.colors.R +++ b/R/clim.colors.R @@ -1,6 +1,11 @@ clim.colors <- function(n) { - colorbar <- colorRampPalette(c("dodgerblue4", "dodgerblue1", "forestgreen", - "yellowgreen", "white", "white", "yellow", - "orange", "red", "saddlebrown")) + + colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976", + "#feb24c", "#fd8d3c", "#fc4e2a", + "#e31a1c", "#bd0026", "#800026")) + colorbar(n) + } + + -- GitLab From ecc76ed539690ea07433eda83024f5858a3ccf3f Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Wed, 18 Jan 2017 16:18:46 +0100 Subject: [PATCH 04/13] Very minor changes --- R/PlotEquiMap.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 61d1feaa..7bf706fa 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -138,13 +138,14 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, varmin <- min(var, na.rm = TRUE) if (is.null(bar_limits)) { - var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) - bar_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) - } else if (varmin == bar_limits[1]) { - var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) - } else { - var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) - } + var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) + bar_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + } else if (varmin == bar_limits[1]) { + var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) + } else { + var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + } + # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks # draw_separators, triangle_ends_scale, label_scale, units, units_scale, -- GitLab From f375eb4af3347906726ca7137052f2363448d4c9 Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Thu, 26 Jan 2017 10:49:31 +0100 Subject: [PATCH 05/13] Changes to default map colors --- R/clim.colors.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/R/clim.colors.R b/R/clim.colors.R index bcda36ee..1a0f26e0 100644 --- a/R/clim.colors.R +++ b/R/clim.colors.R @@ -1,11 +1,14 @@ -clim.colors <- function(n) { +clim.colors <- function(n, scheme = "heat") { - colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976", - "#feb24c", "#fd8d3c", "#fc4e2a", - "#e31a1c", "#bd0026", "#800026")) - - colorbar(n) + #colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976", + # "#feb24c", "#fd8d3c", "#fc4e2a", + # "#e31a1c", "#bd0026", "#800026")) + + colorbar <- colorRampPalette(rev(c("#67001f", "#b2182b", "#d6604d", "#f4a582", "#fddbc7", "#f7f7f7", "#d1e5f0", "#92c5de", "#4393c3", "#2166ac", "#053061"))) + + colorbar(n) + } -- GitLab From e6bce58250a4ae59c5961e16ae59a7ddccf04770 Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Mon, 30 Jan 2017 15:36:58 +0100 Subject: [PATCH 06/13] Add new color schemes for map plots --- R/ColorBar.R | 4 ++-- R/PlotEquiMap.R | 19 +++++++++++++------ R/PlotStereoMap.R | 4 ++-- R/clim.colors.R | 30 +++++++++++++++++++++++------- 4 files changed, 40 insertions(+), 17 deletions(-) diff --git a/R/ColorBar.R b/R/ColorBar.R index fb2f0a28..6fd98ecb 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -5,7 +5,7 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, extra_labels = NULL, title = NULL, title_scale = 1, label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, ...) { + extra_margin = rep(0, 4), label_digits = 4, climcol = "bluered", ...) { # Required checks if (!is.null(brks)) { if (!is.numeric(brks)) { @@ -112,7 +112,7 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) } if (is.null(cols)) { - cols <- color_fun(length(brks) - 1 + sum(triangle_ends)) + cols <- color_fun(length(brks) - 1 + sum(triangle_ends), climcol = climcol) if (triangle_ends[1]) { if (is.null(col_inf)) col_inf <- head(cols, 1) cols <- cols[-1] diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 7bf706fa..8963e27a 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -25,7 +25,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, fileout = NULL, width = 8, height = 5, size_units = 'in', - res = 100, ...) { + res = 100, climcol = "bluered", ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "din", "fig", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "oma", "ps", "tck") @@ -138,12 +138,19 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, varmin <- min(var, na.rm = TRUE) if (is.null(bar_limits)) { - var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) - bar_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + if (!is.null(cols)) { + intervals <- length(cols) + 1 + } else { + intervals <- 21 + } + half.width <- 0.5*(max(var, na.rm = TRUE) - min(var, na.rm = TRUE))/(intervals-1) # calculate the bar_limits using min(var) and max(var) as the midpoints of the upper and lower intervals. + var_limits <- c(min(var, na.rm = TRUE) - half.width, max(var, na.rm = TRUE) + half.width) + bar_limits <- c(min(var, na.rm = TRUE) - half.width, max(var, na.rm = TRUE) + half.width) } else if (varmin == bar_limits[1]) { - var_limits <- c(min(var, na.rm = TRUE) - 0.0000001, max(var, na.rm = TRUE)) + .warning("Lowest values are less than or equal to the lower bound of the colour bar and will not be plotted.") + var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) } else { - var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) + var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) } @@ -158,7 +165,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, triangle_ends_scale = triangle_ends_scale, label_scale = bar_label_scale, title = units, title_scale = units_scale, tick_scale = bar_tick_scale, - extra_margin = bar_extra_margin, label_digits = bar_label_digits) + extra_margin = bar_extra_margin, label_digits = bar_label_digits, climcol = climcol) brks <- colorbar$brks cols <- colorbar$cols col_inf <- colorbar$col_inf diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 347007f0..88a185f1 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -17,7 +17,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, height = 5, size_units = 'in', - res = 100, ...) { + res = 100, climcol = "bluered", ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("cex", "cex.main", "col", "fin", "lab", "las", "lwd", "mai", "mar", "mgp", "new", "pch", "ps") @@ -128,7 +128,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), triangle_ends_scale = triangle_ends_scale, label_scale = bar_label_scale, title = units, title_scale = units_scale, tick_scale = bar_tick_scale, - extra_margin = bar_extra_margin, label_digits = bar_label_digits) + extra_margin = bar_extra_margin, label_digits = bar_label_digits, climcol = climcol) brks <- colorbar$brks cols <- colorbar$cols col_inf <- colorbar$col_inf diff --git a/R/clim.colors.R b/R/clim.colors.R index 1a0f26e0..8d3fde6e 100644 --- a/R/clim.colors.R +++ b/R/clim.colors.R @@ -1,11 +1,27 @@ -clim.colors <- function(n, scheme = "heat") { +clim.colors <- function(n, scheme = "heat", climcol = "bluered") { - - #colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976", - # "#feb24c", "#fd8d3c", "#fc4e2a", - # "#e31a1c", "#bd0026", "#800026")) - - colorbar <- colorRampPalette(rev(c("#67001f", "#b2182b", "#d6604d", "#f4a582", "#fddbc7", "#f7f7f7", "#d1e5f0", "#92c5de", "#4393c3", "#2166ac", "#053061"))) + if (climcol == "bluered") { + colorbar <- colorRampPalette(rev(c("#67001f", "#b2182b", "#d6604d", + "#f4a582", "#fddbc7", "#f7f7f7", + "#d1e5f0", "#92c5de", "#4393c3", + "#2166ac", "#053061"))) + + } else if (climcol == "redblue") { + colorbar <- colorRampPalette(c("#67001f", "#b2182b", "#d6604d", + "#f4a582", "#fddbc7", "#f7f7f7", + "#d1e5f0", "#92c5de", "#4393c3", + "#2166ac", "#053061")) + } else if (climcol == "yellowred") { + colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976", + "#feb24c", "#fd8d3c", "#fc4e2a", + "#e31a1c", "#bd0026", "#800026")) + } else if (climcol == "redyellow") { + colorbar <- colorRampPalette(rev(c("#ffffcc", "#ffeda0", "#fed976", + "#feb24c", "#fd8d3c", "#fc4e2a", + "#e31a1c", "#bd0026", "#800026"))) + } else { + stop("climcol must be one of 'bluered', 'redblue', 'yellowred', 'redyellow'") + } colorbar(n) -- GitLab From 76505e18cf39b5c530285aa3e2504100cf17a635 Mon Sep 17 00:00:00 2001 From: "alasdair.hunter" Date: Tue, 31 Jan 2017 09:29:57 +0100 Subject: [PATCH 07/13] Add new palettes --- R/ColorBar.R | 18 +++++++++--------- R/PlotEquiMap.R | 13 +++++++------ R/PlotStereoMap.R | 15 ++++++++------- R/clim.colors.R | 10 +++++----- 4 files changed, 29 insertions(+), 27 deletions(-) diff --git a/R/ColorBar.R b/R/ColorBar.R index 6fd98ecb..235e4bf8 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -1,11 +1,11 @@ -ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, - subsampleg = NULL, bar_limits = NULL, var_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = clim.colors, plot = TRUE, draw_ticks = TRUE, - draw_separators = FALSE, triangle_ends_scale = 1, - extra_labels = NULL, title = NULL, title_scale = 1, - label_scale = 1, tick_scale = 1, - extra_margin = rep(0, 4), label_digits = 4, climcol = "bluered", ...) { +ColorBar <- function(brks = NULL, cols = NULL, palette = "bluered", + vertical = TRUE, subsampleg = NULL, bar_limits = NULL, + var_limits = NULL, triangle_ends = NULL, col_inf = NULL, + col_sup = NULL, color_fun = clim.colors, plot = TRUE, + draw_ticks = TRUE, draw_separators = FALSE, + triangle_ends_scale = 1, extra_labels = NULL, title = NULL, + title_scale = 1, label_scale = 1, tick_scale = 1, + extra_margin = rep(0, 4), label_digits = 4, ...) { # Required checks if (!is.null(brks)) { if (!is.numeric(brks)) { @@ -112,7 +112,7 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) } if (is.null(cols)) { - cols <- color_fun(length(brks) - 1 + sum(triangle_ends), climcol = climcol) + cols <- color_fun(length(brks) - 1 + sum(triangle_ends), palette) if (triangle_ends[1]) { if (is.null(col_inf)) col_inf <- head(cols, 1) cols <- cols[-1] diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 8963e27a..48022f3e 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -1,7 +1,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, sizetit = NULL, units = NULL, - brks = NULL, cols = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, + brks = NULL, cols = NULL, palette = "bluered", + bar_limits = NULL, triangle_ends = NULL, + col_inf = NULL, col_sup = NULL, colNA = 'white', color_fun = clim.colors, square = TRUE, filled.continents = NULL, coast_color = NULL, coast_width = 1, @@ -25,7 +26,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, fileout = NULL, width = 8, height = 5, size_units = 'in', - res = 100, climcol = "bluered", ...) { + res = 100, ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "din", "fig", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "oma", "ps", "tck") @@ -158,14 +159,14 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # draw_separators, triangle_ends_scale, label_scale, units, units_scale, # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup - colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, + colorbar <- ColorBar(brks, cols, palette, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, triangle_ends_scale = triangle_ends_scale, label_scale = bar_label_scale, title = units, title_scale = units_scale, tick_scale = bar_tick_scale, - extra_margin = bar_extra_margin, label_digits = bar_label_digits, climcol = climcol) + extra_margin = bar_extra_margin, label_digits = bar_label_digits) brks <- colorbar$brks cols <- colorbar$cols col_inf <- colorbar$col_inf @@ -638,7 +639,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # ~~~~~~~~~~ # if (drawleg) { - ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, + ColorBar(brks, cols, palette, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, title = units, diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 88a185f1..8c4a01d5 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -1,8 +1,9 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), toptitle = NULL, sizetit = NULL, units = NULL, - brks = NULL, cols = NULL, bar_limits = NULL, - triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - colNA = 'white', color_fun = clim.colors, + brks = NULL, cols = NULL, palette = "bluered", + bar_limits = NULL, triangle_ends = NULL, + col_inf = NULL, col_sup = NULL, + colNA = 'black', color_fun = clim.colors, filled.continents = FALSE, coast_color = NULL, coast_width = 1, dots = NULL, dot_symbol = 4, dot_size = 0.8, @@ -17,7 +18,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), margin_scale = rep(1, 4), title_scale = 1, numbfig = NULL, fileout = NULL, width = 6, height = 5, size_units = 'in', - res = 100, climcol = "bluered", ...) { + res = 100, ...) { # Process the user graphical parameters that may be passed in the call ## Graphical parameters to exclude excludedArgs <- c("cex", "cex.main", "col", "fin", "lab", "las", "lwd", "mai", "mar", "mgp", "new", "pch", "ps") @@ -121,14 +122,14 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) - colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, + colorbar <- ColorBar(brks, cols, palette, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, triangle_ends_scale = triangle_ends_scale, label_scale = bar_label_scale, title = units, title_scale = units_scale, tick_scale = bar_tick_scale, - extra_margin = bar_extra_margin, label_digits = bar_label_digits, climcol = climcol) + extra_margin = bar_extra_margin, label_digits = bar_label_digits) brks <- colorbar$brks cols <- colorbar$cols col_inf <- colorbar$col_inf @@ -392,7 +393,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), # ~~~~~~~~~~ # if (drawleg) { - ColorBar(brks, cols, TRUE, subsampleg, bar_limits, var_limits, + ColorBar(brks, cols, palette, TRUE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, title = units, diff --git a/R/clim.colors.R b/R/clim.colors.R index 8d3fde6e..6941e465 100644 --- a/R/clim.colors.R +++ b/R/clim.colors.R @@ -1,21 +1,21 @@ -clim.colors <- function(n, scheme = "heat", climcol = "bluered") { +clim.colors <- function(n, palette = "bluered") { - if (climcol == "bluered") { + if (palette == "bluered") { colorbar <- colorRampPalette(rev(c("#67001f", "#b2182b", "#d6604d", "#f4a582", "#fddbc7", "#f7f7f7", "#d1e5f0", "#92c5de", "#4393c3", "#2166ac", "#053061"))) - } else if (climcol == "redblue") { + } else if (palette == "redblue") { colorbar <- colorRampPalette(c("#67001f", "#b2182b", "#d6604d", "#f4a582", "#fddbc7", "#f7f7f7", "#d1e5f0", "#92c5de", "#4393c3", "#2166ac", "#053061")) - } else if (climcol == "yellowred") { + } else if (palette == "yellowred") { colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976", "#feb24c", "#fd8d3c", "#fc4e2a", "#e31a1c", "#bd0026", "#800026")) - } else if (climcol == "redyellow") { + } else if (palette == "redyellow") { colorbar <- colorRampPalette(rev(c("#ffffcc", "#ffeda0", "#fed976", "#feb24c", "#fd8d3c", "#fc4e2a", "#e31a1c", "#bd0026", "#800026"))) -- GitLab From 5ae9417dc464734debc49455ff1eb87698d3c6bd Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Feb 2017 12:05:25 +0100 Subject: [PATCH 08/13] Changed parameter palette b by the clim.palette mechanism. --- R/ColorBar.R | 15 +++++++------ R/PlotEquiMap.R | 11 +++++----- R/PlotStereoMap.R | 7 +++--- R/{clim.colors.R => clim.palette.R} | 12 +++++------ man/clim.colors.Rd | 27 ----------------------- man/clim.palette.Rd | 33 +++++++++++++++++++++++++++++ 6 files changed, 54 insertions(+), 51 deletions(-) rename R/{clim.colors.R => clim.palette.R} (86%) delete mode 100644 man/clim.colors.Rd create mode 100644 man/clim.palette.Rd diff --git a/R/ColorBar.R b/R/ColorBar.R index 235e4bf8..a7cdbb34 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -1,10 +1,11 @@ -ColorBar <- function(brks = NULL, cols = NULL, palette = "bluered", - vertical = TRUE, subsampleg = NULL, bar_limits = NULL, - var_limits = NULL, triangle_ends = NULL, col_inf = NULL, - col_sup = NULL, color_fun = clim.colors, plot = TRUE, +ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, + subsampleg = NULL, bar_limits = NULL, var_limits = NULL, + triangle_ends = NULL, col_inf = NULL, col_sup = NULL, + color_fun = clim.palette(), plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, - triangle_ends_scale = 1, extra_labels = NULL, title = NULL, - title_scale = 1, label_scale = 1, tick_scale = 1, + triangle_ends_scale = 1, extra_labels = NULL, + title = NULL, title_scale = 1, + label_scale = 1, tick_scale = 1, extra_margin = rep(0, 4), label_digits = 4, ...) { # Required checks if (!is.null(brks)) { @@ -112,7 +113,7 @@ ColorBar <- function(brks = NULL, cols = NULL, palette = "bluered", brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) } if (is.null(cols)) { - cols <- color_fun(length(brks) - 1 + sum(triangle_ends), palette) + cols <- color_fun(length(brks) - 1 + sum(triangle_ends)) if (triangle_ends[1]) { if (is.null(col_inf)) col_inf <- head(cols, 1) cols <- cols[-1] diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 48022f3e..2092e352 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -1,9 +1,8 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, sizetit = NULL, units = NULL, - brks = NULL, cols = NULL, palette = "bluered", - bar_limits = NULL, triangle_ends = NULL, - col_inf = NULL, col_sup = NULL, - colNA = 'white', color_fun = clim.colors, + brks = NULL, cols = NULL, bar_limits = NULL, + triangle_ends = NULL, col_inf = NULL, col_sup = NULL, + colNA = 'white', color_fun = clim.palette(), square = TRUE, filled.continents = NULL, coast_color = NULL, coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, @@ -159,7 +158,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # draw_separators, triangle_ends_scale, label_scale, units, units_scale, # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup - colorbar <- ColorBar(brks, cols, palette, FALSE, subsampleg, bar_limits, var_limits, + colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, @@ -639,7 +638,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, # ~~~~~~~~~~ # if (drawleg) { - ColorBar(brks, cols, palette, FALSE, subsampleg, bar_limits, var_limits, + ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, title = units, diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 8c4a01d5..57cb6650 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -1,9 +1,8 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), toptitle = NULL, sizetit = NULL, units = NULL, - brks = NULL, cols = NULL, palette = "bluered", - bar_limits = NULL, triangle_ends = NULL, - col_inf = NULL, col_sup = NULL, - colNA = 'black', color_fun = clim.colors, + brks = NULL, cols = NULL, bar_limits = NULL, + triangle_ends = NULL, col_inf = NULL, col_sup = NULL, + colNA = 'black', color_fun = clim.palette(), filled.continents = FALSE, coast_color = NULL, coast_width = 1, dots = NULL, dot_symbol = 4, dot_size = 0.8, diff --git a/R/clim.colors.R b/R/clim.palette.R similarity index 86% rename from R/clim.colors.R rename to R/clim.palette.R index 6941e465..f52f980a 100644 --- a/R/clim.colors.R +++ b/R/clim.palette.R @@ -1,11 +1,13 @@ clim.colors <- function(n, palette = "bluered") { + clim.palette(palette)(n) +} +clim.palette <- function(palette = "bluered") { if (palette == "bluered") { colorbar <- colorRampPalette(rev(c("#67001f", "#b2182b", "#d6604d", "#f4a582", "#fddbc7", "#f7f7f7", "#d1e5f0", "#92c5de", "#4393c3", "#2166ac", "#053061"))) - } else if (palette == "redblue") { colorbar <- colorRampPalette(c("#67001f", "#b2182b", "#d6604d", "#f4a582", "#fddbc7", "#f7f7f7", @@ -20,11 +22,7 @@ clim.colors <- function(n, palette = "bluered") { "#feb24c", "#fd8d3c", "#fc4e2a", "#e31a1c", "#bd0026", "#800026"))) } else { - stop("climcol must be one of 'bluered', 'redblue', 'yellowred', 'redyellow'") + stop("Parameter 'palette' must be one of 'bluered', 'redblue', 'yellowred' or 'redyellow'.") } - - colorbar(n) - + colorbar } - - diff --git a/man/clim.colors.Rd b/man/clim.colors.Rd deleted file mode 100644 index 8d61dad9..00000000 --- a/man/clim.colors.Rd +++ /dev/null @@ -1,27 +0,0 @@ -\name{clim.colors} -\alias{clim.colors} -\title{Generate Climate Color Bar} -\description{ -Generates a color bar with color ranges useful in climate temperature variable plotting.\cr -The original colors are:\cr - c("dodgerblue4", "dodgerblue1", "forestgreen", "yellowgreen", "white",\cr - "white", "yellow", "orange", "red", "saddlebrown") -} -\usage{ -clim.colors(n) -} -\arguments{ - \item{n}{ -Number of colors to generate. - } -} -\examples{ -cols <- clim.colors(20) -lims <- seq(-1, 1, length.out = 21) -ColorBar(lims, cols) -} -\author{ -History:\cr -0.0 - 2016-01 (N. Manubens, \email{nicolau.manubens at bsc.es}) - Original code.\cr -} -\keyword{datagen} diff --git a/man/clim.palette.Rd b/man/clim.palette.Rd new file mode 100644 index 00000000..b82a5efd --- /dev/null +++ b/man/clim.palette.Rd @@ -0,0 +1,33 @@ +\name{clim.palette} +\alias{clim.colors} +\alias{clim.palette} +\title{Generate Climate Color Palettes} +\description{ +Generates a colorblind friendly color palette with color ranges useful in climate temperature variable plotting.\cr +} +\usage{ +clim.palette(palette = 'bluered') + +clim.colors(n, palette = 'bluered') +} +\arguments{ + \item{palette}{ +Which type of palette to generate: from blue through white to red ('bluered'), from red through white to blue ('redblue'), from yellow through orange to red ('yellowred'), or from red through orange to red ('redyellow'). + } + \item{n}{ +Number of colors to generate. + } +} +\examples{ +lims <- seq(-1, 1, length.out = 21) + +ColorBar(lims, color_fun = clim.palette('redyellow')) + +cols <- clim.colors(20) +ColorBar(lims, cols) +} +\author{ +History:\cr +0.0 - 2016-01 (N. Manubens, \email{nicolau.manubens at bsc.es}) - Original code.\cr +} +\keyword{datagen} -- GitLab From 6d6a2c0e9a00ea2c71134e3bded712e0914d51c9 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Feb 2017 20:05:29 +0100 Subject: [PATCH 09/13] Transferred color bar extension from PlotEquiMap to ColorBar. Tidy up of ColorBar checks. Add na_colour attribute to predefined colour bars in clim.palette. --- R/ColorBar.R | 140 ++++++++++++++++++++++++++----------------- R/PlotEquiMap.R | 41 +++++-------- R/PlotStereoMap.R | 21 +++++-- R/clim.palette.R | 4 ++ man/ColorBar.Rd | 2 +- man/PlotEquiMap.Rd | 4 +- man/PlotStereoMap.Rd | 4 +- 7 files changed, 125 insertions(+), 91 deletions(-) diff --git a/R/ColorBar.R b/R/ColorBar.R index a7cdbb34..a211d2d2 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -8,6 +8,12 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, label_scale = 1, tick_scale = 1, extra_margin = rep(0, 4), label_digits = 4, ...) { # Required checks + if ((is.null(brks) || length(brks) < 2) && is.null(bar_limits) && is.null(var_limits)) { + stop("At least one of 'brks' with the desired breaks, 'bar_limits' or ", + "'var_limits' must be provided to generate the colour bar.") + } + + # Check brks if (!is.null(brks)) { if (!is.numeric(brks)) { stop("Parameter 'brks' must be numeric if specified.") @@ -17,41 +23,84 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, cols <- cols[reorder$ix[which(reorder$ix <= length(cols))]] } brks <- reorder$x - } + } } - if ((is.null(brks) || length(brks) < 2) && is.null(var_limits)) { - stop("At least one of 'brks' with the desired breaks or 'var_limits' must be provided to generate the colour bar.") + + # Check bar_limits + if (!is.null(bar_limits)) { + if (!(all(is.na(bar_limits) | is.numeric(bar_limits)) && (length(bar_limits) == 2))) { + stop("Parameter 'bar_limits' must be a vector of two numeric elements or NAs.") + } } # Check var_limits - if (is.null(var_limits)) { - var_limits <- c(head(brks, 1), tail(brks, 1)) - } else if (!is.numeric(var_limits) || length(var_limits) != 2) { - stop("Parameter 'var_limits' must be a numeric vector with two elements.") - } else if (any(is.na(var_limits))) { - stop("Parameter 'var_limits' must not contain NA values.") - } else if (any(is.infinite(var_limits))) { - stop("Parameter 'var_limits' must no contain infinite values.") + if (!is.null(var_limits)) { + if (!(is.numeric(var_limits) && (length(var_limits) == 2))) { + stop("Parameter 'var_limits' must be a numeric vector of length 2.") + } else if (any(is.na(var_limits))) { + stop("Parameter 'var_limits' must not contain NA values.") + } else if (any(is.infinite(var_limits))) { + stop("Parameter 'var_limits' must not contain infinite values.") + } } - # Check bar_limits - if (is.null(bar_limits)) { - if (!is.null(brks) && length(brks) > 1) { - bar_limits <- c(head(brks, 1), tail(brks, 1)) - } else { - bar_limits <- var_limits + # Check cols + if (!is.null(cols)) { + if (!is.character(cols)) { + stop("Parameter 'cols' must be a vector of character strings.") + } else if (any(!sapply(cols, .IsColor))) { + stop("Parameter 'cols' must contain valid colour identifiers.") } - } else if ((!is.numeric(bar_limits) && !all(is.na(bar_limits))) || length(bar_limits) != 2) { - stop("Parameter 'bar_limits' must be a numeric vector with two elements.") - } else { - bar_limits[which(is.na(bar_limits))] <- var_limits[which(is.na(bar_limits))] } # Check color_fun if (!is.function(color_fun)) { stop("Parameter 'color_fun' must be a colour-generator function.") } - + + # Check integrity among brks, bar_limits and var_limits + if (is.null(brks) || (length(brks) < 2)) { + if (is.null(brks)) { + if (is.null(cols)) { + brks <- 21 + } else { + brks <- length(cols) + 1 + } + } + if (is.null(bar_limits) || any(is.na(bar_limits))) { + # var_limits is defined + if (is.null(bar_limits)) { + bar_limits <- c(NA, NA) + } + half_width <- 0.5 * (var_limits[2] - var_limits[1]) / (brks - 1) + bar_limits[which(is.na(bar_limits))] <- c(var_limits[1] - half_width, var_limits[2] + half_width)[which(is.na(bar_limits))] + brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) + } else if (is.null(var_limits)) { + # bar_limits is defined + brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) + var_limits <- bar_limits + var_limits[1] <- var_limits[1] + .Machine$double.xmin + } else { + # both bar_limits and var_limits are defined + brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) + } + } else if (is.null(bar_limits)) { + if (is.null(var_limits)) { + # brks is defined + bar_limits <- c(head(brks, 1), tail(brks, 1)) + var_limits <- bar_limits + var_limits[1] <- var_limits[1] + .Machine$double.xmin + } else { + # brks and var_limits are defined + bar_limits <- c(head(brks, 1), tail(brks, 1)) + } + } else { + # brks and bar_limits are defined + # or + # brks, bar_limits and var_limits are defined + stop("Only one of 'brks' or 'bar_limits' can be defined.") + } + # Check col_inf if (!is.null(col_inf)) { if (!.IsColor(col_inf)) { @@ -73,7 +122,7 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, teflc <- triangle_ends_from_limit_cols <- c(!is.null(col_inf), !is.null(col_sup)) if (is.null(triangle_ends) && is.null(col_inf) && is.null(col_sup)) { triangle_ends <- c(FALSE, FALSE) - if (bar_limits[1] > var_limits[1]) { + if (bar_limits[1] >= var_limits[1]) { triangle_ends[1] <- TRUE } if (bar_limits[2] < var_limits[2]) { @@ -93,40 +142,21 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, } } - # Check brks and cols - if (!is.null(cols)) { - if (!is.character(cols)) { - stop("Parameter 'cols' must be a character vector.") - } else if (any(!sapply(cols, .IsColor))) { - stop("Parameter 'cols' must contain valid colour identifiers.") - } - } - if (is.null(brks)) { - if (!is.null(cols)) { - brks <- length(cols) + 1 - } else { - brks <- 21 - } - } - if (is.numeric(brks)) { - if (length(brks) == 1) { - brks <- seq(bar_limits[1], bar_limits[2], length.out = brks) + # Generate colours if needed + if (is.null(cols)) { + cols <- color_fun(length(brks) - 1 + sum(triangle_ends)) + attr_bk <- attributes(cols) + if (triangle_ends[1]) { + if (is.null(col_inf)) col_inf <- head(cols, 1) + cols <- cols[-1] } - if (is.null(cols)) { - cols <- color_fun(length(brks) - 1 + sum(triangle_ends)) - if (triangle_ends[1]) { - if (is.null(col_inf)) col_inf <- head(cols, 1) - cols <- cols[-1] - } - if (triangle_ends[2]) { - if (is.null(col_sup)) col_sup <- tail(cols, 1) - cols <- cols[-length(cols)] - } - } else if ((length(cols) != (length(brks) - 1))) { - stop("Incorrect number of 'brks' and 'cols'. There must be one more break than the number of colours.") + if (triangle_ends[2]) { + if (is.null(col_sup)) col_sup <- tail(cols, 1) + cols <- cols[-length(cols)] } - } else { - stop("Parameter 'brks' must be a numeric vector.") + attributes(cols) <- attr_bk + } else if ((length(cols) != (length(brks) - 1))) { + stop("Incorrect number of 'brks' and 'cols'. There must be one more break than the number of colours.") } # Check vertical diff --git a/R/PlotEquiMap.R b/R/PlotEquiMap.R index 2092e352..84173ec8 100644 --- a/R/PlotEquiMap.R +++ b/R/PlotEquiMap.R @@ -2,7 +2,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, sizetit = NULL, units = NULL, brks = NULL, cols = NULL, bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - colNA = 'white', color_fun = clim.palette(), + colNA = NULL, color_fun = clim.palette(), square = TRUE, filled.continents = NULL, coast_color = NULL, coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, @@ -131,29 +131,7 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, title_scale <- sizetit } - # Check colNA - if (!.IsColor(colNA)) { - stop("Parameter 'colNA' must be a valid colour identifier.") - } - - varmin <- min(var, na.rm = TRUE) - if (is.null(bar_limits)) { - if (!is.null(cols)) { - intervals <- length(cols) + 1 - } else { - intervals <- 21 - } - half.width <- 0.5*(max(var, na.rm = TRUE) - min(var, na.rm = TRUE))/(intervals-1) # calculate the bar_limits using min(var) and max(var) as the midpoints of the upper and lower intervals. - var_limits <- c(min(var, na.rm = TRUE) - half.width, max(var, na.rm = TRUE) + half.width) - bar_limits <- c(min(var, na.rm = TRUE) - half.width, max(var, na.rm = TRUE) + half.width) - } else if (varmin == bar_limits[1]) { - .warning("Lowest values are less than or equal to the lower bound of the colour bar and will not be plotted.") - var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) - } else { - var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) - } - - + var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks # draw_separators, triangle_ends_scale, label_scale, units, units_scale, # bar_label_digits @@ -171,7 +149,20 @@ PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL, col_inf <- colorbar$col_inf col_sup <- colorbar$col_sup bar_limits <- c(head(brks, 1), tail(brks, 1)) - + + # Check colNA + if (is.null(colNA)) { + if ('na_color' %in% names(attributes(cols))) { + colNA <- attr(cols, 'na_color') + if (!.IsColor(colNA)) { + stop("The 'na_color' provided as attribute of the colour vector must be a valid colour identifier.") + } + } else { + colNA <- 'pink' + } + } else if (!.IsColor(colNA)) { + stop("Parameter 'colNA' must be a valid colour identifier.") + } # Check square if (!is.logical(square)) { diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 57cb6650..29ab15e0 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -2,7 +2,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), toptitle = NULL, sizetit = NULL, units = NULL, brks = NULL, cols = NULL, bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - colNA = 'black', color_fun = clim.palette(), + colNA = NULL, color_fun = clim.palette(), filled.continents = FALSE, coast_color = NULL, coast_width = 1, dots = NULL, dot_symbol = 4, dot_size = 0.8, @@ -111,11 +111,6 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), title_scale <- sizetit } - # Check colNA - if (!.IsColor(colNA)) { - stop("Parameter 'colNA' must be a valid colour identifier.") - } - # Check: brks, cols, subsampleg, bar_limits, color_fun, bar_extra_labels, draw_bar_ticks # draw_separators, triangle_ends_scale, label_scale, units, units_scale, # bar_label_digits @@ -135,6 +130,20 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), col_sup <- colorbar$col_sup bar_limits <- c(head(brks, 1), tail(brks, 1)) + # Check colNA + if (is.null(colNA)) { + if ('na_color' %in% names(attributes(cols))) { + colNA <- attr(cols, 'na_color') + if (!.IsColor(colNA)) { + stop("The 'na_color' provided as attribute of the colour vector must be a valid colour identifier.") + } + } else { + colNA <- 'pink' + } + } else if (!.IsColor(colNA)) { + stop("Parameter 'colNA' must be a valid colour identifier.") + } + # Check filled.continents if (!.IsColor(filled.continents) && !is.logical(filled.continents)) { stop("Parameter 'filled.continents' must be logical or a colour identifier.") diff --git a/R/clim.palette.R b/R/clim.palette.R index f52f980a..5673c61d 100644 --- a/R/clim.palette.R +++ b/R/clim.palette.R @@ -8,19 +8,23 @@ clim.palette <- function(palette = "bluered") { "#f4a582", "#fddbc7", "#f7f7f7", "#d1e5f0", "#92c5de", "#4393c3", "#2166ac", "#053061"))) + attr(colorbar, 'na_color') <- 'pink' } else if (palette == "redblue") { colorbar <- colorRampPalette(c("#67001f", "#b2182b", "#d6604d", "#f4a582", "#fddbc7", "#f7f7f7", "#d1e5f0", "#92c5de", "#4393c3", "#2166ac", "#053061")) + attr(colorbar, 'na_color') <- 'pink' } else if (palette == "yellowred") { colorbar <- colorRampPalette(c("#ffffcc", "#ffeda0", "#fed976", "#feb24c", "#fd8d3c", "#fc4e2a", "#e31a1c", "#bd0026", "#800026")) + attr(colorbar, 'na_color') <- 'pink' } else if (palette == "redyellow") { colorbar <- colorRampPalette(rev(c("#ffffcc", "#ffeda0", "#fed976", "#feb24c", "#fd8d3c", "#fc4e2a", "#e31a1c", "#bd0026", "#800026"))) + attr(colorbar, 'na_color') <- 'pink' } else { stop("Parameter 'palette' must be one of 'bluered', 'redblue', 'yellowred' or 'redyellow'.") } diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 98d2f31a..26f5ade5 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -51,7 +51,7 @@ Colour to fill the inferior triangle end with. Useful if specifying colours manu Colour to fill the superior triangle end with. Useful if specifying colours manually with parameter 'cols', to specify the colour and to trigger the drawing of the upper extreme triangle, or if 'cols' is not specified, to replace the colour automatically generated by ColorBar(). } \item{color_fun}{ -Function to generate the colours of the color bar. Must take an integer and must return as many colours. Set by default to clim.colors. +Function to generate the colours of the color bar. Must take an integer and must return as many colours. The returned colour vector can have the attribute 'na_color', with a colour to draw NA values. This parameter is set by default to clim.palette(). } \item{plot}{ Logical value indicating whether to only compute its breaks and colours (FALSE) or to also draw it on the current device (TRUE). diff --git a/man/PlotEquiMap.Rd b/man/PlotEquiMap.Rd index 9ba2ca49..23e142ea 100644 --- a/man/PlotEquiMap.Rd +++ b/man/PlotEquiMap.Rd @@ -11,7 +11,7 @@ PlotEquiMap(var, lon, lat, varu = NULL, varv = NULL, toptitle = NULL, sizetit = NULL, units = NULL, brks = NULL, cols = NULL, bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - colNA = 'white', color_fun = clim.colors, + colNA = NULL, color_fun = clim.palette(), square = TRUE, filled.continents = NULL, coast_color = NULL, coast_width = 1, contours = NULL, brks2 = NULL, contour_lwd = 0.5, @@ -64,7 +64,7 @@ Title at the top of the colour bar, most commonly the units of the variable prov Usually only providing 'brks' is enough to generate the desired colour bar. These parameters allow to define n breaks that define n - 1 intervals to classify each of the values in 'var'. The corresponding grid cell of a given value in 'var' will be coloured in function of the interval it belongs to. These parameters are sent to \code{ColorBar()} to generate the breaks and colours. Additional colours for values beyond the limits of the colour bar are also generated and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are properly provided to do so. See ?ColorBar for a full explanation.\cr } \item{col_inf,col_sup,colNA}{ -Colour identifiers to colour the values in 'var' that go beyond the extremes of the colour bar and to colour NA values, respectively. 'colNA' takes 'white' by default. 'col_inf' and 'col_sup' will take the value of 'colNA' if not specified. See ?ColorBar for a full explanation on 'col_inf' and 'col_sup'. +Colour identifiers to colour the values in 'var' that go beyond the extremes of the colour bar and to colour NA values, respectively. 'colNA' takes attr(cols, 'na_color') if available by default, where cols is the parameter 'cols' if provided or the vector of colors returned by 'color_fun'. If not available, it takes 'pink' by default. 'col_inf' and 'col_sup' will take the value of 'colNA' if not specified. See ?ColorBar for a full explanation on 'col_inf' and 'col_sup'. } \item{color_fun,subsampleg,bar_extra_labels,draw_bar_ticks,draw_separators,triangle_ends_scale,bar_label_digits,bar_label_scale,units_scale,bar_tick_scale,bar_extra_margin}{ Set of parameters to control the visual aspect of the drawn colour bar. See ?ColorBar for a full explanation. diff --git a/man/PlotStereoMap.Rd b/man/PlotStereoMap.Rd index fe197eee..8b262b7f 100644 --- a/man/PlotStereoMap.Rd +++ b/man/PlotStereoMap.Rd @@ -11,7 +11,7 @@ PlotStereoMap(var, lon, lat, latlims = c(60, 90), toptitle = NULL, sizetit = NULL, units = NULL, brks = NULL, cols = NULL, bar_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - colNA = 'white', color_fun = clim.colors, + colNA = NULL, color_fun = clim.palette(), filled.continents = FALSE, coast_color = NULL, coast_width = 1, dots = NULL, dot_symbol = 4, dot_size = 0.8, @@ -55,7 +55,7 @@ Title at the top of the colour bar, most commonly the units of the variable prov Usually only providing 'brks' is enough to generate the desired colour bar. These parameters allow to define n breaks that define n - 1 intervals to classify each of the values in 'var'. The corresponding grid cell of a given value in 'var' will be coloured in function of the interval it belongs to. These parameters are sent to \code{ColorBar()} to generate the breaks and colours. Additional colours for values beyond the limits of the colour bar are also generated and applied to the plot if 'bar_limits' or 'brks' and 'triangle_ends' are properly provided to do so. See ?ColorBar for a full explanation.\cr } \item{col_inf,col_sup,colNA}{ -Colour identifiers to colour the values in 'var' that go beyond the extremes of the colour bar and to colour NA values, respectively. 'colNA' takes 'white' by default. 'col_inf' and 'col_sup' will take the value of 'colNA' if not specified. See ?ColorBar for a full explanation on 'col_inf' and 'col_sup'. +Colour identifiers to colour the values in 'var' that go beyond the extremes of the colour bar and to colour NA values, respectively. 'colNA' takes attr(cols, 'na_color') if available by default, where cols is the parameter 'cols' if provided or the vector of colors returned by 'color_fun'. If not available, it takes 'pink' by default. 'col_inf' and 'col_sup' will take the value of 'colNA' if not specified. See ?ColorBar for a full explanation on 'col_inf' and 'col_sup'. } \item{color_fun,subsampleg,bar_extra_labels,draw_bar_ticks,draw_separators,triangle_ends_scale,bar_label_digits,bar_label_scale,units_scale,bar_tick_scale,bar_extra_margin}{ Set of parameters to control the visual aspect of the drawn colour bar. See ?ColorBar for a full explanation. -- GitLab From fabb2e058bea829bbc2ee73ee0968eaaa5f5668f Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Feb 2017 20:21:40 +0100 Subject: [PATCH 10/13] Minor fixes. --- R/AnimateMap.R | 4 +--- R/ColorBar.R | 4 +++- man/ColorBar.Rd | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/AnimateMap.R b/R/AnimateMap.R index 22f6e9fc..86bacf35 100644 --- a/R/AnimateMap.R +++ b/R/AnimateMap.R @@ -45,9 +45,7 @@ AnimateMap <- function(var, lon, lat, toptitle = c("", "", "", if (length(lon) != nlon | length(lat) != nlat) { stop("Inconsistent var dimensions / longitudes + latitudes") } - colorbar <- colorRampPalette(c("dodgerblue4", "dodgerblue1", - "forestgreen", "yellowgreen", "white", "white", "yellow", - "orange", "red", "saddlebrown")) + colorbar <- clim.palette() if (is.null(brks) == TRUE) { ll <- signif(min(var[, , 2, , , ], na.rm = TRUE), 4) ul <- signif(max(var[, , 2, , , ], na.rm = TRUE), 4) diff --git a/R/ColorBar.R b/R/ColorBar.R index a211d2d2..7e8d55b8 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -98,7 +98,9 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, # brks and bar_limits are defined # or # brks, bar_limits and var_limits are defined - stop("Only one of 'brks' or 'bar_limits' can be defined.") + if (head(brks, 1) != bar_limits[1] || tail(brks, 1) != bar_limits[2]) { + stop("Parameters 'brks' and 'bar_limits' are inconsistent.") + } } # Check col_inf diff --git a/man/ColorBar.Rd b/man/ColorBar.Rd index 26f5ade5..fb7cc7e5 100644 --- a/man/ColorBar.Rd +++ b/man/ColorBar.Rd @@ -10,7 +10,7 @@ The only mandatory parameters are 'var_limits' or 'brks' (in its second format, ColorBar(brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, bar_limits = NULL, var_limits = NULL, triangle_ends = NULL, col_inf = NULL, col_sup = NULL, - color_fun = clim.colors, plot = TRUE, draw_ticks = TRUE, + color_fun = clim.palette(), plot = TRUE, draw_ticks = TRUE, draw_separators = FALSE, triangle_ends_scale = 1, extra_labels = NULL, title = NULL, title_scale = 1, label_scale = 1, tick_scale = 1, -- GitLab From e0570938d40b3af947bdb95b2b3ae5093266c0c1 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Feb 2017 20:33:14 +0100 Subject: [PATCH 11/13] Small fix. --- R/PlotStereoMap.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/PlotStereoMap.R b/R/PlotStereoMap.R index 29ab15e0..f14199e9 100644 --- a/R/PlotStereoMap.R +++ b/R/PlotStereoMap.R @@ -116,7 +116,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), # bar_label_digits # Build: brks, cols, bar_limits, col_inf, col_sup var_limits <- c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)) - colorbar <- ColorBar(brks, cols, palette, FALSE, subsampleg, bar_limits, var_limits, + colorbar <- ColorBar(brks, cols, FALSE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf, col_sup, color_fun, FALSE, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, @@ -401,7 +401,7 @@ PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), # ~~~~~~~~~~ # if (drawleg) { - ColorBar(brks, cols, palette, TRUE, subsampleg, bar_limits, var_limits, + ColorBar(brks, cols, TRUE, subsampleg, bar_limits, var_limits, triangle_ends, col_inf = col_inf, col_sup = col_sup, extra_labels = bar_extra_labels, draw_ticks = draw_bar_ticks, draw_separators = draw_separators, title = units, -- GitLab From 4778e03015fc2cbbe29890d82166717df2956ed0 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Feb 2017 22:15:30 +0100 Subject: [PATCH 12/13] Added warning when disabling triangle ends. --- R/ColorBar.R | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/R/ColorBar.R b/R/ColorBar.R index 7e8d55b8..0a325b0e 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -120,7 +120,7 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, # Check triangle_ends if (!is.null(triangle_ends) && (!is.logical(triangle_ends) || length(triangle_ends) != 2)) { stop("Parameter 'triangle_ends' must be a logical vector with two elements.") - } + } teflc <- triangle_ends_from_limit_cols <- c(!is.null(col_inf), !is.null(col_sup)) if (is.null(triangle_ends) && is.null(col_inf) && is.null(col_sup)) { triangle_ends <- c(FALSE, FALSE) @@ -143,6 +143,16 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, triangle_ends <- triangle_ends } } + if ((bar_limits[1] >= var_limits[1]) && !triange_ends[1]) { + .warning("There are variable values smaller or equal to the lower limit ", + "of the colour bar and the lower triangle end has been ", + "disabled. These will be painted in the colour for NA values.") + } + if ((bar_limits[2] < var_limits[2]) && !triange_ends[2]) { + .warning("There are variable values greater than the higher limit ", + "of the colour bar and the higher triangle end has been ", + "disabled. These will be painted in the colour for NA values.") + } # Generate colours if needed if (is.null(cols)) { -- GitLab From 92b44e7713a0fc88a7a5d8d3be34165db297d049 Mon Sep 17 00:00:00 2001 From: Nicolau Manubens Date: Wed, 1 Feb 2017 22:37:40 +0100 Subject: [PATCH 13/13] Minor improvements. --- R/ColorBar.R | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/R/ColorBar.R b/R/ColorBar.R index 0a325b0e..eb01a9ae 100644 --- a/R/ColorBar.R +++ b/R/ColorBar.R @@ -143,15 +143,17 @@ ColorBar <- function(brks = NULL, cols = NULL, vertical = TRUE, triangle_ends <- triangle_ends } } - if ((bar_limits[1] >= var_limits[1]) && !triange_ends[1]) { - .warning("There are variable values smaller or equal to the lower limit ", - "of the colour bar and the lower triangle end has been ", - "disabled. These will be painted in the colour for NA values.") - } - if ((bar_limits[2] < var_limits[2]) && !triange_ends[2]) { - .warning("There are variable values greater than the higher limit ", - "of the colour bar and the higher triangle end has been ", - "disabled. These will be painted in the colour for NA values.") + if (plot) { + if ((bar_limits[1] >= var_limits[1]) && !triangle_ends[1]) { + .warning("There are variable values smaller or equal to the lower limit ", + "of the colour bar and the lower triangle end has been ", + "disabled. These will be painted in the colour for NA values.") + } + if ((bar_limits[2] < var_limits[2]) && !triangle_ends[2]) { + .warning("There are variable values greater than the higher limit ", + "of the colour bar and the higher triangle end has been ", + "disabled. These will be painted in the colour for NA values.") + } } # Generate colours if needed -- GitLab