Nothing
#' Plot quality-control metrics and thresholds of a "nacho" object
#'
#' This function allows to plot any qualit-control figures available
#' within the shiny app using [`visualise()`] or in the HTML report from [`render()`].
#'
#' @inheritParams render
#' @param object [[list]] List obtained from [`load_rcc()`] or [`normalise()`].
#' @param x [[character]] Character string naming the quality-control metrics to plot from `nacho_object`.
#' The possible values are:
#'
#' * `"BD"` (Binding Density)
#' * `"FoV"` (Imaging)
#' * `"PCL"` (Positive Control Linearity)
#' * `"LoD"` (Limit of Detection)
#' * `"Positive"` (Positive Controls)
#' * `"Negative"` (Negative Controls)
#' * `"Housekeeping"` (Housekeeping Genes)
#' * `"PN"` (Positive Controls vs. Negative Controls)
#' * `"ACBD"` (Average Counts vs. Binding Density)
#' * `"ACMC"` (Average Counts vs. Median Counts)
#' * `"PCA12"` (Principal Component 1 vs. 2)
#' * `"PCAi"` (Principal Component scree plot)
#' * `"PCA"` (Principal Components planes)
#' * `"PFNF"` (Positive Factor vs. Negative Factor)
#' * `"HF"` (Housekeeping Factor)
#' * `"NORM"` (Normalisation Factor)
#'
#' @param ... Other arguments (Not used).
#'
#' @return NULL
#' @export
#'
#' @importFrom ggplot2 .data
#'
#' @examples
#'
#' data(GSE74821)
#'
#' autoplot(GSE74821, x = "BD")
#'
autoplot.nacho <- function(
object, x,
colour = "CartridgeID",
size = 0.5,
show_legend = TRUE,
show_outliers = TRUE,
outliers_factor = 1,
outliers_labels = NULL,
...
) {
if (missing(object)) {
stop(
'[NACHO] "object" is missing, results from "load_rcc()" and/or "normalise()" is mandatory!'
)
}
if (missing(x) | is.null(x)) {
stop(
paste(
'[NACHO] "x" is missing. It must be one of the following possible values:',
' * "BD", "FoV", "PCL", "LoD"',
' * "Positive", "Negative", "Housekeeping", "PN"',
' * "ACBD", "ACMC"',
' * "PCA12", "PCAi", "PCA"',
' * "PFB", "HF", "NORM"',
sep = "\n"
)
)
}
object <- check_outliers(object)
if (!is.null(outliers_labels)) show_outliers <- TRUE
# if (attr(object, "RCC_type") == "n8" & x %in% c("PCL", "LoD")) {
# stop('[NACHO] "PCL" and "LoD" are not available for the provided NanoString dataset.')
# }
switch(
EXPR = x,
"BD" = plot_metrics(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"FoV" = plot_metrics(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"PCL" = plot_metrics(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"LoD" = plot_metrics(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"Positive" = plot_cg(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"Negative" = plot_cg(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"Housekeeping" = plot_cg(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"PN" = plot_pn(
nacho_object = object,
x,
colour,
size,
show_legend
),
"ACBD" = plot_acbd(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"ACMC" = plot_acmc(
nacho_object = object,
x,
colour,
size,
show_legend
),
"PCA12" = plot_pca12(
nacho_object = object,
x,
colour,
size,
show_legend
),
"PCAi" = plot_pcai(
nacho_object = object,
x,
colour,
size),
"PCA" = plot_pca(
nacho_object = object,
x,
colour,
size,
show_legend
),
"PFNF" = plot_pfnf(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"HF" = plot_hf(
nacho_object = object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
),
"NORM" = plot_norm(
nacho_object = object,
x,
colour,
size,
show_legend
),
stop(
paste(
'[NACHO] "x" must be one of the following possible values:',
' * "BD", "FoV", "PCL", "LoD"',
' * "Positive", "Negative", "Housekeeping", "PN"',
' * "ACBD", "ACMC"',
' * "PCA12", "PCAi", "PCA"',
' * "PFB", "HF", "NORM"',
sep = "\n"
)
)
)
}
#' plot_metrics
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_metrics <- function(
nacho_object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
) {
ymax <- ymin <- NULL # no visible binding for global variable
labels <- c(
"BD" = "Binding Density",
"FoV" = "Field of View",
"PCL" = "Positive Control Linearity",
"LoD" = "Limit of Detection"
)
units <- c(
"BD" = '"(Optical features / ", mu, m^2, ")"',
"FoV" = '"(% Counted)"',
"PCL" = '"(R^2)"',
"LoD" = '"(Z)"'
)
if (attr(nacho_object, "RCC_type") == "n8" & x %in% c("PCL", "LoD")) {
message('[NACHO] "PCL" and "LoD" are not available for RCC type "n8".')
return(
ggplot2::ggplot() +
ggplot2::labs(
x = "CartridgeID",
y = parse(text = paste0("atop(\"", labels[x], "\", paste(", units[x], "))")),
colour = colour
) +
ggplot2::annotate(
"text", x = 0.5, y = 0.5, label = "Not available!",
angle = 30, size = 24, colour = "#b22222", alpha = 0.25
) +
ggplot2::theme(axis.text = ggplot2::element_blank())
)
}
if (!is.null(outliers_labels) && !outliers_labels %in% colnames(nacho_object$nacho)) {
outliers_labels <- nacho_object$access
}
ggplot2::ggplot(
data = nacho_object$nacho[
j = (nacho_object$access) := sub("_S[0-9]*$", "", .SD),
.SDcols = nacho_object$access
][
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
x,
"is_outlier",
outliers_labels
))
]
) +
ggplot2::aes(
x = .data[["CartridgeID"]],
y = .data[[x]],
colour = .data[[colour]]
) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::geom_boxplot(
mapping = ggplot2::aes(group = .data[["CartridgeID"]]),
fill = NA,
outlier.shape = NA,
na.rm = TRUE,
show.legend = FALSE
) +
{
if (show_outliers) {
list(
ggplot2::geom_point(
data = ~ .x[!(is_outlier)],
size = size, na.rm = TRUE,
position = ggplot2::position_jitter(width = 0.25, height = 0)
),
ggplot2::geom_point(
data = ~ .x[(is_outlier)],
size = size * outliers_factor,
colour = "#b22222",
na.rm = TRUE,
position = ggplot2::position_jitter(width = 0.25, height = 0)
),
if (!is.null(outliers_labels)) {
ggrepel::geom_label_repel(
data = ~ .x[(is_outlier)],
mapping = ggplot2::aes(label = .data[[outliers_labels]]),
colour = "#b22222",
na.rm = TRUE
)
}
)
} else {
ggplot2::geom_point(
size = size, na.rm = TRUE,
position = ggplot2::position_jitter(width = 0.25, height = 0)
)
}
} +
ggplot2::labs(
x = "CartridgeID",
y = parse(text = paste0("atop(\"", labels[x], "\", paste(", units[x], "))")),
colour = colour
) +
ggplot2::geom_rect(
data = data.table::data.table(
ymin = nacho_object$outliers_thresholds[[x]]
)[j = ymax := c(-Inf, Inf)[seq_along(ymin)]],
mapping = ggplot2::aes(
xmin = -Inf,
xmax = Inf,
ymin = .data[["ymin"]],
ymax = .data[["ymax"]]
),
fill = "#b22222",
alpha = 0.2,
colour = "transparent",
inherit.aes = FALSE
) +
ggplot2::geom_hline(
data = data.table::data.table(value = nacho_object$outliers_thresholds[[x]]),
mapping = ggplot2::aes(yintercept = .data[["value"]]),
colour = "#b22222",
linetype = "longdash"
) +
{if (!show_legend) ggplot2::guides(colour = "none")} +
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 30, hjust = 1, vjust = 1))
}
#' plot_cg
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_cg <- function(
nacho_object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
) {
CodeClass <- NULL # no visible binding for global variable
if (!is.null(outliers_labels) && !outliers_labels %in% colnames(nacho_object$nacho)) {
outliers_labels <- nacho_object$access
}
if (is.null(nacho_object$housekeeping_genes) & x %in% "Housekeeping") {
message("[NACHO] No housekeeping genes found.")
return(
ggplot2::ggplot() +
ggplot2::labs(
x = "Gene Name",
y = "Counts + 1",
colour = colour
) +
ggplot2::annotate(
"text", x = 0.5, y = 0.5, label = "Not available!",
angle = 30, size = 24, colour = "#b22222", alpha = 0.25
) +
ggplot2::theme(axis.text = ggplot2::element_blank())
)
}
ggplot2::ggplot(
data = nacho_object$nacho[
j = (nacho_object$access) := sub("_S[0-9]*$", "", nacho_object$access)
][
CodeClass %in% x
][
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
"Name",
"Count",
"is_outlier",
outliers_labels
))
]
) +
ggplot2::aes(
x = .data[["Name"]],
y = .data[["Count"]] + 1,
colour = .data[[colour]]
) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::geom_boxplot(
mapping = ggplot2::aes(group = .data[["Name"]]),
fill = NA,
outlier.shape = NA,
na.rm = TRUE,
show.legend = FALSE
) +
{
if (show_outliers) {
list(
ggplot2::geom_point(
data = ~ .x[!(is_outlier)],
size = size, na.rm = TRUE,
position = ggplot2::position_jitter(width = 0.25, height = 0)
),
ggplot2::geom_point(
data = ~ .x[(is_outlier)],
size = size * outliers_factor,
colour = "#b22222",
na.rm = TRUE,
position = ggplot2::position_jitter(width = 0.25, height = 0)
),
if (!is.null(outliers_labels)) {
ggrepel::geom_label_repel(
data = ~ .x[(is_outlier)],
mapping = ggplot2::aes(label = .data[[outliers_labels]]),
colour = "#b22222",
na.rm = TRUE
)
}
)
} else {
ggplot2::geom_point(
size = size, na.rm = TRUE,
position = ggplot2::position_jitter(width = 0.25, height = 0)
)
}
} +
ggplot2::scale_y_log10(
# limits = c(1, NA),
labels = function(x) format(x, big.mark = ",")
) +
ggplot2::labs(
x = if (x %in% c("Negative", "Positive")) "Control Name" else "Gene Name",
y = "Counts + 1",
colour = colour
) +
{if (!show_legend) ggplot2::guides(colour = "none")} +
ggplot2::theme(axis.text.x = ggplot2::element_text(face = "italic", angle = 30, hjust = 1, vjust = 1))
}
#' plot_pn
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_pn <- function(
nacho_object,
x,
colour,
size,
show_legend
) {
CodeClass <- NULL # no visible binding for global variable
ggplot2::ggplot(
data = nacho_object$nacho[
j = (nacho_object$access) := sub("_S[0-9]*$", "", nacho_object$access)
][
CodeClass %in% c("Positive", "Negative")
][
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
"CodeClass",
"Name",
"Count",
"is_outlier"
))
]
) +
ggplot2::aes(
x = .data[[nacho_object$access]],
y = .data[["Count"]] + 1,
colour = .data[["Name"]],
group = .data[["Name"]]
) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::geom_line() +
ggplot2::facet_wrap(facets = "CodeClass", scales = "free_y", ncol = 2) +
ggplot2::scale_y_log10(
# limits = c(1, NA),
labels = function(x) format(x, big.mark = ",")
) +
ggplot2::scale_x_discrete(labels = NULL) +
ggplot2::labs(
x = "Sample Index",
y = "Counts + 1",
colour = "Control",
linetype = "Smooth"
) +
ggplot2::theme(
panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor.x = ggplot2::element_blank()
) +
ggplot2::geom_smooth(
mapping = ggplot2::aes(
x = as.numeric(as.factor(.data[[nacho_object$access]])),
linetype = "Loess",
group = "CodeClass"
),
colour = "black",
se = TRUE,
method = "loess"
) +
ggplot2::guides(colour = ggplot2::guide_legend(ncol = 2)) +
{if (!show_legend) ggplot2::guides(colour = "none")}
}
#' plot_acbd
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_acbd <- function(
nacho_object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
) {
ymax <- ymin <- NULL # no visible binding for global variable
if (!is.null(outliers_labels) && !outliers_labels %in% colnames(nacho_object$nacho)) {
outliers_labels <- nacho_object$access
}
ggplot2::ggplot(
data = nacho_object$nacho[
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
"MC",
"BD",
"is_outlier",
outliers_labels
))
]
) +
ggplot2::aes(
x = .data[["MC"]],
y = .data[["BD"]],
colour = .data[[colour]]
) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
{
if (show_outliers) {
list(
ggplot2::geom_point(
data = ~ .x[!(is_outlier)],
size = size, na.rm = TRUE
),
ggplot2::geom_point(
data = ~ .x[(is_outlier)],
size = size * outliers_factor,
colour = "#b22222",
na.rm = TRUE
),
if (!is.null(outliers_labels)) {
ggrepel::geom_label_repel(
data = ~ .x[(is_outlier)],
mapping = ggplot2::aes(label = .data[[outliers_labels]]),
colour = "#b22222",
na.rm = TRUE
)
}
)
} else {
ggplot2::geom_point(size = size, na.rm = TRUE)
}
} +
ggplot2::scale_x_continuous(labels = function(x) format(x, big.mark = ",")) +
ggplot2::labs(
x = "Average Counts",
y = parse(text = 'atop("Binding Density", paste("(Optical features / ", mu, m^2, ")"))'),
colour = colour
) +
ggplot2::geom_rect(
data = data.table::data.table(
ymin = nacho_object$outliers_thresholds[["BD"]]
)[
j = ymax := c(-Inf, Inf)[seq_along(ymin)]
],
mapping = ggplot2::aes(xmin = -Inf, xmax = Inf, ymin = .data[["ymin"]], ymax = .data[["ymax"]]),
fill = "#b22222",
alpha = 0.2,
colour = "transparent",
inherit.aes = FALSE
) +
ggplot2::geom_hline(
data = data.table::data.table(value = nacho_object$outliers_thresholds[["BD"]]),
mapping = ggplot2::aes(yintercept = .data[["value"]]),
colour = "#b22222",
linetype = "longdash"
) +
{if (!show_legend) ggplot2::guides(colour = "none")}
}
#' plot_acmc
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_acmc <- function(
nacho_object,
x,
colour,
size,
show_legend
) {
ggplot2::ggplot(
data = nacho_object$nacho[
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
"MC",
"MedC"
))
]
) +
ggplot2::aes(
x = .data[["MC"]],
y = .data[["MedC"]],
colour = .data[[colour]]
) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::geom_point(size = size, na.rm = TRUE) +
ggplot2::scale_x_continuous(labels = function(x) format(x, big.mark = ",")) +
ggplot2::scale_y_continuous(labels = function(x) format(x, big.mark = ",")) +
ggplot2::labs(
x = "Average Counts",
y = "Median Counts",
colour = colour
) +
{if (!show_legend) ggplot2::guides(colour = "none")}
}
#' plot_pca12
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_pca12 <- function(
nacho_object,
x,
colour,
size,
show_legend
) {
ggplot2::ggplot(
data = nacho_object$nacho[
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
"PC01",
"PC02"
))
]
) +
ggplot2::aes(
x = .data[["PC01"]],
y = .data[["PC02"]],
colour = .data[[colour]]
) +
ggforce::geom_mark_ellipse(na.rm = TRUE, alpha = 0.1) +
ggplot2::geom_point(size = size, na.rm = TRUE) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::scale_fill_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::scale_x_continuous(expand = ggplot2::expansion(0.25)) +
ggplot2::scale_y_continuous(expand = ggplot2::expansion(0.25)) +
ggplot2::labs(x = "PC01", y = "PC02", colour = colour) +
{if (!show_legend) ggplot2::guides(colour = "none")}
}
#' plot_pca
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_pca <- function(
nacho_object,
x,
colour,
size,
show_legend
) {
X.PC <- Y.PC <- NULL # no visible binding for global variable
ggplot2::ggplot(
data = nacho_object$nacho[
j = merge(
x = data.table::melt(
data = unique(.SD),
id.vars = unique(c("CartridgeID", nacho_object$access, colour)),
measure.vars = sprintf("PC%02d", seq_len(min(nacho_object$n_comp, 5))),
variable.name = "X.PC",
value.name = "X"
),
y = data.table::melt(
data = unique(.SD),
id.vars = unique(c("CartridgeID", nacho_object$access, colour)),
measure.vars = sprintf("PC%02d", seq_len(min(nacho_object$n_comp, 5))),
variable.name = "Y.PC",
value.name = "Y"
),
by = c(unique(c("CartridgeID", nacho_object$access, colour))),
allow.cartesian = TRUE
),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
sprintf("PC%02d", seq_len(min(nacho_object$n_comp, 5)))
))
][
as.numeric(sub("PC", "", X.PC)) < as.numeric(sub("PC", "", Y.PC))
]
) +
ggplot2::aes(
x = .data[["X"]],
y = .data[["Y"]],
colour = .data[[colour]],
fill = .data[[colour]]
) +
ggforce::geom_mark_ellipse(na.rm = TRUE, alpha = 0.1) +
ggplot2::geom_point(size = size, na.rm = TRUE) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::scale_fill_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::scale_x_continuous(expand = ggplot2::expansion(0.25)) +
ggplot2::scale_y_continuous(expand = ggplot2::expansion(0.25)) +
ggplot2::labs(x = NULL, y = NULL, colour = colour, fill = colour) +
ggplot2::facet_grid(
rows = ggplot2::vars(.data[["Y.PC"]]),
cols = ggplot2::vars(.data[["X.PC"]]),
scales = "free"
) +
{if (!show_legend) ggplot2::guides(colour = "none")}
}
#' plot_pcai
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_pcai <- function(
nacho_object,
x,
colour,
size
) {
PoV <- `Proportion of Variance` <- NULL # no visible binding for global variable
ggplot2::ggplot(
data = data.table::as.data.table(
nacho_object$pc_sum
)[
j = PoV := sprintf("%0.2f%%", `Proportion of Variance` * 100)
]
) +
ggplot2::aes(x = .data[["PC"]], y = .data[["Proportion of Variance"]]) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::geom_bar(stat = "identity") +
ggplot2::geom_text(
mapping = ggplot2::aes(label = .data[["PoV"]]),
vjust = -1,
show.legend = FALSE
) +
ggplot2::scale_y_continuous(
labels = function(x) sprintf("%0.2f%%", x * 100),
expand = ggplot2::expansion(mult = c(0, 0.15))
) +
ggplot2::labs(x = "Principal Components", y = "Proportion of Variance")
}
#' plot_pfnf
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_pfnf <- function(
nacho_object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
) {
if (!is.null(outliers_labels) && !outliers_labels %in% colnames(nacho_object$nacho)) {
outliers_labels <- nacho_object$access
}
ggplot2::ggplot(
data = nacho_object$nacho[
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
"Negative_factor",
"Positive_factor",
"is_outlier",
outliers_labels
))
]
) +
ggplot2::aes(
x = .data[["Negative_factor"]],
y = .data[["Positive_factor"]],
colour = .data[[colour]]
) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
{
if (show_outliers) {
list(
ggplot2::geom_point(
data = ~ .x[!(is_outlier)],
size = size, na.rm = TRUE
),
ggplot2::geom_point(
data = ~ .x[(is_outlier)],
size = size * outliers_factor,
colour = "#b22222",
na.rm = TRUE
),
if (!is.null(outliers_labels)) {
ggrepel::geom_label_repel(
data = ~ .x[(is_outlier)],
mapping = ggplot2::aes(label = .data[[outliers_labels]]),
colour = "#b22222",
na.rm = TRUE
)
}
)
} else {
ggplot2::geom_point(size = size, na.rm = TRUE)
}
} +
ggplot2::labs(x = "Negative Factor", y = "Positive Factor", colour = colour) +
ggplot2::scale_y_log10() +
ggplot2::geom_rect(
data = data.table::data.table(
ymin = nacho_object$outliers_thresholds[["Positive_factor"]],
ymax = c(0, Inf)
),
mapping = ggplot2::aes(xmin = -Inf, xmax = Inf, ymin = .data[["ymin"]], ymax = .data[["ymax"]]),
fill = "#b22222",
alpha = 0.2,
colour = "transparent",
inherit.aes = FALSE
) +
ggplot2::geom_hline(
data = data.table::data.table(value = nacho_object$outliers_thresholds[["Positive_factor"]]),
mapping = ggplot2::aes(yintercept = .data[["value"]]),
colour = "#b22222",
linetype = "longdash"
) +
{if (!show_legend) ggplot2::guides(colour = "none")}
}
#' plot_hf
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_hf <- function(
nacho_object,
x,
colour,
size,
show_legend,
show_outliers,
outliers_factor,
outliers_labels
) {
if (!is.null(outliers_labels) && !outliers_labels %in% colnames(nacho_object$nacho)) {
outliers_labels <- nacho_object$access
}
is_house_factor <- "House_factor" %in% colnames(nacho_object[["nacho"]])
if (!is_house_factor) {
message('[NACHO] "House_factor" was not computed.')
return(
ggplot2::ggplot() +
ggplot2::labs(x = "Positive Factor", y = "Housekeeping Factor", colour = colour) +
ggplot2::annotate(
"text", x = 0.5, y = 0.5, label = "Not available!",
angle = 30, size = 24, colour = "#b22222", alpha = 0.25
) +
ggplot2::theme(axis.text = ggplot2::element_blank())
)
}
ggplot2::ggplot(
data = nacho_object$nacho[
j = unique(.SD),
.SDcols = unique(c(
"CartridgeID",
colour,
nacho_object$access,
"House_factor",
"Positive_factor",
"is_outlier",
outliers_labels
))
]
) +
ggplot2::aes(
x = .data[["Positive_factor"]],
y = .data[["House_factor"]],
colour = .data[[colour]]
) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
{
if (show_outliers) {
list(
ggplot2::geom_point(
data = ~ .x[!(is_outlier)],
size = size, na.rm = TRUE
),
ggplot2::geom_point(
data = ~ .x[(is_outlier)],
size = size * outliers_factor,
colour = "#b22222",
na.rm = TRUE
),
if (!is.null(outliers_labels)) {
ggrepel::geom_label_repel(
data = ~ .x[(is_outlier)],
mapping = ggplot2::aes(label = .data[[outliers_labels]]),
colour = "#b22222",
na.rm = TRUE
)
}
)
} else {
ggplot2::geom_point(size = size, na.rm = TRUE)
}
} +
ggplot2::labs(x = "Positive Factor", y = "Housekeeping Factor", colour = colour) +
ggplot2::scale_x_log10() +
ggplot2::scale_y_log10() +
ggplot2::geom_rect(
data = data.table::data.table(
xmin = c(0, 0, nacho_object$outliers_thresholds[["Positive_factor"]]),
xmax = c(Inf, Inf, 0, Inf),
ymin = c(nacho_object$outliers_thresholds[["House_factor"]], 0, 0),
ymax = c(0, Inf, Inf, Inf)
),
mapping = ggplot2::aes(
xmin = .data[["xmin"]],
xmax = .data[["xmax"]],
ymin = .data[["ymin"]],
ymax = .data[["ymax"]]
),
fill = "#b22222",
alpha = 0.2,
colour = "transparent",
inherit.aes = FALSE
) +
ggplot2::geom_hline(
data = data.table::data.table(value = nacho_object$outliers_thresholds[["House_factor"]]),
mapping = ggplot2::aes(yintercept = .data[["value"]]),
colour = "#b22222",
linetype = "longdash"
) +
ggplot2::geom_vline(
data = data.table::data.table(value = nacho_object$outliers_thresholds[["Positive_factor"]]),
mapping = ggplot2::aes(xintercept = .data[["value"]]),
colour = "#b22222",
linetype = "longdash"
) +
{if (!show_legend) ggplot2::guides(colour = "none")}
}
#' plot_norm
#'
#' @inheritParams autoplot.nacho
#'
#' @keywords internal
#' @noRd
#'
#' @return NULL
plot_norm <- function(
nacho_object,
x,
colour,
size,
show_legend
) {
Status <- Count <- NULL # no visible binding for global variable
if (is.null(nacho_object$housekeeping_genes)) {
probe_var <- "CodeClass"
probe_type <- "Positive"
} else {
probe_var <- "Name"
probe_type <- nacho_object$housekeeping_genes
}
ggplot2::ggplot(
data = nacho_object$nacho[
j = c("Count", "Count_Norm") := lapply(.SD, as.double),
.SDcols = c("Count", "Count_Norm")
][
j = data.table::melt(
data = unique(.SD),
id.vars = unique(c(
"CartridgeID",
nacho_object$access,
"Name",
"CodeClass",
"is_outlier"
)),
measure.vars = c("Count", "Count_Norm"),
variable.name = "Status",
value.name = "Count"
),
.SDcols = unique(c(
"CartridgeID",
nacho_object$access,
"Count",
"Count_Norm",
"Name",
"CodeClass",
"is_outlier"
))
][
get(probe_var) %in% c(probe_type)
][
j = `:=`(
Status = factor(
x = c("Count" = "Raw", "Count_Norm" = "Normalised")[Status],
levels = c("Count" = "Raw", "Count_Norm" = "Normalised")
),
Count = Count + 1
)
]
) +
ggplot2::aes(
x = .data[[nacho_object$access]],
y = .data[["Count"]]
) +
ggplot2::geom_line(
mapping = ggplot2::aes(colour = .data[["Name"]], group = .data[["Name"]]),
linewidth = size,
na.rm = TRUE
) +
ggplot2::facet_grid(cols = ggplot2::vars(.data[["Status"]])) +
ggplot2::scale_colour_viridis_d(option = "plasma", direction = 1, end = 0.85) +
ggplot2::scale_x_discrete(label = NULL) +
ggplot2::scale_y_log10(
# limits = c(1, NA),
labels = function(x) format(x, big.mark = ",")
) +
ggplot2::labs(
x = "Sample Index",
y = "Counts + 1",
colour = if (is.null(nacho_object$housekeeping_genes)) "Positive Control" else "Housekeeping Genes",
linetype = "Smooth"
) +
ggplot2::theme(
panel.grid.major.x = ggplot2::element_blank(),
panel.grid.minor.x = ggplot2::element_blank()
) +
ggplot2::geom_smooth(
mapping = ggplot2::aes(
x = as.numeric(as.factor(.data[[nacho_object$access]])),
linetype = "Loess"
),
colour = "black",
se = TRUE,
method = "loess"
) +
{if (!(show_legend & length(nacho_object$housekeeping_genes) <= 10)) ggplot2::guides(colour = "none")}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.