Nothing
R/manipulations.R
In PlotFTIR: Plot FTIR Spectra
Defines functions
add_band
highlight_sample
move_plot_legend
rename_plot_sample_ids
add_wavenumber_marker
compress_low_energy
`-.gg`
compress_trans
zoom_in_on_range
Documented in
add_band
add_wavenumber_marker
compress_low_energy
compress_trans
highlight_sample
move_plot_legend
rename_plot_sample_ids
zoom_in_on_range
#' Zoom in on a spectral range
#'
#' @description It's common to be interested in only a small portion of the FTIR
#' range. In these cases, this function will zoom the spectral plot to the
#' range provided.
#'
#' Il est courant de s'intéresser uniquement à une petite partie de la gamme
#' IRTF. Dans ces cas, cette fonction permet de zoomer sur le tracé spectral
#' sur la gamme fournie.
#'
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param zoom_range A vector of length two, with the wavenumber range of
#' interest. Order of provided limits is not important.
#'
#' Un vecteur de longueur deux, avec la gamme de nombres d'ondes de d'intérêt.
#' L'ordre des limites fournies n'est pas important.
#'
#' @return the FTIR plot as a ggplot2 object, with x axis limits as those supplied by
#' `zoom_range`.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec des limites d'axe x comme
#' celles fournies par `zoom_range`.
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' biodiesel_plot <- plot_ftir(biodiesel)
#'
#' # Zoom to a specified range of 1850 to 1650 cm^-1
#' zoom_in_on_range(biodiesel_plot, c(1650, 1850))
#' }
#' @md
zoom_in_on_range <- function(ftir_spectra_plot, zoom_range = c(1000, 1900)) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!(length(zoom_range) == 2) || !all(is.numeric(zoom_range))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg zoom_range} must be a numeric vector of length two."
)
}
data <- ftir_spectra_plot$data
if (
any(zoom_range < min(data$wavenumber), zoom_range > max(data$wavenumber))
) {
cli::cli_abort(
"Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg zoom_range} must be values between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
if ("transmittance" %in% colnames(data)) {
if ('normal' %in% attr(ftir_spectra_plot, 'spectra_style')) {
yrange <- c(0, 100)
} else {
yrange <- c(0, max(c(data$transmittance, 100), na.rm = TRUE))
}
} else {
yrange <- range(
data[
(data$wavenumber > min(zoom_range) & data$wavenumber < max(zoom_range)),
]$absorbance
)
}
suppressMessages(
p <- ftir_spectra_plot +
ggplot2::coord_cartesian(
xlim = c(max(zoom_range), min(zoom_range)),
ylim = yrange
)
)
return(p)
}
#' Compression Transformation
#'
#' @description used in `compress_low_energy()`
#' utilisé en `compress_low_energy`()`
#'
#' @param intercept the wavenumber at which compression starts
#' le nombre d'onde auquel la compression commence
#' @param ratio the rate of compression (larger numbers are more compressed)
#' le taux de compression (des nombres plus grands sont plus compressés)
#'
#' @references From https://stackoverflow.com/a/43321639 & https://stackoverflow.com/a/78360580
#' @keywords internal
compress_trans <- function(intercept = 2000, ratio = 5) {
# For FTIR, note that the plot has scale_x_reverse() always applied to it.
# So, we're really talking about intercept as a -1*intercept
intercept <- intercept * -1
scales::trans_new(
"compress",
transform = function(x) {
ifelse(x > intercept, x, (x - intercept) / ratio + intercept)
},
inverse = function(x) {
ifelse(x > intercept, x, ((x - intercept) * ratio) + intercept)
}
)
}
#' Add GGPlot Layer below others
#'
#' @description Inserts a layer *underneath* the existing layers on a ggplot
#' object simply by calling `plot` - `layer` instead of the usual `plot` +
#' `layer`.
#'
#' Insère un calque *sous* les calques existants sur un objet ggplot
#' simplement en appelant `plot` - `layer` au lieu de l'habituel `plot` +
#' `layer`.
#'
#' @param plot The plot to which the layer should be added.
#'
#' Le tracé auquel le calque doit être ajouté.
#'
#' @param layer The layer to add to the plot.
#'
#' La couche à ajouter au tracé.
#'
#' @return The ggplot2 `plot` object, with layer `layer` added underneath.
#'
#' L'objet ggplot2 `plot`, avec le calque `layer` ajouté en dessous.
#'
#' @export
#'
#' @keywords internal
#'
#' @references From https://stackoverflow.com/a/64011534
#'
#' @md
`-.gg` <- function(plot, layer) {
if (is.null(layer) || missing(layer)) {
cli::cli_abort(c(
"Cannot use {.code -.gg()} with a single argument, it must be followed by a {.arg layer}.",
i = "Did you accidentally put {.code -} on a new line?"
))
}
if (!ggplot2::is.ggplot(plot)) {
cli::cli_abort(
"You need to have a ggplot on the left side. You provided {.obj_type_friendly { plot }}."
)
}
plot$layers <- c(layer, plot$layers)
plot
}
#' Compress Low-Energy Region
#'
#' @description Compress the lower energy region of a FTIR plot (on the x axis) to
#' leave more space for the higher-energy region. This is commonly done for
#' wavenumbers higher than 2000 cm^-1 as the more complex spectra at higher
#' energy (lower wavenumber) is harder to see clearly.
#'
#' Compressez la région de basse énergie d'un tracé d'IRTF (sur l'axe des x) pour
#' laisser plus d'espace à la région de haute énergie. Cette opération
#' généralement réalisée pour les nombres d'onde supérieurs à 2000 cm^-1, car
#' les spectres plus complexes à houte énergie (nombre d'onde
#' plus faible) sont plus difficiles à voir clairement.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param cutoff The wavenumber whereat those at lower energy will be
#' compressed, but those above will be shown normally.
#'
#' Le nombre d'ondes où celles à faible énergie seront comprimées,
#' mais celles au-dessus seront affichées normalement.
#'
#' @param compression_ratio A numeric value indicating the ratio by which to
#' squeeze the data
#'
#' Une valeur numérique indiquant le rapport selon lequel compresser les
#' données
#'
#' @return the FTIR plot as a ggplot2 object, with x axis compressed for some
#' wavenumber range
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec l'axe des x comprimé pour
#' une certaine gamme de nombres d'ondes
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' biodiesel_plot <- plot_ftir(biodiesel)
#'
#' # Compress below 2000 cm^-1 by a factor of 5
#' compress_low_energy(biodiesel_plot, cutoff = 2000, compression_ratio = 5)
#' }
compress_low_energy <- function(
ftir_spectra_plot,
cutoff = 2000,
compression_ratio = 2
) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!is.numeric(cutoff)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg cutoff} must be a numeric value. You provided {.obj_type_friendly {cutoff}}."
)
}
data <- ftir_spectra_plot$data
if (cutoff < min(data$wavenumber) || cutoff > max(data$wavenumber)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg cutoff} must be a value between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
if (!is.numeric(compression_ratio)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg compression_ratio} must be a numeric value. You provided {.obj_type_friendly {compression_ratio}}."
)
}
if (compression_ratio < 0.01 || compression_ratio > 100) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg compression_ratio} must be a value between 0.01 and 100."
)
}
p <- ftir_spectra_plot +
ggplot2::coord_trans(
x = compress_trans(intercept = cutoff, ratio = compression_ratio)
)
return(p)
}
#' Add a Marker at a Wavenumber
#'
#' @description Add a vertical line marker, at a given wavenumber, to an FTIR
#' plot, and label at the top of the plot with a provided text (or by default
#' the wavenumber of the marker). This is useful for noting important
#' wavenumbers.
#'
#' This function can be called repeatedly. Note that older labels will be
#' covered by newer labels if they overlap.
#'
#' Ajoutez un marqueur de ligne verticale, à un nombre d'ondes donné, à un
#' tracé FTIR, et l'étiquette en haut du tracé avec un texte fourni (ou par
#' défaut le nombre d'ondes du marqueur). Cette fonction est utile pour noter
#' les nombres d'ondes importants. Cette fonction peut être appelée plusieurs
#' fois.
#'
#' Notez que les vieux labels seront couverts par les nouveaux s'ils se
#' chevauchent.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param wavenumber the wavenumber at which the marker should be placed.
#'
#' le nombre d'ondes auquel le marqueur doit être placé.
#'
#' @param text The text of the label over the marker (optional). If no text is
#' provided, the label will show the wavenumber (rounded to the nearest whole
#' number).
#'
#' Le texte de l'étiquette au-dessus du marqueur (facultatif). Si aucun texte
#' n'est fourni, l'étiquette indiquera le nombre d'ondes (arrondi au nombre
#' entier le plus proche).
#'
#' @param line_aesthetics A named `list` of aesthetics to pass to ggplot for
#' creating the vertical line. See `[ggplot2::geom_path()]`'s aesthetics
#' section for more info. Specifically, `alpha`, `colo(u)r`, `linetype` and
#' `linewidth` are permitted. Positioning aesthetics will be removed.
#'
#' Une `list` nommée d'esthétiques à transmettre à ggplot pour créer la ligne
#' verticale. Voir la section esthétique de `[ggplot2::geom_path()]` pour plus
#' d'informations. Plus précisément, `alpha`, `colo(u)r`, `linetype` et
#' `linewidth`` sont autorisés. Les aspects esthétiques du positionnement
#' seront supprimés.
#'
#' @param label_aesthetics A named `list` of aesthetics to pass to ggplot for
#' creating the label. See `[ggplot2::geom_text()]`'s aesthetics section for
#' more info. Specifically, `alpha`, `colo(u)r`, `family`, `fill`, `fontface` and
#' `size`are permitted. Positioning aesthetics will be removed.
#'
#' Une `list` nommée d'esthétiques à transmettre à ggplot pour créer
#' l'étiquette. Voir la section esthétique de `[ggplot2::geom_text()]` pour
#' plus d'informations. Plus précisément, `alpha`, `colo(u)r`, `family`, `fill`,
#' `fontface` et `size` sont autorisés. Les aspects esthétiques du
#' positionnement seront supprimés.
#'
#' @return the FTIR plot as a ggplot2 object, with a marker added at the
#' specified wavenumber.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec un marqueur ajouté au nombre
#' d'ondes spécifié.
#'
#' @seealso See `vignette("ggplot2-specs")` for more information on setting
#' aesthetics.
#'
#' Voir `vignette("ggplot2-specs")` pour plus d'informations sur la définition
#' de l'esthétique.
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' biodiesel_plot <- plot_ftir(biodiesel)
#'
#' # Add a marker at 1742 cm^-1 for the carbonyl C=O Stretch
#' p <- add_wavenumber_marker(biodiesel_plot, 1742, text = "C=O Stretch")
#' p
#'
#' # Add a second marker and use a dashed line for the C-H aliphatic stretch
#' add_wavenumber_marker(p, 2920,
#' text = "C-H Stretch",
#' line_aesthetics = list("linetype" = "dashed")
#' )
#' }
#' @md
#'
#' @seealso [add_band()]
add_wavenumber_marker <- function(
ftir_spectra_plot,
wavenumber,
text = NULL,
line_aesthetics = NULL,
label_aesthetics = NULL
) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!is.numeric(wavenumber)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg wavenumber} must be a numeric value. You provided {.obj_type_friendly {wavenumber}}."
)
}
if (!is.null(text)) {
if (is.data.frame(text) || is.matrix(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (!is.numeric(text) && !is.character(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (length(text) > 1) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg text} should be character or numeric, but not a vector of length greater than one."
)
}
} else {
text <- as.character(as.integer(wavenumber))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
data <- ftir_spectra_plot$data
if (wavenumber < min(data$wavenumber) || wavenumber > max(data$wavenumber)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg wavenumber} must be a value between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
p <- ftir_spectra_plot -
rlang::inject(ggplot2::geom_vline(
xintercept = wavenumber,
!!!line_aesthetics
)) +
rlang::inject(ggplot2::annotate(
"label",
label = text,
x = wavenumber,
y = Inf,
vjust = 1,
!!!label_aesthetics
))
return(p)
}
#' Rename Sample IDs in Plot
#'
#' @description This function permits renaming Sample IDs as shown in the legend
#' of a plot. While typically having proper names assigned in the data is
#' preferred, this function allows for names to be modified after plot
#' creation.
#'
#' Cette fonction permet de renommer les identifiants des échantillons dans la
#' légende d'un tracé. Bien qu'il soit préférable d'attribuer les noms
#' appropriés dans les données, cette fonction permet de modifier les noms
#' après la création du tracé.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param sample_ids A named vector of format `"new name" = "old name"`. Must
#' include *all* sample ID old names (a pair of `"old name" = "old name"` is
#' permissible and results in no renaming for that sample).
#'
#' Un vecteur nommé du format `"nouveau nom" = "ancien nom"`. Doit inclure
#' *tous* les anciens noms d'ID d'échantillon (une paire de `"ancien nom" =
#' "ancien nom"` est autorisée et n'entraîne aucun changement de nom pour cet
#' échantillon).
#'
#' @return the FTIR plot as a ggplot2 object, with samples renamed in the
#' legend.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec les échantillons renommés dans
#' la légende.
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Rename Samples in Legend:
#' new_ids <- c(
#' "Toluene" = "toluene", "C7 Alkanes" = "heptanes", "IPA" = "isopropanol",
#' "White Paper" = "paper", "PS Film" = "polystyrene"
#' )
#' rename_plot_sample_ids(p, new_ids)
#' }
#' @md
rename_plot_sample_ids <- function(ftir_spectra_plot, sample_ids) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::rename_plot_sample_ids}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
preexisting_sampleids <- as.vector(get_plot_sample_ids(ftir_spectra_plot))
if (!(all(sample_ids %in% preexisting_sampleids))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::rename_plot_sample_ids}. All provided 'old names' must be in the {.arg ftir_spectra_plot}."
)
}
if (!(all(preexisting_sampleids %in% sample_ids))) {
additional_sampleids <- preexisting_sampleids[
!(preexisting_sampleids %in% sample_ids)
]
names(additional_sampleids) <- additional_sampleids
sample_ids <- c(sample_ids, additional_sampleids)
}
new_ids <- names(sample_ids)
names(new_ids) <- unname(sample_ids)
# removing the old scales prevents the warning message from printing
ftir_spectra_plot$scales$scales <- list()
if (
!requireNamespace("ggthemes", quietly = TRUE) ||
length(unique(ftir_spectra_plot$sample_id)) > 15
) {
p <- ftir_spectra_plot +
ggplot2::scale_color_viridis_d(labels = new_ids) +
ggplot2::scale_x_reverse()
} else {
p <- ftir_spectra_plot +
ggthemes::scale_color_calc(labels = new_ids) +
ggplot2::scale_x_reverse(breaks = scales::breaks_extended())
}
return(p)
}
#' Move Plot Legend
#'
#' @description A shortcut to basic plot legend modifications. The plot legend
#' can be moved to different locations, justifieid in those locations, and/or
#' changed from vertical to horizontal. By default, legends are positioned
#' with `position = "right"`, `justification = "center"`, and
#' `direction = "vertical"`.
#'
#' For more complex legend manipulation please perform using [ggplot::theme()]
#' controls directly on the plot object. More information at
#' [https://ggplot2.tidyverse.org/reference/theme.html](https://ggplot2.tidyverse.org/reference/theme.html#examples).
#'
#' Un raccourci vers les modifications de base de la légende du tracé. La
#' légende du tracé peut être déplacée à différents emplacements, justifiée à
#' ces endroits et/ou modifiée de verticale à horizontale. Par défaut, les
#' légendes sont positionnées avec `position = "right"`,
#' `justification = "center"` et `direction = "vertical"`.
#'
#' Pour une manipulation plus complexe de légende, veuillez utiliser les
#' contrôles [ggplot::theme()] directement sur l'objet de tracé. Pour plus
#' d'informations, voir
#' [https://ggplot2.tidyverse.org/reference/theme.html](https://ggplot2.tidyverse.org/reference/theme.html#examples).
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param position Position for the legend. One of `"none"`, `"left"`,
#' `"right"`, `"bottom"`, or `"top"`.
#'
#' Position pour la légende. Un des `"none"`, `"left"`, `"right"`, `"bottom"`,
#' ou `"top"`.
#'
#' @param justification Justification for the legend. One of `"top"`,
#' `"bottom"`, `"center"`, `"left"`, or `"right"`.
#'
#' Justification de la légende. Un des `"top"`, `"bottom"`, `"center"`,
#' `"left"`, ou `"right"`.
#'
#' @param direction Direction for the legend. One of `"horizontal"` or
#' `"vertical"`.
#'
#' Direction de la légende. L'un des `"horizontal"` ou `"vertical"`.
#'
#' @param legend_title_position A position for the legend title relative to the
#' legend items. One of `"top"`, `"right"`, `"left"`, or `"bottom"`.
#'
#' Une position pour le titre de la légende par rapport aux éléments de
#' légende. Un des `"top"`, `"right"`, `"left"`, ou `"bottom"`.
#'
#' @return the FTIR plot as a ggplot2 object, with legend relocated as required.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec la légende déplacée si
#' nécessaire
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Move legend to bottom:
#' move_plot_legend(p, position = "bottom", direction = "horizontal")
#' }
move_plot_legend <- function(
ftir_spectra_plot,
position = NULL,
justification = NULL,
direction = NULL,
legend_title_position = NULL
) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!is.null(position)) {
allowed_positions <- c("none", "left", "right", "bottom", "top")
if (!(position %in% allowed_positions)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg position} must be one of {.or {.val {allowed_positions}}}, or NULL."
)
}
}
if (!is.null(justification)) {
allowed_justifications <- c("top", "bottom", "center", "left", "right")
if (!(justification %in% allowed_justifications)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. Error in {.fn PlotFTIR::move_plot_legend}. {.arg justification} must be one of {.or {.val {allowed_justifications}}}, or NULL."
)
}
}
if (!is.null(direction)) {
allowed_directions <- c("horizontal", "vertical")
if (!(direction %in% allowed_directions)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg direction} must be one of {.or {.val {allowed_directions}}}, or NULL."
)
}
}
if (!is.null(legend_title_position)) {
allowed_title_pos <- c("top", "bottom", "left", "right")
if (!(legend_title_position %in% allowed_title_pos)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg legend_title_position} must be one of {.or {.val {allowed_title_pos}}}, or NULL."
)
}
}
p <- ftir_spectra_plot +
ggplot2::theme(
legend.position = position,
legend.justification = justification,
legend.direction = direction,
legend.title.position = legend_title_position
)
return(p)
}
#' Highlight Sample Spectra
#'
#' @description
#' Highlight one or more sample spectra on a spectral image. Changes all un-selected `sample_id`s to grey lines. Requires [gghighlight::gghighlight()] to function.
#'
#' Surligne un ou plusieurs spectres d'échantillons sur une image spectrale. Change tous les spectres `sample_id`s non sélectionnés en lignes grises. Nécessite [gghighlight::gghighlight()] pour fonctionner.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#' @param sample_ids A vector of one or more `sample_id`s from the `ftir_spectra_plot` to highlight.
#'
#' Un vecteur d'un ou plusieurs `sample_id`s du `ftir_spectra_plot` à souligner.
#'
#' @param ... Additional parameters to pass to [gghighlight::gghighlight()].
#'
#' Paramètres supplémentaires à passer à [gghighlight::gghighlight()].
#'
#' @return the FTIR plot as a ggplot2 object, with selected sample spectra highlighted.
#'
#' le tracé FTIR en tant qu'objet ggplot2, avec les spectres de l'échantillon sélectionné soulignier.
#'
#' @export
#' @md
#' @seealso [gghighlight::gghighlight()]
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE) & requireNamespace("gghighlight", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Highlight one sample:
#' highlight_sample(p, "isopropanol")
#' }
highlight_sample <- function(ftir_spectra_plot, sample_ids, ...) {
if (!requireNamespace("ggplot2")) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!requireNamespace("gghighlight")) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg gghighlight} package installation.",
i = "Install {.pkg gghighlight} with {.run install.packages('gghighlight')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::highlight_sample}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
preexisting_sampleids <- as.vector(get_plot_sample_ids(ftir_spectra_plot))
if (!(all(sample_ids %in% preexisting_sampleids))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::highlight_sample}. All provided {.arg sample_ids} must be in the {.arg ftir_spectra_plot}."
)
}
p <- suppressWarnings(
ftir_spectra_plot +
gghighlight::gghighlight(.data$sample_id %in% sample_ids),
...
)
return(p)
}
#' Add Band
#'
#' @description
#' Add a shaded band (with optional text overlay) to a FTIR spectral region, to visually highlight an area.
#'
#' Ajoutez une bande ombrée (avec un texte en option) à une région spectrale FTIR, pour mettre visuellement en évidence une zone.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param wavenumber_range A vector of length two, with the wavenumber range of the shaded band.
#' Order of provided limits is not important.
#'
#' Un vecteur de longueur deux, avec la gamme de nombres d'ondes de la bande ombrée.
#' L'ordre des limites fournies n'est pas important.
#'
#'
#' @param text The text of the label over the band (optional).
#'
#' Le texte de l'étiquette au-dessus du bande (facultatif).
#'
#' @param colour A colour for the shaded band. Note that alpha will be set to 0.5.
#' A default blue band will be added if not provided.
#' See `vignette("ggplot2-specs", "ggplot2")` for more information on aesthetics in graphics.
#'
#' Une couleur pour la bande ombrée. Notez que la valeur alpha est fixée à 0,5.
#' Une bande bleue sera ajoutée par défaut si aucune valeur n'est fournie.
#' Voir `vignette(« ggplot2-specs », « ggplot2 »)` pour plus d'informations sur l'esthétique dans les graphiques.
#'
#' @param label_aesthetics A named `list` of aesthetics to pass to ggplot for
#' creating the label. See `[ggplot2::geom_text()]`'s aesthetics section for
#' more info. Specifically, `alpha`, `colo(u)r`, `family`, `fill`, `fontface` and
#' `size`are permitted. Positioning aesthetics will be removed.
#'
#' Une `list` nommée d'esthétiques à transmettre à ggplot pour créer
#' l'étiquette. Voir la section esthétique de `[ggplot2::geom_text()]` pour
#' plus d'informations. Plus précisément, `alpha`, `colo(u)r`, `family`, `fill`,
#' `fontface` et `size` sont autorisés. Les aspects esthétiques du
#' positionnement seront supprimés.
#'
#' @return the FTIR plot as a ggplot2 object, with the shaded band added.
#'
#' le tracé FTIR en tant qu'objet ggplot2, avec la bande ombrée ajoutée.
#'
#' @export
#' @md
#' @seealso [add_wavenumber_marker()]
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Add a band to -OH region:
#' add_band(p, c(3600, 3100), "-OH Stretch")
#' }
add_band <- function(
ftir_spectra_plot,
wavenumber_range,
text = NULL,
colour = NULL,
label_aesthetics = NULL
) {
if (!requireNamespace("ggplot2")) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!is.null(text)) {
if (is.data.frame(text) || is.matrix(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (!is.numeric(text) && !is.character(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (length(text) > 1) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg text} should be character or numeric, but not a vector of length greater than one."
)
}
} else {
text <- ""
}
if (!(length(wavenumber_range) == 2) || !all(is.numeric(wavenumber_range))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg wavenumber_range} must be a numeric vector of length two."
)
}
if (wavenumber_range[1] == wavenumber_range[2]) {
# IF both wavenumbers are the same, then add a marker there, since a 0 width band won't show
return(add_wavenumber_marker(
ftir_spectra_plot = ftir_spectra_plot,
wavenumber = wavenumber_range[1],
text = text,
label_aesthetics = label_aesthetics,
line_aesthetics = list(color = colour)
))
}
wavenumber_range <- wavenumber_range[order(wavenumber_range)]
data <- ftir_spectra_plot$data
if (
any(wavenumber_range < min(data$wavenumber)) ||
any(wavenumber_range > max(data$wavenumber))
) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg wavenumber_range} must be values between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
if (is.null(colour)) {
colour <- "#80c7ff"
}
p <- ftir_spectra_plot -
ggplot2::annotate(
"rect",
fill = colour,
xmin = min(wavenumber_range),
xmax = max(wavenumber_range),
ymin = -Inf,
ymax = Inf,
alpha = 0.5
)
if (text != "") {
p <- p +
rlang::inject(ggplot2::annotate(
"label",
label = text,
x = mean(wavenumber_range),
y = Inf,
vjust = 1,
!!!label_aesthetics
))
}
return(p)
}
Try the PlotFTIR package in your browser
Any scripts or data that you put into this service are public.
PlotFTIR documentation built on April 13, 2025, 5:11 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions add_band highlight_sample move_plot_legend rename_plot_sample_ids add_wavenumber_marker compress_low_energy `-.gg` compress_trans zoom_in_on_range
Documented in add_band add_wavenumber_marker compress_low_energy compress_trans highlight_sample move_plot_legend rename_plot_sample_ids zoom_in_on_range
#' Zoom in on a spectral range
#'
#' @description It's common to be interested in only a small portion of the FTIR
#' range. In these cases, this function will zoom the spectral plot to the
#' range provided.
#'
#' Il est courant de s'intéresser uniquement à une petite partie de la gamme
#' IRTF. Dans ces cas, cette fonction permet de zoomer sur le tracé spectral
#' sur la gamme fournie.
#'
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param zoom_range A vector of length two, with the wavenumber range of
#' interest. Order of provided limits is not important.
#'
#' Un vecteur de longueur deux, avec la gamme de nombres d'ondes de d'intérêt.
#' L'ordre des limites fournies n'est pas important.
#'
#' @return the FTIR plot as a ggplot2 object, with x axis limits as those supplied by
#' `zoom_range`.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec des limites d'axe x comme
#' celles fournies par `zoom_range`.
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' biodiesel_plot <- plot_ftir(biodiesel)
#'
#' # Zoom to a specified range of 1850 to 1650 cm^-1
#' zoom_in_on_range(biodiesel_plot, c(1650, 1850))
#' }
#' @md
zoom_in_on_range <- function(ftir_spectra_plot, zoom_range = c(1000, 1900)) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!(length(zoom_range) == 2) || !all(is.numeric(zoom_range))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg zoom_range} must be a numeric vector of length two."
)
}
data <- ftir_spectra_plot$data
if (
any(zoom_range < min(data$wavenumber), zoom_range > max(data$wavenumber))
) {
cli::cli_abort(
"Error in {.fn PlotFTIR::zoom_in_on_range}. {.arg zoom_range} must be values between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
if ("transmittance" %in% colnames(data)) {
if ('normal' %in% attr(ftir_spectra_plot, 'spectra_style')) {
yrange <- c(0, 100)
} else {
yrange <- c(0, max(c(data$transmittance, 100), na.rm = TRUE))
}
} else {
yrange <- range(
data[
(data$wavenumber > min(zoom_range) & data$wavenumber < max(zoom_range)),
]$absorbance
)
}
suppressMessages(
p <- ftir_spectra_plot +
ggplot2::coord_cartesian(
xlim = c(max(zoom_range), min(zoom_range)),
ylim = yrange
)
)
return(p)
}
#' Compression Transformation
#'
#' @description used in `compress_low_energy()`
#' utilisé en `compress_low_energy`()`
#'
#' @param intercept the wavenumber at which compression starts
#' le nombre d'onde auquel la compression commence
#' @param ratio the rate of compression (larger numbers are more compressed)
#' le taux de compression (des nombres plus grands sont plus compressés)
#'
#' @references From https://stackoverflow.com/a/43321639 & https://stackoverflow.com/a/78360580
#' @keywords internal
compress_trans <- function(intercept = 2000, ratio = 5) {
# For FTIR, note that the plot has scale_x_reverse() always applied to it.
# So, we're really talking about intercept as a -1*intercept
intercept <- intercept * -1
scales::trans_new(
"compress",
transform = function(x) {
ifelse(x > intercept, x, (x - intercept) / ratio + intercept)
},
inverse = function(x) {
ifelse(x > intercept, x, ((x - intercept) * ratio) + intercept)
}
)
}
#' Add GGPlot Layer below others
#'
#' @description Inserts a layer *underneath* the existing layers on a ggplot
#' object simply by calling `plot` - `layer` instead of the usual `plot` +
#' `layer`.
#'
#' Insère un calque *sous* les calques existants sur un objet ggplot
#' simplement en appelant `plot` - `layer` au lieu de l'habituel `plot` +
#' `layer`.
#'
#' @param plot The plot to which the layer should be added.
#'
#' Le tracé auquel le calque doit être ajouté.
#'
#' @param layer The layer to add to the plot.
#'
#' La couche à ajouter au tracé.
#'
#' @return The ggplot2 `plot` object, with layer `layer` added underneath.
#'
#' L'objet ggplot2 `plot`, avec le calque `layer` ajouté en dessous.
#'
#' @export
#'
#' @keywords internal
#'
#' @references From https://stackoverflow.com/a/64011534
#'
#' @md
`-.gg` <- function(plot, layer) {
if (is.null(layer) || missing(layer)) {
cli::cli_abort(c(
"Cannot use {.code -.gg()} with a single argument, it must be followed by a {.arg layer}.",
i = "Did you accidentally put {.code -} on a new line?"
))
}
if (!ggplot2::is.ggplot(plot)) {
cli::cli_abort(
"You need to have a ggplot on the left side. You provided {.obj_type_friendly { plot }}."
)
}
plot$layers <- c(layer, plot$layers)
plot
}
#' Compress Low-Energy Region
#'
#' @description Compress the lower energy region of a FTIR plot (on the x axis) to
#' leave more space for the higher-energy region. This is commonly done for
#' wavenumbers higher than 2000 cm^-1 as the more complex spectra at higher
#' energy (lower wavenumber) is harder to see clearly.
#'
#' Compressez la région de basse énergie d'un tracé d'IRTF (sur l'axe des x) pour
#' laisser plus d'espace à la région de haute énergie. Cette opération
#' généralement réalisée pour les nombres d'onde supérieurs à 2000 cm^-1, car
#' les spectres plus complexes à houte énergie (nombre d'onde
#' plus faible) sont plus difficiles à voir clairement.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param cutoff The wavenumber whereat those at lower energy will be
#' compressed, but those above will be shown normally.
#'
#' Le nombre d'ondes où celles à faible énergie seront comprimées,
#' mais celles au-dessus seront affichées normalement.
#'
#' @param compression_ratio A numeric value indicating the ratio by which to
#' squeeze the data
#'
#' Une valeur numérique indiquant le rapport selon lequel compresser les
#' données
#'
#' @return the FTIR plot as a ggplot2 object, with x axis compressed for some
#' wavenumber range
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec l'axe des x comprimé pour
#' une certaine gamme de nombres d'ondes
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' biodiesel_plot <- plot_ftir(biodiesel)
#'
#' # Compress below 2000 cm^-1 by a factor of 5
#' compress_low_energy(biodiesel_plot, cutoff = 2000, compression_ratio = 5)
#' }
compress_low_energy <- function(
ftir_spectra_plot,
cutoff = 2000,
compression_ratio = 2
) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!is.numeric(cutoff)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg cutoff} must be a numeric value. You provided {.obj_type_friendly {cutoff}}."
)
}
data <- ftir_spectra_plot$data
if (cutoff < min(data$wavenumber) || cutoff > max(data$wavenumber)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg cutoff} must be a value between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
if (!is.numeric(compression_ratio)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg compression_ratio} must be a numeric value. You provided {.obj_type_friendly {compression_ratio}}."
)
}
if (compression_ratio < 0.01 || compression_ratio > 100) {
cli::cli_abort(
"Error in {.fn PlotFTIR::compress_low_energy}. {.arg compression_ratio} must be a value between 0.01 and 100."
)
}
p <- ftir_spectra_plot +
ggplot2::coord_trans(
x = compress_trans(intercept = cutoff, ratio = compression_ratio)
)
return(p)
}
#' Add a Marker at a Wavenumber
#'
#' @description Add a vertical line marker, at a given wavenumber, to an FTIR
#' plot, and label at the top of the plot with a provided text (or by default
#' the wavenumber of the marker). This is useful for noting important
#' wavenumbers.
#'
#' This function can be called repeatedly. Note that older labels will be
#' covered by newer labels if they overlap.
#'
#' Ajoutez un marqueur de ligne verticale, à un nombre d'ondes donné, à un
#' tracé FTIR, et l'étiquette en haut du tracé avec un texte fourni (ou par
#' défaut le nombre d'ondes du marqueur). Cette fonction est utile pour noter
#' les nombres d'ondes importants. Cette fonction peut être appelée plusieurs
#' fois.
#'
#' Notez que les vieux labels seront couverts par les nouveaux s'ils se
#' chevauchent.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param wavenumber the wavenumber at which the marker should be placed.
#'
#' le nombre d'ondes auquel le marqueur doit être placé.
#'
#' @param text The text of the label over the marker (optional). If no text is
#' provided, the label will show the wavenumber (rounded to the nearest whole
#' number).
#'
#' Le texte de l'étiquette au-dessus du marqueur (facultatif). Si aucun texte
#' n'est fourni, l'étiquette indiquera le nombre d'ondes (arrondi au nombre
#' entier le plus proche).
#'
#' @param line_aesthetics A named `list` of aesthetics to pass to ggplot for
#' creating the vertical line. See `[ggplot2::geom_path()]`'s aesthetics
#' section for more info. Specifically, `alpha`, `colo(u)r`, `linetype` and
#' `linewidth` are permitted. Positioning aesthetics will be removed.
#'
#' Une `list` nommée d'esthétiques à transmettre à ggplot pour créer la ligne
#' verticale. Voir la section esthétique de `[ggplot2::geom_path()]` pour plus
#' d'informations. Plus précisément, `alpha`, `colo(u)r`, `linetype` et
#' `linewidth`` sont autorisés. Les aspects esthétiques du positionnement
#' seront supprimés.
#'
#' @param label_aesthetics A named `list` of aesthetics to pass to ggplot for
#' creating the label. See `[ggplot2::geom_text()]`'s aesthetics section for
#' more info. Specifically, `alpha`, `colo(u)r`, `family`, `fill`, `fontface` and
#' `size`are permitted. Positioning aesthetics will be removed.
#'
#' Une `list` nommée d'esthétiques à transmettre à ggplot pour créer
#' l'étiquette. Voir la section esthétique de `[ggplot2::geom_text()]` pour
#' plus d'informations. Plus précisément, `alpha`, `colo(u)r`, `family`, `fill`,
#' `fontface` et `size` sont autorisés. Les aspects esthétiques du
#' positionnement seront supprimés.
#'
#' @return the FTIR plot as a ggplot2 object, with a marker added at the
#' specified wavenumber.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec un marqueur ajouté au nombre
#' d'ondes spécifié.
#'
#' @seealso See `vignette("ggplot2-specs")` for more information on setting
#' aesthetics.
#'
#' Voir `vignette("ggplot2-specs")` pour plus d'informations sur la définition
#' de l'esthétique.
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' biodiesel_plot <- plot_ftir(biodiesel)
#'
#' # Add a marker at 1742 cm^-1 for the carbonyl C=O Stretch
#' p <- add_wavenumber_marker(biodiesel_plot, 1742, text = "C=O Stretch")
#' p
#'
#' # Add a second marker and use a dashed line for the C-H aliphatic stretch
#' add_wavenumber_marker(p, 2920,
#' text = "C-H Stretch",
#' line_aesthetics = list("linetype" = "dashed")
#' )
#' }
#' @md
#'
#' @seealso [add_band()]
add_wavenumber_marker <- function(
ftir_spectra_plot,
wavenumber,
text = NULL,
line_aesthetics = NULL,
label_aesthetics = NULL
) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!is.numeric(wavenumber)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg wavenumber} must be a numeric value. You provided {.obj_type_friendly {wavenumber}}."
)
}
if (!is.null(text)) {
if (is.data.frame(text) || is.matrix(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (!is.numeric(text) && !is.character(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (length(text) > 1) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg text} should be character or numeric, but not a vector of length greater than one."
)
}
} else {
text <- as.character(as.integer(wavenumber))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
data <- ftir_spectra_plot$data
if (wavenumber < min(data$wavenumber) || wavenumber > max(data$wavenumber)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_wavenumber_marker}. {.arg wavenumber} must be a value between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
p <- ftir_spectra_plot -
rlang::inject(ggplot2::geom_vline(
xintercept = wavenumber,
!!!line_aesthetics
)) +
rlang::inject(ggplot2::annotate(
"label",
label = text,
x = wavenumber,
y = Inf,
vjust = 1,
!!!label_aesthetics
))
return(p)
}
#' Rename Sample IDs in Plot
#'
#' @description This function permits renaming Sample IDs as shown in the legend
#' of a plot. While typically having proper names assigned in the data is
#' preferred, this function allows for names to be modified after plot
#' creation.
#'
#' Cette fonction permet de renommer les identifiants des échantillons dans la
#' légende d'un tracé. Bien qu'il soit préférable d'attribuer les noms
#' appropriés dans les données, cette fonction permet de modifier les noms
#' après la création du tracé.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param sample_ids A named vector of format `"new name" = "old name"`. Must
#' include *all* sample ID old names (a pair of `"old name" = "old name"` is
#' permissible and results in no renaming for that sample).
#'
#' Un vecteur nommé du format `"nouveau nom" = "ancien nom"`. Doit inclure
#' *tous* les anciens noms d'ID d'échantillon (une paire de `"ancien nom" =
#' "ancien nom"` est autorisée et n'entraîne aucun changement de nom pour cet
#' échantillon).
#'
#' @return the FTIR plot as a ggplot2 object, with samples renamed in the
#' legend.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec les échantillons renommés dans
#' la légende.
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Rename Samples in Legend:
#' new_ids <- c(
#' "Toluene" = "toluene", "C7 Alkanes" = "heptanes", "IPA" = "isopropanol",
#' "White Paper" = "paper", "PS Film" = "polystyrene"
#' )
#' rename_plot_sample_ids(p, new_ids)
#' }
#' @md
rename_plot_sample_ids <- function(ftir_spectra_plot, sample_ids) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::rename_plot_sample_ids}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
preexisting_sampleids <- as.vector(get_plot_sample_ids(ftir_spectra_plot))
if (!(all(sample_ids %in% preexisting_sampleids))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::rename_plot_sample_ids}. All provided 'old names' must be in the {.arg ftir_spectra_plot}."
)
}
if (!(all(preexisting_sampleids %in% sample_ids))) {
additional_sampleids <- preexisting_sampleids[
!(preexisting_sampleids %in% sample_ids)
]
names(additional_sampleids) <- additional_sampleids
sample_ids <- c(sample_ids, additional_sampleids)
}
new_ids <- names(sample_ids)
names(new_ids) <- unname(sample_ids)
# removing the old scales prevents the warning message from printing
ftir_spectra_plot$scales$scales <- list()
if (
!requireNamespace("ggthemes", quietly = TRUE) ||
length(unique(ftir_spectra_plot$sample_id)) > 15
) {
p <- ftir_spectra_plot +
ggplot2::scale_color_viridis_d(labels = new_ids) +
ggplot2::scale_x_reverse()
} else {
p <- ftir_spectra_plot +
ggthemes::scale_color_calc(labels = new_ids) +
ggplot2::scale_x_reverse(breaks = scales::breaks_extended())
}
return(p)
}
#' Move Plot Legend
#'
#' @description A shortcut to basic plot legend modifications. The plot legend
#' can be moved to different locations, justifieid in those locations, and/or
#' changed from vertical to horizontal. By default, legends are positioned
#' with `position = "right"`, `justification = "center"`, and
#' `direction = "vertical"`.
#'
#' For more complex legend manipulation please perform using [ggplot::theme()]
#' controls directly on the plot object. More information at
#' [https://ggplot2.tidyverse.org/reference/theme.html](https://ggplot2.tidyverse.org/reference/theme.html#examples).
#'
#' Un raccourci vers les modifications de base de la légende du tracé. La
#' légende du tracé peut être déplacée à différents emplacements, justifiée à
#' ces endroits et/ou modifiée de verticale à horizontale. Par défaut, les
#' légendes sont positionnées avec `position = "right"`,
#' `justification = "center"` et `direction = "vertical"`.
#'
#' Pour une manipulation plus complexe de légende, veuillez utiliser les
#' contrôles [ggplot::theme()] directement sur l'objet de tracé. Pour plus
#' d'informations, voir
#' [https://ggplot2.tidyverse.org/reference/theme.html](https://ggplot2.tidyverse.org/reference/theme.html#examples).
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param position Position for the legend. One of `"none"`, `"left"`,
#' `"right"`, `"bottom"`, or `"top"`.
#'
#' Position pour la légende. Un des `"none"`, `"left"`, `"right"`, `"bottom"`,
#' ou `"top"`.
#'
#' @param justification Justification for the legend. One of `"top"`,
#' `"bottom"`, `"center"`, `"left"`, or `"right"`.
#'
#' Justification de la légende. Un des `"top"`, `"bottom"`, `"center"`,
#' `"left"`, ou `"right"`.
#'
#' @param direction Direction for the legend. One of `"horizontal"` or
#' `"vertical"`.
#'
#' Direction de la légende. L'un des `"horizontal"` ou `"vertical"`.
#'
#' @param legend_title_position A position for the legend title relative to the
#' legend items. One of `"top"`, `"right"`, `"left"`, or `"bottom"`.
#'
#' Une position pour le titre de la légende par rapport aux éléments de
#' légende. Un des `"top"`, `"right"`, `"left"`, ou `"bottom"`.
#'
#' @return the FTIR plot as a ggplot2 object, with legend relocated as required.
#'
#' le tracé IRTF en tant qu'objet ggplot2, avec la légende déplacée si
#' nécessaire
#'
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Move legend to bottom:
#' move_plot_legend(p, position = "bottom", direction = "horizontal")
#' }
move_plot_legend <- function(
ftir_spectra_plot,
position = NULL,
justification = NULL,
direction = NULL,
legend_title_position = NULL
) {
# Package Checks
if (!requireNamespace("ggplot2", quietly = TRUE)) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!is.null(position)) {
allowed_positions <- c("none", "left", "right", "bottom", "top")
if (!(position %in% allowed_positions)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg position} must be one of {.or {.val {allowed_positions}}}, or NULL."
)
}
}
if (!is.null(justification)) {
allowed_justifications <- c("top", "bottom", "center", "left", "right")
if (!(justification %in% allowed_justifications)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. Error in {.fn PlotFTIR::move_plot_legend}. {.arg justification} must be one of {.or {.val {allowed_justifications}}}, or NULL."
)
}
}
if (!is.null(direction)) {
allowed_directions <- c("horizontal", "vertical")
if (!(direction %in% allowed_directions)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg direction} must be one of {.or {.val {allowed_directions}}}, or NULL."
)
}
}
if (!is.null(legend_title_position)) {
allowed_title_pos <- c("top", "bottom", "left", "right")
if (!(legend_title_position %in% allowed_title_pos)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::move_plot_legend}. {.arg legend_title_position} must be one of {.or {.val {allowed_title_pos}}}, or NULL."
)
}
}
p <- ftir_spectra_plot +
ggplot2::theme(
legend.position = position,
legend.justification = justification,
legend.direction = direction,
legend.title.position = legend_title_position
)
return(p)
}
#' Highlight Sample Spectra
#'
#' @description
#' Highlight one or more sample spectra on a spectral image. Changes all un-selected `sample_id`s to grey lines. Requires [gghighlight::gghighlight()] to function.
#'
#' Surligne un ou plusieurs spectres d'échantillons sur une image spectrale. Change tous les spectres `sample_id`s non sélectionnés en lignes grises. Nécessite [gghighlight::gghighlight()] pour fonctionner.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#' @param sample_ids A vector of one or more `sample_id`s from the `ftir_spectra_plot` to highlight.
#'
#' Un vecteur d'un ou plusieurs `sample_id`s du `ftir_spectra_plot` à souligner.
#'
#' @param ... Additional parameters to pass to [gghighlight::gghighlight()].
#'
#' Paramètres supplémentaires à passer à [gghighlight::gghighlight()].
#'
#' @return the FTIR plot as a ggplot2 object, with selected sample spectra highlighted.
#'
#' le tracé FTIR en tant qu'objet ggplot2, avec les spectres de l'échantillon sélectionné soulignier.
#'
#' @export
#' @md
#' @seealso [gghighlight::gghighlight()]
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE) & requireNamespace("gghighlight", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Highlight one sample:
#' highlight_sample(p, "isopropanol")
#' }
highlight_sample <- function(ftir_spectra_plot, sample_ids, ...) {
if (!requireNamespace("ggplot2")) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!requireNamespace("gghighlight")) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg gghighlight} package installation.",
i = "Install {.pkg gghighlight} with {.run install.packages('gghighlight')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::highlight_sample}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
preexisting_sampleids <- as.vector(get_plot_sample_ids(ftir_spectra_plot))
if (!(all(sample_ids %in% preexisting_sampleids))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::highlight_sample}. All provided {.arg sample_ids} must be in the {.arg ftir_spectra_plot}."
)
}
p <- suppressWarnings(
ftir_spectra_plot +
gghighlight::gghighlight(.data$sample_id %in% sample_ids),
...
)
return(p)
}
#' Add Band
#'
#' @description
#' Add a shaded band (with optional text overlay) to a FTIR spectral region, to visually highlight an area.
#'
#' Ajoutez une bande ombrée (avec un texte en option) à une région spectrale FTIR, pour mettre visuellement en évidence une zone.
#'
#' @param ftir_spectra_plot A plot generated by [plot_ftir()] or
#' [plot_ftir_stacked()].
#'
#' Un tracé généré par [plot_ftir()] ou [plot_ftir_stacked()].
#'
#' @param wavenumber_range A vector of length two, with the wavenumber range of the shaded band.
#' Order of provided limits is not important.
#'
#' Un vecteur de longueur deux, avec la gamme de nombres d'ondes de la bande ombrée.
#' L'ordre des limites fournies n'est pas important.
#'
#'
#' @param text The text of the label over the band (optional).
#'
#' Le texte de l'étiquette au-dessus du bande (facultatif).
#'
#' @param colour A colour for the shaded band. Note that alpha will be set to 0.5.
#' A default blue band will be added if not provided.
#' See `vignette("ggplot2-specs", "ggplot2")` for more information on aesthetics in graphics.
#'
#' Une couleur pour la bande ombrée. Notez que la valeur alpha est fixée à 0,5.
#' Une bande bleue sera ajoutée par défaut si aucune valeur n'est fournie.
#' Voir `vignette(« ggplot2-specs », « ggplot2 »)` pour plus d'informations sur l'esthétique dans les graphiques.
#'
#' @param label_aesthetics A named `list` of aesthetics to pass to ggplot for
#' creating the label. See `[ggplot2::geom_text()]`'s aesthetics section for
#' more info. Specifically, `alpha`, `colo(u)r`, `family`, `fill`, `fontface` and
#' `size`are permitted. Positioning aesthetics will be removed.
#'
#' Une `list` nommée d'esthétiques à transmettre à ggplot pour créer
#' l'étiquette. Voir la section esthétique de `[ggplot2::geom_text()]` pour
#' plus d'informations. Plus précisément, `alpha`, `colo(u)r`, `family`, `fill`,
#' `fontface` et `size` sont autorisés. Les aspects esthétiques du
#' positionnement seront supprimés.
#'
#' @return the FTIR plot as a ggplot2 object, with the shaded band added.
#'
#' le tracé FTIR en tant qu'objet ggplot2, avec la bande ombrée ajoutée.
#'
#' @export
#' @md
#' @seealso [add_wavenumber_marker()]
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#' # Generate a plot
#' p <- plot_ftir(sample_spectra)
#'
#' # Add a band to -OH region:
#' add_band(p, c(3600, 3100), "-OH Stretch")
#' }
add_band <- function(
ftir_spectra_plot,
wavenumber_range,
text = NULL,
colour = NULL,
label_aesthetics = NULL
) {
if (!requireNamespace("ggplot2")) {
cli::cli_abort(c(
"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",
i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"
))
}
if (!ggplot2::is.ggplot(ftir_spectra_plot)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg ftir_spectra_plot} must be a ggplot object. You provided {.obj_type_friendly {ftir_spectra_plot}}."
)
}
if (!is.null(text)) {
if (is.data.frame(text) || is.matrix(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (!is.numeric(text) && !is.character(text)) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg text} must be character or numeric, you provided {.obj_type_friendly {text}}."
)
} else if (length(text) > 1) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg text} should be character or numeric, but not a vector of length greater than one."
)
}
} else {
text <- ""
}
if (!(length(wavenumber_range) == 2) || !all(is.numeric(wavenumber_range))) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg wavenumber_range} must be a numeric vector of length two."
)
}
if (wavenumber_range[1] == wavenumber_range[2]) {
# IF both wavenumbers are the same, then add a marker there, since a 0 width band won't show
return(add_wavenumber_marker(
ftir_spectra_plot = ftir_spectra_plot,
wavenumber = wavenumber_range[1],
text = text,
label_aesthetics = label_aesthetics,
line_aesthetics = list(color = colour)
))
}
wavenumber_range <- wavenumber_range[order(wavenumber_range)]
data <- ftir_spectra_plot$data
if (
any(wavenumber_range < min(data$wavenumber)) ||
any(wavenumber_range > max(data$wavenumber))
) {
cli::cli_abort(
"Error in {.fn PlotFTIR::add_band}. {.arg wavenumber_range} must be values between {round(min(data$wavenumber))} and {round(max(data$wavenumber))} cm^-1."
)
}
if (is.null(colour)) {
colour <- "#80c7ff"
}
p <- ftir_spectra_plot -
ggplot2::annotate(
"rect",
fill = colour,
xmin = min(wavenumber_range),
xmax = max(wavenumber_range),
ymin = -Inf,
ymax = Inf,
alpha = 0.5
)
if (text != "") {
p <- p +
rlang::inject(ggplot2::annotate(
"label",
label = text,
x = mean(wavenumber_range),
y = Inf,
vjust = 1,
!!!label_aesthetics
))
}
return(p)
}
Try the PlotFTIR package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.