R/print.methods.R

Defines functions print.pls print.mint.pls print.plsda print.mint.plsda print.spls print.mint.spls print.splsda print.mint.splsda print.rcc print.pca print.spca print.ipca print.sipca print.rgcca print.sgcca print.sgccda print.summary print.perf.pls.mthd print.perf.spls.mthd print.perf.plsda.mthd print.perf.splsda.mthd print.perf.mint.splsda.mthd print.perf.sgccda.mthd print.tune.pca print.tune.rcc print.tune.splsda print.tune.mint.splsda print.tune.block.splsda print.predict

Documented in print.pca print.pls print.rcc print.rgcca print.sgcca print.spca print.spls print.summary

#############################################################################################################
# Author :
#   Sebastien Dejean, Institut de Mathematiques, Universite de Toulouse et CNRS (UMR 5219), France
#   Ignacio Gonzalez, Genopole Toulouse Midi-Pyrenees, France
#   Kim-Anh Le Cao, French National Institute for Agricultural Research and
#   ARC Centre of Excellence ins Bioinformatics, Institute for Molecular Bioscience, University of Queensland, Australia
#   Leigh Coonan, Student, University of Queensland, Australia
#   Fangzhou Yao, Queensland Facility for Advanced Bioinformatics, University of Queensland, Australia and
#   Shangai University of Finance and Economics, Shanghai, P.R. China
#   Jeff Coquery, Queensland Facility for Advanced Bioinformatics, University of Queensland, Australia and
#   Sup Biotech, Paris, France
#   Florian Rohart, The University of Queensland, The University of Queensland Diamantina Institute, Translational Research Institute, Brisbane, QLD
#
# created: 2009
# last modified: 05-10-2017
#
# Copyright (C) 2009
#
# 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.
#############################################################################################################


#------------------ print method for pls ------------------#
print.pls <-
function(x, ...)
{
    
    mode = paste("'", x$mode, "'", sep = "")
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" PLS with a", mode, "mode with", x$ncomp, "PLS components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y of dimensions:", nrow(x$Y), ncol(x$Y), "\n\n")
    
    cat(" No variable selection. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
    
}

#------------------ print method for mint.pls ------------------#
print.mint.pls <-
function(x, ...)
{
    
    mode = paste("'", x$mode, "'", sep = "")
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" MINT PLS with a", mode, "mode with", x$ncomp, "PLS components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y of dimensions:", nrow(x$Y), ncol(x$Y), "\n\n")
    cat(" You entered a grouping factor with", nlevels(x$study), "studies. \n")
    
    cat(" No variable selection. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" loading vectors per study: see object$loadings.partial \n")
    cat(" variates: see object$variates \n")
    cat(" variates per study: see object$variates.partial \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
}

#------------------ print method for plsda ------------------#
print.plsda <-
function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" PLS-DA (regression mode) with", x$ncomp, "PLS-DA components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y with", ncol(x$ind.mat) , "classes. \n\n")
    
    cat(" No variable selection. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow, cim \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" auc \n")
    
}

