tests/testthat/test-plotIndiv.pls.R

context("plotIndiv.pls")

## rcc model
data(nutrimouse)
X <- nutrimouse$lipid
Y <- nutrimouse$gene
rcc.res <- rcc(X, Y, ncomp = 3, lambda1 = 0.064, lambda2 = 0.008)

## spls model
data(liver.toxicity)
X <- liver.toxicity$gene
Y <- liver.toxicity$clinic
spls.res <- spls(X, Y, ncomp = 3, keepX = c(50, 50, 50),
                      keepY = c(10, 10, 10))

## splsda models
data(breast.tumors)
X <- breast.tumors$gene.exp
Y <- breast.tumors$sample$treatment
splsda.breast <- splsda(X, Y,keepX=c(10,10), ncomp=2)

data(srbct)
X <- srbct$gene
Y <- srbct$class
srbct.splsda <- splsda(X, Y, ncomp = 10)

## ------------------------------------------------------------------------ ##
## Test that outputs are correct when running default style = "ggplot2"

test_that("plotIndiv works for rcc", {
  
  pl.res <- plotIndiv(rcc.res)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check coordinates
  .expect_numerically_close(pl.res$graph$data$x[1], 0.87088852)
  
  pl.res <- plotIndiv(rcc.res, rep.space= 'XY-variate', group = nutrimouse$genotype,
                      legend = TRUE)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check coordinates
  .expect_numerically_close(pl.res$graph$data$x[1], 0.8270997)
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(nutrimouse$genotype)))
})

test_that("plotIndiv works for (s)pls", {
  
  pl.res <- plotIndiv(spls.res, rep.space="X-variate", ind.name = FALSE,
                      group = factor(liver.toxicity$treatment$Time.Group),
                      legend.title = 'Time',
                      col = c("red", "blue", "green", "black"),
                      pch = factor(liver.toxicity$treatment$Dose.Group),
                      legend.title.pch = 'Dose',
                      legend = TRUE)
  
  # check coordinates
  .expect_numerically_close(pl.res$graph$data$x[1], 4.146771)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check colour assignments are correct
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 6]), "red")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 18]), "blue")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 24]), "green")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 48]), "black")
  # check right number of samples
  expect_equal(dim(spls.res$X)[1], dim(pl.res$df)[1])
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(liver.toxicity$treatment$Time.Group)))
  
})

test_that("plotIndiv works for (s)plsda", {
  
  pl.res <- plotIndiv(splsda.breast)
  # check coordinates
  .expect_numerically_close(pl.res$graph$data$x[1], -1.075222)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check colours
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "BE"]), "#F68B33")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "AF"]), "#388ECC")
  # check right number of samples
  expect_equal(dim(splsda.breast$X)[1], dim(pl.res$df)[1])
})

test_that("plotIndiv works for (s)plsda and ellipses", {
  
  groups <- factor(srbct$class, levels = c("RMS", "NB", "EWS", "BL"))
  pl.res <- plotIndiv(srbct.splsda , comp = 1:2, col = c("red", "blue", "green", "black"),
            group = groups, ind.names = FALSE,  # colour points by class
            ellipse = TRUE, # include 95% confidence ellipse for each class
            legend = TRUE, title = '(a) PLSDA with confidence ellipses')
  
  # check coordinates
  .expect_numerically_close(pl.res$graph$data$x[1], -6.83832)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check colours
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "RMS"]), "red")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "NB"]), "blue")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "EWS"]), "green")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "BL"]), "black")
  # check right number of samples
  expect_equal(dim(srbct.splsda$X)[1], dim(pl.res$df)[1])
  # check ellipses
  expect_false(is.null(pl.res$df.ellipse))
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(groups)))
})

