From d1cf422bb158c7ba55ab34ef69800ad783b9b952 Mon Sep 17 00:00:00 2001 From: Pedro Aphalo Date: Fri, 27 Sep 2024 22:31:31 +0300 Subject: [PATCH] Allow manual back-transform of wavelengths Implemented in stat_peaks(), stat_valleys(), stat_label_peaks() and stat_label_valleys(). --- DESCRIPTION | 2 +- R/stat-label-peaks.R | 133 ++++++++++++++++++++++++++++------------ R/stat-peaks.R | 95 ++++++++++++++++++---------- man/stat_label_peaks.Rd | 71 +++++++++++++++------ man/stat_peaks.Rd | 18 +++--- 5 files changed, 219 insertions(+), 100 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 807b85ed..aad3a619 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: ggspectra Type: Package Title: Extensions to 'ggplot2' for Radiation Spectra -Version: 0.3.13 +Version: 0.3.13.9000 Date: 2024-09-12 Authors@R: c( diff --git a/R/stat-label-peaks.R b/R/stat-label-peaks.R index 6d2d777a..ddb8dd25 100644 --- a/R/stat-label-peaks.R +++ b/R/stat-label-peaks.R @@ -1,8 +1,10 @@ #' Label peaks and valleys. #' #' \code{stat_labels_peaks} finds at which x positions local maxima are located, -#' and adds labels and colors to the data wihtout subsetting. To find local -#' minima, you can use \code{stat_labels_valleys} instead. +#' and adds labels and colors to the data without subsetting. To find local +#' minima, you can use \code{stat_labels_valleys} instead. The variable +#' mapped to the \code{x} aesthetic is expected to contain wavelength values +#' expressed in nanometres. #' #' @param mapping The aesthetic mapping, usually constructed with #' \code{\link[ggplot2]{aes}} or \code{\link[ggplot2]{aes_}}. Only needs to be @@ -34,15 +36,12 @@ #' all other values in its window to be considered a peak. Default: FALSE. #' @param chroma.type character one of "CMF" (color matching function) or "CC" #' (color coordinates) or a \code{\link[photobiology]{chroma_spct}} object. -#' @param label.fmt character string giving a format definition for converting -#' values into character strings by means of function \code{\link{sprintf}}. -#' @param x.label.fmt character string giving a format definition for -#' converting $x$-values into character strings by means of function -#' \code{\link{sprintf}}. -#' @param y.label.fmt character string giving a format definition for -#' converting $y$-values into character strings by means of function -#' \code{\link{sprintf}}. -#' @param label.fill character string ot use for labels not at peaks or valleys +#' @param label.fmt,x.label.fmt,y.label.fmt character strings giving a format +#' definition for construction of character strings labels with function +#' \code{\link{sprintf}} from \code{x} and/or \code{y} values. +#' @param x.label.transform,y.label.transform,colour.transform function Applied +#' to \code{x} or \code{y} values when constructing the character labels. +#' @param label.fill character string to use for labels not at peaks or valleys #' being highlighted. #' #' @return The original data with additional computed variables added. @@ -71,12 +70,22 @@ #' @seealso \code{\link{stat_peaks}}, \code{\link{stat_valleys}} and #' \code{\link[photobiology]{find_peaks}}, which is used internally. #' -#' @details These stats use \code{geom_text} by default as it is the geom most +#' @details These statistics assemble text labels for each peak or valley and +#' compute the colour corresponding to the wavelength of the peaks and +#' valleys. Defaults work as long as the variable mapped to the \code{x} +#' aesthetic contains wavelengths expressed in nanometres and the plot has +#' an x-scale that does not apply a transformation. The three \code{transform} +#' parameters can be used to back-transform the values when scales apply +#' transformations so that peak/valley labels and axis labels match. Of +#' course, \code{x.label.transform} and \code{y.label.transform} make also +#' possible to scale the values in the labels. +#' +#' Both statistics use \code{geom_text} by default as it is the geom most #' likely to work well in almost any situation without need of tweaking. These #' statistics work best with \code{geom_text_repel} and #' \code{geom_label_repel} from package 'ggrepel' as they are designed so that -#' peak or valley labels will not overlapT any observation in the whole data -#' set. Default aesthetics set by these stats allow their direct use with +#' peak or valley labels will not overlap any observation in the whole data +#' set. Default aesthetics set by these statistics allow their direct use with #' \code{geom_text}, \code{geom_label}, \code{geom_line}, \code{geom_rug}, #' \code{geom_hline} and \code{geom_vline}. The formatting of the labels #' returned can be controlled by the user. @@ -93,12 +102,30 @@ #' @examples #' #' # ggplot() methods for spectral objects set a default mapping for x and y. -#' ggplot(sun.spct) + geom_line() + +#' ggplot(sun.spct) + +#' geom_line() + #' stat_label_peaks(hjust = "left", span = 31, angle = 90, color = "red") -#' ggplot(sun.spct) + geom_line() + +#' +#' ggplot(sun.spct) + +#' geom_line() + #' stat_label_valleys(hjust = "right", span = 21, angle = 90, color = "blue") #' -#' ggplot(sun.spct) + geom_line() + +#' # using transformed scales requires the user to pass functions as arguments +#' ggplot(sun.spct) + +#' geom_line() + +#' stat_label_peaks(hjust = "left", span = 31, angle = 90, color = "red", +#' x.label.transform = abs) + +#' scale_x_reverse() +#' +#' ggplot(sun.spct) + +#' geom_line() + +#' stat_label_peaks(hjust = "left", span = 31, angle = 90, color = "red", +#' x.label.transform = function(x) {10^x}) + +#' scale_x_log10() +#' +#' # geom_label +#' ggplot(sun.spct) + +#' geom_line() + #' stat_peaks(span = 41, shape = 21, size = 3) + #' stat_label_peaks(span = 41, geom = "label", label.fmt = "%3.0f nm") + #' scale_fill_identity() + @@ -113,7 +140,8 @@ #' ggplot(sun.spct) + geom_line() + #' stat_peaks(span = 41, shape = 21, size = 3) + #' stat_label_peaks(span = 41, geom = "label_repel", segment.colour = "red", -#' nudge_y = 0.12, label.fmt = "%3.0f nm", vjust = 1) + +#' nudge_y = 0.12, label.fmt = "%3.0f nm", +#' max.overlaps = Inf, min.segment.length = 0) + #' scale_fill_identity() + #' scale_color_identity() + #' expand_limits(y = c(NA, 1)) @@ -135,6 +163,9 @@ stat_label_peaks <- label.fmt = "%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, label.fill = "", na.rm = TRUE, show.legend = FALSE, @@ -149,6 +180,9 @@ stat_label_peaks <- label.fmt = label.fmt, x.label.fmt = x.label.fmt, y.label.fmt = y.label.fmt, + x.label.transform = x.label.transform, + y.label.transform = y.label.transform, + colour.transform = colour.transform, label.fill = label.fill, na.rm = na.rm, ...) @@ -184,6 +218,9 @@ StatLabelPeaks <- label.fmt, x.label.fmt, y.label.fmt, + x.label.transform, + y.label.transform, + colour.transform, label.fill) { if (!is.character(label.fill)) { as.character(label.fill) @@ -200,18 +237,23 @@ StatLabelPeaks <- } out.df[["is_peak"]] <- FALSE out.df[peaks.idx, "is_peak"] <- TRUE - out.df[["x.label"]] <- ifelse(out.df[["is_peak"]], - sprintf(x.label.fmt, out.df[["x"]]), - label.fill) - out.df[["y.label"]] <- ifelse(out.df[["is_peak"]], - sprintf(y.label.fmt, out.df[["y"]]), - label.fill) - out.df[["wl.color"]] <- ifelse(out.df[["is_peak"]], - photobiology::fast_color_of_wl(out.df[["x"]], chroma.type = chroma.type), - rgb(1, 1, 1, 0)) - out.df[["BW.color"]] <- ifelse(out.df[["is_peak"]], - black_or_white(out.df[["wl.color"]]), - rgb(0, 0, 0, 0)) + out.df[["x.label"]] <- + ifelse(out.df[["is_peak"]], + sprintf(x.label.fmt, x.label.transform(out.df[["x"]])), + label.fill) + out.df[["y.label"]] <- + ifelse(out.df[["is_peak"]], + sprintf(y.label.fmt, y.label.transform(out.df[["y"]])), + label.fill) + out.df[["wl.color"]] <- + ifelse(out.df[["is_peak"]], + photobiology::fast_color_of_wl(colour.transform(out.df[["x"]]), + chroma.type = chroma.type), + rgb(1, 1, 1, 0)) + out.df[["BW.color"]] <- + ifelse(out.df[["is_peak"]], + black_or_white(out.df[["wl.color"]]), + rgb(0, 0, 0, 0)) out.df[["lab.hjust"]] <- 0.5 out.df[["lab.vjust"]] <- -0.2 out.df @@ -244,6 +286,9 @@ stat_label_valleys <- function(mapping = NULL, label.fmt = "%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, label.fill = "", na.rm = TRUE, show.legend = FALSE, @@ -258,6 +303,9 @@ stat_label_valleys <- function(mapping = NULL, label.fmt = label.fmt, x.label.fmt = x.label.fmt, y.label.fmt = y.label.fmt, + x.label.transform = x.label.transform, + y.label.transform = y.label.transform, + colour.transform = colour.transform, label.fill = label.fill, na.rm = na.rm, ...) @@ -279,6 +327,9 @@ StatLabelValleys <- label.fmt, x.label.fmt, y.label.fmt, + x.label.transform, + y.label.transform, + colour.transform, label.fill) { if (!is.character(label.fill)) { as.character(label.fill) @@ -295,15 +346,19 @@ StatLabelValleys <- } out.df[["is_valley"]] <- FALSE out.df[valleys.idx, "is_valley"] <- TRUE - out.df[["x.label"]] <- ifelse(out.df[["is_valley"]], - sprintf(x.label.fmt, out.df[["x"]]), - label.fill) - out.df[["y.label"]] <- ifelse(out.df[["is_valley"]], - sprintf(y.label.fmt, out.df[["y"]]), - label.fill) - out.df[["wl.color"]] <- ifelse(out.df[["is_valley"]], - photobiology::fast_color_of_wl(out.df[["x"]], chroma.type = chroma.type), - rgb(1, 1, 1, 0)) + out.df[["x.label"]] <- + ifelse(out.df[["is_valley"]], + sprintf(x.label.fmt, x.label.transform(out.df[["x"]])), + label.fill) + out.df[["y.label"]] <- + ifelse(out.df[["is_valley"]], + sprintf(y.label.fmt, y.label.transform(out.df[["y"]])), + label.fill) + out.df[["wl.color"]] <- + ifelse(out.df[["is_valley"]], + photobiology::fast_color_of_wl(colour.transform(out.df[["x"]]), + chroma.type = chroma.type), + rgb(1, 1, 1, 0)) out.df[["BW.color"]] <- ifelse(out.df[["is_valley"]], black_or_white(out.df[["wl.color"]]), rgb(0, 0, 0, 0)) diff --git a/R/stat-peaks.R b/R/stat-peaks.R index 99a228bf..c0d5dc99 100644 --- a/R/stat-peaks.R +++ b/R/stat-peaks.R @@ -43,12 +43,11 @@ #' fitting. Currently only spline interpolation is implemented. #' @param chroma.type character one of "CMF" (color matching function) or "CC" #' (color coordinates) or a \code{\link[photobiology]{chroma_spct}} object. -#' @param label.fmt character string giving a format definition for converting -#' values into character strings by means of function \code{\link{sprintf}}. -#' @param x.label.fmt character string giving a format definition for converting -#' $x$-values into character strings by means of function \code{\link{sprintf}}. -#' @param y.label.fmt character string giving a format definition for converting -#' $y$-values into character strings by means of function \code{\link{sprintf}}. +#' @param label.fmt,x.label.fmt,y.label.fmt character strings giving a format +#' definition for construction of character strings labels with function +#' \code{\link{sprintf}} from \code{x} and/or \code{y} values. +#' @param x.label.transform,y.label.transform,colour.transform function Applied +#' to \code{x} or \code{y} values when constructing the character labels. #' #' @return A data frame with one row for each peak (or valley) found in the #' data. @@ -158,6 +157,9 @@ stat_peaks <- function(mapping = NULL, label.fmt = "%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, na.rm = FALSE, show.legend = FALSE, inherit.aes = TRUE) { @@ -173,6 +175,9 @@ stat_peaks <- function(mapping = NULL, label.fmt = label.fmt, x.label.fmt = x.label.fmt, y.label.fmt = y.label.fmt, + x.label.transform = x.label.transform, + y.label.transform = y.label.transform, + colour.transform = colour.transform, na.rm = na.rm, ...) ) @@ -208,21 +213,29 @@ StatPeaks <- chroma.type, label.fmt, x.label.fmt, - y.label.fmt) { - peaks.df <- photobiology::peaks(data, - x.var.name = "x", - y.var.name = "y", - span = span, - ignore_threshold = ignore_threshold, - strict = strict, - refine.wl = refine.wl, - method = method, - na.rm = FALSE) - peaks.df[["x.label"]] <- sprintf(x.label.fmt, peaks.df[["x"]]) - peaks.df[["y.label"]] <- sprintf(y.label.fmt, peaks.df[["y"]]) + y.label.fmt, + x.label.transform, + y.label.transform, + colour.transform) { + peaks.df <- + photobiology::peaks(data, + x.var.name = "x", + y.var.name = "y", + span = span, + ignore_threshold = ignore_threshold, + strict = strict, + refine.wl = refine.wl, + method = method, + na.rm = FALSE) + peaks.df[["x.label"]] <- + sprintf(x.label.fmt, x.label.transform(peaks.df[["x"]])) + peaks.df[["y.label"]] <- + sprintf(y.label.fmt, y.label.transform(peaks.df[["y"]])) peaks.df[["wl.color"]] <- - photobiology::fast_color_of_wl(peaks.df[["x"]], chroma.type = chroma.type) - peaks.df[["BW.color"]] <- black_or_white(peaks.df[["wl.color"]]) + photobiology::fast_color_of_wl(colour.transform(peaks.df[["x"]]), + chroma.type = chroma.type) + peaks.df[["BW.color"]] <- + black_or_white(peaks.df[["wl.color"]]) peaks.df }, default_aes = ggplot2::aes(label = after_stat(x.label), @@ -250,6 +263,9 @@ stat_valleys <- function(mapping = NULL, label.fmt = "%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, na.rm = FALSE, show.legend = FALSE, inherit.aes = TRUE) { @@ -265,6 +281,9 @@ stat_valleys <- function(mapping = NULL, label.fmt = label.fmt, x.label.fmt = x.label.fmt, y.label.fmt = y.label.fmt, + x.label.transform = x.label.transform, + y.label.transform = y.label.transform, + colour.transform = colour.transform, na.rm = na.rm, ...) ) @@ -286,21 +305,29 @@ StatValleys <- chroma.type, label.fmt, x.label.fmt, - y.label.fmt) { - valleys.df <- photobiology::valleys(data, - x.var.name = "x", - y.var.name = "y", - span = span, - ignore_threshold = ignore_threshold, - strict = strict, - refine.wl = refine.wl, - method = method, - na.rm = FALSE) - valleys.df[["x.label"]] <- sprintf(x.label.fmt, valleys.df[["x"]]) - valleys.df[["y.label"]] <- sprintf(y.label.fmt, valleys.df[["y"]]) + y.label.fmt, + x.label.transform, + y.label.transform, + colour.transform) { + valleys.df <- + photobiology::valleys(data, + x.var.name = "x", + y.var.name = "y", + span = span, + ignore_threshold = ignore_threshold, + strict = strict, + refine.wl = refine.wl, + method = method, + na.rm = FALSE) + valleys.df[["x.label"]] <- + sprintf(x.label.fmt, x.label.transform(valleys.df[["x"]])) + valleys.df[["y.label"]] <- + sprintf(y.label.fmt, y.label.transform(valleys.df[["y"]])) valleys.df[["wl.color"]] <- - photobiology::fast_color_of_wl(valleys.df[["x"]], chroma.type = chroma.type) - valleys.df[["BW.color"]] <- black_or_white(valleys.df[["wl.color"]]) + photobiology::fast_color_of_wl(colour.transform(valleys.df[["x"]]), + chroma.type = chroma.type) + valleys.df[["BW.color"]] <- + black_or_white(valleys.df[["wl.color"]]) valleys.df }, default_aes = ggplot2::aes(label = after_stat(x.label), diff --git a/man/stat_label_peaks.Rd b/man/stat_label_peaks.Rd index 74372201..041a2d9d 100644 --- a/man/stat_label_peaks.Rd +++ b/man/stat_label_peaks.Rd @@ -18,6 +18,9 @@ stat_label_peaks( label.fmt = "\%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, label.fill = "", na.rm = TRUE, show.legend = FALSE, @@ -37,6 +40,9 @@ stat_label_valleys( label.fmt = "\%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, label.fill = "", na.rm = TRUE, show.legend = FALSE, @@ -74,18 +80,14 @@ all other values in its window to be considered a peak. Default: FALSE.} \item{chroma.type}{character one of "CMF" (color matching function) or "CC" (color coordinates) or a \code{\link[photobiology]{chroma_spct}} object.} -\item{label.fmt}{character string giving a format definition for converting -values into character strings by means of function \code{\link{sprintf}}.} +\item{label.fmt, x.label.fmt, y.label.fmt}{character strings giving a format +definition for construction of character strings labels with function +\code{\link{sprintf}} from \code{x} and/or \code{y} values.} -\item{x.label.fmt}{character string giving a format definition for -converting $x$-values into character strings by means of function -\code{\link{sprintf}}.} +\item{x.label.transform, y.label.transform, colour.transform}{function Applied +to \code{x} or \code{y} values when constructing the character labels.} -\item{y.label.fmt}{character string giving a format definition for -converting $y$-values into character strings by means of function -\code{\link{sprintf}}.} - -\item{label.fill}{character string ot use for labels not at peaks or valleys +\item{label.fill}{character string to use for labels not at peaks or valleys being highlighted.} \item{na.rm}{a logical value indicating whether NA values should be stripped @@ -105,16 +107,28 @@ The original data with additional computed variables added. } \description{ \code{stat_labels_peaks} finds at which x positions local maxima are located, -and adds labels and colors to the data wihtout subsetting. To find local -minima, you can use \code{stat_labels_valleys} instead. +and adds labels and colors to the data without subsetting. To find local +minima, you can use \code{stat_labels_valleys} instead. The variable +mapped to the \code{x} aesthetic is expected to contain wavelength values +expressed in nanometres. } \details{ -These stats use \code{geom_text} by default as it is the geom most +These statistics assemble text labels for each peak or valley and + compute the colour corresponding to the wavelength of the peaks and + valleys. Defaults work as long as the variable mapped to the \code{x} + aesthetic contains wavelengths expressed in nanometres and the plot has + an x-scale that does not apply a transformation. The three \code{transform} + parameters can be used to back-transform the values when scales apply + transformations so that peak/valley labels and axis labels match. Of + course, \code{x.label.transform} and \code{y.label.transform} make also + possible to scale the values in the labels. + + Both statistics use \code{geom_text} by default as it is the geom most likely to work well in almost any situation without need of tweaking. These statistics work best with \code{geom_text_repel} and \code{geom_label_repel} from package 'ggrepel' as they are designed so that - peak or valley labels will not overlapT any observation in the whole data - set. Default aesthetics set by these stats allow their direct use with + peak or valley labels will not overlap any observation in the whole data + set. Default aesthetics set by these statistics allow their direct use with \code{geom_text}, \code{geom_label}, \code{geom_line}, \code{geom_rug}, \code{geom_hline} and \code{geom_vline}. The formatting of the labels returned can be controlled by the user. @@ -159,12 +173,30 @@ These stats work nicely together with geoms \code{geom_text_repel} and \examples{ # ggplot() methods for spectral objects set a default mapping for x and y. -ggplot(sun.spct) + geom_line() + +ggplot(sun.spct) + + geom_line() + stat_label_peaks(hjust = "left", span = 31, angle = 90, color = "red") -ggplot(sun.spct) + geom_line() + + +ggplot(sun.spct) + + geom_line() + stat_label_valleys(hjust = "right", span = 21, angle = 90, color = "blue") -ggplot(sun.spct) + geom_line() + +# using transformed scales requires the user to pass functions as arguments +ggplot(sun.spct) + + geom_line() + + stat_label_peaks(hjust = "left", span = 31, angle = 90, color = "red", + x.label.transform = abs) + + scale_x_reverse() + +ggplot(sun.spct) + + geom_line() + + stat_label_peaks(hjust = "left", span = 31, angle = 90, color = "red", + x.label.transform = function(x) {10^x}) + + scale_x_log10() + +# geom_label +ggplot(sun.spct) + + geom_line() + stat_peaks(span = 41, shape = 21, size = 3) + stat_label_peaks(span = 41, geom = "label", label.fmt = "\%3.0f nm") + scale_fill_identity() + @@ -179,7 +211,8 @@ library(ggrepel) ggplot(sun.spct) + geom_line() + stat_peaks(span = 41, shape = 21, size = 3) + stat_label_peaks(span = 41, geom = "label_repel", segment.colour = "red", - nudge_y = 0.12, label.fmt = "\%3.0f nm", vjust = 1) + + nudge_y = 0.12, label.fmt = "\%3.0f nm", + max.overlaps = Inf, min.segment.length = 0) + scale_fill_identity() + scale_color_identity() + expand_limits(y = c(NA, 1)) diff --git a/man/stat_peaks.Rd b/man/stat_peaks.Rd index 4a360f70..f684abb5 100644 --- a/man/stat_peaks.Rd +++ b/man/stat_peaks.Rd @@ -20,6 +20,9 @@ stat_peaks( label.fmt = "\%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, na.rm = FALSE, show.legend = FALSE, inherit.aes = TRUE @@ -40,6 +43,9 @@ stat_valleys( label.fmt = "\%.3g", x.label.fmt = label.fmt, y.label.fmt = label.fmt, + x.label.transform = I, + y.label.transform = I, + colour.transform = x.label.transform, na.rm = FALSE, show.legend = FALSE, inherit.aes = TRUE @@ -88,14 +94,12 @@ fitting. Currently only spline interpolation is implemented.} \item{chroma.type}{character one of "CMF" (color matching function) or "CC" (color coordinates) or a \code{\link[photobiology]{chroma_spct}} object.} -\item{label.fmt}{character string giving a format definition for converting -values into character strings by means of function \code{\link{sprintf}}.} +\item{label.fmt, x.label.fmt, y.label.fmt}{character strings giving a format +definition for construction of character strings labels with function +\code{\link{sprintf}} from \code{x} and/or \code{y} values.} -\item{x.label.fmt}{character string giving a format definition for converting -$x$-values into character strings by means of function \code{\link{sprintf}}.} - -\item{y.label.fmt}{character string giving a format definition for converting -$y$-values into character strings by means of function \code{\link{sprintf}}.} +\item{x.label.transform, y.label.transform, colour.transform}{function Applied +to \code{x} or \code{y} values when constructing the character labels.} \item{na.rm}{a logical value indicating whether NA values should be stripped before the computation proceeds.}