Skip to content

Commit

Permalink
Implement unit tests for plotRDA
Browse files Browse the repository at this point in the history
  • Loading branch information
@RiboRings
RiboRings committed Sep 11, 2023
1 parent 1e98dcd commit 2aa225e
Show file tree
Hide file tree
Showing 2 changed files with 74 additions and 26 deletions.
47 changes: 34 additions & 13 deletions R/plotCCA.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,11 @@
#' @param ellipse.linewidth Number specifying the size of ellipses.
#' (default: \code{ellipse.linewidth = 0.1})
#'
#' @param ellipse.linetype Discrete number specifying the style of ellipses
#' @param ellipse.linetype Discrete number specifying the style of ellipses.
#' (default: \code{ellipse.linetype = 1})
#'
#' @param add.vectors TRUE or FALSE, should vectors appear in the plot.
#' (default: \code{add.vectors = TRUE})
#'
#' @param vec.size Number specifying the size of vectors.
#' (default: \code{vec.size = 0.5})
Expand Down Expand Up @@ -56,12 +59,15 @@
#' @param vec.text TRUE or FALSE, should text instead of labels be used to label vectors.
#' (default: \code{vec.text = TRUE})
#'
#' @param repel.labels TRUE or FALSE, should labels be repelled
#' @param repel.labels TRUE or FALSE, should labels be repelled.
#' (default: \code{repel.labels = TRUE})
#'
#'
#' @param parse.labels TRUE or FALSE, should labels be parsed.
#' (default: \code{parse.labels = TRUE})
#'
#' @param add.significance TRUE or FALSE, should explained variance and p-value
#' appear in the labels. (default: \code{add.significance = TRUE})
#'
#'
#' @param add.expl.var TRUE or FALSE, should explained variance appear on the
#' coordinate axes. (default: \code{add.expl.var = TRUE})
#'
Expand Down Expand Up @@ -120,6 +126,11 @@
#' colour_by = "ClinicalStatus",
#' repel.labels = FALSE)
#'
#' # Create RDA plot without vectors
#' plotRDA(tse, "RDA",
#' colour_by = "ClinicalStatus",
#' add.vectors = FALSE)
#'
#' # Calculate RDA as a separate object
#' rda_mat <- calculateRDA(tse,
#' formula = assay ~ ClinicalStatus + Gender + Age,
Expand Down Expand Up @@ -172,23 +183,33 @@ setMethod("plotRDA", signature = c(object = "SingleCellExperiment"),
vec.size = 0.5, vec.color = vec.colour, vec.colour = "black", vec.linetype = 1,
arrow.size = 0.25, label.color = label.colour, label.colour = "black", label.size = 4,
vec.text = TRUE, repel.labels = TRUE, sep.group = "\U2012", repl.underscore = " ",
add.significance = TRUE, add.expl.var = TRUE, ...){
add.significance = TRUE, add.expl.var = TRUE, add.vectors = TRUE, parse.labels = TRUE, ...){
###################### Input check ########################
if( !(add.ellipse %in% c(TRUE, FALSE, "fill", "color", "colour")) ){
stop("'add.ellipse' must be one of c(TRUE, FALSE, 'fill', 'color', 'colour').", call. = FALSE)
}
if ( !.is_a_bool(add.vectors) ){
stop("'add.vectors must be TRUE or FALSE.", call. = FALSE)
}
if ( !add.vectors ){
warning("'add.vectors' is FALSE, so other arguments for vectors and labels will be disregarded.", call. = FALSE)
}
if( !.is_a_bool(vec.text) ){
stop("'vec.text' must be TRUE or FALSE.", call. = FALSE)
}
if( !.is_a_bool(repel.labels) ){
stop("'repel.labels' must be TRUE or FALSE.", call. = FALSE)
}
if( !.is_a_bool(add.significance) ){
stop("'add.significance' must be TRUE or FALSE.", call. = FALSE)
if( !.is_a_bool(parse.labels) ){
stop("'parse.labels' must be TRUE or FALSE.", call. = FALSE)
}
if( !.is_a_bool(add.significance) ){
stop("'add.significance' must be TRUE or FALSE.", call. = FALSE)
}
if( parse.labels && !add.significance ){
parse.labels <- FALSE
warning("'parse.labels' was turned off because 'add.significance' is FALSE.", call. = FALSE)
}
if( !.is_a_bool(add.expl.var) ){
stop("'add.expl.var' must be TRUE or FALSE.", call. = FALSE)
}
Expand Down Expand Up @@ -230,7 +251,7 @@ setMethod("plotRDA", signature = c(object = "SingleCellExperiment"),
plot_data <- .incorporate_rda_vis(
object, dimred, sep.group = sep.group, repl.underscore = repl.underscore,
add.significance = add.significance, add.expl.var = add.expl.var,
add.ellipse = add.ellipse, ...
add.ellipse = add.ellipse, add.vectors = add.vectors, ...
)
# Create a plot
plot <- .rda_plotter(
Expand All @@ -239,7 +260,7 @@ setMethod("plotRDA", signature = c(object = "SingleCellExperiment"),
vec.colour = vec.colour, vec.linetype = vec.linetype, arrow.size = arrow.size,
label.color = label.color, label.colour = label.colour, label.size = label.size,
vec.text = vec.text, add.ellipse = add.ellipse, repel.labels = repel.labels,
parse = add.significance, ...
parse.labels = parse.labels, ...
)
return(plot)
}
Expand Down Expand Up @@ -277,7 +298,7 @@ setMethod("plotRDA", signature = c(object = "matrix"),
tse, dimred, ncomponents = 2, colour_by = color_by, color_by = NULL,
shape_by = NULL, size_by = NULL, order_by = NULL, text_by = NULL,
other_fields = list(), swap_rownames = NULL, point.padding = NA,
add.ellipse = TRUE, add_vectors = TRUE, add.significance = TRUE,
add.ellipse = TRUE, add.vectors = TRUE, add.significance = TRUE,
add.expl.var = TRUE, vec_lab = NULL, bins = NULL, sep.group = "\U2012",
repl.underscore = " ", ...){

Expand Down Expand Up @@ -329,7 +350,7 @@ setMethod("plotRDA", signature = c(object = "matrix"),

# Get data for vectors
vector_data <- NULL
if( add_vectors ){
if( add.vectors ){
# Check if data is available
ind <- names(attributes(reduced_dim)) %in% c("rda", "cca")
# If it can be found
Expand Down Expand Up @@ -504,7 +525,7 @@ setMethod("plotRDA", signature = c(object = "matrix"),
vec.size = 0.5, vec.color = vec.colour, vec.colour = "black",
vec.linetype = 1, arrow.size = 0.25, min.segment.length = 5,
label.color = label.colour, label.colour = "black", label.size = 4,
parse = TRUE, vec.text = TRUE, repel.labels = TRUE, add.ellipse = TRUE,
parse.labels = TRUE, vec.text = TRUE, repel.labels = TRUE, add.ellipse = TRUE,
position = NULL, nudge_x = NULL, nudge_y = NULL, direction = "both",
max.overlaps = 10, check_overlap = FALSE, ...){

Expand Down Expand Up @@ -551,7 +572,7 @@ setMethod("plotRDA", signature = c(object = "matrix"),
label_args <- list(
data = data,
mapping = aes(x = .data[[xvar]], y = .data[[yvar]]),
label = data[["vector_label"]], parse = parse,
label = data[["vector_label"]], parse = parse.labels,
color = label.color, size = label.size, stat = "identity",
nudge_x = nudge_x, nudge_y = nudge_y, show.legend = NA,
na.rm = FALSE, inherit.aes = TRUE
Expand Down
53 changes: 40 additions & 13 deletions tests/testthat/test-plotCCA.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,9 +20,18 @@ test_that("plot RDA/CCA", {
"'colour_by' must match the name of a column in colData.")
expect_error(plotRDA(tse, "RDA", colour_by = "cohort", shape_by = "wrong colname"),
"'shape_by' must match the name of a column in colData.")
expect_error(plotRDA(tse, "RDA", add.ellipse = "invalid entry"),
expect_error(plotRDA(tse, "RDA", add.ellipse = "invalid value"),
"'add.ellipse' must be one of c(TRUE, FALSE, 'fill', 'color', 'colour').",
fixed = TRUE)
expect_error(plotRDA(tse, "RDA", add.significance = "invalid value"),
"'add.significance' must be TRUE or FALSE.")
expect_error(plotRDA(tse, "RDA", add.expl.var = "invalid value"),
"'add.expl.var' must be TRUE or FALSE.")
expect_error(plotRDA(tse, "RDA", repel.labels))
expect_warning(plotRDA(tse, "RDA", add.significance = FALSE, parse.labels = TRUE),
"'parse.labels' was turned off because 'add.significance' is FALSE.")
expect_warning(plotRDA(tse, "RDA", add.vectors = FALSE),
"'add.vectors' is FALSE, so other arguments for vectors and labels will be disregarded.")
## add more tests here

### 2). TEST plot layers ###
Expand All @@ -31,23 +40,41 @@ test_that("plot RDA/CCA", {
el_false <- plotRDA(tse, "RDA", colour_by = "patient_status", add.ellipse = FALSE)
el_col <- plotRDA(tse, "RDA", colour_by = "patient_status", add.ellipse = "colour")
el_fill <- plotRDA(tse, "RDA", colour_by = "patient_status", add.ellipse = "fill")

# filled ellipse has one more layer than no ellipse plot
vec_false <- plotRDA(tse, "RDA", colour_by = "patient_status", add.vectors = FALSE)
# Filled ellipse has one more layer than no ellipse plot
expect_equal(length(ggplot_build(el_true)[["data"]]), 4)
expect_equal(length(ggplot_build(el_false)[["data"]]), 3)

# coloured ellipse but not filled ellipse plot has all 0 alpha values
# No-vector plot has only one layer
expect_equal(length(ggplot_build(vec_false)[["data"]]), 1)
# Coloured ellipse but not filled ellipse plot has all 0 alpha values
expect_true(all(ggplot_build(el_col)[["data"]][[2]][["alpha"]] == 0))
expect_false(all(ggplot_build(el_fill)[["data"]][[2]][["alpha"]] == 0))

# Check ggplot aesthetics
p_aes <- plotRDA(tse, "RDA", colour_by = "patient_status", ellipse.alpha = 0.5,
ellipse.linewidth = 0.2, ellipse.linetype = 3)

# ellipse aesthetics are correctly defined in ggplot
expect_true(all(ggplot_build(p_aes)[["data"]][[2]][["alpha"]] == 0.5))
expect_true(all(ggplot_build(p_aes)[["data"]][[2]][["linewidth"]] == 0.2))
expect_true(all(ggplot_build(p_aes)[["data"]][[2]][["linetype"]] == 3))

## add more tests here
ellipse.linewidth = 0.2, ellipse.linetype = 3, vec.size = 0.6,
vec.colour = "red", vec.linetype = 2, arrow.size = 0.15,
label.colour = "blue", label.size = 5)
# Build plot and get data
p_aes_build <- ggplot_build(p_aes)[["data"]]
# Ellipse aesthetics are correctly defined in ggplot
expect_true(all(p_aes_build[[2]][["alpha"]] == 0.5))
expect_true(all(ggplot_build(p_aes)[[2]][["linewidth"]] == 0.2))
expect_true(all(ggplot_build(p_aes)[[2]][["linetype"]] == 3))
# Vector aesthetics are correctly defined in ggplot
expect_true(all(p_aes_build[[3]][["colour"]] == "red"))
expect_true(all(p_aes_build[[3]][["linewidth"]] == 0.6))
expect_true(all(p_aes_build[[3]][["linetype"]] == 2))
# Label aesthetics are correctly defined in ggplot
expect_true(all(p_aes_build[[4]][["colour"]] == "blue"))
expect_true(all(p_aes_build[[4]][["size"]] == 5))
# Where is arrow size stored?
# expect_true(arrow_size == 0.15)

# Vector or label text
p_vec <- plotRDA(tse, "RDA", colour_by = "patient_status", vec.text = TRUE)
p_lab <- plotRDA(tse, "RDA", colour_by = "patient_status", vec.text = FALSE)
# Column "fill" is present in p_vec and missing in p_lab, so length differs by 1
expect_length(ggplot_build(p_vec)[["data"]][[4]], 29)
expect_length(ggplot_build(p_lab)[["data"]][[4]], 28)
})

0 comments on commit 2aa225e

Please sign in to comment.