test_that("plotIndiv works for (s)plsda and backgrounds", {
  data(srbct)
  X <- srbct$gene
  Y <- srbct$class
  srbct.splsda <- splsda(X, Y, ncomp = 10)
  groups <- factor(srbct$class, levels = c("RMS", "NB", "EWS", "BL"))
  background = background.predict(srbct.splsda, comp.predicted=2, dist = "max.dist")
  pl.res <- plotIndiv(srbct.splsda, comp = 1:2,
            group = srbct$class, ind.names = FALSE, # colour points by class
            background = background, # include prediction background for each class
            legend = TRUE, title = " (b) PLSDA with prediction background")
  
  # check coordinates
  .expect_numerically_close(pl.res$graph$data$x[1], -6.83832)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check right number of samples
  expect_equal(dim(srbct.splsda$X)[1], dim(pl.res$df)[1])
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(groups)))
})

## ------------------------------------------------------------------------ ##

test_that("plotIndiv.rcc works without ind.names", code = {
    data(nutrimouse)
    X <- nutrimouse$lipid
    Y <- nutrimouse$gene
    nutri.res <- rcc(X, Y, ncomp = 3, lambda1 = 0.064, lambda2 = 0.008)
    
    plotIndiv.res <- plotIndiv(nutri.res, group = nutrimouse$genotype, ind.names = FALSE, legend = TRUE)
    
    expect_is(plotIndiv.res$graph, "ggplot")
})

## ------------------------------------------------------------------------ ##
## Plotting with 'lattice' style

test_that("plotIndiv works for rcc (lattice style)", {
  data(nutrimouse)
  X <- nutrimouse$lipid
  Y <- nutrimouse$gene
  nutri.res <- rcc(X, Y, ncomp = 3, lambda1 = 0.064, lambda2 = 0.008)
  
  pl.res <- plotIndiv(nutri.res, style = "lattice")
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], 0.87088852)
  
  pl.res <- plotIndiv(nutri.res, rep.space= 'XY-variate', group = nutrimouse$genotype,
                      legend = TRUE, style = "lattice")
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], 0.8270997)
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(nutrimouse$genotype)))
})

test_that("plotIndiv works for (s)pls (lattice style)", {
  data(liver.toxicity)
  X <- liver.toxicity$gene
  Y <- liver.toxicity$clinic
  toxicity.spls <- spls(X, Y, ncomp = 3, keepX = c(50, 50, 50),
                        keepY = c(10, 10, 10))
  
  pl.res <- plotIndiv(toxicity.spls, rep.space="X-variate", ind.name = FALSE,
                      group = factor(liver.toxicity$treatment$Time.Group),
                      legend.title = 'Time',
                      col = c("red", "blue", "green", "black"),
                      pch = factor(liver.toxicity$treatment$Dose.Group),
                      legend.title.pch = 'Dose',
                      legend = TRUE, style = "lattice")
  
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], 4.146771)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check colour assignments are correct
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 6]), "red")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 18]), "blue")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 24]), "green")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 48]), "black")
  # check right number of samples
  expect_equal(dim(toxicity.spls$X)[1], dim(pl.res$df)[1])
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(liver.toxicity$treatment$Time.Group)))
  
})

test_that("plotIndiv works for (s)plsda (lattice style)", {
  data(breast.tumors)
  X <- breast.tumors$gene.exp
  Y <- breast.tumors$sample$treatment
  splsda.breast <- splsda(X, Y,keepX=c(10,10), ncomp=2)
  
  pl.res <- plotIndiv(splsda.breast, style = "lattice")
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], -1.075222)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check colours
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "BE"]), "#F68B33")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "AF"]), "#388ECC")
  # check right number of samples
  expect_equal(dim(splsda.breast$X)[1], dim(pl.res$df)[1])
})

## ------------------------------------------------------------------------ ##
## Plotting with 'graphics' style

test_that("plotIndiv works for rcc (graphics style)", {
  data(nutrimouse)
  X <- nutrimouse$lipid
  Y <- nutrimouse$gene
  nutri.res <- rcc(X, Y, ncomp = 3, lambda1 = 0.064, lambda2 = 0.008)
  
  pl.res <- plotIndiv(nutri.res, style = "graphics")
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], 0.87088852)
  
  pl.res <- plotIndiv(nutri.res, rep.space= 'XY-variate', group = nutrimouse$genotype,
                      legend = TRUE, style = "lattice")
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], 0.8270997)
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(nutrimouse$genotype)))
})

