17212036758

Committed 25 Aug 2025 02:37PM UTC coverage: 55.617% (-42.8%) from 98.398%

Build # 17212036758

Build Type

Pull #24

github

Committed by

web-flow

Commit Message

Merge 93a6ede4b into f690f0636

Pull Request Pull Request #24: Updates to ggplot label access in testing ggplot labels

Run Details

2 of 30 new or added lines in 4 files covered. (6.67%)

593 existing lines in 4 files now uncovered.

807 of 1451 relevant lines covered (55.62%)

8.08 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

8.22

/R/plot_ftir.R

# Plot FTIR Spectra

#' PlotFTIR core plot generator
#'
#' @description Plot the FTIR spectra in a journal prepared format. Call
#'   [plot_ftir()] for basic (overlaid) plots and [plot_ftir_stacked()] for
#'   stacked and offset plots.
#'
#'   Tracez les spectres IRTF dans un format préparé par un journal. Appelez
#'   [plot_ftir()] pour les tracés de base (superposés) et [plot_ftir_stacked()]
#'   pour les tracés empilés et décalés.
#'
#' @param ftir A data.frame in long format with columns `sample_id`,
#'   `wavenumber`, and `absorbance`. The `absorbance` column may be replaced by
#'   a `transmittance` column for transmittance plots. The code determines the
#'   correct y axis units and labels the plot/adjusts the margins appropriately.
#'
#'   Un data.frame au format long avec les colonnes `sample_id`, `wavenumber`,
#'   et `absorbance`. La colonne `absorbance` peut être remplacée par une
#'   colonne `transmittance` pour les tracés de transmission. Le code détermine
#'   les unités correctes de l'axe y et étiquette le tracé/ajuste les marges de
#'   manière appropriée.
#'
#' @param plot_title A title for a plot. Defaults to "FTIR Spectra". If a vector
#'   length two, the second element will be used for a subtitle.
#'
#'   Un titre pour une trace. La valeur par défaut est «FTIR Spectra». Si un
#'   vecteur mesure deux, le deuxième élément sera utilisé pour un sous-titre.
#'
#' @param legend_title A title for the legend. Defaults to "Sample ID".
#'
#'   Un titre pour la légende. La valeur par défaut est «Sample ID».
#'
#' @param lang An optional argument for language. If set to one of `fr`,
#'   `french`, `francais`, or `français` the axis and default plot and legend
#'   titles will change to french. If non-default legend or plot titles are
#'   provided they are used as-is. You can also provide `en`, `english` or
#'   `anglais`, or (the default) `NA` will use the default language from user
#'   options. To set a permanent default, set `options("PlotFTIR.lang" = "en")`
#'   or `options("PlotFTIR.lang" = "fr")` for English or French, respectively.
#'
#'   Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`,
#'   ou `Français`, l'axe et les titres par défaut de le tracé et du légende
#'   seront en français. Si des titres du légende ou de tracé autres que ceux
#'   par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi
#'   fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le
#'   langue par défaut des options de l'utilisateur. Pour définir une valeur
#'   par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou
#'   `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français,
#'   respectivement.
#'
#' @keywords internal
#'
#' @return a ggplot object containing a  FTIR spectral plot. The plot and legend
#'   titles are as provided, with each sample provided a different default
#'   color. Because this is a ggplot object, any other ggplot modifiers, layers,
#'   or changes can be applied to the returned object. Further manipulations can
#'   be performed by this package. Peut également fournir `en`, `english` ou
#'   `anglais`.
#'
#'   un objet ggplot contenant un tracé spectral IRTF. Les titres de le tracé et
#'   de la légende sont tels que fournis, avec une couleur par défaut différente
#'   pour chaque échantillon. Puisqu'il s'agit d'un objet ggplot, tous les
#'   autres modificateurs, calques ou changements ggplot peuvent être appliqués
#'   à l'objet retourné. D'autres manipulations peuvent être effectuées par ce
#'   package.
#'
#' @seealso [zoom_in_on_range()] to 'zoom' into a specified range,
#'   [compress_low_energy()] to make the x axis non-linear (compressing lower
#'   energy regions), [add_wavenumber_marker()] to add markers to highlight
#'   important wavenumbers, and [move_plot_legend()] to modify the legend
#'   position.
#'
#'   [zoom_in_on_range()] pour 'zoomer' sur une gamme spécifiée,
#'   [compress_low_energy()] pour rendre l'axe x non linéaire (en compression
#'   les régions à basse énergie), [add_wavenumber_marker()] pour ajouter des
#'   marqueurs afin de mettre en évidence les nombres d'ondes importants, et
#'   [move_plot_legend()] pour modifier la position de la légende.
#'
plot_ftir_core <- function(
  ftir,
  plot_title = "FTIR Spectra",
  legend_title = "Sample ID",
  lang = NA
) {
  # 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')}"
    ))
  }

  ftir <- check_ftir_data(ftir)
  if (!is.character(plot_title) || length(plot_title) > 2) {
    cli::cli_abort(
      "Error in {.fn PlotFTIR:::plot_ftir_core}. {.arg plot_title} must be a character string or vector of strings with length not more than two."
    )
  }
  if (!is.character(legend_title) || length(legend_title) > 1) {
    cli::cli_abort(
      "Error in {.fn PlotFTIR:::plot_ftir_core}. {.arg legend_title} must be a single character string."
    )
  }
  if (length(unique(ftir$sample_id)) > 12) {
    cli::cli_warn(c(
      "Warning in {.fn PlotFTIR:::plot_ftir_core}. The color palette in use works best with 12 or fewer unique samples in {.arg ftir}.",
      i = "You have a total of {length(unique(ftir$sample_id))} unique sample IDs."
    ))
  }

  # if language is provided, check against permitted, else use default from options
  if (!is.na(lang)) {
    lang <- rlang::arg_match(
      lang,
      values = c(
        "en",
        "english",
        "anglais",
        "fr",
        "french",
        "francais",
        "fran\u00e7ais"
      ),
      multiple = FALSE
    )
  } else {
    lang <- getOption("PlotFTIR.lang", default = "en")
  }

  l <- substr(lang, 0, 2)
  if (l == "fr") {
    if (all(plot_title == "FTIR Spectra")) {
      plot_title <- "Spectres IRTF"
    }
    if (legend_title == "Sample ID") {
      legend_title <- "ID de l'\u00e9chantillon"
    }
  }

  mode <- attr(ftir, "intensity")

  if (l == "fr") {
    xtitle <- bquote("Nombre d'onde" ~ (cm^-1))
  } else {
    xtitle <- bquote("Wavenumber" ~ (cm^-1))
  }

  ytitle <- ifelse(
    mode %in% c("absorbance", "normalized absorbance"),
    "Absorbance",
    "% Transmittance"
  )

  if (grepl("normalized", mode)) {
    ytitle <- paste("Normalized", ytitle)
  }

  ftir <- ftir[stats::complete.cases(ftir), ]
  ftir$wavenumber <- as.numeric(ftir$wavenumber)

  if (grepl("absorbance", mode)) {
    ftir$absorbance <- as.numeric(ftir$absorbance)
    p <- ggplot2::ggplot(ftir) +
      ggplot2::geom_line(ggplot2::aes(
        x = .data$wavenumber,
        y = .data$absorbance,
        color = as.factor(.data$sample_id)
      )) +
      ggplot2::scale_y_continuous()
  } else {
    ftir$transmittance <- as.numeric(ftir$transmittance)
    p <- ggplot2::ggplot(ftir) +
      ggplot2::geom_line(ggplot2::aes(
        x = .data$wavenumber,
        y = .data$transmittance,
        color = as.factor(.data$sample_id)
      )) +
      ggplot2::scale_y_continuous(breaks = scales::breaks_width(20)) +
      ggplot2::coord_cartesian(ylim = c(0, 100))
  }

  p <- p +
    ggplot2::labs(
      title = plot_title[1],
      subtitle = if (length(plot_title) < 2) NULL else plot_title[2], # Can't return Null from ifelse()
      x = xtitle,
      y = ytitle
    ) +
    ggplot2::guides(
      color = ggplot2::guide_legend(title = legend_title),
      x = ggplot2::guide_axis(minor.ticks = TRUE)
    ) +
    ggplot2::theme_light() +
    ggplot2::scale_x_reverse(
      breaks = scales::breaks_extended(),
      expand = ggplot2::expansion()
    )

  if (
    !requireNamespace("ggthemes", quietly = TRUE) ||
      length(unique(ftir$sample_id)) > 15
  ) {
    p <- p +
      ggplot2::scale_color_viridis_d()
  } else {
    p <- p +
      ggthemes::scale_color_calc()
  }

  if (grepl("normalized", mode)) {
    p <- p +
      ggplot2::theme(
        axis.text.y = ggplot2::element_blank()
      )
  }

  attr(p, "intensity") <- attr(ftir, "intensity")

  return(p)
}


