Nothing
#' Find wavelength for target quantity value.
#'
#' \code{stat_find_wls} finds at which x positions values equal to a target are
#' located.
#'
#' @param mapping The aesthetic mapping, usually constructed with
#' \code{\link[ggplot2]{aes}} or \code{\link[ggplot2]{aes_}}. Only needs to be
#' set at the layer level if you are overriding the plot defaults.
#' @param data A layer specific dataset - only needed if you want to override
#' the plot defaults.
#' @param geom The geometric object to use display the data
#' @param position The position adjustment to use for overlapping points on this
#' layer
#' @param show.legend logical. Should this layer be included in the legends?
#' \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE}
#' never includes, and \code{TRUE} always includes.
#' @param inherit.aes If \code{FALSE}, overrides the default aesthetics, rather
#' than combining with them. This is most useful for helper functions that
#' define both data and aesthetics and shouldn't inherit behaviour from the
#' default plot specification, e.g. \code{\link[ggplot2]{borders}}.
#' @param ... other arguments passed on to \code{\link[ggplot2]{layer}}. This
#' can include aesthetics whose values you want to set, not map. See
#' \code{\link[ggplot2]{layer}} for more details.
#' @param na.rm a logical value indicating whether NA values should be stripped
#' before the computation proceeds.
#' @param target numeric vector indicating the spectral quantity values for
#' which wavelengths are to be searched and interpolated if need. The
#' \code{character} strings "half.maximum" and "half.range" are also accepted
#' as arguments. A list with \code{numeric} and/or \code{character} values is
#' also accepted.
#' @param interpolate logical Indicating whether the nearest wavelength value in
#' \code{x} should be returned or a value calculated by linear interpolation
#' between wavelength values stradling the target.
#' @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}}.
#'
#' @return A data frame with one row for each match to \code{target} found in
#' the data.
#'
#' @section Computed variables: \describe{ \item{x}{x-value at or nearest to the
#' match to the target as numeric} \item{y}{target value or y-value nearest to
#' the target as numeric} \item{x.label}{x-value at or nearest to the match
#' formatted as character} \item{y.label}{target value or y-value nearest to
#' the target formatted as character} \item{wl.color}{color definition calculated
#' by assuming that x-values are wavelengths expressed in nanometres.} }
#'
#' @section Default aesthetics: Set by the statistic and available to geoms.
#' \describe{ \item{label}{..x.label..} \item{xintercept}{..x..}
#' \item{yintercept}{..y..} \item{fill}{..wl.color..} }
#'
#' @section Required aesthetics: Required by the statistic and need to be set
#' with \code{aes()}. \describe{ \item{x}{numeric, wavelength in nanometres}
#' \item{y}{numeric, a spectral quantity} }
#'
#' @seealso \code{\link[photobiology]{find_peaks}}.
#'
#' @details These stats use \code{geom_point} by default as it is the geom most
#' likely to work well in almost any situation without need of tweaking. The
#' default aesthetics set by these stats 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.
#'
#' @note These stats work nicely together with geoms \code{geom_text_repel} and
#' \code{geom_label_repel} from package \code{\link[ggrepel]{ggrepel}} to
#' solve the problem of overlapping labels by displacing them. To discard
#' overlapping labels use \code{check_overlap = TRUE} as argument to
#' \code{geom_text}. By default the labels are character values suitable to be
#' plotted as is, but with a suitable \code{label.fmt} labels suitable for
#' parsing by the geoms (e.g. into expressions containing greek letters or
#' super or subscripts) can be also easily obtained.
#'
#' @examples
#'
#' # ggplot() methods for spectral objects set a default mapping for x and y.
#' ggplot(yellow_gel.spct) + geom_line() +
#' stat_find_wls(target = c(0.25, 0.5, 0.75))
#' ggplot(yellow_gel.spct) + geom_line() +
#' stat_find_wls(target = "half.maximum", geom = "point", colour = "red") +
#' stat_find_wls(target = "half.maximum", geom = "text", colour = "red",
#' hjust = 1.1, label.fmt = "%3.0f nm")
#' @export
#' @family stats functions
#'
stat_find_wls <- function(mapping = NULL,
data = NULL,
geom = "point",
target = "half.maximum",
interpolate = TRUE,
chroma.type = "CMF",
label.fmt = "%.3g",
x.label.fmt = label.fmt,
y.label.fmt = label.fmt,
position = "identity",
na.rm = FALSE,
show.legend = FALSE,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatFindWls, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(target = target,
interpolate = interpolate,
chroma.type = chroma.type,
label.fmt = label.fmt,
x.label.fmt = x.label.fmt,
y.label.fmt = y.label.fmt,
na.rm = na.rm,
...)
)
}
#' @rdname gg2spectra-ggproto
#'
#' @export
#'
StatFindWls <-
ggplot2::ggproto("StatFindWls", ggplot2::Stat,
compute_group = function(data,
scales,
target,
interpolate,
chroma.type,
label.fmt,
x.label.fmt,
y.label.fmt) {
wls.df <- photobiology::wls_at_target(data,
x.var.name = "x",
y.var.name = "y",
target = target,
interpolate = interpolate,
na.rm = FALSE)
wls.df[["x.label"]] <- sprintf(x.label.fmt, wls.df[["x"]])
wls.df[["y.label"]] <- sprintf(y.label.fmt, wls.df[["y"]])
wls.df[["wl.color"]] <-
photobiology::fast_color_of_wl(wls.df[["x"]], chroma.type = chroma.type)
wls.df[["BW.color"]] <- black_or_white(wls.df[["wl.color"]])
wls.df
},
default_aes = ggplot2::aes(label = after_stat(x.label),
fill = after_stat(wl.color),
xintercept = after_stat(x),
yintercept = after_stat(y),
hjust = 0.5,
vjust = 0.5),
required_aes = c("x", "y")
)
#' Find quantity value for target wavelength value.
#'
#' \code{stat_find_qtys} finds at which y positions values equal to an x target
#' are located.
#'
#' @param mapping The aesthetic mapping, usually constructed with
#' \code{\link[ggplot2]{aes}} or \code{\link[ggplot2]{aes_}}. Only needs to be
#' set at the layer level if you are overriding the plot defaults.
#' @param data A layer specific dataset - only needed if you want to override
#' the plot defaults.
#' @param geom The geometric object to use display the data
#' @param position The position adjustment to use for overlapping points on this
#' layer
#' @param show.legend logical. Should this layer be included in the legends?
#' \code{NA}, the default, includes if any aesthetics are mapped. \code{FALSE}
#' never includes, and \code{TRUE} always includes.
#' @param inherit.aes If \code{FALSE}, overrides the default aesthetics, rather
#' than combining with them. This is most useful for helper functions that
#' define both data and aesthetics and shouldn't inherit behaviour from the
#' default plot specification, e.g. \code{\link[ggplot2]{borders}}.
#' @param ... other arguments passed on to \code{\link[ggplot2]{layer}}. This
#' can include aesthetics whose values you want to set, not map. See
#' \code{\link[ggplot2]{layer}} for more details.
#' @param na.rm a logical value indicating whether NA values should be stripped
#' before the computation proceeds.
#' @param target numeric value indicating the spectral quantity value for which
#' wavelengths are to be searched and interpolated if need. The character
#' string "half.maximum" is also accepted as argument.
#' @param interpolate logical Indicating whether the nearest wavelength value
#' in \code{x} should be returned or a value calculated by linear
#' interpolation between wavelength values straddling the target.
#' @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}}.
#'
#' @return A data frame with one row for each match to the target subset from
#' the data or interpolated. As spectra are monotonic in wavelength, this
#' statistic will never return more than one row when used with spectra.
#'
#' @section Computed variables: \describe{ \item{x}{x-value at or nearest to the
#' match to the target as numeric} \item{y}{target value or y-value nearest to
#' the target as numeric} \item{x.label}{x-value at or nearest to the match
#' formatted as character} \item{y.label}{target value or y-value nearest to
#' the target formatted as character} \item{color}{color definition calculated
#' by assuming that x-values are wavelengths expressed in nanometres.} }
#'
#' @section Default aesthetics: Set by the statistic and available to geoms.
#' \describe{ \item{label}{..x.label..} \item{xintercept}{..x..}
#' \item{yintercept}{..y..} \item{fill}{..color..} }
#'
#' @section Required aesthetics: Required by the statistic and need to be set
#' with \code{aes()}. \describe{ \item{x}{numeric, wavelength in nanometres}
#' \item{y}{numeric, a spectral quantity} }
#'
#' @seealso \code{\link[photobiology]{find_peaks}}.
#'
#' @details These stats use \code{geom_point} by default as it is the geom most
#' likely to work well in almost any situation without need of tweaking. The
#' default aesthetics set by these stats 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.
#'
#' @note These stats work nicely together with geoms \code{geom_text_repel} and
#' \code{geom_label_repel} from package \code{\link[ggrepel]{ggrepel}} to
#' solve the problem of overlapping labels by displacing them. To discard
#' overlapping labels use \code{check_overlap = TRUE} as argument to
#' \code{geom_text}. By default the labels are character values suitable to be
#' plotted as is, but with a suitable \code{label.fmt} labels suitable for
#' parsing by the geoms (e.g. into expressions containing greek letters or
#' super or subscripts) can be also easily obtained.
#'
#' @examples
#'
#' # ggplot() methods for spectral objects set a default mapping for x and y.
#' ggplot(yellow_gel.spct) + geom_line() +
#' stat_find_qtys(target = "half.range")
#' ggplot(yellow_gel.spct) + geom_line() +
#' stat_find_qtys(target = c(490, 500, 510))
#' ggplot(yellow_gel.spct) + geom_line() +
#' stat_find_qtys(target = 500, geom = "point", colour = "red") +
#' stat_find_qtys(target = 500, geom = "text", colour = "red",
#' hjust = 1.1, label.fmt = "Tfr = %1.2f")
#' @export
#' @family stats functions
#'
stat_find_qtys <- function(mapping = NULL,
data = NULL,
geom = "point",
target = "half.maximum",
interpolate = TRUE,
chroma.type = "CMF",
label.fmt = "%.3g",
x.label.fmt = label.fmt,
y.label.fmt = label.fmt,
position = "identity",
na.rm = FALSE,
show.legend = FALSE,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatFindQty, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(target = target,
interpolate = interpolate,
chroma.type = chroma.type,
label.fmt = label.fmt,
x.label.fmt = x.label.fmt,
y.label.fmt = y.label.fmt,
na.rm = na.rm,
...)
)
}
#' @rdname gg2spectra-ggproto
#'
#' @export
#'
StatFindQty <-
ggplot2::ggproto("StatFindQty", ggplot2::Stat,
compute_group = function(data,
scales,
target,
interpolate,
chroma.type,
label.fmt,
x.label.fmt,
y.label.fmt) {
# By swapping the column names, we obtain qty values instead of wls
if (is.numeric(target)) {
target <- target[target >= min(data[["x"]], na.rm = TRUE) &
target <= max(data[["x"]], na.rm = TRUE)]
}
if (length(target) == 0L) {
# if target is NULL or an out-of-range then return an empty data frame
rows.df <-
data.frame(x = numeric(),
y = numeric(),
x.label = character(),
y.label = character(),
color = character(),
BW.color = character())
} else {
rows.df <- data.frame()
for (t in target) {
rows.df <-
rbind(rows.df,
photobiology::find_wls(data,
.fun = `<=`,
target = t,
interpolate = interpolate,
col.name.x = "y",
col.name = "x"))
}
rows.df[["x.label"]] <- sprintf(x.label.fmt, rows.df[["x"]])
rows.df[["y.label"]] <- sprintf(y.label.fmt, rows.df[["y"]])
rows.df[["wl.color"]] <-
photobiology::fast_color_of_wl(rows.df[["x"]], chroma.type = chroma.type)
rows.df[["BW.color"]] <- black_or_white(rows.df[["wl.color"]])
}
rows.df
},
default_aes = ggplot2::aes(label = after_stat(y.label),
fill = after_stat(wl.color),
xintercept = after_stat(x),
yintercept = after_stat(y),
hjust = 0.5,
vjust = 0.5),
required_aes = c("x", "y")
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.