# R/DCCSWA.R In multigroup: Multigroup Data Analysis

#### Documented in DCCSWA

#' @title Dual Common Component and Specific Weights Analysis
#'
#' @description
#' Dual Common Component and Specific Weights Analysis: to find
#' common structure among variables of different groups
#'
#' @param Data a numeric matrix or data frame
#' @param Group a vector of factors associated with group structure
#' @param ncomp number of components, if NULL number of components is equal to 2
#' @param Scale scaling variables, by defalt is FALSE. By default data are centered within groups
#' @return list with the following results:
#' @return \item{Data}{     Original data}
#' @return \item{Con.Data}{     Concatenated centered data}
#' @return \item{split.Data}{     Group centered data}
#' @return \item{Group}{      Group as a factor vector}
#' @return \item{saliences}{      Each group having a specific contribution to the determination of this common
#' space, namely the salience, for each dimension under study}
#' @return \item{lambda}{     The specific variances of groups}
#' @return \item{exp.var}{      Percentages of total variance recovered associated with each dimension}
#' @export
#' @references E. M. Qannari, P. Courcoux, and E. Vigneau (2001). Common components and specific weights analysis performed
#'  on preference data. \emph{Food Quality and Preference}, 12(5-7), 365-368.
#'
#'
#' @references A. Eslami (2013). Multivariate data analysis of multi-group datasets: application to biology. University  of Rennes I.
#'
#'
#'
#' @examples
#' Data = iris[,-5]
#' Group = iris[,5]
#' res.DCCSWA = DCCSWA(Data, Group, graph=TRUE)
#' scoreplot(res.DCCSWA, axes=c(1,2))
DCCSWA <- function(Data, Group, ncomp=NULL, Scale=FALSE, graph=FALSE){

#=========================================================================
#                             1. Checking the inputs
#=========================================================================
check(Data, Group)

#=========================================================================
#                              2. preparing Data
#=========================================================================
if (is.data.frame(Data) == TRUE) {
Data=as.matrix(Data)
}
if(is.null(ncomp)) {ncomp=2}
if(is.null(colnames(Data))) {
colnames(Data) = paste('V', 1:ncol(Data), sep='')
}
Group = as.factor(Group)

rownames(Data)=Group                 #---- rownames of data=groups
M=length(levels(Group))              #----number of groups: M
P=dim(Data)[2]                       #----number of variables: P
n=as.vector(table(Group))            #----number of individuals in each group
N=sum(n)                             #----number of individuals
split.Data=split(Data,Group)         #----split Data to M parts

# centering and scaling if TRUE
for(m in 1:M){
split.Data[[m]]=matrix(split.Data[[m]],nrow=n[m])
split.Data[[m]]<-scale(split.Data[[m]],center=TRUE,scale=Scale)
}

# concatinated dataset by row as groups
Con.Data = split.Data[[1]]
for(m in 2:M) {
Con.Data = rbind(Con.Data, split.Data[[m]])
}
rownames(Con.Data) = Group
colnames(Con.Data) = colnames(Data)

# Variance-covariance matrix for each group
cov.Group=vector("list", M)
for(m in 1:M){
cov.Group[[m]] = t(split.Data[[m]]) %*% split.Data[[m]] / n[m]
}

# Total variance of all dataset sum(trace(Vm*Vm)
Itot = 0
for (m in 1:M) {
Itot = Itot + sum(cov.Group[[m]]^2)
}

#==========================================================================
#    			                      Outputs
#==========================================================================
saliences = matrix(0,M,ncomp)               #----saliences
explained = matrix(0,ncomp)
res <- list(
Data       = Data,
Con.Data   = Con.Data,
split.Data = split.Data,
Group=Group)

#============================================================================
#      		                      3. Iterative algorithm
#============================================================================
for (h in 1:ncomp)  {

# Initialization: Choose initial values for salience=1
salience= c(rep(1,M))
threshold = 1e-10
deltafit = 1000000;
previousfit = Itot;

while(deltafit > threshold){

# Compute compromise varaiance-covariance matrix
Vc = 0
for(m in 1:M){
Vc = salience[m] * cov.Group[[m]] + Vc
}

#Set a to the eigenvector of Vc associated with the largest eigenvalue
a = eigen(Vc)$vectors[,1] #Update new saliences for(m in 1:M){ salience[m] = t(a) %*% cov.Group[[m]] %*% a } # criterion def=0 for(m in 1:M){ def = sum(cov.Group[[m]] - salience[m] * as.matrix(a) %*% t(as.matrix(a)))^2 + def } deltafit = previousfit-def previousfit = def } # end of iteration explained[h,1] = 100 * sum(salience ^2) / Itot saliences[,h] = salience; A[,h] = a; #========================================================================== # Deflation #========================================================================== aux = diag(1,P)- matrix(a,ncol=1) %*% matrix(a,nrow=1); for (m in 1:M) { split.Data[[m]] = split.Data[[m]] %*% aux cov.Group[[m]] = t(split.Data[[m]]) %*% split.Data[[m]] } } res$loadings.common=A
rownames(res$loadings.common)=colnames(Data) colnames(res$loadings.common)=paste("Dim", 1:ncomp, sep="")

res$saliences= saliences rownames(res$saliences) = levels(Group)
colnames(res$saliences) = paste("Dim", 1:ncomp, sep="") expl = matrix(0, nrow=ncomp, ncol=2) expl[,1] = c(explained) expl[,2] = cumsum(expl[,1]) res$exp.variance = expl
rownames(res$exp.variance) = paste("Dim", 1:ncomp, sep="") colnames(res$exp.variance)  = c("%Total Var expl", "Cumul % total Var")

#============================================================================
#                                Explained variance
#============================================================================

Y<-scale(Data,center=TRUE,scale=FALSE)
Datam=split(Y, Group)
for(m in 1:M){
Datam[[m]] = matrix(Datam[[m]], nrow=n[m])
Datam[[m]] = scale(Datam[[m]], center=TRUE, scale=FALSE)
}

for(m in 1:M) {
cov.Group[[m]] = t(Datam[[m]]) %*% Datam[[m]] / n[m]
}

lambda = matrix(0, nrow=M, ncol=ncomp)

for(m in 1:M){
lambda[m,]=round(diag(t(A) %*%  (cov.Group[[m]]) %*% A),3)
}
res$lambda = lambda rownames(res$lambda) = levels(Group)
colnames(res$lambda) = paste("Dim", 1:ncomp, sep="") # exp.var exp.var = matrix(0,M,ncomp) for(m in 1:M){ exp.var[m,] = 100 * lambda[m,]/ sum(diag(cov.Group[[m]])) } res$exp.var = exp.var
rownames(res$exp.var) = levels(Group) colnames(res$exp.var) = paste("Dim", 1:ncomp, sep="")

#=================================================
if(graph) {plot.mg(res)}

class(res) = c("DCCSWA", "mg")
return(res)
}

#' @S3method print DCCSWA
print.DCCSWA <- function(x, ...)
{
cat("\nDual Common Component and Specific Weights Analysis\n")
cat(rep("-",43), sep="")
cat("\n$loadings.common ", "common loadings") cat("\n$Data              ", "Data set")
cat("\n")
invisible(x)
}

## Try the multigroup package in your browser

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

multigroup documentation built on March 26, 2020, 5:50 p.m.