#' Plot FTIR in stacked format
#'
#' @description Plot the FTIR spectra in a journal prepared format. It may be
#'  desirable to plot spectra 'stacked and offset' by a certain amount. In this
#'  case the y axis becomes non-labelled and each charts baseline (0 for
#'  absorbance or 100 for transmittance) is offset by a certain amount.
#'
#'  Tracez les spectres IRTF dans un format préparé par un journal. Il peut être
#'  souhaitable de tracer les spectres 'empilés et décalés' d'une
#'  certaine quantité. Dans ce cas l'axe y devient non étiqueté et
#'  chaque ligne de base du graphique (0 pour absorbance ou 100 pour la
#'  transmittance) est décalée d'une certaine quantité.
#'
#' @inheritParams plot_ftir_core
#' @param stack_offset The amount in percentage of stacking offset to use. For
#'  transmittance this is directly linked to the units of Y axis, for absorbance
#'  this is about 0.2 absorbance units.
#'
#'  Le montant en pourcentage de décalage d'empilement à utiliser. Pour
#'  transmittance, cette valeur est directement liée aux unités de l'axe y, pour
#'  l'absorbance cela représente environ 0,2 unités d'absorbance.
#'
#' @inherit plot_ftir_core return
#'
#' @inherit plot_ftir_core seealso
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#'   # Plot FTIR spectras stacked showing the differences in the `biodiesel` dataset
#'   plot_ftir_stacked(biodiesel)
#' }
plot_ftir_stacked <- function(
  ftir,
  plot_title = "FTIR Spectra",
  legend_title = "Sample ID",
  stack_offset = 10,
  lang = NA
) {
  ftir <- check_ftir_data(ftir)

  if (!is.numeric(stack_offset) || length(stack_offset) > 1) {
    cli::cli_abort(
      "Error in {.fn PlotFTIR:::plot_ftir_stacked}. {.arg stack_offset} must be a single numeric value."
    )
  }
  if (stack_offset < 0 || stack_offset > 200) {
    cli::cli_abort(
      "Error in {.fn PlotFTIR:::plot_ftir_stacked}. {.arg stack_offset} must be between 0 and 200."
    )
  }

  mode <- attr(ftir, "intensity")

  # Stack FTIR traces by 10% of range number of unique samples
  stack_samples <- unique(ftir$sample_id)
  nsamples <- length(unique(stack_samples))

  if (nsamples > 1) {
    if (grepl("absorbance", mode)) {
      # Transmittance gets an offset of stack_offset % against a percentage scale
      # for absorbance, most signals max out around 2 so that's the range.
      stack_offset <- (stack_offset / 100) * 2.0
    }
    offset <- data.frame(
      "sample_id" = stack_samples,
      "offset" = seq(from = 0, by = stack_offset, length.out = nsamples)
    )

    ftir <- merge(x = ftir, y = offset, by = "sample_id")
    if (grepl("absorbance", mode)) {
      ftir$absorbance <- ftir$absorbance + ftir$offset
    } else {
      ftir$transmittance <- ftir$transmittance + ftir$offset
    }
    ftir$offset <- NULL
  }

  p <- plot_ftir_core(
    ftir = ftir,
    plot_title = plot_title,
    legend_title = legend_title,
    lang = lang
  )

  p <- p + ggplot2::theme(axis.text.y = ggplot2::element_blank())
  suppressMessages(p <- p + ggplot2::coord_cartesian(ylim = c(0, NA)))

  if (grepl("absorbance", mode)) {
    p <- p + ggplot2::ylab("Absorbance (a.u.)")
  } else {
    p <- p + ggplot2::ylab("Transmittance (a.u.)")
  }

  attr(p, "spectra_style") <- "stacked"

  return(p)
}


