diff --git a/DESCRIPTION b/DESCRIPTION
index 962c003209c86b21808577b7d02c76e3708756c6..a25e6c29825afe39ee16f0ca723d942669edfa9d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -3,7 +3,7 @@ Type: Package
Title: Omics Data Integration Using Kernel Methods
Version: 0.9
Date: 2023-09-17
-Depends: R (>= 3.5.0), mixOmics, ggplot2, reticulate (>= 1.14)
+Depends: R (>= 3.5.0), ggplot2, reticulate (>= 1.14)
Imports: vegan, phyloseq, corrplot, psych, quadprog, LDRTools, Matrix, methods, markdown
Suggests: rmarkdown, knitr
Authors@R: c(person("Nathalie", "Vialaneix", role = c("aut", "cre"), email="nathalie.vialaneix@inrae.fr"),
diff --git a/NAMESPACE b/NAMESPACE
index 41da812a771f2836320c9dd61b16786c54e78950..db3e999e59fbbea6920a356fe968bd0f7e7ac211 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,11 +8,11 @@ export(compute.kernel)
export(kernel.pca)
export(kernel.pca.permute)
export(mixKernel.users.guide)
+export(plotIndiv)
export(plotVar.kernel.pca)
export(select.features)
import(ggplot2)
import(markdown)
-import(mixOmics)
import(reticulate)
importFrom(LDRTools,O2P)
importFrom(LDRTools,Pdist)
diff --git a/R/mixKernel-package.R b/R/mixKernel-package.R
index f617fef21ce55b2363f1df760886417ebc8dff1a..11dc0ff87383356fef03158bb1853b66d34feff6 100644
--- a/R/mixKernel-package.R
+++ b/R/mixKernel-package.R
@@ -1,4 +1,3 @@
-#' @import mixOmics
#' @import ggplot2
#' @import reticulate
#' @import markdown
diff --git a/R/mixPlot.R b/R/mixPlot.R
new file mode 100644
index 0000000000000000000000000000000000000000..3475b5ff4cda4dfdcb13e290dbf70bfe467ba0bc
--- /dev/null
+++ b/R/mixPlot.R
@@ -0,0 +1,1265 @@
+################################################################################
+# Author:
+# Florian Rohart,
+#
+# created: 16-03-2016
+# last modified: 24-08-2016
+#
+# Copyright (C) 2016
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+################################################################################
+
+# -----------------------------------------------------------------------------
+# Internal helpers functions to run "plotIndiv" functions
+# -----------------------------------------------------------------------------
+
+# df: data frame with all the information needed: coordinates (x,y,z),
+# grouping factor 'group', 'Block' that indicates the block,
+# names (ind.names), 'pch', 'cex' or each point,
+# 'col.per.group' that gives the color of each point,
+# 'pch.legend' that gives the pch of each point for the legend (same as pch?)
+# as well as: x0 and y0 if plot centroid==TRUE
+# centroid
+# star
+# ellipse
+# df.ellipse
+# xlim
+# ylim
+# title
+# X.label
+# Y.label
+# legend
+# display.names
+
+internal_graphicModule <-
+ function(df,
+ centroid,
+ col.per.group,
+ title,
+ X.label,
+ Y.label,
+ Z.label,
+ xlim,
+ ylim,
+ zlim,
+ class.object,
+ display.names,
+ legend,
+ abline,
+ star,
+ layout=NULL,
+ #missing.col,
+ axes.box,
+ study.levels,
+ plot_parameters,
+ alpha)
+ {
+ object.pls = c("mixo_pls", "mixo_spls", "mixo_mlspls", "rcc")
+ object.pca = c("ipca", "sipca", "pca", "spca", "prcomp")
+ object.blocks = c("sgcca", "rgcca")
+ object.mint = c("mint.pls", "mint.spls", "mint.plsda", "mint.splsda")
+ #class.object=class(object)
+
+ # to satisfy R CMD check that doesn't recognise x, y and group (in aes)
+ x = y = group = pch = studyname = pch.levels = Var1 = Var2 = NULL
+
+ size.title = plot_parameters$size.title
+ size.subtitle = plot_parameters$size.subtitle
+ size.xlabel = plot_parameters$size.xlabel
+ size.ylabel = plot_parameters$size.ylabel
+ size.axis = plot_parameters$size.axis
+ size.legend = plot_parameters$size.legend
+ size.legend.title = plot_parameters$size.legend.title
+ legend.title = plot_parameters$legend.title
+ legend.title.pch = plot_parameters$legend.title.pch
+ legend.position = plot_parameters$legend.position
+ point.lwd = plot_parameters$point.lwd
+
+ # check whether pch and group are the same factors,
+ # otherwise we need two legends
+ group.pch = "same"
+ temp = table(df$group, df$pch)
+ # if factors are the same, there should be only one value
+ # different from 0 per column/row
+ # if pch is same factor as color, then same legend
+ a = NULL
+ for(i in 1:nrow(temp))
+ {
+ a = c(a, sum(temp[i,]!=0))
+ }
+ if(sum(a) != nrow(temp))
+ {
+ group.pch = "different"
+ } else {
+ a = NULL
+ for(j in 1:ncol(temp))
+ {
+ a = c(a, sum(temp[,j]!=0))
+ }
+ if(sum(a) != ncol(temp))
+ group.pch = "different"
+ }
+
+ df$pch.levels = factor(as.character(df$pch.levels)) #forced to be character,
+ # so that the order of the levels is the same all the time
+ # (1, 10, 11, 12, 2, 3...), instead of changing between ggplot2 and
+ # the rest
+
+ # df$pch.levels is sorted in the legend, we need to have the df$pch in the
+ # same order so that points/legend are matching
+ a=sort(unique(as.numeric(df$pch.levels)),index.return=TRUE)
+ # unique(df$pch.levels)[a$ix] is ordered
+
+ values.pch = unique(df$pch) [a$ix]
+
+ #values.pch = unique(df$pch)[match(unique(df$pch.levels),
+ # sort(levels(df$pch.levels)))]#as.numeric(levels(df$pch.levels))
+ #unique(df$pch)[as.numeric(unique(df$pch.levels))]
+ # makes pch and pch.levels correspond
+ #df$pch = factor(df$pch) #number or names
+
+ # shape in ggplot is ordered by the levels of pch.levels:
+ # levels(factor(as.character(df$pch.levels)))
+
+ # override if only one pch
+ if(nlevels(factor(df$pch)) == 1)
+ group.pch = "same"
+
+ #save(list=ls(),file="temp.Rdata")
+
+ #-- Start: ggplot2
+ nResp = nlevels(df$Block)
+ if (is.null(layout))
+ {
+ nRows = min(c(3, ceiling(nResp/2)))
+ nCols = min(c(3, ceiling(nResp/nRows)))
+ layout = c(nRows, nCols)
+ } else {
+ if (length(layout) != 2 || !is.numeric(layout) ||
+ any(is.na(layout)))
+ stop("'layout' must be a numeric vector of length 2.")
+ nRows = layout[1]
+ nCols = layout[2]
+ }
+
+ #note: at this present time, ggplot2 does not allow xlim to be changed
+ # per subplot, so cannot use xlim properly
+
+ #-- Initialise ggplot2
+ if (!is.null(df$colour.var)) {
+ p = ggplot(df, aes(x = x, y = y, color = colour.var, shape = pch.levels))
+ } else {
+ p = ggplot(df, aes(x = x, y = y, color = group, shape = pch.levels))
+ }
+ p = p +
+ labs(title=title, x = X.label, y = Y.label) +
+ theme_bw() + theme(strip.text = element_text(size = size.subtitle,
+ face = "bold"))
+
+ #-- Display sample or row.names
+ for (i in levels(df$group))
+ {
+ if(display.names)
+ {
+ p = p + geom_point(data = subset(df, df$group == i),
+ size = 0, shape = 0)
+ } else {
+ p = p + geom_point(data = subset(df, df$group == i),
+ size = subset(df, df$group == i)$cex[1],
+ stroke = point.lwd)
+ }
+ if (centroid == TRUE)
+ {
+ columns_selected <- intersect(c("col", "x0", "y0", "colour.var",
+ "Block", "cex", "pch", "group"),
+ names(df))
+ p = p + geom_point(data = subset(df[, columns_selected], df$group == i),
+ aes(x=x0,y=y0), size = 0, shape = 0)
+ }
+ }
+
+
+ #-- Modify scale colour - Change X/Ylabel - split plots into Blocks
+ if (!is.null(df$colour.var)) {
+ p = p + scale_colour_continuous(type = "viridis", name = legend.title)
+ } else {
+ p = p + scale_color_manual(values = unique(col.per.group)[match(
+ levels(factor(as.character(df$group))), levels(df$group))],
+ name = legend.title)
+ }
+
+
+ if(group.pch == "same" && is.null(df$colour.var))
+ {
+ p = p + scale_shape_manual(values = values.pch[match(
+ levels(factor(as.character(df$pch.levels))),levels(df$pch.levels))],
+ name = legend.title, labels = levels(factor(df$group)),
+ guide = "none")
+ #match(..) reorder the values as the values of pch.levels,
+ #if there's more than 10 levels, R/ggplot orders characters
+ #different than values 1, 10, 11, 2, 3, etc
+ } else {
+ # if pch different factor, then second legend
+ p = p + scale_shape_manual(values = values.pch[match(
+ levels(factor(as.character(df$pch.levels))),levels(df$pch.levels))],
+ name = legend.title.pch, labels = levels(df$pch.levels))
+ }
+
+ p = p + #labs(list(title = title, x = X.label, y = Y.label)) +
+ facet_wrap(~ Block, ncol = nCols, scales = "free", as.table = TRUE)
+ #as.table to plot in the same order as the factor
+
+ p = p + theme(plot.title=element_text(size=size.title),
+ axis.title.x=element_text(size=size.xlabel),
+ axis.title.y=element_text(size=size.ylabel),
+ axis.text=element_text(size=size.axis))# bigger title
+
+ #-- xlim, ylim
+ p = p + coord_cartesian(xlim=xlim,ylim=ylim)
+
+ #-- color samples according to col
+ for (i in unique(df$col))
+ {
+ for(j in 1:nlevels(df$Block))
+ {
+ if (display.names && is.null(df$colour.var))
+ {
+ p = p + geom_point(data = subset(df, col == i &
+ df$Block == levels(df$Block)[j]),
+ size = 0, shape = 0,
+ color = unique(df[df$col == i & df$Block ==
+ levels(df$Block)[j], ]$col))+
+ geom_text(data = subset(df, col == i & df$Block ==
+ levels(df$Block)[j]),
+ aes(label = names),
+ color = df[df$col == i & df$Block ==
+ levels(df$Block)[j], ]$col,
+ size = df[df$col == i & df$Block ==
+ levels(df$Block)[j], ]$cex,
+ show.legend = FALSE)
+ }
+ if (display.names && !is.null(df$colour.var))
+ {
+ p = p +geom_point(data = subset(df, col == i &
+ df$Block == levels(df$Block)[j]),
+ size = 0, shape = 0)+
+ geom_text(data = subset(df, col == i & df$Block ==
+ levels(df$Block)[j]),
+ aes(label = names),
+ size = df[df$col == i & df$Block ==
+ levels(df$Block)[j], ]$cex,
+ show.legend = FALSE)
+ }
+ if (centroid == TRUE)
+ {
+ p = p +
+ geom_point(data = subset(df[, c("col", "x0", "y0","Block",
+ "cex", "pch", "group")],
+ col == i),
+ aes(x = x0, y = y0),
+ color = unique(
+ df[df$col == i & df$Block == levels(df$Block)[1], ]$col
+ ),
+ size = unique(
+ df[df$col == i & df$Block == levels(df$Block)[1], ]$cex
+ ),
+ shape = 8, stroke = point.lwd)
+ }
+
+ }
+ }
+
+
+ #-- Legend
+ if (!legend)
+ {
+ p = p + theme(legend.position="none")
+ } else if(group.pch == "same") {
+ if (display.names | any(class.object%in%object.mint) ) {
+ group.shape <- 19
+ } else {
+ group.shape <- unique(df$pch.legend)
+
+ if (length(group.shape) > 1)
+ {
+ names(group.shape) <- unique(df$group)
+ group.shape <- group.shape[sort(names(group.shape))]
+ }
+ }
+
+ if (is.null(df$colour.var)) {
+ p = p + guides(color =
+ guide_legend(override.aes =
+ list(
+ shape = group.shape,
+ size = 3,
+ stroke = point.lwd
+ )))
+ }
+ p = p +
+ theme(legend.title=element_text(size=size.legend.title),
+ legend.text=element_text(size=size.legend)) +
+ theme(legend.position=legend.position)
+ } else if(group.pch == "different") {
+ p = p + guides(shape = guide_legend(override.aes =
+ list(size=3, stroke=point.lwd)))
+ }
+
+ #-- abline
+ if (abline)
+ p = p + geom_vline(aes(xintercept = 0), linetype = 2,
+ colour = "darkgrey") + geom_hline(aes(yintercept = 0),
+ linetype = 2,
+ colour = "darkgrey")
+
+ #-- star
+ if (star == TRUE)
+ {
+ for (i in 1 : nlevels(df$group))
+ {
+ p = p + geom_segment(data = subset(df, group ==
+ levels(df$group)[i]),
+ aes(x = x0, y = y0, xend = x, yend = y),
+ #label = "Block"),
+ color = unique(col.per.group)[i],size = point.lwd)
+ }
+ }
+
+ plot(p)
+ #-- End: ggplot2
+
+ return(p)
+ }
+
+check.input.plotIndiv <-
+ function(object,
+ comp = NULL,
+ blocks = NULL,
+ # to choose which block data to plot, when using GCCA module
+ ind.names = TRUE,
+ style = "ggplot2",
+ # can choose between graphics, 3d, lattice or ggplot2
+ #study = "global",
+ ellipse = FALSE,
+ ellipse.level = 0.95,
+ centroid = FALSE,
+ star = FALSE,
+ legend = FALSE,
+ X.label = NULL,
+ Y.label = NULL,
+ Z.label = NULL,
+ abline = FALSE,
+ xlim = NULL,
+ ylim = NULL,
+ alpha = 0.2,
+ axes.box = "box",
+ plot_parameters
+ )
+ {
+
+
+ # --------------------------------------------------------------------------
+ # independent from class.object
+ # --------------------------------------------------------------------------
+
+ ### Start: Validation of arguments
+ ncomp = object$ncomp
+
+ #-- style
+ if (!style %in% c("ggplot2", "lattice", "graphics", "3d"))
+ stop("'style' must be one of 'ggplot2', 'lattice', 'graphics' or '3d' .",
+ call. = FALSE)
+
+ #-- axes.box
+ choices = c("box", "bbox", "both")
+ axes.box = choices[pmatch(axes.box, choices)]
+
+ if (is.na(axes.box))
+ stop("'axes.box' should be one of 'box', 'bbox' or 'both'.",
+ call. = FALSE)
+
+ #-- ellipse.level
+ if ((ellipse.level > 1) | (ellipse.level < 0))
+ stop("The value taken by 'ellipse.level' must be between 0 and 1")
+
+ #-- legend
+ if (length(legend) != 1 || !is.logical(legend))
+ stop("'legend' must be a logical value.", call. = FALSE)
+
+ #-- alpha correlation
+ if (!is.numeric(alpha) | (alpha > 1) | (alpha < 0))
+ stop("The value taken by 'alpha' must be between 0 and 1", call. = FALSE)
+
+
+ #-- comp
+ if (is.null(comp))
+ {
+ if (style == "3d")
+ {
+ comp = c(1:3)
+ } else {
+ comp = c(1:2)
+ }
+ }
+ if (length(comp) != 2 && !(style == "3d"))
+ {
+ stop("'comp' must be a numeric vector of length 2.", call. = FALSE)
+ } else if (length(comp) != 3 && (style == "3d")) {
+ stop("'comp' must be a numeric vector of length 3.", call. = FALSE)
+ }
+
+ if (!is.numeric(comp))
+ stop("Invalid vector for 'comp'.")
+
+ if (any(ncomp < max(comp)))
+ stop(paste0("The number of components of the object to be plotted
+ (ncomp = ",
+ max(object$ncomp), ") is smaller than 'comp' (",
+ paste(comp, collapse = ", "),
+ "). Please increase ncomp or decrease 'comp'"),
+ call. = FALSE)
+
+ comp1 = round(comp[1])
+ comp2 = round(comp[2])
+ if (style == "3d")
+ {
+ comp3 = round(comp[3])
+ } else {
+ comp3 = NULL
+ }
+
+
+ #ellipse
+ if (!is.logical(ellipse))
+ stop("'ellipse' must be either TRUE or FALSE", call. = FALSE)
+
+ #centroid
+ if (!is.logical(centroid))
+ stop("'centroid' must be either TRUE or FALSE", call. = FALSE)
+
+ #star
+ if (!is.logical(star))
+ stop("'star' must be either TRUE or FALSE", call. = FALSE)
+
+ #legend
+ if (!is.logical(legend))
+ stop("'legend' must be either TRUE or FALSE", call. = FALSE)
+
+ # abline
+ if (!is.logical(abline))
+ stop("'abline' must be either TRUE or FALSE", call. = FALSE)
+
+ #X.label, Y.label, Z.label
+ if (!is.null(X.label))
+ {
+ if (length(X.label)!= 1 | !is.vector(X.label))
+ stop("'X.label' must be a vector of length 1", call. = FALSE)
+ }
+
+ if (!is.null(Y.label))
+ {
+ if (length(Y.label)!= 1 | !is.vector(Y.label))
+ stop("'Y.label' must be a vector of length 1", call. = FALSE)
+ }
+
+ if (!is.null(Z.label))
+ {
+ if (style!= "3d")
+ warning("'Z.label' is not used as style!= '3d'")
+ if (length(Z.label)!= 1 | !is.vector(Z.label))
+ stop("'Z.label' must be a vector of length 1", call. = FALSE)
+ }
+
+ # plot_parameters
+ #plot_parameters = list(size.title = size.title,
+ # size.subtitle = size.subtitle,
+ # size.xlabel = size.xlabel,
+ # size.ylabel = size.ylabel,
+ # size.axis = size.axis,
+ # size.legend = size.legend,
+ # size.legend.title = size.legend.title,
+ # legend.position = legend.position)
+ size.title = plot_parameters$size.title
+ size.subtitle = plot_parameters$size.subtitle
+ size.xlabel = plot_parameters$size.xlabel
+ size.ylabel = plot_parameters$size.ylabel
+ size.axis = plot_parameters$size.axis
+ size.legend = plot_parameters$size.legend
+ size.legend.title = plot_parameters$size.legend.title
+ legend.title = plot_parameters$legend.title
+ legend.title.pch = plot_parameters$legend.title.pch
+ legend.position = plot_parameters$legend.position
+ point.lwd = plot_parameters$point.lwd
+
+ if (!is.numeric(size.title) || length(size.title)>1 || size.title<0)
+ stop("'size.title' needs to be a non negative number")
+
+ if (!is.numeric(size.subtitle) || length(size.subtitle)>1 ||
+ size.subtitle<0)
+ stop("'size.subtitle' needs to be a non negative number")
+
+ if (!is.numeric(size.xlabel) || length(size.xlabel)>1 || size.xlabel<0)
+ stop("'size.xlabel' needs to be a non negative number")
+
+ if (!is.numeric(size.ylabel) || length(size.ylabel)>1 || size.ylabel<0)
+ stop("'size.ylabel' needs to be a non negative number")
+
+ if (!is.numeric(size.axis) || length(size.axis)>1 || size.axis<0)
+ stop("'size.axis' needs to be a non negative number")
+
+ if (!is.numeric(size.legend) || length(size.legend)>1 || size.legend<0)
+ stop("'size.legend' needs to be a non negative number")
+
+ if (!is.numeric(size.legend.title) || length(size.legend.title)>1 ||
+ size.legend.title<0)
+ stop("'size.legend.title' needs to be a non negative number")
+
+ if (length(legend.position)>1 || !legend.position %in% c("bottom", "left",
+ "right", "top"))
+ stop('"legend.position" needs to be one of "bottom", "left", "right"
+ or "top"')
+
+ if (length(legend.title)>1)
+ stop("'legend.title' needs to be a single value (length 1)")
+
+ if (length(legend.title.pch)>1)
+ stop("'legend.title.pch' needs to be a single value (length 1)")
+
+ if (!is.numeric(point.lwd) || length(point.lwd)>1 || point.lwd<0)
+ stop("'point.lwd' needs to be a non negative number")
+
+ if (is.logical(ind.names) & isTRUE(ind.names))
+ ind.names = object$names$sample
+ if (length(ind.names) > 1)
+ {
+ if (length(ind.names) != length(object$names$sample))
+ stop("'ind.names' must be a character vector of length ",
+ length(object$names$sample), " or a Logical atomic vector.")
+ }
+
+
+ display.names = FALSE
+ if (length(ind.names) == length(object$names$sample))
+ display.names = TRUE
+
+ # --------------------------------------------------------------------------
+ # need blocks
+ # --------------------------------------------------------------------------
+ #-- xlim, ylim
+ if(style %in% c("lattice", "graphics"))
+ {
+ if (!is.null(xlim))
+ {
+ if (length(blocks) == 1)
+ # a single graph is plotted, xlim needs to be a vector of length 2
+ {
+ if (!is.numeric(xlim) || length(xlim) != 2)
+ stop("'xlim' must be a vector of length 2.", call. = FALSE)
+
+ xlim = list(xlim)
+
+ } else {
+ # multiple graphs are plotted, xlim needs to be a list
+ # of vectors of length 2
+
+ if (!is.list(xlim) || length(xlim) != length(blocks) ||
+ length(unlist(xlim)) != 2 * length(blocks))
+ stop("'xlim' must be a list of ", length(blocks),
+ " vectors of length 2.", call. = FALSE)
+ }
+ }
+
+ if (!is.null(ylim))
+ {
+ if (length(blocks) == 1)
+ # a single graph is plotted, ylim needs to be a vector of length 2
+ {
+ if (!is.numeric(ylim) || length(ylim) != 2)
+ stop("'ylim' must be a vector of length 2.", call. = FALSE)
+
+ ylim = list(ylim)
+
+ } else {
+ # multiple graphs are plotted, ylim needs to be a list of vectors
+ # of length 2
+
+ if (!is.list(ylim) || length(ylim) != length(blocks) ||
+ length(unlist(ylim)) != 2 * length(blocks))
+ stop("'ylim' must be a list of ", length(blocks),
+ " vectors of length 2.", call. = FALSE)
+ }
+ }
+ }else if(style =="ggplot2") {
+ #xlim/ylim needs to be a vector: same limits for all graphs
+ if (!is.null(xlim))
+ {
+ if (!is.numeric(xlim) || length(xlim) != 2)
+ stop("'xlim' must be a vector of length 2.", call. = FALSE)
+ }
+ if (!is.null(ylim))
+ {
+ if (!is.numeric(ylim) || length(ylim) != 2)
+ stop("'ylim' must be a vector of length 2.", call. = FALSE)
+ }
+
+ }# for style = 3d, no xlim, ylim used
+
+ out = list(axes.box = axes.box, comp = c(comp1, comp2, comp3), xlim = xlim,
+ ylim = ylim, ind.names = ind.names,
+ display.names = display.names)
+
+ }
+
+shape.input.plotIndiv <-
+ function(object,
+ n,
+ #number of total samples
+ blocks = NULL,
+ # to choose which block data to plot, when using GCCA module
+ x,
+ y,
+ z,
+ ind.names = TRUE,
+ group,
+ # factor indicating the group membership for each sample, useful
+ #for ellipse plots. Coded as default for the -da methods, but needs
+ #to be input for the unsupervised methods (PCA, IPCA...)
+ col.per.group,
+ style = "ggplot2",
+ # can choose between graphics, 3d, lattice or ggplot2
+ study = "global",
+ ellipse = FALSE,
+ ellipse.level = 0.95,
+ centroid = FALSE,
+ star = FALSE,
+ title = NULL,
+ xlim = NULL,
+ ylim = NULL,
+ col,
+ cex,
+ pch,
+ pch.levels,
+ display.names,
+ plot_parameters
+ )
+ {
+
+ class.object = class(object)
+ object.mint = c("mint.pls", "mint.spls", "mint.plsda", "mint.splsda")
+
+ size.title = plot_parameters$size.title
+ size.subtitle = plot_parameters$size.subtitle
+ size.xlabel = plot_parameters$size.xlabel
+ size.ylabel = plot_parameters$size.ylabel
+ size.axis = plot_parameters$size.axis
+ size.legend = plot_parameters$size.legend
+ size.legend.title = plot_parameters$size.legend.title
+ legend.title = plot_parameters$legend.title
+ legend.title.pch = plot_parameters$legend.title.pch
+ legend.position = plot_parameters$legend.position
+ point.lwd = plot_parameters$point.lwd
+
+ # --------------------------------------------------------------------------
+ # need class.object whether it's DA
+ # --------------------------------------------------------------------------
+
+ #-- Define group
+ missing.group = TRUE
+ if (missing(group) & is(object, "DA"))
+ {
+ group = object$Y
+ object$ind.mat = unmap(group)
+ missing.group = FALSE #not user defined
+ } else if (!missing(group)) {
+ missing.group = FALSE
+ if (!is.factor(group)) {
+ ## create a character so it remains in factor levels
+ group[is.na(group)] <- "missing group (NA)"
+ group = as.factor(group)
+ }
+
+
+ object$ind.mat = unmap(group)
+
+ if (length(group) != n)
+ stop("Length of 'group' should be of length ", n,
+ ", the sample size of your data")
+ } else {
+ if (star || centroid || ellipse)
+ warning('star , ellipse and centroid work only if !group == NULL')
+ star = centroid = ellipse = FALSE
+ group = factor(rep("No group", n))
+ object$ind.mat = unmap(group)
+ }
+
+
+
+ # --------------------------------------------------------------------------
+ # independent from class.object
+ # --------------------------------------------------------------------------
+
+ #at this stage, we have a 'group' - user defined or DA, or by default 1
+ # single group
+
+ # col and col.per.group
+ if(!missing.group)
+ # group is user defined or DA; we require a col.per.group input, if only
+ # a 'col' input: we use it as col.per.group
+ {
+ if(missing(col.per.group) & !missing(col))
+ # we use col as a col.per.group
+ {
+ if(length(col) != nlevels(group))
+ stop("Length of 'col' should be of length ", nlevels(group),
+ " (the number of groups).")
+ col.per.group = col
+
+ } else if (missing(col.per.group) & missing(col)) {
+ # we create a col.per.group
+
+ if (nlevels(group) < 10)
+ {
+ #only 10 colors in color.mixo
+ col.per.group = color.mixo(1:nlevels(group))
+ } else {
+ #use color.jet
+ col.per.group = color.jet(nlevels(group))
+ }
+
+
+ } else if (!missing(col.per.group) & !missing(col)) { # we ignore 'col'
+ warning("'col' is ignored as 'group' has been set.")
+
+ } else if (!missing(col.per.group) & missing(col)) {# all good
+
+ }
+
+ if(length(col.per.group) != nlevels(group))
+ stop("Length of 'col.per.group' should be of length ", nlevels(group),
+ " (the number of groups).")
+
+
+ # make a vector of one color per sample from col.per.group
+ levels.color = vector(, n)
+ if (length(col.per.group) != n)
+ {
+ for (i in 1 : nlevels(group))
+ levels.color[group == levels(group)[i]] = col.per.group[i]
+ } else {
+ levels.color = col.per.group
+ }
+
+ } else {
+ #missing group, we require a 'col' of length n (or repeated to length n)
+ # and not a 'col.per.group' col creates a group argument, which creates
+ # a col.per.group (levels from 'col')
+ if(!missing(col.per.group))
+ warning("'col.per.group' is ignored as 'group' has not been set.")
+
+ if(!missing(col))
+ {
+ if (length(col) > n)
+ stop("Length of 'col' should be of length inferior or equal to ",
+ n, ".")
+
+ col = rep(col, ceiling(n/length(col)))[1 : n]
+ group = factor(col)
+ levels.color = col
+ col.per.group = levels(group)
+ object$ind.mat = unmap(group)
+ } else { # no group, no color => a single color by default
+ col.per.group = color.mixo(1)
+ levels.color = rep(col.per.group, n)
+ col = levels.color
+ }
+
+ }
+ # 'group' and 'col' are always the same factor, but different values
+ # here we have a group, a col.per.group (length nlevels(group)) and a
+ # levels.color (length n)
+
+
+ #-- cex argument
+ if (missing(cex))
+ {
+ if (style == "ggplot2")
+ {
+ cex = rep(3, n)
+ cex = cex[as.factor(group)]
+ } else {
+ cex = rep(1, n)
+ cex = cex[as.factor(group)]
+ }
+ } else {
+ if (length(cex) == 1)
+ {
+ cex = rep(cex, n)
+ cex = cex[as.factor(group)]
+ } else if (length(cex) == length(unique(group))) {
+ cex = cex[as.factor(group)]
+ } else {
+ if(length(unique(group))>1)
+ {
+ stop("Length of 'cex' should be either 1 or ",length(unique(group)),
+ ".")
+ }else{ # one group
+ stop("Length of 'cex' should be 1.")
+ }
+ #cex = rep(cex, ceiling(n/length(cex)))[1 : n]
+ }
+ }
+
+ if (ellipse)
+ {
+ # removing calculation for classes with only one sample
+
+ nlevels.class = 1 : ncol(object$ind.mat)
+ ind.unique = which(apply(object$ind.mat, 2, sum) == 1)
+ if(length(ind.unique) > 0)
+ {
+ nlevels.class = nlevels.class[-ind.unique]
+ }
+
+ #-- Start: Computation ellipse
+ min.ellipse = max.ellipse = xlim.min = xlim.max = ylim.min = list()
+ ylim.max = list()
+ ind.gp = matrice = cdg = variance = list()
+ ind.gp = lapply(1 : ncol(object$ind.mat), function(x){
+ which(object$ind.mat[, x] == 1)
+ })
+ matrice = lapply(1 : length(x), function(z1) {
+ lapply(ind.gp, function(z2){
+ matrix(c(x[[z1]][z2], y[[z1]][z2]), ncol = 2)
+ })
+ })
+ cdg = lapply(1 : length(x), function(z){
+ lapply(matrice[[z]], colMeans)
+ })
+ variance = lapply(1 : length(x), function(z){lapply(matrice[[z]], var)})
+ coord.ellipse = lapply(1 : length(x), function(z1){
+ lapply(nlevels.class, function(z2){
+ ellipse(variance[[z1]][[z2]],
+ centre = cdg[[z1]][[z2]],
+ level = ellipse.level)
+ })
+ })
+ max.ellipse = lapply(1 : length(x), function(z1) {
+ sapply(coord.ellipse[[z1]], function(z2){apply(z2, 2, max)})
+ })
+ min.ellipse = lapply(1 : length(x), function(z1) {
+ sapply(coord.ellipse[[z1]], function(z2){apply(z2, 2, min)})
+ })
+ #-- End: Computation ellipse
+
+ if (is.null(xlim))
+ xlim = lapply(1 : length(x), function(z) {
+ c(min(x[[z]], min.ellipse[[z]][1, ]),
+ max(x[[z]], max.ellipse[[z]][1, ]))
+ })
+ if (is.null(ylim))
+ ylim = lapply(1 : length(x), function(z) {
+ c(min(y[[z]], min.ellipse[[z]][2, ]),
+ max(y[[z]], max.ellipse[[z]][2, ]))
+ })
+ if(style == "ggplot2")
+ # no lists, a single vector of two values is expected
+ {
+ temp = matrix(unlist(xlim),ncol=2,byrow=TRUE)
+ xlim = c(min(temp[,1]),max(temp[,2]))
+ temp = matrix(unlist(ylim),ncol=2,byrow=TRUE)
+ ylim = c(min(temp[,1]),max(temp[,2]))
+ }
+
+ }
+ # no need for xlim and ylim as ggplot2, lattice and graphics are good
+ # without by default
+ #else {
+ # if (is.null(xlim))
+ # xlim = lapply(1 : length(x), function(z) {c(min(x[[z]]), max(x[[z]]))})
+ # if (is.null(ylim))
+ # ylim = lapply(1 : length(x), function(z) {c(min(y[[z]]), max(y[[z]]))})
+ #}
+
+
+ # --------------------------------------------------------------------------
+ # not independent from class.object: for the title of the plot,
+ # either "PlotIndiv" or "block:.."
+ # --------------------------------------------------------------------------
+
+ #-- pch argument
+ if (missing(pch) & !any(class.object%in%object.mint))
+ {
+
+ if (style == "3d")
+ {
+ pch = unlist(lapply(1 : length(length(levels(group))), function(x){
+ rep(c("sphere", "tetra", "cube", "octa", "icosa", "dodeca")[x],
+ length(group == x))
+ }))
+
+ } else {
+ pch = as.numeric(group)
+ }
+ pch.levels = pch
+
+ }else if (any(class.object%in%object.mint)) {
+ if (missing(pch))
+ {
+ # a pch per study, forced
+ pch = as.numeric(object$study)
+ } else {
+ if (length(pch)!= length(object$study))
+ stop("'pch' needs to be of length 'object$study' as each of 'pch'
+ represents a specific study", call. = FALSE)
+ }
+ pch.levels = pch
+
+ } else {
+ if (style == "3d")
+ {
+ if (!all(unlist(pch) %in% c("sphere", "tetra", "cube", "octa",
+ "icosa", "dodeca")))
+ stop("pch' must be a simple character or character vector from
+ {'sphere', 'tetra', 'cube', 'octa', 'icosa', 'dodeca'}.",
+ call. = FALSE)
+ }
+
+ if(!missing(pch.levels))
+ {
+ if(length(pch.levels) != length(pch))
+ stop("'pch.levels' needs to be a vector of the same
+ length as 'pch': ", length(pch))
+ } else {
+ pch.levels = pch
+ }
+
+ if (length(pch) == 1)
+ {
+ pch = rep(pch, n)
+ pch.levels = rep(pch.levels, n)
+
+ } else if (length(pch) > n) {
+ stop("Length of 'pch' should be of length inferior or equal to ", n,
+ ".")
+ } else if (length(pch) == length(unique(group)) & length(pch)!=n ) {
+ # prevent from reordering pch when 1 group per sample
+ # (length(pch)=length(group)=n)
+ pch = pch[as.factor(group)]
+ pch.levels = pch.levels[as.factor(group)]
+
+ } else {
+ pch = rep(pch, ceiling(n/length(pch)))[1 : n]
+ pch.levels = rep(pch.levels, ceiling(n/length(pch.levels)))[1 : n]
+ }
+ # if pch is given and ind.names is TRUE, pch takes over
+ display.names = FALSE
+ }
+
+
+
+ # constructing data.frame df
+ if (any(study == "global"))# | length(study) == 1)
+ {
+ #-- Start: data set
+ df = list()
+ if (style == "3d")
+ {
+ for (i in 1 : length(x))
+ df[[i]] = data.frame(x = x[[i]], y = y[[i]], z = z[[i]],
+ group = group)
+ } else {
+ for (i in 1 : length(x))
+ df[[i]] = data.frame(x = x[[i]], y = y[[i]], group = group)
+ }
+
+ title.save = title # to use for ellipse
+ #if (any(class.object %in% c("ipca", "sipca", "pca", "spca", "prcomp",
+ #"splsda", "plsda")) &
+ if(length(blocks) == 1 &
+ !any(class(object)%in%c(object.mint, "sgcca", "rgcca")))
+ # add blocks == 1 to allow "multi" with plsda
+ {
+ if (is.null(title))
+ {
+ df = data.frame(do.call(rbind, df), "Block" = "PlotIndiv")
+ if (style %in%c("graphics"))
+ title = "PlotIndiv" # to add title to graphics
+
+ } else {
+ df = data.frame(do.call(rbind, df), "Block" = title)
+ if (style %in%c("ggplot2", "lattice"))
+ title = NULL # to avoid double title
+
+ }
+
+ # no subtitle with these objects
+ if(size.title != rel(2)) # rel(2) is the default
+ size.subtitle = size.title
+
+
+ df$Block = as.factor(df$Block)
+ } else {
+ df = data.frame(do.call(rbind, df),
+ "Block" = paste0("Block: ",
+ unlist(lapply(1:length(df),
+ function(z){
+ rep(blocks[z],
+ nrow(df[[z]]))
+ }))))
+ df$Block = factor(df$Block, levels = unique(df$Block))
+ }
+
+ if (style == "3d")
+ {
+ names(df)[1:3] = c("x", "y", "z")
+ } else {
+ names(df)[1:2] = c("x", "y")
+ }
+
+ if (display.names)
+ df$names = rep(ind.names, length(x))
+
+ df$pch = pch; df$pch.levels = pch.levels
+ df$cex = cex
+ #df$col.per.group = levels.color#[group] #FR: don't understand what is
+ #that changing as levels.color is already group?
+ df$col = levels.color#as.character(col)
+
+
+ if (centroid == TRUE || star == TRUE)
+ {
+ df = cbind(df, rep(0, nrow(df)))
+ n = ncol(df)
+ df = cbind(df, rep(0, nrow(df)))
+ for (i in 1:nlevels(group))
+ {
+ if (length(x)>1)
+ {
+ for (k in 1 : length(x))
+ {
+ x0 = mean(df[df$group == levels(group)[i] & df$Block %in%
+ paste0("Block: ", blocks[k]), "x"])
+ y0 = mean(df[df$group == levels(group)[i] & df$Block %in%
+ paste0("Block: ", blocks[k]) , "y"])
+ df[df$group == levels(group)[i] & df$Block %in%
+ paste0("Block: ", blocks[k]), n] = x0
+ df[df$group == levels(group)[i] & df$Block %in%
+ paste0("Block: ", blocks[k]), n+1] = y0
+ names(df)[c(ncol(df)-1, ncol(df))] = c("x0", "y0")
+ }
+ } else {
+ x0 = mean(df[df$group == levels(group)[i] , "x"])
+ y0 = mean(df[df$group == levels(group)[i] , "y"])
+ df[df$group == levels(group)[i] , n] = x0
+ df[df$group == levels(group)[i] , n+1] = y0
+ names(df)[c(ncol(df)-1, ncol(df))] = c("x0", "y0")
+ }
+
+ }
+ }
+
+ if (ellipse == TRUE)
+ {
+ df.ellipse = data.frame(do.call("rbind",
+ lapply(1:length(x),
+ function(k){
+ do.call("cbind",
+ coord.ellipse[[k]])
+ })),
+ "Block" = paste0("Block: ",
+ rep(blocks, each = 100)))
+ if(length(ind.unique) > 0)
+ {
+ names(df.ellipse)[1:(2*length(nlevels.class))] =
+ paste0("Col",
+ c(1:(2*nlevels(group)))[-c(2*(ind.unique-1)+1,2*ind.unique)])
+ } else {
+ names(df.ellipse)[1:(2*nlevels(group))] =
+ paste0("Col", c(1 : (2*nlevels(group))))
+
+ }
+ df.ellipse$ellipse.level = ellipse.level
+ } else {
+ df.ellipse = NULL
+ }
+
+ if(ellipse == TRUE && length(blocks) == 1 &
+ !any(class(object)%in%c(object.mint, "sgcca", "rgcca")))
+ # add blocks == 1 to allow "multi" with plsda
+ #if (ellipse == TRUE && any(class.object %in% c("ipca", "sipca", "pca",
+ # "spca", "prcomp", "splsda", "plsda"))& length(blocks) == 1&
+ # !any(class(object)%in%object.mint))
+ {
+ if (is.null(title.save))
+ {
+ df.ellipse$Block = "PlotIndiv"
+ } else {
+ df.ellipse$Block = title.save
+ }
+ }
+
+
+
+ # pch.legend = NULL
+ # for (i in 1:nlevels(group))
+ # {
+ # pch.legend = c(pch.legend, df[df$group == levels(group)[i], ]$pch)
+ # }
+ df$pch.legend <- df$pch
+
+ } else {
+
+ #mint object
+ #display.names = FALSE # so far ggplot and lattice require a unique vector
+ #of names. when the code changes, we can use ind.names (list)
+ group.mint = split(group, object$study)[study]
+ group = as.factor(unlist(group.mint))
+ pch = as.vector(unlist(split(pch, object$study)[study]))
+ cex = as.vector(unlist(split(cex, object$study)[study]))
+ pch.levels = as.vector(unlist(split(pch.levels, object$study)[study]))
+ col.per.group.mint = as.vector(unlist(split(levels.color,
+ object$study)[study]))
+ #col = as.vector(unlist(split(col, object$study)[study]))
+
+
+
+ #-- Start: data set
+ df = list()
+ if (style == "3d")
+ {
+ for (i in 1 : length(x))
+ {
+ df[[i]] = data.frame(x = x[[i]], y = y[[i]], z = z[[i]],
+ group = group.mint[[i]])
+ }
+ } else {
+ for (i in 1 : length(x))
+ {
+ df[[i]] = data.frame(x = x[[i]], y = y[[i]], group = group.mint[[i]])
+ }
+ }
+
+ df = data.frame(do.call(rbind, df),
+ "Block" = paste0("Study: ",
+ unlist(lapply(1:length(df),
+ function(z){
+ rep(blocks[z],
+ nrow(df[[z]]))
+ }))))
+ df$Block = factor(df$Block, levels = unique(df$Block))
+
+ #print(df)
+
+ if (style == "3d")
+ {
+ names(df)[1:3] = c("x", "y", "z")
+ } else {
+ names(df)[1:2] = c("x", "y")
+ }
+
+ # no names for MINT object
+ #if (display.names)
+ #df$names = rep(ind.names, length(x))
+
+ df$pch = pch; df$pch.levels = pch.levels
+ df$cex = cex
+ #df$col.per.group = col.per.group.mint;
+ df$col = col.per.group.mint#as.character(col)
+
+
+ pch.legend = NULL
+ for (i in 1:nlevels(group))
+ pch.legend = c(pch.legend, df[df$group == levels(group)[i], ]$pch)
+
+ df$pch.legend = pch.legend
+ df.ellipse = NULL # no ellipse so far
+ }
+
+ if (any(study == "global"))
+ study = levels(object$study)
+
+ # match study with names of the study
+ study.ind = match(study, levels(object$study))
+
+ #print(df)
+ plot_parameters = list(size.title = size.title,
+ size.subtitle = size.subtitle,
+ size.xlabel = size.xlabel,
+ size.ylabel = size.ylabel,
+ size.axis = size.axis,
+ size.legend = size.legend,
+ size.legend.title = size.legend.title,
+ legend.title = legend.title,
+ legend.title.pch = legend.title.pch,
+ legend.position = legend.position,
+ point.lwd = point.lwd)
+
+ out = list(df = df, study.ind = study.ind, df.ellipse = df.ellipse,
+ col.per.group = col.per.group, title = title,
+ display.names = display.names, xlim = xlim, ylim = ylim,
+ ellipse = ellipse, centroid = centroid, star = star,
+ plot_parameters = plot_parameters)
+ }
+
+
+# Converts a class or group vector or factor into a matrix of indicator
+# variables; not meant to be used directly.
+# cf package mixOmics for documentation.
+unmap <-
+ function (classification, groups = NULL, noise = NULL)
+ {
+ n = length(classification)
+ u = sort(unique(classification))
+ levels = levels(classification)### Add levels
+
+ if (is.null(groups))
+ {
+ groups = u
+ } else {
+ if (any(match(u, groups, nomatch = 0) == 0))
+ stop("groups incompatible with classification")
+ miss = match(groups, u, nomatch = 0) == 0
+ }
+
+ cgroups = as.character(groups)
+ if (!is.null(noise))
+ {
+ noiz = match(noise, groups, nomatch = 0)
+ if (any(noiz == 0))
+ stop("noise incompatible with classification")
+
+ groups = c(groups[groups != noise], groups[groups == noise])
+ noise = as.numeric(factor(as.character(noise), levels = unique(groups)))
+ }
+
+ groups = as.numeric(factor(cgroups, levels = unique(cgroups)))
+ classification = as.numeric(factor(as.character(classification),
+ levels = unique(cgroups)))
+ k = length(groups) - length(noise)
+ nam = levels(groups)
+
+ if (!is.null(noise))
+ {
+ k = k + 1
+ nam = nam[1:k]
+ nam[k] = "noise"
+ }
+
+ z = matrix(0, n, k, dimnames = c(names(classification), nam))
+ for (j in 1:k) z[classification == groups[j], j] = 1
+ attr(z, "levels") = levels
+ z
+ }
diff --git a/R/plotIndiv.R b/R/plotIndiv.R
new file mode 100644
index 0000000000000000000000000000000000000000..bd4df54ae8716d61b4ad7864215f7446d6433af9
--- /dev/null
+++ b/R/plotIndiv.R
@@ -0,0 +1,323 @@
+#' Plot of Individuals (Experimental Units)
+#'
+#' This function provides scatter plots for individuals (experimental units)
+#' representation in PCA
+#'
+#' \code{plotIndiv} method makes scatter plot for individuals representation
+#' depending on the subspace of projection. Each point corresponds to an
+#' individual.
+#'
+#' If \code{ind.names=TRUE} and row names is \code{NULL}, then
+#' \code{ind.names=1:n}, where \code{n} is the number of individuals. Also, if
+#' \code{pch} is an input, then \code{ind.names} is set to FALSE as we do not
+#' show both names and shapes.
+#'
+#' \code{plotIndiv} can have a two layers legend. This is especially convenient
+#' when you have two grouping factors, such as a gender effect and a study
+#' effect, and you want to highlight both simulatenously on the graphical
+#' output. A first layer is coded by the \code{group} factor, the second
+#' by the \code{pch} argument. When \code{pch} is missing, a single layer legend
+#' is shown. If the \code{group} factor is missing, the \code{col}
+#' argument is used to create the grouping factor \code{group}. When a
+#' second grouping factor is needed and added via \code{pch}, \code{pch} needs
+#' to be a vector of length the number of samples. In the case where \code{pch}
+#' is a vector or length the number of groups, then we consider that the user
+#' wants a different \code{pch} for each level of \code{group}. This
+#' leads to a single layer legend and we merge \code{col} and \code{pch}. In the
+#' similar case where \code{pch} is a single value, then this value is used to
+#' represent all samples.
+#'
+#' The argument \code{block = 'average'} averages the components from all blocks
+#' to produce a consensus plot. The argument \code{block='weighted.average'} is
+#' a weighted average of the components according to their correlation with the
+#' outcome Y.
+#'
+#'
+#' Note:
+#' - the code for this function is borrowed from the \pkg{mixOmics}. It is
+#' meant to work as \code{plotIndiv} in \pkg{mixOmics} (but only for PCA
+#' objects), with the additional possibility to use \code{colour.var} to set
+#' continuous colours on plots. But in this case, colours based on \code{group}
+#' are ignored. Furthermore, \code{style} is set to 'ggplot2' and ellipses can't
+#' be drawn.
+#'
+#' @param object object of class inherited from PCA
+#' @param comp integer vector of length two. The components
+#' that will be used on the horizontal and the vertical axis respectively to
+#' project the individuals.
+#' @param rep.space default to \code{"X-variate"}.
+#' @param blocks integer value or name(s) of block(s) to be plotted using the
+#' GCCA module. "average" and "weighted.average" will create average and
+#' weighted average plots, respectively.
+#' @param study Indicates which study-specific outputs to plot. A character
+#' vector containing some levels of \code{object$study}, "all.partial" to plot
+#' all studies or "global" is expected. Default to "global".
+#' @param ind.names either a character vector of names for the individuals to
+#' be plotted, or \code{FALSE} for no names. If \code{TRUE}, the row names of
+#' the first (or second) data matrix is used as names.
+#' @param group factor indicating the group membership for each sample.
+#' @param col.per.group character (or symbol) color to be used when 'group' is
+#' defined. Vector of the same length as the number of groups.
+#' @param colour.var numeric, used to set continuous colours. Should have the
+#' same length as the number of individuals.
+#' @param centroid Logical indicating whether centroid points should be
+#' plotted. The centroid will only be plotted if the argument \code{group} is
+#' provided. The centroid will be calculated based on the group categories.
+#' @param star Logical indicating whether a star plot should be plotted, with
+#' arrows starting from the centroid (see argument \code{centroid}, and ending
+#' for each sample belonging to each group or outcome. Star plot is only be
+#' plotted if the argument \code{group} is provided.
+#' @param title set of characters indicating the title plot.
+#' @param subtitle subtitle for each plot, only used when several \code{block}
+#' or \code{study} are plotted.
+#' @param legend Logical. Whether the legend should be added. Default is FALSE.
+#' @param X.label x axis titles.
+#' @param Y.label y axis titles.
+#' @param Z.label z axis titles (when style = '3d'). Disabled.
+#' @param abline should the vertical and horizontal line through the center be
+#' plotted? Default set to \code{FALSE}
+#' @param xlim,ylim numeric list of vectors of length 2 and length
+#' =length(blocks), giving the x and y coordinates ranges.
+#' @param col character (or symbol) color to be used, possibly vector.
+#' @param cex numeric character (or symbol) expansion, possibly vector.
+#' @param pch plot character. A character string or a vector of single
+#' characters or integers. See \code{\link{points}} for all alternatives.
+#' @param pch.levels Only used when \code{pch} is different from \code{col} or
+#' \code{col.per.group}, ie when \code{pch} creates a second factor. Only used
+#' for the legend.
+#' @param alpha Semi-transparent colors (0 < \code{'alpha'} < 1)
+#' @param axes.box for style '3d', argument to be set to either \code{'axes'},
+#' \code{'box'}, \code{'bbox'} or \code{'all'}, defining the shape of the box.
+#' Disabled.
+#' @param layout layout parameter passed to mfrow. Only used when \code{study}
+#' is not "global"
+#' @param size.title size of the title
+#' @param size.subtitle size of the subtitle
+#' @param size.xlabel size of xlabel
+#' @param size.ylabel size of ylabel
+#' @param size.axis size of the axis
+#' @param size.legend size of the legend
+#' @param size.legend.title size of the legend title
+#' @param legend.title title of the legend
+#' @param legend.title.pch title of the second legend created by \code{pch}, if
+#' any.
+#' @param legend.position position of the legend, one of "bottom", "left",
+#' "top" and "right".
+#' @param point.lwd \code{lwd} of the points, used when \code{ind.names =
+#' FALSE}
+#' @param ... Optional arguments or type par can be added with \code{style =
+#' 'graphics'}
+#' @return none
+#' @author Ignacio González, Benoit Gautier, Francois Bartolo, Florian Rohart,
+#' Kim-Anh Lê Cao, Al J Abadi, Julien Henry
+#' @export
+plotIndiv <-
+ function(object,
+ comp = NULL,
+ ind.names = TRUE,
+ group,
+ col.per.group,
+ colour.var = NULL,
+ centroid = FALSE,
+ star = FALSE,
+ title = NULL,
+ legend = FALSE,
+ X.label = NULL,
+ Y.label = NULL,
+ Z.label = NULL,
+ abline = FALSE,
+ xlim = NULL,
+ ylim = NULL,
+ col,
+ cex,
+ pch,
+ pch.levels,
+ alpha = 0.2,
+ axes.box = "box",
+ layout = NULL,
+ size.title = rel(2),
+ size.subtitle = rel(1.5),
+ size.xlabel = rel(1),
+ size.ylabel = rel(1),
+ size.axis = rel(0.8),
+ size.legend = rel(1),
+ size.legend.title = rel(1.1),
+ legend.title = "Legend",
+ legend.title.pch = "Legend",
+ legend.position = "right",
+ point.lwd = 1,
+ ...
+
+
+ )
+ {
+ plot_parameters = list(
+ size.title = size.title,
+ size.subtitle = size.subtitle,
+ size.xlabel = size.xlabel,
+ size.ylabel = size.ylabel,
+ size.axis = size.axis,
+ size.legend = size.legend,
+ size.legend.title = size.legend.title,
+ legend.title = legend.title,
+ legend.title.pch = legend.title.pch,
+ legend.position = legend.position,
+ point.lwd = point.lwd
+ )
+
+ blocks = "X"
+ rep.space = "X-variate"
+ style = "ggplot2"
+ ellipse = FALSE
+ ellipse.level = 0.95
+
+ check = check.input.plotIndiv(
+ object = object,
+ comp = comp,
+ blocks = blocks,
+ ind.names = ind.names,
+ style = style,
+ ellipse = ellipse,
+ ellipse.level = ellipse.level,
+ centroid = centroid,
+ star = star,
+ legend = legend,
+ X.label = X.label,
+ Y.label = Y.label,
+ Z.label = Z.label,
+ abline = abline,
+ xlim = xlim,
+ ylim = ylim,
+ alpha = alpha,
+ axes.box = axes.box,
+ plot_parameters = plot_parameters
+ )
+
+ # retrieve outputs from the checks
+ axes.box = check$axes.box
+ comp = check$comp
+ xlim = check$xlim
+ ylim = check$ylim
+ ind.names = check$ind.names
+ display.names = check$display.names
+
+
+ #-- Get variates
+ x = y = z = list()
+ x[[1]] = object$variates$X[, comp[1]]
+ y[[1]] = object$variates$X[, comp[2]]
+ if(style == "3d") z[[1]] = object$variates$X[, comp[3]]
+
+
+ #-- Variance explained on X, Y and Z labels
+
+ if (style == "3d")
+ {
+ inf = object$prop_expl_var$X[c(comp[1], comp[2], comp[3])]
+ inf = round(inf, 2)
+ } else {
+ inf = object$prop_expl_var$X[c(comp[1], comp[2])]
+ inf = round(inf, 2)}
+
+
+ if (is.null(X.label))
+ {
+ X.label = paste("PC", comp[1], sep = '')
+ percentage = paste0(inf[1]*100, "% expl. var")
+ X.label = paste(X.label, percentage, sep = ": ")
+ }
+ if (is.null(Y.label))
+ {
+ Y.label = paste("PC", comp[2], sep = '')
+ percentage = paste0(inf[2]*100, "% expl. var")
+ Y.label = paste(Y.label, percentage, sep = ": ")
+ }
+ if (is.null(Z.label)&&style == "3d")
+ {
+ Z.label = paste("PC", comp[3], sep = '')
+ percentage = paste0(inf[3]*100, "% expl. var")
+ Z.label = paste(Z.label, percentage, sep = ": ")
+ }
+
+
+ n = nrow(object$X)
+
+ # create data frame df that contains (almost) all the ploting information
+ out = shape.input.plotIndiv(
+ object = object,
+ n = n,
+ blocks = blocks,
+ x = x,
+ y = y,
+ z = z,
+ ind.names = ind.names,
+ group = group,
+ col.per.group = col.per.group,
+ style = style,
+ study = "global",
+ ellipse = ellipse,
+ ellipse.level = ellipse.level,
+ centroid = centroid,
+ star = star,
+ title = title,
+ xlim = xlim,
+ ylim = ylim,
+ col = col,
+ cex = cex,
+ pch = pch,
+ pch.levels = pch.levels,
+ display.names = display.names,
+ plot_parameters = plot_parameters
+ )
+ #-- retrieve outputs
+ df = out$df
+ df.ellipse = out$df.ellipse
+ col.per.group = out$col.per.group
+ title = out$title
+ display.names = out$display.names
+ xlim = out$xlim
+ ylim = out$ylim
+ #missing.col = out$missing.col
+ ellipse = out$ellipse
+ centroid = out$centroid
+ star = out$star
+ plot_parameters = out$plot_parameters
+
+ if (!is.null(colour.var)) {
+
+ if (length(colour.var) != nrow(df)) {
+ stop("'colour.var' should have the same length as the number of
+ individuals!")
+ }
+ if (!is.numeric(colour.var)) {
+ stop("'colour.var' should be numeric!")
+ }
+ df$colour.var <- colour.var
+
+ }
+
+ #call plot module (ggplot2, lattice, graphics, 3d)
+ res = internal_graphicModule(
+ df = df,
+ centroid = centroid,
+ col.per.group = col.per.group,
+ title = title,
+ X.label = X.label,
+ Y.label = Y.label,
+ Z.label = Z.label,
+ xlim = xlim,
+ ylim = ylim,
+ class.object = class(object),
+ display.names = display.names,
+ legend = legend,
+ abline = abline,
+ star = star,
+ layout = layout,
+ #missing.col = missing.col,
+ axes.box = axes.box,
+ plot_parameters = plot_parameters,
+ alpha = alpha
+ )
+
+ return(invisible(list(df = df, df.ellipse = df.ellipse, graph = res)))
+ }
\ No newline at end of file
diff --git a/man/plotIndiv.Rd b/man/plotIndiv.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..80243ea5276d7b542c54ee086735532455c788ed
--- /dev/null
+++ b/man/plotIndiv.Rd
@@ -0,0 +1,199 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotIndiv.R
+\name{plotIndiv}
+\alias{plotIndiv}
+\title{Plot of Individuals (Experimental Units)}
+\usage{
+plotIndiv(
+ object,
+ comp = NULL,
+ ind.names = TRUE,
+ group,
+ col.per.group,
+ colour.var = NULL,
+ centroid = FALSE,
+ star = FALSE,
+ title = NULL,
+ legend = FALSE,
+ X.label = NULL,
+ Y.label = NULL,
+ Z.label = NULL,
+ abline = FALSE,
+ xlim = NULL,
+ ylim = NULL,
+ col,
+ cex,
+ pch,
+ pch.levels,
+ alpha = 0.2,
+ axes.box = "box",
+ layout = NULL,
+ size.title = rel(2),
+ size.subtitle = rel(1.5),
+ size.xlabel = rel(1),
+ size.ylabel = rel(1),
+ size.axis = rel(0.8),
+ size.legend = rel(1),
+ size.legend.title = rel(1.1),
+ legend.title = "Legend",
+ legend.title.pch = "Legend",
+ legend.position = "right",
+ point.lwd = 1,
+ ...
+)
+}
+\arguments{
+\item{object}{object of class inherited from PCA}
+
+\item{comp}{integer vector of length two. The components
+that will be used on the horizontal and the vertical axis respectively to
+project the individuals.}
+
+\item{ind.names}{either a character vector of names for the individuals to
+be plotted, or \code{FALSE} for no names. If \code{TRUE}, the row names of
+the first (or second) data matrix is used as names.}
+
+\item{group}{factor indicating the group membership for each sample.}
+
+\item{col.per.group}{character (or symbol) color to be used when 'group' is
+defined. Vector of the same length as the number of groups.}
+
+\item{colour.var}{numeric, used to set continuous colours. Should have the
+same length as the number of individuals.}
+
+\item{centroid}{Logical indicating whether centroid points should be
+plotted. The centroid will only be plotted if the argument \code{group} is
+provided. The centroid will be calculated based on the group categories.}
+
+\item{star}{Logical indicating whether a star plot should be plotted, with
+arrows starting from the centroid (see argument \code{centroid}, and ending
+for each sample belonging to each group or outcome. Star plot is only be
+plotted if the argument \code{group} is provided.}
+
+\item{title}{set of characters indicating the title plot.}
+
+\item{legend}{Logical. Whether the legend should be added. Default is FALSE.}
+
+\item{X.label}{x axis titles.}
+
+\item{Y.label}{y axis titles.}
+
+\item{Z.label}{z axis titles (when style = '3d'). Disabled.}
+
+\item{abline}{should the vertical and horizontal line through the center be
+plotted? Default set to \code{FALSE}}
+
+\item{xlim, ylim}{numeric list of vectors of length 2 and length
+=length(blocks), giving the x and y coordinates ranges.}
+
+\item{col}{character (or symbol) color to be used, possibly vector.}
+
+\item{cex}{numeric character (or symbol) expansion, possibly vector.}
+
+\item{pch}{plot character. A character string or a vector of single
+characters or integers. See \code{\link{points}} for all alternatives.}
+
+\item{pch.levels}{Only used when \code{pch} is different from \code{col} or
+\code{col.per.group}, ie when \code{pch} creates a second factor. Only used
+for the legend.}
+
+\item{alpha}{Semi-transparent colors (0 < \code{'alpha'} < 1)}
+
+\item{axes.box}{for style '3d', argument to be set to either \code{'axes'},
+\code{'box'}, \code{'bbox'} or \code{'all'}, defining the shape of the box.
+Disabled.}
+
+\item{layout}{layout parameter passed to mfrow. Only used when \code{study}
+is not "global"}
+
+\item{size.title}{size of the title}
+
+\item{size.subtitle}{size of the subtitle}
+
+\item{size.xlabel}{size of xlabel}
+
+\item{size.ylabel}{size of ylabel}
+
+\item{size.axis}{size of the axis}
+
+\item{size.legend}{size of the legend}
+
+\item{size.legend.title}{size of the legend title}
+
+\item{legend.title}{title of the legend}
+
+\item{legend.title.pch}{title of the second legend created by \code{pch}, if
+any.}
+
+\item{legend.position}{position of the legend, one of "bottom", "left",
+"top" and "right".}
+
+\item{point.lwd}{\code{lwd} of the points, used when \code{ind.names =
+FALSE}}
+
+\item{...}{Optional arguments or type par can be added with \code{style =
+'graphics'}}
+
+\item{rep.space}{default to \code{"X-variate"}.}
+
+\item{blocks}{integer value or name(s) of block(s) to be plotted using the
+GCCA module. "average" and "weighted.average" will create average and
+weighted average plots, respectively.}
+
+\item{study}{Indicates which study-specific outputs to plot. A character
+vector containing some levels of \code{object$study}, "all.partial" to plot
+all studies or "global" is expected. Default to "global".}
+
+\item{subtitle}{subtitle for each plot, only used when several \code{block}
+or \code{study} are plotted.}
+}
+\value{
+none
+}
+\description{
+This function provides scatter plots for individuals (experimental units)
+representation in PCA
+}
+\details{
+\code{plotIndiv} method makes scatter plot for individuals representation
+depending on the subspace of projection. Each point corresponds to an
+individual.
+
+If \code{ind.names=TRUE} and row names is \code{NULL}, then
+\code{ind.names=1:n}, where \code{n} is the number of individuals. Also, if
+\code{pch} is an input, then \code{ind.names} is set to FALSE as we do not
+show both names and shapes.
+
+\code{plotIndiv} can have a two layers legend. This is especially convenient
+when you have two grouping factors, such as a gender effect and a study
+effect, and you want to highlight both simulatenously on the graphical
+output. A first layer is coded by the \code{group} factor, the second
+by the \code{pch} argument. When \code{pch} is missing, a single layer legend
+is shown. If the \code{group} factor is missing, the \code{col}
+argument is used to create the grouping factor \code{group}. When a
+second grouping factor is needed and added via \code{pch}, \code{pch} needs
+to be a vector of length the number of samples. In the case where \code{pch}
+is a vector or length the number of groups, then we consider that the user
+wants a different \code{pch} for each level of \code{group}. This
+leads to a single layer legend and we merge \code{col} and \code{pch}. In the
+similar case where \code{pch} is a single value, then this value is used to
+represent all samples.
+
+The argument \code{block = 'average'} averages the components from all blocks
+to produce a consensus plot. The argument \code{block='weighted.average'} is
+a weighted average of the components according to their correlation with the
+outcome Y.
+
+
+Note:
+- the code for this function is borrowed from the \pkg{mixOmics}. It is
+meant to work as \code{plotIndiv} in \pkg{mixOmics} (but only for PCA
+objects), with the additional possibility to use \code{colour.var} to set
+continuous colours on plots. But in this case, colours based on \code{group}
+are ignored. Furthermore, \code{style} is set to 'ggplot2' and ellipses can't
+be drawn.
+}
+\author{
+Ignacio González, Benoit Gautier, Francois Bartolo, Florian Rohart,
+Kim-Anh Lê Cao, Al J Abadi, Julien Henry
+}