Nothing
R/plotting.R
In powdR: Full Pattern Summation of X-Ray Powder Diffraction Data
Defines functions
plot.XY
plot.multiXY
plot.powdRbkg
plot.powdRlib
plot.powdRlm
plot.powdRafps
plot.powdRfps
.gg_color_hue
.group_patterns
.rng_nm_xy
.rng_nm
.subset_tth_xy
Documented in
plot.multiXY
plot.powdRafps
plot.powdRbkg
plot.powdRfps
plot.powdRlib
plot.powdRlm
plot.XY
.subset_tth_xy <- function(x, xlim) {
x <- x[which(x[[1]] >= xlim[1] & x[[1]] <= xlim[2]),]
return(x)
}
.rng_nm <- function(x){(x-min(x))/(max(x)-min(x))}
.rng_nm_xy <- function(x) {
x <- data.frame("tth" = x[[1]],
"counts" = .rng_nm(x[[2]]))
return(x)
}
.group_patterns <- function(x) {
wpp_df <- x$weighted_pure_patterns
if (!identical(names(wpp_df), x$phases$phase_id)) {
stop("The ID's and names don't match")
}
wpp_df <- data.frame(t(wpp_df))
wpp_df <- data.frame("phase_name" = x$phases$phase_name,
wpp_df)
wpp_df <- stats::aggregate(. ~ phase_name, data = wpp_df, FUN = sum)
wpp_df_names <- wpp_df$phase_name
wpp_df <- data.frame(t(wpp_df[-1]))
names(wpp_df) <- wpp_df_names
rownames(wpp_df) <- NULL
x$weighted_pure_patterns <- wpp_df
return(x)
}
.gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
grDevices::hcl(h = hues, l = 65, c = 100)[1:n]
}
#' Plotting elements of a powdRfps object
#'
#' \code{plot.powdRfps} is designed to provide easy, adaptable plots
#' of full pattern summation outputs produced from \code{\link{fps}}.
#'
#' When seeking to inspect the results from full pattern summation, interactive
#' plots are particularly useful and can be specified with the \code{interactive}
#' argument.
#'
#' @param x a powdRfps object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param mode One of "fit", "residuals" or "both" defining whether to plot the fitted
#' patterns, the residuals of the fit, or both, respectively. Default = "fit".
#' @param group A logical parameter used to specify whether the plotted data are grouped
#' according to the phase name. Default = FALSE.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param show_excluded A logical value specifying whether the areas excluded from the
#' fitting are identified in the plot as grey rectangles. Default \code{= TRUE}.
#' @param interactive logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRfps
#' @examples
#' #Load the minerals library
#' data(minerals)
#'
#' # Load the soils data
#' data(soils)
#'
#' \dontrun{
#' fps_sand <- fps(lib = minerals,
#' smpl = soils$sandstone,
#' refs = minerals$phases$phase_id,
#' std = "QUA.1",
#' align = 0.2)
#'
#' plot(fps_sand, wavelength = "Cu")
#' plot(fps_sand, wavelength = "Cu", interactive = TRUE)
#' }
#' @export
plot.powdRfps <- function(x, wavelength, mode, group,
xlim, show_excluded, interactive, ...) {
if (missing(group)) {
group <- FALSE
}
if (!is.logical(group)) {
stop("group must be logical",
call. = FALSE)
}
if (missing(xlim)) {
xlim <- c(min(x$tth), max(x$tth))
}
if (length(xlim) > 2) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (xlim[1] < min(x$tth) | xlim[2] > max(x$tth)) {
stop("The limits defined in xlim are outside of the 2theta range of the data",
call. = FALSE)
}
if (missing(mode)) {
mode <- "fit"
}
if (!mode %in% c("fit", "residuals", "both")) {
stop("The mode argument must be one of `fit`, `residuals`, or `both`",
call. = FALSE)
}
if(missing(show_excluded)) {
show_excluded <- TRUE
}
if(!is.logical(show_excluded)) {
stop("The show_excluded argument must be logical.",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
#Optional grouping
if (group == TRUE) {
x <- .group_patterns(x = x)
}
#compute d
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
#Create a dataframe of the weighted pure patterns and fitted pattern
pure_patterns <- data.frame(tth = x$tth,
d = d_v,
Measured = x$measured,
Fitted = x$fitted,
x$weighted_pure_patterns,
check.names = FALSE)
refs_colors <- .gg_color_hue(ncol(x$weighted_pure_patterns))
#Residuals
resids <- data.frame(tth = x$tth,
d = d_v,
Counts = x$residuals)
#melt the pure patterns data frame
pure_patterns_long <- reshape::melt(pure_patterns, id = c("tth", "d"))
#Name the counts column
names(pure_patterns_long)[4] <- "Counts"
g1 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = pure_patterns_long,
ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~variable,
linetype = ~variable,
d = ~d),
size = 0.25) +
ggplot2::scale_color_manual(values = c("black", "red",
refs_colors)) +
ggplot2::scale_linetype_manual(values = c("solid", "solid",
rep("dotted", ncol(x$weighted_pure_patterns)))) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::theme(legend.title = ggplot2::element_blank()))
g2 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = resids,
ggplot2::aes_(x = ~tth, y = ~Counts, color = "Residuals", d = ~d), size = 0.15) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::scale_colour_manual(name = "",
values = c("Residuals" = "blue")))
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect1 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect2 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect1,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect2,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect3 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect4 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect3,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect4,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (interactive == TRUE) {
#Convert to ggplotly
p1 <- plotly::ggplotly(g1, tooltip = c("x", "y", "d", "colour", "label"))
p2 <- plotly::ggplotly(g2, tooltip = c("x", "y", "d", "colour", "label"))
if (mode == "fit") {
return(p1)
}
if (mode == "residuals") {
return(p2)
}
if (mode == "both") {
p3 <- plotly::subplot(p1, p2,
nrows = 2,
heights = c((2/3), (1/3)),
widths = c(1),
shareX = TRUE,
titleY = TRUE)
return(p3)
}
} else {
if (mode == "fit") {
return(g1)
}
if (mode == "residuals") {
return(g2)
}
if (mode == "both") {
g3 <- ggpubr::ggarrange(g1, g2, nrow = 2,
heights = c(2,1))
return(g3)
}
}
}
#' Plotting elements of a powdRafps object
#'
#' \code{plot.powdRafps} is designed to provide easy, adaptable plots
#' of full pattern summation outputs produced from \code{\link{afps}}.
#'
#' When seeking to inspect the results from full pattern summation, interactive
#' plots are particularly useful and can be specified with the \code{interactive}
#' argument.
#'
#' @param x a powdRafps object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param mode One of "fit", "residuals" or "both" defining whether to plot the fitted
#' patterns, the residuals of the fit, or both, respectively. Default = "fit".
#' @param group A logical parameter used to specify whether the plotted data are grouped
#' according to the phase name. Default = FALSE.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param show_excluded A logical value specifying whether the areas excluded from the
#' fitting are identified in the plot as grey rectangles. Default \code{= TRUE}.
#' @param interactive logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRafps
#' @examples
#' #Load the minerals library
#' data(minerals)
#'
#' # Load the soils data
#' data(soils)
#'
#' \dontrun{
#' afps_sand <- afps(lib = minerals,
#' smpl = soils$sandstone,
#' std = "QUA.1",
#' amorphous = "ORG",
#' align = 0.2,
#' lod = 0.1)
#'
#' plot(afps_sand, wavelength = "Cu")
#' plot(afps_sand, wavelength = "Cu", interactive = TRUE)
#'
#' }
#' @export
plot.powdRafps <- function(x, wavelength, mode, group, xlim, show_excluded, interactive, ...) {
if (missing(group)) {
group <- FALSE
}
if (!is.logical(group)) {
stop("group must be logical",
call. = FALSE)
}
if (missing(xlim)) {
xlim <- c(min(x$tth), max(x$tth))
}
if (length(xlim) > 2) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (xlim[1] < min(x$tth) | xlim[2] > max(x$tth)) {
stop("The limits defined in xlim are outside of the 2theta range of the data",
call. = FALSE)
}
if (missing(mode)) {
mode <- "fit"
}
if (!mode %in% c("fit", "residuals", "both")) {
stop("The mode argument must be one of `fit`, `residuals`, or `both`",
call. = FALSE)
}
if(missing(show_excluded)) {
show_excluded <- TRUE
}
if(!is.logical(show_excluded)) {
stop("The show_excluded argument must be logical.",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
#Optional grouping
if (group == TRUE) {
x <- .group_patterns(x = x)
}
#compute d
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
#Create a dataframe of the weighted pure patterns and fitted pattern
pure_patterns <- data.frame(tth = x$tth,
d = d_v,
Measured = x$measured,
Fitted = x$fitted,
x$weighted_pure_patterns,
check.names = FALSE)
refs_colors <- .gg_color_hue(ncol(x$weighted_pure_patterns))
#Residuals
resids <- data.frame(tth = x$tth,
d = d_v,
Counts = x$residuals)
#melt the pure patterns data frame
pure_patterns_long <- reshape::melt(pure_patterns, id = c("tth", "d"))
#Name the counts column
names(pure_patterns_long)[4] <- "Counts"
g1 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = pure_patterns_long,
ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~variable,
linetype = ~variable,
d = ~d),
size = 0.25) +
ggplot2::scale_color_manual(values = c("black", "red",
refs_colors)) +
ggplot2::scale_linetype_manual(values = c("solid", "solid",
rep("dotted", ncol(x$weighted_pure_patterns)))) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::theme(legend.title = ggplot2::element_blank()))
g2 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = resids,
ggplot2::aes_(x = ~tth, y = ~Counts, color = "Residuals", d = ~d), size = 0.15) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::scale_colour_manual(name = "",
values = c("Residuals" = "blue")))
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect1 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect2 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect1,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect2,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect3 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect4 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect3,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect4,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (interactive == TRUE) {
#Convert to ggplotly
p1 <- plotly::ggplotly(g1, tooltip = c("x", "y", "d", "colour", "label"))
p2 <- plotly::ggplotly(g2, tooltip = c("x", "y", "d", "colour", "label"))
if (mode == "fit") {
return(p1)
}
if (mode == "residuals") {
return(p2)
}
if (mode == "both") {
p3 <- plotly::subplot(p1, p2,
nrows = 2,
heights = c((2/3), (1/3)),
widths = c(1),
shareX = TRUE,
titleY = TRUE)
return(p3)
}
} else {
if (mode == "fit") {
return(g1)
}
if (mode == "residuals") {
return(g2)
}
if (mode == "both") {
g3 <- ggpubr::ggarrange(g1, g2, nrow = 2,
heights = c(2,1))
return(g3)
}
}
}
#' Plotting elements of a powdRlm object
#'
#' \code{plot.powdRlm} is designed to provide easy, adaptable plots
#' of full pattern summation outputs produced from \code{\link{fps_lm}}.
#'
#' When seeking to inspect the results from full pattern summation, interactive
#' plots are particularly useful and can be specified with the \code{interactive}
#' argument.
#'
#' @param x a powdRlm object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param mode One of "fit", "residuals" or "both" defining whether to plot the fitted
#' patterns, the residuals of the fit, or both, respectively. Default = "fit".
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param group A logical parameter used to specify whether the plotted data are grouped
#' according to the phase name. Default = FALSE.
#' @param show_excluded A logical value specifying whether the areas excluded from the
#' fitting are identified in the plot as grey rectangles. Default \code{= TRUE}.
#' @param interactive logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRlm
#' @examples
#' data(rockjock)
#' data(rockjock_mixtures)
#'
#' #Compute the PCA and loadings
#' x1 <- xrpd_pca(rockjock_mixtures,
#' mean_center = TRUE,
#' bin_size = 1,
#' root_transform = 1)
#'
#' \dontrun{
#' fps_lm_out <- fps_lm(rockjock,
#' smpl = data.frame("x" = x1$loadings$tth,
#' "y" = x1$loadings$Dim.1),
#' refs = rockjock$phases$phase_id,
#' std = "QUARTZ",
#' align = 0.3,
#' p = 0.01)
#'
#' plot(fps_lm_out,
#' wavelength = "Cu",
#' interactive = TRUE,
#' group = TRUE)
#'
#' }
#' @export
plot.powdRlm <- function(x, wavelength, mode, xlim, group, show_excluded, interactive, ...) {
if (missing(xlim)) {
xlim <- c(min(x$tth), max(x$tth))
}
if (missing(group)) {
group <- FALSE
}
if (!is.logical(group)) {
stop("group must be logical",
call. = FALSE)
}
if (length(xlim) > 2) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (xlim[1] < min(x$tth) | xlim[2] > max(x$tth)) {
stop("The limits defined in xlim are outside of the 2theta range of the data",
call. = FALSE)
}
if (missing(mode)) {
mode <- "fit"
}
if (!mode %in% c("fit", "residuals", "both")) {
stop("The mode argument must be one of `fit`, `residuals`, or `both`",
call. = FALSE)
}
if(missing(show_excluded)) {
show_excluded <- TRUE
}
if(!is.logical(show_excluded)) {
stop("The show_excluded argument must be logical.",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
#-----------------------------------
#Optional grouping
#-----------------------------------
if (group == TRUE) {
x <- .group_patterns(x = x)
}
#compute d
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
#Create a dataframe of the weighted pure patterns and fitted pattern
pure_patterns <- data.frame(tth = x$tth,
d = d_v,
Measured = x$measured,
Fitted = x$fitted,
x$weighted_pure_patterns,
check.names = FALSE)
refs_colors <- .gg_color_hue(ncol(x$weighted_pure_patterns))
#Residuals
resids <- data.frame(tth = x$tth,
d = d_v,
Counts = x$residuals)
#melt the pure patterns data frame
pure_patterns_long <- reshape::melt(pure_patterns, id = c("tth", "d"))
#Name the counts column
names(pure_patterns_long)[4] <- "Counts"
g1 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = pure_patterns_long,
ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~variable,
linetype = ~variable,
d = ~d),
size = 0.25) +
ggplot2::scale_color_manual(values = c("black", "red",
refs_colors)) +
ggplot2::scale_linetype_manual(values = c("solid", "solid",
rep("dotted", ncol(x$weighted_pure_patterns)))) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::theme(legend.title = ggplot2::element_blank()))
g2 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = resids,
ggplot2::aes_(x = ~tth, y = ~Counts, color = "Residuals", d = ~d), size = 0.15) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::scale_colour_manual(name = "",
values = c("Residuals" = "blue")))
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect1 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(pure_patterns_long$Counts), ymax = max(pure_patterns_long$Counts))
rect2 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect1,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect2,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect3 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(pure_patterns_long$Counts), ymax = max(pure_patterns_long$Counts))
rect4 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect3,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect4,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (interactive == TRUE) {
#Convert to ggplotly
p1 <- plotly::ggplotly(g1, tooltip = c("x", "y", "d", "colour", "label"))
p2 <- plotly::ggplotly(g2, tooltip = c("x", "y", "d", "colour", "label"))
if (mode == "fit") {
return(p1)
}
if (mode == "residuals") {
return(p2)
}
if (mode == "both") {
p3 <- plotly::subplot(p1, p2,
nrows = 2,
heights = c((2/3), (1/3)),
widths = c(1),
shareX = TRUE,
titleY = TRUE)
return(p3)
}
} else {
if (mode == "fit") {
return(g1)
}
if (mode == "residuals") {
return(g2)
}
if (mode == "both") {
g3 <- ggpubr::ggarrange(g1, g2, nrow = 2,
heights = c(2,1))
return(g3)
}
}
}
#' Plotting elements of a powdRlib object
#'
#' \code{plot.powdRlib} is designed to provide easy, adaptable plots
#' of an XRPD reference library built using the \code{powdRlib} constructor
#' function.
#'
#' Plots can be made interactive using the logical \code{interactive} argument.
#'
#' @param x a powdRlib object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param refs a character string of reference pattern id's to be plotted
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRlib
#'
#' @examples
#' # Load the minerals library
#' data(minerals)
#' \dontrun{
#' plot(minerals, wavelength = "Cu", refs = "ALB")
#' plot(minerals, wavelength = "Cu", refs = "ALB", interactive = TRUE)
#' }
#' @export
plot.powdRlib <- function(x, wavelength, refs, interactive, ...) {
#If a pattern is specified but isn't there, then stop
if (!missing(refs)) {
if (!length(which(refs %in% x$phases$phase_id)) == length(refs)) {
stop("Not all refs defined relate to phase ID's in the library",
call. = FALSE)
}
}
if(missing(refs)) {
refs <- c("")
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
if(!missing(refs) & !is.character(refs)) {
stop("The refs argument must be a character string
of the reference pattern ID's to be plotted",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
melted <- reshape::melt(data.frame("tth" = x[[2]],
"d" = d_v,
x[[1]],
check.names = FALSE), id = c("tth", "d"))
names(melted) <- c("tth", "d", "phase", "Counts")
if(length(which(melted$phase %in% refs)) > 0) {
melted <- melted[which(melted$phase %in% refs), ]
}
p <- suppressWarnings(ggplot2::ggplot(data = melted) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~phase, d = ~d),
size = 0.15) +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank()))
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
#' Plotting a powdRbkg object
#'
#' \code{plot.powdRbkg} is designed to provide quick plots to inspect the
#' fitted backgrounds obtained from \code{bkg}.
#'
#' The only mandatory argument is x, which must be a powdRbkg object. Plots can
#' be made interactive using the logical \code{interactive} argument.
#'
#' @param x a powdRbkg object
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRbkg
#'
#' @examples
#' # Load the minerals library
#' data(minerals)
#'
#' \dontrun{
#' plot(minerals, interactive = TRUE)
#' }
#' @export
plot.powdRbkg <- function(x, interactive, ...) {
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
observed <- data.frame("tth" = x[[1]],
"counts" = x[[2]],
"id" = rep("Observed", length(x[[1]])))
fitted_bkg <- data.frame("tth" = x[[1]],
"counts" = x[[3]],
"id" = rep("Background", length(x[[1]])))
df <- rbind(observed, fitted_bkg)
p <- ggplot2::ggplot(data = data.frame(df)) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~counts,
color = ~id),
size = 0.15) +
ggplot2::scale_color_manual(values = c("black", "red")) +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank())
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
#' Plotting a multiXY object
#'
#' \code{plot.multiXY} is designed to provide easy, adaptable plots
#' of multiple XRPD patterns.
#'
#' Plots can be made interactive using the logical \code{interactive} argument.
#'
#' @param x a multiXY object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param normalise Logical. If TRUE then count intensities will be normalised to a
#' minimum of zero and maximum of 1. Default \code{= FALSE}.
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot multiXY
#'
#' @examples
#' # Load the minerals library
#' data(rockjock_mixtures)
#' \dontrun{
#' plot(as_multi_xy(rockjock_mixtures), wavelength = "Cu")
#' plot(as_multi_xy(rockjock_mixtures), wavelength = "Cu", interactive = TRUE)
#' }
#' @export
plot.multiXY <- function(x, wavelength, xlim, normalise, interactive, ...) {
#If normalise is missing then set it to FALSE
if (missing(normalise)) {
normalise <- FALSE
}
if (!is.logical(normalise)) {
stop("The normalise argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#Define the xlims if not defined
if (missing(xlim)) {
tth_min <- min(unlist(lapply(x, function(x) min(x[[1]]))))
tth_max <- max(unlist(lapply(x, function(x) max(x[[1]]))))
xlim <- c(tth_min, tth_max)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2.",
call. = FALSE)
}
#Subset based on the xlims
x <- lapply(x, .subset_tth_xy, xlim = xlim)
#Normalise counts if required
if (normalise == TRUE) {
x <- lapply(x, .rng_nm_xy)
}
#Create a d vector for each item
for (i in 1:length(x)) {
x[[i]]$d <- round(wavelength/(2*sin((x[[i]]$tth/2)*pi/180)), 3)
}
#Populate each item in the list with an ID
for (i in 1:length(x)) {
x[[i]]$id <- names(x)[i]
}
#Now bind into long dataframe
x_long <- do.call(rbind, x)
p <- suppressWarnings(ggplot2::ggplot(data = x_long) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~counts,
color = ~id, d = ~d),
size = 0.15) +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank()))
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
#' Plotting an XY object
#'
#' \code{plot.XY} is designed to provide easy, adaptable plots
#' of an XRPD pattern.
#'
#' Plots can be made interactive using the logical \code{interactive} argument.
#'
#' @param x an XY object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param normalise Logical. If TRUE then count intensities will be normalised to a
#' minimum of zero and maximum of 1. Default \code{= FALSE}.
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot XY
#'
#' @examples
#' # Load the minerals library
#' data(rockjock_mixtures)
#' \dontrun{
#' plot(rockjock_mixtures$Mix1, wavelength = "Cu")
#' plot(rockjock_mixtures$Mix1, wavelength = "Cu", interactive = TRUE)
#' }
#' @export
plot.XY <- function(x, wavelength, xlim, normalise, interactive, ...) {
#If normalise is missing then set it to FALSE
if (missing(normalise)) {
normalise <- FALSE
}
if (!is.logical(normalise)) {
stop("The normalise argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#Define the xlims if not defined
if (missing(xlim)) {
tth_min <- min(x[[1]])
tth_max <- max(x[[1]])
xlim <- c(tth_min, tth_max)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2.",
call. = FALSE)
}
#Subset based on the xlims
x <- .subset_tth_xy(x, xlim)
#Normalise counts if required
if (normalise == TRUE) {
x <- .rng_nm_xy(x)
}
#Create a d vector for each item
x$d <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
p <- suppressWarnings(ggplot2::ggplot(data = x) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~counts,
d = ~d),
size = 0.15,
colour = "blue") +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank()))
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
Try the powdR package in your browser
Any scripts or data that you put into this service are public.
powdR documentation built on Aug. 13, 2021, 5:08 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 plot.XY plot.multiXY plot.powdRbkg plot.powdRlib plot.powdRlm plot.powdRafps plot.powdRfps .gg_color_hue .group_patterns .rng_nm_xy .rng_nm .subset_tth_xy
Documented in plot.multiXY plot.powdRafps plot.powdRbkg plot.powdRfps plot.powdRlib plot.powdRlm plot.XY
.subset_tth_xy <- function(x, xlim) {
x <- x[which(x[[1]] >= xlim[1] & x[[1]] <= xlim[2]),]
return(x)
}
.rng_nm <- function(x){(x-min(x))/(max(x)-min(x))}
.rng_nm_xy <- function(x) {
x <- data.frame("tth" = x[[1]],
"counts" = .rng_nm(x[[2]]))
return(x)
}
.group_patterns <- function(x) {
wpp_df <- x$weighted_pure_patterns
if (!identical(names(wpp_df), x$phases$phase_id)) {
stop("The ID's and names don't match")
}
wpp_df <- data.frame(t(wpp_df))
wpp_df <- data.frame("phase_name" = x$phases$phase_name,
wpp_df)
wpp_df <- stats::aggregate(. ~ phase_name, data = wpp_df, FUN = sum)
wpp_df_names <- wpp_df$phase_name
wpp_df <- data.frame(t(wpp_df[-1]))
names(wpp_df) <- wpp_df_names
rownames(wpp_df) <- NULL
x$weighted_pure_patterns <- wpp_df
return(x)
}
.gg_color_hue <- function(n) {
hues = seq(15, 375, length = n + 1)
grDevices::hcl(h = hues, l = 65, c = 100)[1:n]
}
#' Plotting elements of a powdRfps object
#'
#' \code{plot.powdRfps} is designed to provide easy, adaptable plots
#' of full pattern summation outputs produced from \code{\link{fps}}.
#'
#' When seeking to inspect the results from full pattern summation, interactive
#' plots are particularly useful and can be specified with the \code{interactive}
#' argument.
#'
#' @param x a powdRfps object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param mode One of "fit", "residuals" or "both" defining whether to plot the fitted
#' patterns, the residuals of the fit, or both, respectively. Default = "fit".
#' @param group A logical parameter used to specify whether the plotted data are grouped
#' according to the phase name. Default = FALSE.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param show_excluded A logical value specifying whether the areas excluded from the
#' fitting are identified in the plot as grey rectangles. Default \code{= TRUE}.
#' @param interactive logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRfps
#' @examples
#' #Load the minerals library
#' data(minerals)
#'
#' # Load the soils data
#' data(soils)
#'
#' \dontrun{
#' fps_sand <- fps(lib = minerals,
#' smpl = soils$sandstone,
#' refs = minerals$phases$phase_id,
#' std = "QUA.1",
#' align = 0.2)
#'
#' plot(fps_sand, wavelength = "Cu")
#' plot(fps_sand, wavelength = "Cu", interactive = TRUE)
#' }
#' @export
plot.powdRfps <- function(x, wavelength, mode, group,
xlim, show_excluded, interactive, ...) {
if (missing(group)) {
group <- FALSE
}
if (!is.logical(group)) {
stop("group must be logical",
call. = FALSE)
}
if (missing(xlim)) {
xlim <- c(min(x$tth), max(x$tth))
}
if (length(xlim) > 2) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (xlim[1] < min(x$tth) | xlim[2] > max(x$tth)) {
stop("The limits defined in xlim are outside of the 2theta range of the data",
call. = FALSE)
}
if (missing(mode)) {
mode <- "fit"
}
if (!mode %in% c("fit", "residuals", "both")) {
stop("The mode argument must be one of `fit`, `residuals`, or `both`",
call. = FALSE)
}
if(missing(show_excluded)) {
show_excluded <- TRUE
}
if(!is.logical(show_excluded)) {
stop("The show_excluded argument must be logical.",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
#Optional grouping
if (group == TRUE) {
x <- .group_patterns(x = x)
}
#compute d
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
#Create a dataframe of the weighted pure patterns and fitted pattern
pure_patterns <- data.frame(tth = x$tth,
d = d_v,
Measured = x$measured,
Fitted = x$fitted,
x$weighted_pure_patterns,
check.names = FALSE)
refs_colors <- .gg_color_hue(ncol(x$weighted_pure_patterns))
#Residuals
resids <- data.frame(tth = x$tth,
d = d_v,
Counts = x$residuals)
#melt the pure patterns data frame
pure_patterns_long <- reshape::melt(pure_patterns, id = c("tth", "d"))
#Name the counts column
names(pure_patterns_long)[4] <- "Counts"
g1 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = pure_patterns_long,
ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~variable,
linetype = ~variable,
d = ~d),
size = 0.25) +
ggplot2::scale_color_manual(values = c("black", "red",
refs_colors)) +
ggplot2::scale_linetype_manual(values = c("solid", "solid",
rep("dotted", ncol(x$weighted_pure_patterns)))) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::theme(legend.title = ggplot2::element_blank()))
g2 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = resids,
ggplot2::aes_(x = ~tth, y = ~Counts, color = "Residuals", d = ~d), size = 0.15) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::scale_colour_manual(name = "",
values = c("Residuals" = "blue")))
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect1 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect2 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect1,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect2,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect3 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect4 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect3,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect4,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (interactive == TRUE) {
#Convert to ggplotly
p1 <- plotly::ggplotly(g1, tooltip = c("x", "y", "d", "colour", "label"))
p2 <- plotly::ggplotly(g2, tooltip = c("x", "y", "d", "colour", "label"))
if (mode == "fit") {
return(p1)
}
if (mode == "residuals") {
return(p2)
}
if (mode == "both") {
p3 <- plotly::subplot(p1, p2,
nrows = 2,
heights = c((2/3), (1/3)),
widths = c(1),
shareX = TRUE,
titleY = TRUE)
return(p3)
}
} else {
if (mode == "fit") {
return(g1)
}
if (mode == "residuals") {
return(g2)
}
if (mode == "both") {
g3 <- ggpubr::ggarrange(g1, g2, nrow = 2,
heights = c(2,1))
return(g3)
}
}
}
#' Plotting elements of a powdRafps object
#'
#' \code{plot.powdRafps} is designed to provide easy, adaptable plots
#' of full pattern summation outputs produced from \code{\link{afps}}.
#'
#' When seeking to inspect the results from full pattern summation, interactive
#' plots are particularly useful and can be specified with the \code{interactive}
#' argument.
#'
#' @param x a powdRafps object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param mode One of "fit", "residuals" or "both" defining whether to plot the fitted
#' patterns, the residuals of the fit, or both, respectively. Default = "fit".
#' @param group A logical parameter used to specify whether the plotted data are grouped
#' according to the phase name. Default = FALSE.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param show_excluded A logical value specifying whether the areas excluded from the
#' fitting are identified in the plot as grey rectangles. Default \code{= TRUE}.
#' @param interactive logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRafps
#' @examples
#' #Load the minerals library
#' data(minerals)
#'
#' # Load the soils data
#' data(soils)
#'
#' \dontrun{
#' afps_sand <- afps(lib = minerals,
#' smpl = soils$sandstone,
#' std = "QUA.1",
#' amorphous = "ORG",
#' align = 0.2,
#' lod = 0.1)
#'
#' plot(afps_sand, wavelength = "Cu")
#' plot(afps_sand, wavelength = "Cu", interactive = TRUE)
#'
#' }
#' @export
plot.powdRafps <- function(x, wavelength, mode, group, xlim, show_excluded, interactive, ...) {
if (missing(group)) {
group <- FALSE
}
if (!is.logical(group)) {
stop("group must be logical",
call. = FALSE)
}
if (missing(xlim)) {
xlim <- c(min(x$tth), max(x$tth))
}
if (length(xlim) > 2) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (xlim[1] < min(x$tth) | xlim[2] > max(x$tth)) {
stop("The limits defined in xlim are outside of the 2theta range of the data",
call. = FALSE)
}
if (missing(mode)) {
mode <- "fit"
}
if (!mode %in% c("fit", "residuals", "both")) {
stop("The mode argument must be one of `fit`, `residuals`, or `both`",
call. = FALSE)
}
if(missing(show_excluded)) {
show_excluded <- TRUE
}
if(!is.logical(show_excluded)) {
stop("The show_excluded argument must be logical.",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
#Optional grouping
if (group == TRUE) {
x <- .group_patterns(x = x)
}
#compute d
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
#Create a dataframe of the weighted pure patterns and fitted pattern
pure_patterns <- data.frame(tth = x$tth,
d = d_v,
Measured = x$measured,
Fitted = x$fitted,
x$weighted_pure_patterns,
check.names = FALSE)
refs_colors <- .gg_color_hue(ncol(x$weighted_pure_patterns))
#Residuals
resids <- data.frame(tth = x$tth,
d = d_v,
Counts = x$residuals)
#melt the pure patterns data frame
pure_patterns_long <- reshape::melt(pure_patterns, id = c("tth", "d"))
#Name the counts column
names(pure_patterns_long)[4] <- "Counts"
g1 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = pure_patterns_long,
ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~variable,
linetype = ~variable,
d = ~d),
size = 0.25) +
ggplot2::scale_color_manual(values = c("black", "red",
refs_colors)) +
ggplot2::scale_linetype_manual(values = c("solid", "solid",
rep("dotted", ncol(x$weighted_pure_patterns)))) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::theme(legend.title = ggplot2::element_blank()))
g2 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = resids,
ggplot2::aes_(x = ~tth, y = ~Counts, color = "Residuals", d = ~d), size = 0.15) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::scale_colour_manual(name = "",
values = c("Residuals" = "blue")))
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect1 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect2 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect1,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect2,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect3 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = 0, ymax = max(pure_patterns_long$Counts))
rect4 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect3,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect4,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (interactive == TRUE) {
#Convert to ggplotly
p1 <- plotly::ggplotly(g1, tooltip = c("x", "y", "d", "colour", "label"))
p2 <- plotly::ggplotly(g2, tooltip = c("x", "y", "d", "colour", "label"))
if (mode == "fit") {
return(p1)
}
if (mode == "residuals") {
return(p2)
}
if (mode == "both") {
p3 <- plotly::subplot(p1, p2,
nrows = 2,
heights = c((2/3), (1/3)),
widths = c(1),
shareX = TRUE,
titleY = TRUE)
return(p3)
}
} else {
if (mode == "fit") {
return(g1)
}
if (mode == "residuals") {
return(g2)
}
if (mode == "both") {
g3 <- ggpubr::ggarrange(g1, g2, nrow = 2,
heights = c(2,1))
return(g3)
}
}
}
#' Plotting elements of a powdRlm object
#'
#' \code{plot.powdRlm} is designed to provide easy, adaptable plots
#' of full pattern summation outputs produced from \code{\link{fps_lm}}.
#'
#' When seeking to inspect the results from full pattern summation, interactive
#' plots are particularly useful and can be specified with the \code{interactive}
#' argument.
#'
#' @param x a powdRlm object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param mode One of "fit", "residuals" or "both" defining whether to plot the fitted
#' patterns, the residuals of the fit, or both, respectively. Default = "fit".
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param group A logical parameter used to specify whether the plotted data are grouped
#' according to the phase name. Default = FALSE.
#' @param show_excluded A logical value specifying whether the areas excluded from the
#' fitting are identified in the plot as grey rectangles. Default \code{= TRUE}.
#' @param interactive logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRlm
#' @examples
#' data(rockjock)
#' data(rockjock_mixtures)
#'
#' #Compute the PCA and loadings
#' x1 <- xrpd_pca(rockjock_mixtures,
#' mean_center = TRUE,
#' bin_size = 1,
#' root_transform = 1)
#'
#' \dontrun{
#' fps_lm_out <- fps_lm(rockjock,
#' smpl = data.frame("x" = x1$loadings$tth,
#' "y" = x1$loadings$Dim.1),
#' refs = rockjock$phases$phase_id,
#' std = "QUARTZ",
#' align = 0.3,
#' p = 0.01)
#'
#' plot(fps_lm_out,
#' wavelength = "Cu",
#' interactive = TRUE,
#' group = TRUE)
#'
#' }
#' @export
plot.powdRlm <- function(x, wavelength, mode, xlim, group, show_excluded, interactive, ...) {
if (missing(xlim)) {
xlim <- c(min(x$tth), max(x$tth))
}
if (missing(group)) {
group <- FALSE
}
if (!is.logical(group)) {
stop("group must be logical",
call. = FALSE)
}
if (length(xlim) > 2) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2",
call. = FALSE)
}
if (xlim[1] < min(x$tth) | xlim[2] > max(x$tth)) {
stop("The limits defined in xlim are outside of the 2theta range of the data",
call. = FALSE)
}
if (missing(mode)) {
mode <- "fit"
}
if (!mode %in% c("fit", "residuals", "both")) {
stop("The mode argument must be one of `fit`, `residuals`, or `both`",
call. = FALSE)
}
if(missing(show_excluded)) {
show_excluded <- TRUE
}
if(!is.logical(show_excluded)) {
stop("The show_excluded argument must be logical.",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
#-----------------------------------
#Optional grouping
#-----------------------------------
if (group == TRUE) {
x <- .group_patterns(x = x)
}
#compute d
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
#Create a dataframe of the weighted pure patterns and fitted pattern
pure_patterns <- data.frame(tth = x$tth,
d = d_v,
Measured = x$measured,
Fitted = x$fitted,
x$weighted_pure_patterns,
check.names = FALSE)
refs_colors <- .gg_color_hue(ncol(x$weighted_pure_patterns))
#Residuals
resids <- data.frame(tth = x$tth,
d = d_v,
Counts = x$residuals)
#melt the pure patterns data frame
pure_patterns_long <- reshape::melt(pure_patterns, id = c("tth", "d"))
#Name the counts column
names(pure_patterns_long)[4] <- "Counts"
g1 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = pure_patterns_long,
ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~variable,
linetype = ~variable,
d = ~d),
size = 0.25) +
ggplot2::scale_color_manual(values = c("black", "red",
refs_colors)) +
ggplot2::scale_linetype_manual(values = c("solid", "solid",
rep("dotted", ncol(x$weighted_pure_patterns)))) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::theme(legend.title = ggplot2::element_blank()))
g2 <- suppressWarnings(ggplot2::ggplot() +
ggplot2::geom_line(data = resids,
ggplot2::aes_(x = ~tth, y = ~Counts, color = "Residuals", d = ~d), size = 0.15) +
ggplot2::ylab("Counts") +
ggplot2::xlab("2theta") +
ggplot2::scale_x_continuous(limits = xlim) +
ggplot2::scale_colour_manual(name = "",
values = c("Residuals" = "blue")))
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect1 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(pure_patterns_long$Counts), ymax = max(pure_patterns_long$Counts))
rect2 <- data.frame(xmin = min(x$tth), xmax = x$inputs$tth_fps[1],
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect1,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect2,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (abs(x$inputs$tth_fps[1] - min(x$tth)) > (x$inputs$align + x$inputs$shift) &
show_excluded == TRUE) {
rect3 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(pure_patterns_long$Counts), ymax = max(pure_patterns_long$Counts))
rect4 <- data.frame(xmin = x$inputs$tth_fps[2], xmax = max(x$tth),
ymin = min(resids$Counts), ymax = max(resids$Counts))
g1 <- suppressWarnings(g1 +
ggplot2::geom_rect(data=rect3,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
g2 <- suppressWarnings(g2 +
ggplot2::geom_rect(data=rect4,
ggplot2::aes_(xmin = ~xmin,
xmax = ~xmax,
ymin = ~ymin,
ymax = ~ymax,
label = "Excluded from fit"),
color="grey10",
alpha=0.25))
}
if (interactive == TRUE) {
#Convert to ggplotly
p1 <- plotly::ggplotly(g1, tooltip = c("x", "y", "d", "colour", "label"))
p2 <- plotly::ggplotly(g2, tooltip = c("x", "y", "d", "colour", "label"))
if (mode == "fit") {
return(p1)
}
if (mode == "residuals") {
return(p2)
}
if (mode == "both") {
p3 <- plotly::subplot(p1, p2,
nrows = 2,
heights = c((2/3), (1/3)),
widths = c(1),
shareX = TRUE,
titleY = TRUE)
return(p3)
}
} else {
if (mode == "fit") {
return(g1)
}
if (mode == "residuals") {
return(g2)
}
if (mode == "both") {
g3 <- ggpubr::ggarrange(g1, g2, nrow = 2,
heights = c(2,1))
return(g3)
}
}
}
#' Plotting elements of a powdRlib object
#'
#' \code{plot.powdRlib} is designed to provide easy, adaptable plots
#' of an XRPD reference library built using the \code{powdRlib} constructor
#' function.
#'
#' Plots can be made interactive using the logical \code{interactive} argument.
#'
#' @param x a powdRlib object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param refs a character string of reference pattern id's to be plotted
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRlib
#'
#' @examples
#' # Load the minerals library
#' data(minerals)
#' \dontrun{
#' plot(minerals, wavelength = "Cu", refs = "ALB")
#' plot(minerals, wavelength = "Cu", refs = "ALB", interactive = TRUE)
#' }
#' @export
plot.powdRlib <- function(x, wavelength, refs, interactive, ...) {
#If a pattern is specified but isn't there, then stop
if (!missing(refs)) {
if (!length(which(refs %in% x$phases$phase_id)) == length(refs)) {
stop("Not all refs defined relate to phase ID's in the library",
call. = FALSE)
}
}
if(missing(refs)) {
refs <- c("")
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
if(!missing(refs) & !is.character(refs)) {
stop("The refs argument must be a character string
of the reference pattern ID's to be plotted",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
d_v <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
melted <- reshape::melt(data.frame("tth" = x[[2]],
"d" = d_v,
x[[1]],
check.names = FALSE), id = c("tth", "d"))
names(melted) <- c("tth", "d", "phase", "Counts")
if(length(which(melted$phase %in% refs)) > 0) {
melted <- melted[which(melted$phase %in% refs), ]
}
p <- suppressWarnings(ggplot2::ggplot(data = melted) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~Counts,
color = ~phase, d = ~d),
size = 0.15) +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank()))
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
#' Plotting a powdRbkg object
#'
#' \code{plot.powdRbkg} is designed to provide quick plots to inspect the
#' fitted backgrounds obtained from \code{bkg}.
#'
#' The only mandatory argument is x, which must be a powdRbkg object. Plots can
#' be made interactive using the logical \code{interactive} argument.
#'
#' @param x a powdRbkg object
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot powdRbkg
#'
#' @examples
#' # Load the minerals library
#' data(minerals)
#'
#' \dontrun{
#' plot(minerals, interactive = TRUE)
#' }
#' @export
plot.powdRbkg <- function(x, interactive, ...) {
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
observed <- data.frame("tth" = x[[1]],
"counts" = x[[2]],
"id" = rep("Observed", length(x[[1]])))
fitted_bkg <- data.frame("tth" = x[[1]],
"counts" = x[[3]],
"id" = rep("Background", length(x[[1]])))
df <- rbind(observed, fitted_bkg)
p <- ggplot2::ggplot(data = data.frame(df)) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~counts,
color = ~id),
size = 0.15) +
ggplot2::scale_color_manual(values = c("black", "red")) +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank())
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
#' Plotting a multiXY object
#'
#' \code{plot.multiXY} is designed to provide easy, adaptable plots
#' of multiple XRPD patterns.
#'
#' Plots can be made interactive using the logical \code{interactive} argument.
#'
#' @param x a multiXY object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param normalise Logical. If TRUE then count intensities will be normalised to a
#' minimum of zero and maximum of 1. Default \code{= FALSE}.
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot multiXY
#'
#' @examples
#' # Load the minerals library
#' data(rockjock_mixtures)
#' \dontrun{
#' plot(as_multi_xy(rockjock_mixtures), wavelength = "Cu")
#' plot(as_multi_xy(rockjock_mixtures), wavelength = "Cu", interactive = TRUE)
#' }
#' @export
plot.multiXY <- function(x, wavelength, xlim, normalise, interactive, ...) {
#If normalise is missing then set it to FALSE
if (missing(normalise)) {
normalise <- FALSE
}
if (!is.logical(normalise)) {
stop("The normalise argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#Define the xlims if not defined
if (missing(xlim)) {
tth_min <- min(unlist(lapply(x, function(x) min(x[[1]]))))
tth_max <- max(unlist(lapply(x, function(x) max(x[[1]]))))
xlim <- c(tth_min, tth_max)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2.",
call. = FALSE)
}
#Subset based on the xlims
x <- lapply(x, .subset_tth_xy, xlim = xlim)
#Normalise counts if required
if (normalise == TRUE) {
x <- lapply(x, .rng_nm_xy)
}
#Create a d vector for each item
for (i in 1:length(x)) {
x[[i]]$d <- round(wavelength/(2*sin((x[[i]]$tth/2)*pi/180)), 3)
}
#Populate each item in the list with an ID
for (i in 1:length(x)) {
x[[i]]$id <- names(x)[i]
}
#Now bind into long dataframe
x_long <- do.call(rbind, x)
p <- suppressWarnings(ggplot2::ggplot(data = x_long) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~counts,
color = ~id, d = ~d),
size = 0.15) +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank()))
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
#' Plotting an XY object
#'
#' \code{plot.XY} is designed to provide easy, adaptable plots
#' of an XRPD pattern.
#'
#' Plots can be made interactive using the logical \code{interactive} argument.
#'
#' @param x an XY object
#' @param wavelength One of "Cu", "Co" or a custom numeric value defining the wavelength
#' (in Angstroms). Used to compute d-spacings.When "Cu" or "Co" are supplied, wavelengths
#' of 1.54056 or 1.78897 are used, respectively.
#' @param xlim A numeric vector providing limits of the x-axis (E.g. \code{c(10, 60)}).
#' Defaults to full x-axis unless specified.
#' @param normalise Logical. If TRUE then count intensities will be normalised to a
#' minimum of zero and maximum of 1. Default \code{= FALSE}.
#' @param interactive Logical. If TRUE then the output will be an interactive
#' ggplotly object. If FALSE then the output will be a ggplot object.
#' @param ... other arguments
#'
#' @method plot XY
#'
#' @examples
#' # Load the minerals library
#' data(rockjock_mixtures)
#' \dontrun{
#' plot(rockjock_mixtures$Mix1, wavelength = "Cu")
#' plot(rockjock_mixtures$Mix1, wavelength = "Cu", interactive = TRUE)
#' }
#' @export
plot.XY <- function(x, wavelength, xlim, normalise, interactive, ...) {
#If normalise is missing then set it to FALSE
if (missing(normalise)) {
normalise <- FALSE
}
if (!is.logical(normalise)) {
stop("The normalise argument must be logical.",
call. = FALSE)
}
#If wavelength is missing then stop the function call
if (missing(wavelength)) {
stop("Provide a wavelength so that d-spacings can be calculated",
call. = FALSE)
}
#If wavelength = "Cu" then define it
if (wavelength == "Cu") {
wavelength <- 1.54056
}
#If wavelength = "Cu" then define it
if (wavelength == "Co") {
wavelength <- 1.78897
}
#At this point if wavelength isn't numeric then stop
if (!is.numeric(wavelength)) {
stop("The wavelength argument must be one of either 'Cu', 'Co', or
a custom numeric value",
call. = FALSE)
}
if(missing(interactive)) {
interactive <- FALSE
}
if(!missing(interactive) & !is.logical(interactive)) {
stop("The interactive argument must be logical.",
call. = FALSE)
}
#Define the xlims if not defined
if (missing(xlim)) {
tth_min <- min(x[[1]])
tth_max <- max(x[[1]])
xlim <- c(tth_min, tth_max)
}
if (!is.numeric(xlim)) {
stop("xlim must be a numeric vector of length 2.",
call. = FALSE)
}
#Subset based on the xlims
x <- .subset_tth_xy(x, xlim)
#Normalise counts if required
if (normalise == TRUE) {
x <- .rng_nm_xy(x)
}
#Create a d vector for each item
x$d <- round(wavelength/(2*sin((x$tth/2)*pi/180)), 3)
p <- suppressWarnings(ggplot2::ggplot(data = x) +
ggplot2::geom_line(ggplot2::aes_(x = ~tth, y = ~counts,
d = ~d),
size = 0.15,
colour = "blue") +
ggplot2::xlab("2theta") +
ggplot2::ylab("Counts") +
ggplot2::theme(legend.title = ggplot2::element_blank()))
if(interactive == TRUE) {
p <- plotly::ggplotly(p)
}
return(p)
}
Try the powdR 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.