test_that("plotIndiv works for (s)pls (graphics style)", {
  data(liver.toxicity)
  X <- liver.toxicity$gene
  Y <- liver.toxicity$clinic
  toxicity.spls <- spls(X, Y, ncomp = 3, keepX = c(50, 50, 50),
                        keepY = c(10, 10, 10))
  
  pl.res <- plotIndiv(toxicity.spls, rep.space="X-variate", ind.name = FALSE,
                      group = factor(liver.toxicity$treatment$Time.Group),
                      legend.title = 'Time',
                      col = c("red", "blue", "green", "black"),
                      pch = factor(liver.toxicity$treatment$Dose.Group),
                      legend.title.pch = 'Dose',
                      legend = TRUE, style = "graphics")
  
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], 4.146771)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check colour assignments are correct
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 6]), "red")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 18]), "blue")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 24]), "green")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 48]), "black")
  # check right number of samples
  expect_equal(dim(toxicity.spls$X)[1], dim(pl.res$df)[1])
  # check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(liver.toxicity$treatment$Time.Group)))
  
})

test_that("plotIndiv works for (s)plsda (graphics style)", {
  data(breast.tumors)
  X <- breast.tumors$gene.exp
  Y <- breast.tumors$sample$treatment
  splsda.breast <- splsda(X, Y,keepX=c(10,10), ncomp=2)
  
  pl.res <- plotIndiv(splsda.breast, style = "graphics")
  # check coordinates
  .expect_numerically_close(pl.res$df[1,1], -1.075222)
  # check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # check colours
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "BE"]), "#F68B33")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "AF"]), "#388ECC")
  # check right number of samples
  expect_equal(dim(splsda.breast$X)[1], dim(pl.res$df)[1])
})

## ------------------------------------------------------------------------ ##
## Plotting with '3d' style

library(rgl)

test_that("plotIndiv works for rcc (3d style)", {
  data(nutrimouse)
  X <- nutrimouse$lipid
  Y <- nutrimouse$gene
  nutri.res <- rcc(X, Y, ncomp = 3, lambda1 = 0.064, lambda2 = 0.008)
  
  # Clear any existing rgl plots and disable plot rendering for non-interactive environments
  options(rgl.useNULL = TRUE)
  clear3d()
  pl.res <- suppressWarnings(suppressMessages(plotIndiv(nutri.res, style = "3d", pch = "sphere")))
  
  # Check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # Check coordinates
  .expect_numerically_close(pl.res$df[1,1], 0.87088852)
  
  clear3d()
  pl.res <- suppressWarnings(suppressMessages(plotIndiv(nutri.res, rep.space = 'XY-variate', group = nutrimouse$genotype,
                                                        legend = TRUE, style = "3d", pch = "sphere")))
  
  # Check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # Check coordinates
  .expect_numerically_close(pl.res$df[1,1], 0.8270997)
  # Check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(nutrimouse$genotype)))
})