#------------------ print method for mint.plsda ------------------#
print.mint.plsda <-
function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" MINT PLS-DA (regression mode) with", x$ncomp, "PLS-DA components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y with", ncol(x$ind.mat) , "classes. \n\n")
    cat(" You entered a grouping factor with", nlevels(x$study), "studies. \n")
    
    cat(" No variable selection. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" loading vectors per study: see object$loadings.partial \n")
    cat(" variates: see object$variates \n")
    cat(" variates per study: see object$variates.partial \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow, cim \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" perf, auc\n")
}

#----------------- print method for spls ------------------#
print.spls <-
function(x, ...)
{
    
    mode = paste("'", x$mode, "'", sep = "")
    keepX = paste("[", x$keepX, "]", sep = "")
    keepY = paste("[", x$keepY, "]", sep = "")
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" sPLS with a", mode, "mode with", x$ncomp, "sPLS components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y of dimensions:", nrow(x$Y), ncol(x$Y), "\n\n")
    
    cat(" Selection of", keepX, "variables on each of the sPLS components on the X data set. \n")
    cat(" Selection of", keepY, "variables on each of the sPLS components on the Y data set. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
}

#----------------- print method for mint.spls ------------------#
print.mint.spls <-
function(x, ...)
{
    
    mode = paste("'", x$mode, "'", sep = "")
    keepX = paste("[", x$keepX, "]", sep = "")
    keepY = paste("[", x$keepY, "]", sep = "")
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" MINT sPLS with a", mode, "mode with", x$ncomp, "sPLS components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y of dimensions:", nrow(x$Y), ncol(x$Y), "\n\n")
    cat(" You entered a grouping factor with", nlevels(x$study), "studies. \n")
    
    cat(" Selection of", keepX, "variables on each of the sPLS components on the X data set. \n")
    cat(" Selection of", keepY, "variables on each of the sPLS components on the Y data set. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" loading vectors per study: see object$loadings.partial \n")
    cat(" variates: see object$variates \n")
    cat(" variates per study: see object$variates.partial \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" selectVar\n")
}


#----------------- print method for splsda ------------------#
print.splsda <-
function(x, ...)
{
    
    keepX = paste("[", x$keepX, "]", sep = "")
    keepY = paste("[", x$keepY, "]", sep = "")
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" sPLS-DA (regression mode) with", x$ncomp, "sPLS-DA components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y with", ncol(x$ind.mat) , "classes. \n\n")
    
    cat(" Selection of", keepX, "variables on each of the sPLS-DA components on the X data set. \n")
    cat(" No Y variables can be selected. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow, cim \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" selectVar, tune, perf, auc \n")
}

#----------------- print method for mint.splsda ------------------#
print.mint.splsda <-
function(x, ...)
{
    
    keepX = paste("[", x$keepX, "]", sep = "")
    keepY = paste("[", x$keepY, "]", sep = "")
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" MINT sPLS-DA (regression mode) with", x$ncomp, "sPLS-DA components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y with", ncol(x$ind.mat) , "classes. \n\n")
    cat(" You entered a grouping factor with", nlevels(x$study), "studies. \n")
    
    cat(" Selection of", keepX, "variables on each of the sPLS-DA components on the X data set. \n")
    cat(" No Y variables can be selected. \n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" loading vectors per study: see object$loadings.partial \n")
    cat(" variates: see object$variates \n")
    cat(" variates per study: see object$variates.partial \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow, cim \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, cim \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" selectVar, tune, perf, auc \n")
    
}

#------------------ print method for rcc ------------------#
print.rcc <-
function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" rCCA with", x$ncomp, "components and regularization parameters", x$lambda[1], "and", x$lambda[2], "for the X and Y data. \n")
    cat(" You entered data X of dimensions :", nrow(x$X), ncol(x$X), "\n")
    cat(" You entered data Y of dimensions :", nrow(x$Y), ncol(x$Y), "\n\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" canonical correlations: see object$cor \n")
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
}

# ------------------------ print for pca --------------------------------
print.pca <- function(x, ...)
{
    
    ind.show = min(10, x$ncomp)
    
    cat("Eigenvalues for the first", ind.show, "principal components, see object$sdev^2:", "\n")
    print((x$sdev[1:ind.show])^2)
    cat("\n")
    
    per.var = x$explained_variance
    cum.var=as.vector(cumsum(per.var))
    x$sdev=as.vector(x$sdev)
    names(x$sdev) = paste("PC", 1:length(x$sdev), sep = "")
    names(per.var) = paste("PC", 1:length(per.var), sep = "")
    names(cum.var) = paste("PC", 1:length(cum.var), sep = "")
    
    cat("Proportion of explained variance for the first", ind.show, "principal components, see object$explained_variance:", "\n")
    print(per.var[1:ind.show])
    cat("\n")
    
    cat("Cumulative proportion explained variance for the first", ind.show, "principal components, see object$cum.var:", "\n")
    print(cum.var[1:ind.show])
    cat("\n")
    
    cat(" Other available components: \n", "-------------------- \n")
    cat(" loading vectors: see object$rotation \n")
}

# ------------------------ print for spca -------------------------
print.spca <-
function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" sparse pCA with", x$ncomp, "principal components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    
    cat(" Selection of", x$keepX, "variables on each of the principal components on the X data set. \n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" loading vectors: see object$rotation \n")
    cat(" principal components: see object$x \n")
    cat(" cumulative explained variance: see object$varX \n")
    cat(" variable names: see object$names \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" selectVar, tune\n")
    
}

# ------------------------ print for ipca -------------------------
print.ipca <-
function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" IPCA with", x$ncomp, "independent components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" unmixing matrix: see object$unmixing \n")
    cat(" independent principal components: see object$x \n")
    cat(" mxing matrix: see object$mixing \n")
    cat(" kurtosis: see object$kurtosis \n")
    cat(" variable names: see object$names \n")
    cat(" independent loading vectors: see object$loadings \n")
}

# ------------------------ print for sipca -------------------------
print.sipca <-
function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    cat(" Sparse IPCA with", x$ncomp, "independent components. \n")
    cat(" You entered data X of dimensions:", nrow(x$X), ncol(x$X), "\n")
    
    cat(" Selection of", x$keepX, "variables on each of the principal components on the X data set. \n")
    
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    
    cat(" unmixing matrix: see object$unmixing \n")
    cat(" independent principal components: see object$x \n")
    cat(" mxing matrix: see object$mixing \n")
    cat(" kurtosis: see object$kurtosis \n")
    cat(" variable names: see object$names \n")
    cat(" independent loading vectors: see object$loadings \n")
    
}

# ------------------------ print for rgcca -------------------------
print.rgcca <- function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    # components
    for(k in 1:length(x$blocks)){
        cat(" rGCCA with", x$ncomp[k], "components on block", k, "named", x$names$blocks[k], "\n")
    }
    cat("\n")
    
    # dimension
    for(k in 1 : length(x$blocks)){
        cat(" Dimension of block", k, 'is ', dim(x$blocks[[k]]), "\n")
    }
    cat("\n")
    cat(" Main numerical outputs: \n", "-------------------- \n")
    
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" selectVar\n")
    
}


