17212736350

Committed 25 Aug 2025 03:05PM UTC coverage: 98.411% (+0.01%) from 98.398%

Build # 17212736350

Build Type

Pull #24

github

Committed by

web-flow

Commit Message

Merge da90d893d into f690f0636

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

Run Details

28 of 28 new or added lines in 4 files covered. (100.0%)

44 existing lines in 4 files now uncovered.

1424 of 1447 relevant lines covered (98.41%)

32.18 hits per line

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

100.0

/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)) {	55✔
UNCOV 88	cli::cli_abort(c(	1✔
UNCOV 89	"{.pkg PlotFTIR} requires {.pkg ggplot2} package installation.",	1✔
UNCOV 90	i = "Install {.pkg ggplot2} with {.run install.packages('ggplot2')}"	1✔
UNCOV 91	))	1✔
92	}
93
94	ftir <- check_ftir_data(ftir)	54✔
95	if (!is.character(plot_title) \|\| length(plot_title) > 2) {	54✔
96	cli::cli_abort(	4✔
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."	4✔
98	)	4✔
99	}
100	if (!is.character(legend_title) \|\| length(legend_title) > 1) {	50✔
101	cli::cli_abort(	2✔
102	"Error in {.fn PlotFTIR:::plot_ftir_core}. {.arg legend_title} must be a single character string."	2✔
103	)	2✔
104	}
105	if (length(unique(ftir$sample_id)) > 12) {	48✔
106	cli::cli_warn(c(	6✔
107	"Warning in {.fn PlotFTIR:::plot_ftir_core}. The color palette in use works best with 12 or fewer unique samples in {.arg ftir}.",	6✔
108	i = "You have a total of {length(unique(ftir$sample_id))} unique sample IDs."	6✔
109	))	6✔
110	}
111
112	# if language is provided, check against permitted, else use default from options
113	if (!is.na(lang)) {	48✔
114	lang <- rlang::arg_match(	8✔
115	lang,	8✔
116	values = c(	8✔
117	"en",	8✔
118	"english",	8✔
119	"anglais",	8✔
120	"fr",	8✔
121	"french",	8✔
122	"francais",	8✔
123	"fran\u00e7ais"	8✔
124	),	8✔
125	multiple = FALSE	8✔
126	)	8✔
127	} else {
128	lang <- getOption("PlotFTIR.lang", default = "en")	40✔
129	}
130
131	l <- substr(lang, 0, 2)	44✔
132	if (l == "fr") {	44✔
133	if (all(plot_title == "FTIR Spectra")) {	4✔
134	plot_title <- "Spectres IRTF"	2✔
135	}
136	if (legend_title == "Sample ID") {	4✔
137	legend_title <- "ID de l'\u00e9chantillon"	4✔
138	}
139	}
140
141	mode <- attr(ftir, "intensity")	44✔
142
143	if (l == "fr") {	44✔
144	xtitle <- bquote("Nombre d'onde" ~ (cm^-1))	4✔
145	} else {
146	xtitle <- bquote("Wavenumber" ~ (cm^-1))	40✔
147	}
148
149	ytitle <- ifelse(	44✔
150	mode %in% c("absorbance", "normalized absorbance"),	44✔
151	"Absorbance",	44✔
152	"% Transmittance"	44✔
153	)	44✔
154
155	if (grepl("normalized", mode)) {	44✔
156	ytitle <- paste("Normalized", ytitle)	2✔
157	}
158
159	ftir <- ftir[stats::complete.cases(ftir), ]	44✔
160	ftir$wavenumber <- as.numeric(ftir$wavenumber)	44✔
161
162	if (grepl("absorbance", mode)) {	44✔
163	ftir$absorbance <- as.numeric(ftir$absorbance)	36✔
164	p <- ggplot2::ggplot(ftir) +	36✔
165	ggplot2::geom_line(ggplot2::aes(	36✔
166	x = .data$wavenumber,	36✔
167	y = .data$absorbance,	36✔
168	color = as.factor(.data$sample_id)	36✔
169	)) +	36✔
170	ggplot2::scale_y_continuous()	36✔
171	} else {
172	ftir$transmittance <- as.numeric(ftir$transmittance)	8✔
173	p <- ggplot2::ggplot(ftir) +	8✔
174	ggplot2::geom_line(ggplot2::aes(	8✔
175	x = .data$wavenumber,	8✔
176	y = .data$transmittance,	8✔
177	color = as.factor(.data$sample_id)	8✔
178	)) +	8✔
179	ggplot2::scale_y_continuous(breaks = scales::breaks_width(20)) +	8✔
180	ggplot2::coord_cartesian(ylim = c(0, 100))	8✔
181	}
182
183	p <- p +	44✔
184	ggplot2::labs(	44✔
185	title = plot_title[1],	44✔
186	subtitle = if (length(plot_title) < 2) NULL else plot_title[2], # Can't return Null from ifelse()	44✔
187	x = xtitle,	44✔
188	y = ytitle	44✔
189	) +	44✔
190	ggplot2::guides(	44✔
191	color = ggplot2::guide_legend(title = legend_title),	44✔
192	x = ggplot2::guide_axis(minor.ticks = TRUE)	44✔
193	) +	44✔
194	ggplot2::theme_light() +	44✔
195	ggplot2::scale_x_reverse(	44✔
196	breaks = scales::breaks_extended(),	44✔
197	expand = ggplot2::expansion()	44✔
198	)	44✔
199
200	if (
201	!requireNamespace("ggthemes", quietly = TRUE) \|\|	44✔
202	length(unique(ftir$sample_id)) > 15	44✔
203	) {
204	p <- p +	25✔
205	ggplot2::scale_color_viridis_d()	25✔
206	} else {
207	p <- p +	19✔
208	ggthemes::scale_color_calc()	19✔
209	}
210
211	if (grepl("normalized", mode)) {	44✔
212	p <- p +	2✔
213	ggplot2::theme(	2✔
214	axis.text.y = ggplot2::element_blank()	2✔
215	)	2✔
216	}
217
218	attr(p, "intensity") <- attr(ftir, "intensity")	44✔
219
220	return(p)	44✔
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	) {
263	ftir <- check_ftir_data(ftir)	22✔
264
265	if (!is.numeric(stack_offset) \|\| length(stack_offset) > 1) {	12✔
266	cli::cli_abort(	2✔
267	"Error in {.fn PlotFTIR:::plot_ftir_stacked}. {.arg stack_offset} must be a single numeric value."	2✔
268	)	2✔
269	}
270	if (stack_offset < 0 \|\| stack_offset > 200) {	10✔
271	cli::cli_abort(	2✔
272	"Error in {.fn PlotFTIR:::plot_ftir_stacked}. {.arg stack_offset} must be between 0 and 200."	2✔
273	)	2✔
274	}
275
276	mode <- attr(ftir, "intensity")	8✔
277
278	# Stack FTIR traces by 10% of range number of unique samples
279	stack_samples <- unique(ftir$sample_id)	8✔
280	nsamples <- length(unique(stack_samples))	8✔
281
282	if (nsamples > 1) {	8✔
283	if (grepl("absorbance", mode)) {	8✔
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.
286	stack_offset <- (stack_offset / 100) * 2.0	4✔
287	}
288	offset <- data.frame(	8✔
289	"sample_id" = stack_samples,	8✔
290	"offset" = seq(from = 0, by = stack_offset, length.out = nsamples)	8✔
291	)	8✔
292
293	ftir <- merge(x = ftir, y = offset, by = "sample_id")	8✔
294	if (grepl("absorbance", mode)) {	8✔
295	ftir$absorbance <- ftir$absorbance + ftir$offset	4✔
296	} else {
297	ftir$transmittance <- ftir$transmittance + ftir$offset	4✔
298	}
299	ftir$offset <- NULL	8✔
300	}
301
302	p <- plot_ftir_core(	8✔
303	ftir = ftir,	8✔
304	plot_title = plot_title,	8✔
305	legend_title = legend_title,	8✔
306	lang = lang	8✔
307	)	8✔
308
309	p <- p + ggplot2::theme(axis.text.y = ggplot2::element_blank())	6✔
310	suppressMessages(p <- p + ggplot2::coord_cartesian(ylim = c(0, NA)))	6✔
311
312	if (grepl("absorbance", mode)) {	6✔
313	p <- p + ggplot2::ylab("Absorbance (a.u.)")	2✔
314	} else {
315	p <- p + ggplot2::ylab("Transmittance (a.u.)")	4✔
316	}
317
318	attr(p, "spectra_style") <- "stacked"	6✔
319
320	return(p)	6✔
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)	57✔
347	p <- plot_ftir_core(	47✔
348	ftir = ftir,	47✔
349	plot_title = plot_title,	47✔
350	legend_title = legend_title,	47✔
351	lang = lang	47✔
352	)	47✔
353
354	attr(p, "spectra_style") <- "normal"	38✔
355
356	return(p)	38✔
357	}

NRCan / PlotFTIR / 17212736350

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