test_that("plotIndiv works for (s)pls (3d style)", {
  data(liver.toxicity)
  X <- liver.toxicity$gene
  Y <- liver.toxicity$clinic
  toxicity.spls <- spls(X, Y, ncomp = 3, keepX = c(50, 50, 50),
                        keepY = c(10, 10, 10))
  
  # Expect error when passing numbers as pch argument
  expect_error(suppressWarnings(suppressMessages(plotIndiv(toxicity.spls, rep.space="X-variate", ind.name = FALSE,
                                                           group = factor(liver.toxicity$treatment$Time.Group),
                                                           legend.title = 'Time',
                                                           col = c("red", "blue", "green", "black"),
                                                           pch = factor(liver.toxicity$treatment$Dose.Group),
                                                           legend.title.pch = 'Dose',
                                                           legend = TRUE, style = "3d"))),
               "pch' must be a simple character or character vector from {'sphere', 'tetra', 'cube', 'octa', 'icosa', 'dodeca'}.",
               fixed = TRUE)
  
  # Plot with correct pch values
  pchs <- factor(liver.toxicity$treatment$Dose.Group)
  levels(pchs) <- c("sphere", "tetra", "octa", "icosa")
  
  clear3d()
  pl.res <- suppressWarnings(suppressMessages(plotIndiv(toxicity.spls, rep.space="X-variate", ind.name = FALSE,
                                                        group = factor(liver.toxicity$treatment$Time.Group),
                                                        legend.title = 'Time',
                                                        col = c("red", "blue", "green", "black"),
                                                        pch = pchs,
                                                        legend.title.pch = 'Dose',
                                                        legend = TRUE, style = "3d")))
  
  # Check coordinates
  .expect_numerically_close(pl.res$df[1,1], 4.146771)
  # Check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # Check colour assignments are correct
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 6]), "red")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 18]), "blue")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 24]), "green")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == 48]), "black")
  # Check right number of samples
  expect_equal(dim(toxicity.spls$X)[1], dim(pl.res$df)[1])
  # Check groups
  expect_true(!is.null(pl.res$df$group))
  expect_equal(length(unique(pl.res$df$group)), length(unique(liver.toxicity$treatment$Time.Group)))
})

test_that("plotIndiv works for (s)plsda (3d style)", {
  data(breast.tumors)
  X <- breast.tumors$gene.exp
  Y <- breast.tumors$sample$treatment
  splsda.breast <- splsda(X, Y, keepX=c(10,10), ncomp=3)
  
  clear3d()
  pl.res <- suppressWarnings(suppressMessages(plotIndiv(splsda.breast, style = "3d", pch = "cube")))
  
  # Check coordinates
  .expect_numerically_close(pl.res$df[1,1], -1.075222)
  # Check correct output structure
  expect_equal(names(pl.res), c("df", "df.ellipse", "graph"))
  # Check colours
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "BE"]), "#F68B33")
  expect_equal(unique(pl.res$df$col[pl.res$df$group == "AF"]), "#388ECC")
  # Check right number of samples
  expect_equal(dim(splsda.breast$X)[1], dim(pl.res$df)[1])
})

# Clear the rgl device
if (rgl::rgl.cur() > 0) {
  rgl::close3d()
}

## ------------------------------------------------------------------------ ##
## ------------------------------------------------------------------------ ##
## vdiffr testing - "ggplot2" with rcc object
library(vdiffr)

test_that("plotIndiv works for rcc with sample names (default)", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # simple plot showing sample names
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot sample names", 
    fig = plotIndiv(rcc.res))
  ))
  # samples coloured by primary groups, sample names, default colours
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot sample names coloured by primary groups",
    fig = plotIndiv(rcc.res, group = nutrimouse$diet))
  ))
  # samples coloured by primary groups, sample names, user-defined colours
  invisible(capture.output(
  expect_doppelganger(
    title = "PCA plot sample names coloured by primary groups custom cols",
    fig = plotIndiv(rcc.res, group = nutrimouse$diet, col = c("red", "blue", "black", "pink", "grey"), legend = TRUE))
  ))
})

test_that("plotIndiv works for rcc without sample names", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # simple plot
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot", 
    fig = plotIndiv(rcc.res, ind.names = FALSE))
  # samples coloured by primary groups, default colours, by default shapes also match primary groups
  ))
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot coloured by primary groups", 
    fig = plotIndiv(rcc.res, ind.names = FALSE,
                    group = nutrimouse$diet, legend = TRUE))
  ))
  # samples coloured by primary groups, user-defined colours, groups reordered, by default shapes also match primary groups
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot coloured by primary groups custom cols reordered groups", 
    fig = plotIndiv(rcc.res, ind.names = FALSE,
                    group = factor(nutrimouse$diet, levels = c("coc", "lin", "ref", "sun", "fish")), 
                    col = c("red", "blue", "black", "pink", "grey"), legend = TRUE))
  ))
})

test_that("plotIndiv works for rcc with ellipse on groups", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, ellipse
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot with ellipse coloured by primary groups", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, group = nutrimouse$diet, ellipse = TRUE, legend = TRUE))
  ))
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, ellipse confidence
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot with ellipse coloured by primary groups, ellipse level 0.5", 
    fig = plotIndiv(rcc.res, ind.names = TRUE, group = nutrimouse$diet, ellipse = TRUE, 
                    legend = TRUE, ellipse.level = 0.5))
  ))
})

test_that("plotIndiv works for rcc with centroids on groups", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, centroid
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot with centroids coloured by primary groups", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, group = nutrimouse$diet, centroid = TRUE, 
                    legend = TRUE))
  ))
})

test_that("plotIndiv works for rcc controlling colours and pch", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # force pch to be the same for all samples, so groups only coloured differently
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot coloured by primary groups custom cols with set pch (circle) for all samples", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, group = nutrimouse$diet, 
                    legend = TRUE, pch = 1))
  ))
  # control the pch of each of the primary groups by setting pch with length = levels(primary_groups)
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot coloured by primary groups with set pch for each group", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, group = nutrimouse$diet, 
                    legend = TRUE, pch = c(2, 4, 6, 3, 1)))
  ))
  # use pch to show a whole new grouping (secondary groups)
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot coloured by primary groups with pch for secondary groups", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, group = nutrimouse$diet, 
                    legend = TRUE, pch = as.factor(c(rep("A", 20), rep("B", 20)))))
  ))
  # only pch grouping
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot with pch for primary groups, col consistent", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, col = "purple",
                    legend = TRUE, pch = as.factor(c(rep("A", 20), rep("B", 20))), legend.title.pch = "Groups"))
  ))
})

test_that("plotIndiv works for rcc with different rep space", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples projected on XY variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot on XY variate space", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, rep.space = "XY-variate"))
  ))
  # samples projected on X variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot on X variate space", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, rep.space = "X-variate"))
  ))
  # samples projected on Y variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot on Y variate space", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, rep.space = "Y-variate"))
  ))
  # samples projected on multivariate space
  invisible(capture.output(
  expect_doppelganger(
    title = "rCCA plot on multi variate space", 
    fig = plotIndiv(rcc.res, ind.names = FALSE, rep.space = "multi"))
  ))
})

## ------------------------------------------------------------------------ ##
## ------------------------------------------------------------------------ ##
## vdiffr testing - "ggplot2" with pls object

test_that("plotIndiv works for sPLS with sample names (default)", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # simple plot showing sample names
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot sample names", 
    fig = plotIndiv(spls.res))
  ))
  # samples coloured by primary groups, sample names, default colours
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot sample names coloured by primary groups",
    fig = plotIndiv(spls.res, group = liver.toxicity$treatment$Treatment.Group))
  ))
})

test_that("plotIndiv works for sPLS without sample names", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # simple plot
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot", 
    fig = plotIndiv(spls.res, ind.names = FALSE))
  ))
  # samples coloured by primary groups, default colours, by default shapes also match primary groups
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot coloured by primary groups", 
    fig = plotIndiv(spls.res, ind.names = FALSE,
                    group = liver.toxicity$treatment$Treatment.Group, legend = TRUE))
  ))
})

test_that("plotIndiv works for sPLS with ellipse on groups", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, ellipse
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot with ellipse coloured by primary groups", 
    fig = plotIndiv(spls.res, ind.names = FALSE, group = liver.toxicity$treatment$Treatment.Group, ellipse = TRUE, legend = TRUE))
  ))
})

test_that("plotIndiv works for spls with centroids on groups", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, centroid
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot with centroids and stars coloured by primary groups", 
    fig = plotIndiv(spls.res, ind.names = FALSE, group = liver.toxicity$treatment$Treatment.Group, centroid = TRUE, 
                    legend = TRUE, star = TRUE))
  ))
})

test_that("plotIndiv works for sPLS with different rep space", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples projected on XY variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot on XY variate space", 
    fig = plotIndiv(spls.res, ind.names = FALSE, rep.space = "XY-variate"))
  ))
  # samples projected on X variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot on X variate space", 
    fig = plotIndiv(spls.res, ind.names = FALSE, rep.space = "X-variate"))
  ))
  # samples projected on Y variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot on Y variate space", 
    fig = plotIndiv(spls.res, ind.names = FALSE, rep.space = "Y-variate"))
  ))
  # samples projected on multivariate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLS plot on multi variate space", 
    fig = plotIndiv(spls.res, ind.names = FALSE, rep.space = "multi"))
  ))
})

## ------------------------------------------------------------------------ ##
## ------------------------------------------------------------------------ ##
## vdiffr testing - "ggplot2" with plsda object

test_that("plotIndiv works for sPLSDA with background", {
  skip_on_ci() # only run the vdiffr tests locally
  
  background = background.predict(srbct.splsda, comp.predicted=2, dist = "max.dist")
  invisible(capture.output(
  expect_doppelganger(
    title = "mint sPLSDA plot with background", 
    fig = plotIndiv(srbct.splsda, background = background, legend = TRUE))
  ))
})

test_that("plotIndiv works for sPLSDA with sample names (default)", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # simple plot showing sample names, by default coloured by groups
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot sample names", 
    fig = plotIndiv(srbct.splsda))
  ))
  # samples coloured by custom groups, sample names
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot sample names coloured by custom groups",
    fig = plotIndiv(srbct.splsda, group = as.factor(c(rep("A", 30), rep("B", 33)))))
  ))
})

test_that("plotIndiv works for sPLSDA without sample names", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # coloured and shapes by default by extracted groups
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot coloured by extracted groups", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, legend = TRUE))
  ))
})

test_that("plotIndiv works for sPLSDA with ellipse from predictions", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, ellipse
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot with ellipse", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, ellipse = TRUE, legend = TRUE))
  ))
  # samples coloured by primary groups and ellipse on custom groups
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot with ellipse on custom groups", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, group = as.factor(c(rep("A", 30), rep("B", 33))),
                    ellipse = TRUE, legend = TRUE))
  ))
})

test_that("plotIndiv works for sPLSDA with centroids on groups", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, centroid
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot with centroids and stars", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, centroid = TRUE, 
                    legend = TRUE, star = TRUE))
  ))
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, centroid, custom cols
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot with centroids and stars, custom cols", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, centroid = TRUE, 
                    legend = TRUE, star = TRUE,
                    col = c("red", "purple", "orange", "yellow")))
  ))
  # samples coloured by primary groups, default colours, by default shapes also match primary groups, centroid, custom cols, pch on secondary groups
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot with centroids and stars, custom cols, pch on second grouping", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, centroid = TRUE, 
                    legend = TRUE, star = TRUE,
                    col = c("red", "purple", "orange", "yellow"),
                    pch = as.factor(c(rep("A", 30), rep("B", 33)))))
  ))
})

test_that("plotIndiv works for sPLSDA with different rep space", {
  skip_on_ci() # only run the vdiffr tests locally
  
  # samples projected on XY variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot on XY variate space", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, rep.space = "XY-variate"))
  ))
  # samples projected on X variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot on X variate space", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, rep.space = "X-variate"))
  ))
  # samples projected on Y variate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot on Y variate space", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, rep.space = "Y-variate"))
  ))
  # samples projected on multivariate space
  invisible(capture.output(
  expect_doppelganger(
    title = "sPLSDA plot on multi variate space", 
    fig = plotIndiv(srbct.splsda, ind.names = FALSE, rep.space = "multi"))
  ))
})
mixOmicsTeam/mixOmics documentation built on April 13, 2025, 11:59 p.m.