# ------------------------ print for sgcca -------------------------
print.sgcca<- function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    # components
    for(k in 1 : length(x$X)){
        cat(" sGCCA with", x$ncomp[[k]], "components on block", k, "named", x$names$blocks[k], "\n")
    }
    cat("\n")
    
    # dimension
    for(k in 1 : length(x$X)){
        cat(" Dimension of block", k, 'is ', dim(x$X[[k]]), "\n")
    }
    cat("\n")
    
    # selected variables
    list.select = list()
    for(k in 1:length(x$X)){
        list.select[[k]] = apply(x$loadings[[k]], 2, function(x){sum(x!=0)})
        cat(" Selection of", list.select[[k]], "variables on each of the sGCCA components on the block", k, "\n")
    }
    cat("\n")
    cat(" Main numerical outputs: \n", "-------------------- \n")
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
    
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network\n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" selectVar \n")
    
}


# ------------------------ print for sgcca -------------------------
print.sgccda<- function(x, ...)
{
    
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    
    # components
    for(k in 1 : length(x$X)){
        cat(" sGCCA with", x$ncomp[[k]], "components on block", k, "named", x$names$blocks[k], "\n")
    }
    cat(" sGCCA with", x$ncomp[x$indY], "components on the outcome Y\n")
    cat("\n")
    
    
    # dimension
    for(k in 1 : length(x$X)){
        cat(" Dimension of block", k, 'is ', dim(x$X[[k]]), "\n")
    }
    cat(" Outcome Y has", nlevels(x$Y), "levels \n")
    cat("\n")
    
    # selected variables
    list.select = list()
    for(k in 1:length(x$X)){
        list.select[[k]] = apply(x$loadings[[k]], 2, function(x){sum(x!=0)})
        cat(" Selection of", list.select[[k]], "variables on each of the sGCCA components on the block", k, "\n")
    }
    cat("\n")
    cat(" Main numerical outputs: \n", "-------------------- \n")
    cat(" loading vectors: see object$loadings \n")
    cat(" variates: see object$variates \n")
    cat(" variable names: see object$names \n")
    
    
    cat("\n")
    cat(" Functions to visualise samples: \n", "-------------------- \n")
    cat(" plotIndiv, plotArrow, cimDiablo, plotDiablo \n")
    cat("\n")
    cat(" Functions to visualise variables: \n", "-------------------- \n")
    cat(" plotVar, plotLoadings, network, circosPlot \n")
    cat("\n")
    cat(" Other functions: \n", "-------------------- \n")
    cat(" selectVar, perf, auc \n")
    
}