#' Plot FTIR Spectra Overlaid
#'
#' @description Produce a basic spectra overlay plot for all samples found in
#' the FTIR dataset provided.
#'
#' Produisez un tracé de base de superposition de spectres pour tous les
#' échantillons trouvés dans l'ensemble de données IRTF fourni.
#'
#' @inherit plot_ftir_core params return
#' @export
#'
#' @examples
#' if (requireNamespace("ggplot2", quietly = TRUE)) {
#'   # Plot a basic FTIR Spectra overlay from the `sample_spectra` data set with default titles
#'   plot_ftir(sample_spectra)
#' }
plot_ftir <- function(
  ftir,
  plot_title = "FTIR Spectra",
  legend_title = "Sample ID",
  lang = NA
) {
  ftir <- check_ftir_data(ftir)
  p <- plot_ftir_core(
    ftir = ftir,
    plot_title = plot_title,
    legend_title = legend_title,
    lang = lang
  )

  attr(p, "spectra_style") <- "normal"

  return(p)
}

1	# Plot FTIR Spectra
2
3	#' PlotFTIR core plot generator
4	#'
5	#' @description Plot the FTIR spectra in a journal prepared format. Call
6	#' [plot_ftir()] for basic (overlaid) plots and [plot_ftir_stacked()] for
7	#' stacked and offset plots.
8	#'
9	#' Tracez les spectres IRTF dans un format préparé par un journal. Appelez
10	#' [plot_ftir()] pour les tracés de base (superposés) et [plot_ftir_stacked()]
11	#' pour les tracés empilés et décalés.
12	#'
13	#' @param ftir A data.frame in long format with columns `sample_id`,
14	#' `wavenumber`, and `absorbance`. The `absorbance` column may be replaced by
15	#' a `transmittance` column for transmittance plots. The code determines the
16	#' correct y axis units and labels the plot/adjusts the margins appropriately.
17	#'
18	#' Un data.frame au format long avec les colonnes `sample_id`, `wavenumber`,
19	#' et `absorbance`. La colonne `absorbance` peut être remplacée par une
20	#' colonne `transmittance` pour les tracés de transmission. Le code détermine
21	#' les unités correctes de l'axe y et étiquette le tracé/ajuste les marges de
22	#' manière appropriée.
23	#'
24	#' @param plot_title A title for a plot. Defaults to "FTIR Spectra". If a vector
25	#' length two, the second element will be used for a subtitle.
26	#'
27	#' Un titre pour une trace. La valeur par défaut est «FTIR Spectra». Si un
28	#' vecteur mesure deux, le deuxième élément sera utilisé pour un sous-titre.
29	#'
30	#' @param legend_title A title for the legend. Defaults to "Sample ID".
31	#'
32	#' Un titre pour la légende. La valeur par défaut est «Sample ID».
33	#'
34	#' @param lang An optional argument for language. If set to one of `fr`,
35	#' `french`, `francais`, or `français` the axis and default plot and legend
36	#' titles will change to french. If non-default legend or plot titles are
37	#' provided they are used as-is. You can also provide `en`, `english` or
38	#' `anglais`, or (the default) `NA` will use the default language from user
39	#' options. To set a permanent default, set `options("PlotFTIR.lang" = "en")`
40	#' or `options("PlotFTIR.lang" = "fr")` for English or French, respectively.
41	#'
42	#' Un argument optionnel pour la langue. S'il vaut `Fr`, `French`, `Francais`,
43	#' ou `Français`, l'axe et les titres par défaut de le tracé et du légende
44	#' seront en français. Si des titres du légende ou de tracé autres que ceux
45	#' par défaut sont fournis, ils seront utilisés tels quels. Vous pouvez aussi
46	#' fournir `en`, `english` ou `anglais`, ou (le défaut) `NA` qui utilisera le
47	#' langue par défaut des options de l'utilisateur. Pour définir une valeur
48	#' par défaut permanente, mettez `options("PlotFTIR.lang" = "en")` ou
49	#' `options("PlotFTIR.lang" = "fr")` pour l'anglais ou le français,
50	#' respectivement.
51	#'
52	#' @keywords internal
53	#'
54	#' @return a ggplot object containing a FTIR spectral plot. The plot and legend
55	#' titles are as provided, with each sample provided a different default
56	#' color. Because this is a ggplot object, any other ggplot modifiers, layers,
57	#' or changes can be applied to the returned object. Further manipulations can
58	#' be performed by this package. Peut également fournir `en`, `english` ou
59	#' `anglais`.
60	#'
61	#' un objet ggplot contenant un tracé spectral IRTF. Les titres de le tracé et
62	#' de la légende sont tels que fournis, avec une couleur par défaut différente
63	#' pour chaque échantillon. Puisqu'il s'agit d'un objet ggplot, tous les
64	#' autres modificateurs, calques ou changements ggplot peuvent être appliqués
65	#' à l'objet retourné. D'autres manipulations peuvent être effectuées par ce
66	#' package.
67	#'
68	#' @seealso [zoom_in_on_range()] to 'zoom' into a specified range,
69	#' [compress_low_energy()] to make the x axis non-linear (compressing lower
70	#' energy regions), [add_wavenumber_marker()] to add markers to highlight
71	#' important wavenumbers, and [move_plot_legend()] to modify the legend
72	#' position.
73	#'
74	#' [zoom_in_on_range()] pour 'zoomer' sur une gamme spécifiée,
75	#' [compress_low_energy()] pour rendre l'axe x non linéaire (en compression
76	#' les régions à basse énergie), [add_wavenumber_marker()] pour ajouter des
77	#' marqueurs afin de mettre en évidence les nombres d'ondes importants, et
78	#' [move_plot_legend()] pour modifier la position de la légende.
79	#'
80	plot_ftir_core <- function(
81	ftir,
82	plot_title = "FTIR Spectra",
83	legend_title = "Sample ID",
84	lang = NA
85	) {
86	# Package Checks
87	if (!requireNamespace("ggplot2", quietly = TRUE)) {	1✔
88	cli::cli_abort(c(	1✔
89	"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",	1✔
90	i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"	1✔
91	))	1✔
92	}
93
UNCOV 94	ftir <- check_ftir_data(ftir)	×
UNCOV 95	if (!is.character(plot_title) \|\| length(plot_title) > 2) {	×
UNCOV 96	cli::cli_abort(	×
UNCOV 97	"Error in {.fn PlotFTIR:::plot_ftir_core}. {.arg plot_title} must be a character string or vector of strings with length not more than two."	×
UNCOV 98	)	×
99	}
UNCOV 100	if (!is.character(legend_title) \|\| length(legend_title) > 1) {	×
UNCOV 101	cli::cli_abort(	×
UNCOV 102	"Error in {.fn PlotFTIR:::plot_ftir_core}. {.arg legend_title} must be a single character string."	×
UNCOV 103	)	×
104	}
UNCOV 105	if (length(unique(ftir$sample_id)) > 12) {	×
UNCOV 106	cli::cli_warn(c(	×
UNCOV 107	"Warning in {.fn PlotFTIR:::plot_ftir_core}. The color palette in use works best with 12 or fewer unique samples in {.arg ftir}.",	×
UNCOV 108	i = "You have a total of {length(unique(ftir$sample_id))} unique sample IDs."	×
UNCOV 109	))	×
110	}
111
112	# if language is provided, check against permitted, else use default from options
UNCOV 113	if (!is.na(lang)) {	×
UNCOV 114	lang <- rlang::arg_match(	×
UNCOV 115	lang,	×
UNCOV 116	values = c(	×
UNCOV 117	"en",	×
UNCOV 118	"english",	×
UNCOV 119	"anglais",	×
UNCOV 120	"fr",	×
UNCOV 121	"french",	×
UNCOV 122	"francais",	×
UNCOV 123	"fran\u00e7ais"	×
UNCOV 124	),	×
UNCOV 125	multiple = FALSE	×
UNCOV 126	)	×
127	} else {
UNCOV 128	lang <- getOption("PlotFTIR.lang", default = "en")	×
129	}
130
UNCOV 131	l <- substr(lang, 0, 2)	×
UNCOV 132	if (l == "fr") {	×
UNCOV 133	if (all(plot_title == "FTIR Spectra")) {	×
UNCOV 134	plot_title <- "Spectres IRTF"	×
135	}
UNCOV 136	if (legend_title == "Sample ID") {	×
UNCOV 137	legend_title <- "ID de l'\u00e9chantillon"	×
138	}
139	}
140
UNCOV 141	mode <- attr(ftir, "intensity")	×
142
UNCOV 143	if (l == "fr") {	×
UNCOV 144	xtitle <- bquote("Nombre d'onde" ~ (cm^-1))	×
145	} else {
UNCOV 146	xtitle <- bquote("Wavenumber" ~ (cm^-1))	×
147	}
148
UNCOV 149	ytitle <- ifelse(	×
UNCOV 150	mode %in% c("absorbance", "normalized absorbance"),	×
UNCOV 151	"Absorbance",	×
UNCOV 152	"% Transmittance"	×
UNCOV 153	)	×
154
UNCOV 155	if (grepl("normalized", mode)) {	×
UNCOV 156	ytitle <- paste("Normalized", ytitle)	×
157	}
158
UNCOV 159	ftir <- ftir[stats::complete.cases(ftir), ]	×
UNCOV 160	ftir$wavenumber <- as.numeric(ftir$wavenumber)	×
161
UNCOV 162	if (grepl("absorbance", mode)) {	×
UNCOV 163	ftir$absorbance <- as.numeric(ftir$absorbance)	×
UNCOV 164	p <- ggplot2::ggplot(ftir) +	×
UNCOV 165	ggplot2::geom_line(ggplot2::aes(	×
UNCOV 166	x = .data$wavenumber,	×
UNCOV 167	y = .data$absorbance,	×
UNCOV 168	color = as.factor(.data$sample_id)	×
UNCOV 169	)) +	×
UNCOV 170	ggplot2::scale_y_continuous()	×
171	} else {
UNCOV 172	ftir$transmittance <- as.numeric(ftir$transmittance)	×
UNCOV 173	p <- ggplot2::ggplot(ftir) +	×
UNCOV 174	ggplot2::geom_line(ggplot2::aes(	×
UNCOV 175	x = .data$wavenumber,	×
UNCOV 176	y = .data$transmittance,	×
UNCOV 177	color = as.factor(.data$sample_id)	×
UNCOV 178	)) +	×
UNCOV 179	ggplot2::scale_y_continuous(breaks = scales::breaks_width(20)) +	×
UNCOV 180	ggplot2::coord_cartesian(ylim = c(0, 100))	×
181	}
182
UNCOV 183	p <- p +	×
UNCOV 184	ggplot2::labs(	×
UNCOV 185	title = plot_title[1],	×
UNCOV 186	subtitle = if (length(plot_title) < 2) NULL else plot_title[2], # Can't return Null from ifelse()	×
UNCOV 187	x = xtitle,	×
UNCOV 188	y = ytitle	×
UNCOV 189	) +	×
UNCOV 190	ggplot2::guides(	×
UNCOV 191	color = ggplot2::guide_legend(title = legend_title),	×
UNCOV 192	x = ggplot2::guide_axis(minor.ticks = TRUE)	×
UNCOV 193	) +	×
UNCOV 194	ggplot2::theme_light() +	×
UNCOV 195	ggplot2::scale_x_reverse(	×
UNCOV 196	breaks = scales::breaks_extended(),	×
UNCOV 197	expand = ggplot2::expansion()	×
UNCOV 198	)	×
199
200	if (
UNCOV 201	!requireNamespace("ggthemes", quietly = TRUE) \|\|	×
UNCOV 202	length(unique(ftir$sample_id)) > 15	×
203	) {
UNCOV 204	p <- p +	×
UNCOV 205	ggplot2::scale_color_viridis_d()	×
206	} else {
UNCOV 207	p <- p +	×
UNCOV 208	ggthemes::scale_color_calc()	×
209	}
210
UNCOV 211	if (grepl("normalized", mode)) {	×
UNCOV 212	p <- p +	×
UNCOV 213	ggplot2::theme(	×
UNCOV 214	axis.text.y = ggplot2::element_blank()	×
UNCOV 215	)	×
216	}
217
UNCOV 218	attr(p, "intensity") <- attr(ftir, "intensity")	×
219
UNCOV 220	return(p)	×
221	}
222
223
224	#' Plot FTIR in stacked format
225	#'
226	#' @description Plot the FTIR spectra in a journal prepared format. It may be
227	#' desirable to plot spectra 'stacked and offset' by a certain amount. In this
228	#' case the y axis becomes non-labelled and each charts baseline (0 for
229	#' absorbance or 100 for transmittance) is offset by a certain amount.
230	#'
231	#' Tracez les spectres IRTF dans un format préparé par un journal. Il peut être
232	#' souhaitable de tracer les spectres 'empilés et décalés' d'une
233	#' certaine quantité. Dans ce cas l'axe y devient non étiqueté et
234	#' chaque ligne de base du graphique (0 pour absorbance ou 100 pour la
235	#' transmittance) est décalée d'une certaine quantité.
236	#'
237	#' @inheritParams plot_ftir_core
238	#' @param stack_offset The amount in percentage of stacking offset to use. For
239	#' transmittance this is directly linked to the units of Y axis, for absorbance
240	#' this is about 0.2 absorbance units.
241	#'
242	#' Le montant en pourcentage de décalage d'empilement à utiliser. Pour
243	#' transmittance, cette valeur est directement liée aux unités de l'axe y, pour
244	#' l'absorbance cela représente environ 0,2 unités d'absorbance.
245	#'
246	#' @inherit plot_ftir_core return
247	#'
248	#' @inherit plot_ftir_core seealso
249	#' @export
250	#'
251	#' @examples
252	#' if (requireNamespace("ggplot2", quietly = TRUE)) {
253	#' # Plot FTIR spectras stacked showing the differences in the `biodiesel` dataset
254	#' plot_ftir_stacked(biodiesel)
255	#' }
256	plot_ftir_stacked <- function(
257	ftir,
258	plot_title = "FTIR Spectra",
259	legend_title = "Sample ID",
260	stack_offset = 10,
261	lang = NA
262	) {
UNCOV 263	ftir <- check_ftir_data(ftir)	×
264
UNCOV 265	if (!is.numeric(stack_offset) \|\| length(stack_offset) > 1) {	×
UNCOV 266	cli::cli_abort(	×
UNCOV 267	"Error in {.fn PlotFTIR:::plot_ftir_stacked}. {.arg stack_offset} must be a single numeric value."	×
UNCOV 268	)	×
269	}
UNCOV 270	if (stack_offset < 0 \|\| stack_offset > 200) {	×
UNCOV 271	cli::cli_abort(	×
UNCOV 272	"Error in {.fn PlotFTIR:::plot_ftir_stacked}. {.arg stack_offset} must be between 0 and 200."	×
UNCOV 273	)	×
274	}
275
UNCOV 276	mode <- attr(ftir, "intensity")	×
277
278	# Stack FTIR traces by 10% of range number of unique samples
UNCOV 279	stack_samples <- unique(ftir$sample_id)	×
UNCOV 280	nsamples <- length(unique(stack_samples))	×
281
UNCOV 282	if (nsamples > 1) {	×
UNCOV 283	if (grepl("absorbance", mode)) {	×
284	# Transmittance gets an offset of stack_offset % against a percentage scale
285	# for absorbance, most signals max out around 2 so that's the range.
UNCOV 286	stack_offset <- (stack_offset / 100) * 2.0	×
287	}
UNCOV 288	offset <- data.frame(	×
UNCOV 289	"sample_id" = stack_samples,	×
UNCOV 290	"offset" = seq(from = 0, by = stack_offset, length.out = nsamples)	×
UNCOV 291	)	×
292
UNCOV 293	ftir <- merge(x = ftir, y = offset, by = "sample_id")	×
UNCOV 294	if (grepl("absorbance", mode)) {	×
UNCOV 295	ftir$absorbance <- ftir$absorbance + ftir$offset	×
296	} else {
UNCOV 297	ftir$transmittance <- ftir$transmittance + ftir$offset	×
298	}
UNCOV 299	ftir$offset <- NULL	×
300	}
301
UNCOV 302	p <- plot_ftir_core(	×
UNCOV 303	ftir = ftir,	×
UNCOV 304	plot_title = plot_title,	×
UNCOV 305	legend_title = legend_title,	×
UNCOV 306	lang = lang	×
UNCOV 307	)	×
308
UNCOV 309	p <- p + ggplot2::theme(axis.text.y = ggplot2::element_blank())	×
UNCOV 310	suppressMessages(p <- p + ggplot2::coord_cartesian(ylim = c(0, NA)))	×
311
UNCOV 312	if (grepl("absorbance", mode)) {	×
NEW 313	p <- p + ggplot2::ylab("Absorbance (a.u.)")	×
314	} else {
NEW 315	p <- p + ggplot2::ylab("Transmittance (a.u.)")	×
316	}
317
UNCOV 318	attr(p, "spectra_style") <- "stacked"	×
319
UNCOV 320	return(p)	×
321	}
322
323
324	#' Plot FTIR Spectra Overlaid
325	#'
326	#' @description Produce a basic spectra overlay plot for all samples found in
327	#' the FTIR dataset provided.
328	#'
329	#' Produisez un tracé de base de superposition de spectres pour tous les
330	#' échantillons trouvés dans l'ensemble de données IRTF fourni.
331	#'
332	#' @inherit plot_ftir_core params return
333	#' @export
334	#'
335	#' @examples
336	#' if (requireNamespace("ggplot2", quietly = TRUE)) {
337	#' # Plot a basic FTIR Spectra overlay from the `sample_spectra` data set with default titles
338	#' plot_ftir(sample_spectra)
339	#' }
340	plot_ftir <- function(
341	ftir,
342	plot_title = "FTIR Spectra",
343	legend_title = "Sample ID",
344	lang = NA
345	) {
346	ftir <- check_ftir_data(ftir)	1✔
347	p <- plot_ftir_core(	1✔
348	ftir = ftir,	1✔
349	plot_title = plot_title,	1✔
350	legend_title = legend_title,	1✔
351	lang = lang	1✔
352	)	1✔
353
UNCOV 354	attr(p, "spectra_style") <- "normal"	×
355
UNCOV 356	return(p)	×
357	}

NRCan / PlotFTIR / 17212036758

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous