########## 3-way example ##########
# create random data list with Parafac2 structure
set.seed(3)
mydim <- c(NA,10,20)
nf <- 2
nk <- sample(c(50,100,200),mydim[3],replace=TRUE)
Gmat <- matrix(rnorm(nf^2),nf,nf)
Bmat <- matrix(runif(mydim[2]*nf),mydim[2],nf)
Cmat <- matrix(runif(mydim[3]*nf),mydim[3],nf)
Xmat <- Emat <- Hmat <- vector("list",mydim[3])
for(k in 1:mydim[3]){
Hmat[[k]] <- svd(matrix(rnorm(nk[k]*nf),nk[k],nf),nv=0)$u
Xmat[[k]] <- tcrossprod(Hmat[[k]]%*%Gmat%*%diag(Cmat[k,]),Bmat)
Emat[[k]] <- matrix(rnorm(nk[k]*mydim[2]),nk[k],mydim[2])
}
Emat <- nscale(Emat,0,sumsq(Xmat)) # SNR=1
X <- mapply("+",Xmat,Emat)
# fit Parafac2 model (unconstrained)
pfac <- parafac2(X,nfac=nf,nstart=1)
pfac$Rsq
# check solution
Xhat <- fitted(pfac)
sse <- sumsq(mapply("-",Xmat,Xhat))
sse/(sum(nk)*mydim[2])
crossprod(pfac$A$H[[1]])
crossprod(pfac$A$G)
# reorder and resign factors
pfac$B[1:4,]
pfac <- reorder(pfac, 2:1)
pfac$B[1:4,]
pfac <- resign(pfac, mode="B")
pfac$B[1:4,]
Xhat <- fitted(pfac)
sse <- sumsq(mapply("-",Xmat,Xhat))
sse/(sum(nk)*mydim[2])
# rescale factors
colSums(pfac$B^2)
colSums(pfac$C^2)
pfac <- rescale(pfac, mode="C", absorb="B")
colSums(pfac$B^2)
colSums(pfac$C^2)
Xhat <- fitted(pfac)
sse <- sumsq(mapply("-",Xmat,Xhat))
sse/(sum(nk)*mydim[2])
########## 4-way example ##########
# create random data list with Parafac2 structure
set.seed(4)
mydim <- c(NA,10,20,5)
nf <- 3
nk <- sample(c(50,100,200),mydim[4],replace=TRUE)
Gmat <- matrix(rnorm(nf^2),nf,nf)
Bmat <- matrix(runif(mydim[2]*nf),mydim[2],nf)
Cmat <- matrix(runif(mydim[3]*nf),mydim[3],nf)
Dmat <- matrix(runif(mydim[4]*nf),mydim[4],nf)
Xmat <- Emat <- Hmat <- vector("list",mydim[4])
for(k in 1:mydim[4]){
Hmat[[k]] <- svd(matrix(rnorm(nk[k]*nf),nk[k],nf),nv=0)$u
Xmat[[k]] <- array(tcrossprod(Hmat[[k]]%*%Gmat%*%diag(Dmat[k,]),
krprod(Cmat,Bmat)),dim=c(nk[k],mydim[2],mydim[3]))
Emat[[k]] <- array(rnorm(nk[k]*mydim[2]*mydim[3]),dim=c(nk[k],mydim[2],mydim[3]))
}
Emat <- nscale(Emat,0,sumsq(Xmat)) # SNR=1
X <- mapply("+",Xmat,Emat)
# fit Parafac2 model (unconstrained)
pfac <- parafac2(X,nfac=nf,nstart=1)
pfac$Rsq
# check solution
Xhat <- fitted(pfac)
sse <- sumsq(mapply("-",Xmat,Xhat))
sse/(sum(nk)*mydim[2]*mydim[3])
crossprod(pfac$A$H[[1]])
crossprod(pfac$A$G)
########## parallel computation ##########
# create random data list with Parafac2 structure
set.seed(3)
mydim <- c(NA,10,20)
nf <- 2
nk <- sample(c(50,100,200),mydim[3],replace=TRUE)
Gmat <- matrix(rnorm(nf^2),nf,nf)
Bmat <- matrix(runif(mydim[2]*nf),mydim[2],nf)
Cmat <- matrix(runif(mydim[3]*nf),mydim[3],nf)
Xmat <- Emat <- Hmat <- vector("list",mydim[3])
for(k in 1:mydim[3]){
Hmat[[k]] <- svd(matrix(rnorm(nk[k]*nf),nk[k],nf),nv=0)$u
Xmat[[k]] <- tcrossprod(Hmat[[k]]%*%Gmat%*%diag(Cmat[k,]),Bmat)
Emat[[k]] <- matrix(rnorm(nk[k]*mydim[2]),nk[k],mydim[2])
}
Emat <- nscale(Emat,0,sumsq(Xmat)) # SNR=1
X <- mapply("+",Xmat,Emat)
# fit Parafac2 model (10 random starts -- sequential computation)
set.seed(1)
system.time({pfac <- parafac2(X,nfac=nf)})
pfac$Rsq
# fit Parafac2 model (10 random starts -- parallel computation)
set.seed(1)
cl <- makeCluster(detectCores())
ce <- clusterEvalQ(cl,library(multiway))
system.time({pfac <- parafac2(X,nfac=nf,parallel=TRUE,cl=cl)})
pfac$Rsq
stopCluster(cl)
Run the code above in your browser using DataLab