#------- print for summary with (s)PLS object or rcc ---------#
print.summary <-
function(x, ...)
{
    
    print.gap = 4
    what = x$what
    digits = x$digits
    
    #--------------------- output pls/spls ---------------------#
    if(any(class(x) %in% c("pls", "spls"))){
        
        if (any(class(x) == "pls"))
        {
            cat(" PLS mode:", x$mode)
            cat("\n Number of variates considered:", x$ncomp, "\n")
        } else {
            cat(" sPLS mode:", x$mode)
            cat("\n Number of variates considered:", x$ncomp)
            cat("\n Number of X-variables selected on each of the sPLS components:", x$keepX)
            cat("\n Number of Y-variables selected on each of the sPLS components:", x$keepY, "\n")
        }
        
        #---------- affichage communaute ----------#
        if (any(what == "all") || any(what == "communalities"))
        {
            cat("\n\n Communalities Analysis:\n",
            "----------------------")
            
            cat("\n X-Variables vs their own Variates: see object$CM.X$own \n")
            cat("\n X-Variables vs the opposite Variates: see object$CM.X$opp \n")
            cat("\n Y-Variables vs their own Variates: see object$CM.Y$opp \n")
            cat("\n Y-Variables vs the opposite Variates: see object$CM.Y$opp \n")
        }
        
        #--------- affichage redondance -----------#
        if (any(what == "all") || any(what == "redundancy"))
        {
            cat("\n\n Redundancy Analysis:\n",
            "-------------------\n")
            
            cat("\n X-Variables vs their own Variates: see object$Rd.X$own \n")
            cat("\n X-Variables vs the opposite Variates: see object$Rd.X$opp \n")
            cat("\n Y-Variables vs their own Variates: see object$Rd.Y$opp \n")
            cat("\n Y-Variables vs the opposite Variates: see object$Rd.Y$opp \n")
        }
        
        #---------- tableau VIP ---------#
        if (any(what == "all") || any(what == "VIP"))
        {
            cat("\n\n", "Variable Importance in the Projection (VIP): see object$VIP \n",
            "------------------------------------------- \n\n")
        }
        
    }  #end if pls
    
    # ---------------------- output rcc ------------------------#
    if(any(class(x) == "rcc"))
    {
        print.gap = 4
        if (any(what == "all"))
        {
            cat(" Number of canonical variates considered:", x$ncomp, "\n")
            cat("\n Canonical correlations:",
            "\n ----------------------\n")
            print(round(x$can.cor, digits = digits), print.gap = print.gap)
        }
        
        #-- affichage communaute --#
        if (any(what == "all") || any(what == "communalities"))
        {
            cat("\n\n Canonical Communalities Analysis:\n",
            "--------------------------------")
            
            cat("\n X-Variables vs their own Canonical Variates: see object$Cm.X$own \n")
            cat("\n X-Variables vs the opposite Canonical Variates: see object$Cm.X$opp \n")
            cat("\n Y-Variables vs their own Canonical Variates: see object$Cm.Y$own \n")
            cat("\n Y-Variables vs the opposite Canonical Variates: see object$Cm.Y$opp \n")
        }
        
        #--------- affichage redondance -----------#
        if (any(what == "all") || any(what == "redundancy"))
        {
            cat("\n\n Redundancy Analysis:\n",
            "-------------------\n")
            
            cat("\n X-Variables vs their own Variates: see object$Rd.X$own \n")
            cat("\n X-Variables vs the opposite Variates: see object$Rd.X$opp \n")
            cat("\n Y-Variables vs their own Variates: see object$Rd.Y$opp \n")
            cat("\n Y-Variables vs the opposite Variates: see object$Rd.Y$opp \n")
        }
        
    }  #end rcc
}


# perf.diablo / sgccda.mthd
# perf.splsda = perf.plsda / splsda.mthd plsda.mthd
# perf.spls  = perf.pls / spls.mthd pls.mthd

print.perf.pls.mthd = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" MSEP, R2, Q2, Q2.total, RSS, PRESS. See the help file ?perf \n\n")
    
    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")

}

print.perf.spls.mthd = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" MSEP, R2, Q2, Q2.total, RSS, PRESS. See the help file ?perf \n")
    cat(" Stable features of X on each component: see object$features$stable.X \n")
    cat(" Stable features of Y on each component: see object$features$stable.Y \n\n")
    
    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")

}


print.perf.plsda.mthd = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" Error rate (overall or BER) for each component and for each distance: see object$error.rate \n")
    cat(" Error rate per class, for each component and for each distance: see object$error.rate.class \n")
    cat(" Prediction values for each component: see object$predict \n")
    cat(" Classification of each sample, for each component and for each distance: see object$class \n")
    cat(" AUC values: see object$auc if auc = TRUE \n\n")
    
    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")

}

print.perf.splsda.mthd = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" Error rate (overall or BER) for each component and for each distance (averaged over the nrepeat): see object$error.rate \n")
    cat(" Error rate (overall or BER) for each component, for each distance and for each repeat: see object$error.rate.all \n")
    cat(" Error rate per class, for each component and for each distance: see object$error.rate.class \n")
    cat(" Prediction values for each component: see object$predict \n")
    cat(" Classification of each sample, for each component and for each distance: see object$class \n")
    cat(" Stable features on each component: see object$features$stable \n")
    cat(" AUC values: see object$auc if auc = TRUE \n\n")
    
    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")

}

print.perf.mint.splsda.mthd = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" Study-specific error rate (overall, BER and error rate per class) for each component and for each distance: see object$study.specific.error \n")
    cat(" Global error rate (overall, BER and error rate per class) for each component and for each distance: see object$global.error \n")
    cat(" Prediction values for each component: see object$predict \n")
    cat(" Classification of each sample, for each component and for each distance: see object$class \n")
    cat(" AUC values: see object$auc \n")
    cat(" AUC values per study: see object$auc.study if auc = TRUE \n\n")
    
    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")

}

print.perf.sgccda.mthd = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" Error rate (overall or BER) for each component and for each distance: see object$error.rate \n")
    cat(" Error rate per class, for each component and for each distance: see object$error.rate.class \n")
    cat(" Prediction values for each component: see object$predict \n")
    cat(" Classification of each sample, for each component and for each distance: see object$class \n")
    cat(" Stable features on each component: see object$features$stable \n")
    cat(" AUC values: see object$auc if auc = TRUE \n\n")
    
    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")

}


# tune: "spls", "splsda", "mint.splsda", "rcc", "pca"
print.tune.pca = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" for all principal components, see object$sdev, object$explained_variance and object$cum.var\n")
}

print.tune.rcc = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat("  lambda1 = ", x$opt.lambda1, ", see object$opt.lambda1\n", " lambda2 = ", x$opt.lambda2, ",  see object$opt.lambda2\n",
    "CV-score = ", x$opt.score, ", see object$opt.score\n")
}

print.tune.splsda = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" Optimal keepX for each component, see object$choice.keepX \n")
    cat(" Optimal number of components: see object$choice.ncomp \n")
    cat(" Error rate for each tested keepX and for each component (averaged over the nrepeat, mean and standard deviation): see object$error.rate and object$error.rate.sd  \n")
    cat(" Error rate for each tested keepX, for each component and for each repeat: see object$error.rate.all \n")
    cat(" Error rate per class obtained with the optimal keepX, for each component and for each nrepeat: see object$error.rate.class \n")
    cat(" AUC when applicable, (note that those results may differ with sPLS-DA prediction, see details): see object$AUC \n\n")
    
    cat(" Other outputs are available, and details on those outputs in ?tune.splsda.  \n\n")

    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")
}

print.tune.mint.splsda = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" Optimal keepX for each component, see object$choice.keepX \n")
    cat(" Error rate for each tested keepX and for each component: see object$error.rate \n")
    cat(" Error rate per class obtained with the optimal keepX, for each component: see object$error.rate.class \n\n")
    
    cat(" Other outputs available, see ?tune.mint.splsda \n\n")

    cat(" Visualisation Functions: \n", "-------------------- \n")
    cat(" plot \n")
}

print.tune.block.splsda = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    cat(" Optimal keepX for each component, see object$choice.keepX \n")
    cat(" Error rate for each tested keepX and for each component (averaged over the nrepeat): see object$error.rate \n")
    cat(" Error rate for each tested keepX, for each component and for each repeat: see object$error.rate.all \n")
    cat(" Error rate per class obtained with the optimal keepX, for each component and for each nrepeat: see object$error.rate.class \n\n")
    
    cat(" Other outputs available, see ?tune.splsda.  \n\n")
    
}

print.predict = function(x, ...)
{
    cat("\nCall:\n", deparse(x$call, width.cutoff = 500), "\n\n")
    cat(" Main numerical outputs: \n",
    "-------------------- \n")
    if(is.list(x$predict)) #block analysis
    {
        cat(" Prediction values of the test samples for each block and each component: see object$predict \n")
        cat(" variates of the test samples for each block and each component: see object$variates \n")
        
        
        if(!is.null(x$dist)) #DA object, more outputs
        {
            cat(" Classification of the test samples for each distance, for each block and each component: see object$class \n")
            cat(" Majority vote of the test samples for each distance and each component: see object$vote \n")
        }
    }else{
        cat(" Prediction values of the test samples for each component: see object$predict \n")
        cat(" variates of the test samples: see object$variates \n")
        
        if(!is.null(x$dist)) #DA object, more outputs
        cat(" Classification of the test samples for each distance and for each component: see object$class \n")
    }
    
}

Try the mixOmics package in your browser

Any scripts or data that you put into this service are public.

mixOmics documentation built on June 1, 2018, 5:06 p.m.