Skip to content

Commit

Permalink
Merge branch '14-stat_label_peaks-etc-with-transformed-wavelength-sca…
Browse files Browse the repository at this point in the history 
…les'
  • Loading branch information
@aphalo
aphalo committed Sep 27, 2024
2 parents 63948e7 + d1cf422 commit 9d10403
Show file tree
Hide file tree
Showing 5 changed files with 219 additions and 100 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -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(
Expand Down
133 changes: 94 additions & 39 deletions R/stat-label-peaks.R
View file
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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.
Expand All @@ -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() +
Expand All @@ -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))
Expand All @@ -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,
Expand All @@ -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,
...)
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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,
Expand All @@ -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,
...)
Expand All @@ -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)
Expand All @@ -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))
Expand Down
Loading

0 comments on commit 9d10403

Please sign in to comment.