Required packages

''mvtnorm'', ''TRES'', ''rTensor'', ''tensr'', ''caret'', and ''MASS''.

datel: Main function for DATE-L.

Input:

dimen is the dimension of the tensor predictor in the form of c(p_1,p_2,...p_M).

K is the number of classes.

Etrain is the training tensor dataset with dim(dimen, ntr), where ntr is the sample size of the training data.

Etest is the testing tensor dataset with dim(dimen, nte), where nte is the sample size of the testing data.

ytrain is the class label for the training dataset.

ytest is the class label for the training dataset.

ztr is trainig covariates; zte is testing covarates (for the method with additional covariate). They are set to be NULL for the methods DATE-L proposed in the paper.

u is the input envelope dimenison in form of c(u_1,...u_M)

Output:

pred is the predicted class label for the testing set.

pred_err is the prediction error.

Bk is the estimation for the parameter B_k.

dated: Main function for DATE-D.

The input and output are the same with datel.

Example: Simulation for M1

Data generating

###########################some basic setting for simulation data################
set.seed(999)
r <- c(80, 20)
m <- length(r)
p <- 1
u <- c(4, 2)
n <- 200; ntest <- 2000
K <- 2
nk <- n/K*matrix(1, K, 1)
nktest <- ntest/K*matrix(1, K, 1)
md <-3 #md=1 represents covariance structure (C1); md=2 represents covariance structure (C1); md=3 represents covariance structure (C1).

# response
Yn <- rep(c(1, 2), each = n/K)
Yntest <- rep(c(1, 2), each = ntest/K)

# set parameters 
Omega <- Omega0 <- Gamma <- Gamma0 <- NULL
Sig <- Siginv <- Sigsqrtm <- NULL

for (i in 1:m) {
  #generate basis matrices
  Gamma[[i]] <- matrix(runif(r[i]*u[i]), r[i], u[i])
  Gamma[[i]] <- qr.Q(qr(Gamma[[i]]))
  Gamma0[[i]] <- qr.Q(qr(Gamma[[i]]), complete = TRUE)[, (u[i]+1):r[i]]
  
  #generate the covariance matrices
  if(md==3){
    O <- matrix(runif(u[i]^2), u[i], u[i])
    O <- qr.Q(qr(O))
    D <- diag(5^(1:u[i]))
    Omega[[i]] <- O %*% D %*% t(O)
    Op <- matrix(runif((r[i]-u[i])^2), (r[i]-u[i]), (r[i]-u[i]))
    Op <- qr.Q(qr(Op))
    D <- diag(exp(seq(i, -10, length.out = r[i]-u[i])))
    Omega0[[i]] <- Op %*% D %*% t(Op)
    Sig[[i]] <- Gamma[[i]] %*% Omega[[i]] %*% t(Gamma[[i]]) +
      Gamma0[[i]] %*% Omega0[[i]] %*% t(Gamma0[[i]]) 
    Sig[[i]] <- 3*Sig[[i]]/norm(Sig[[i]], type="F")
  }else if(md==1){
    Omega[[i]] <- diag(u[i])
    Omega0[[i]] <- 0.01*diag(r[i]-u[i])
    Sig[[i]] <- Gamma[[i]] %*% Omega[[i]] %*% t(Gamma[[i]]) +
      Gamma0[[i]] %*% Omega0[[i]] %*% t(Gamma0[[i]]) 
    Sig[[i]] <- 1*Sig[[i]]/norm(Sig[[i]], type="F")
  }else if(md==2){
    Omega[[i]] <- 0.1*diag(u[i])
    Omega0[[i]] <- diag(r[i]-u[i])
    Sig[[i]] <- Gamma[[i]] %*% Omega[[i]] %*% t(Gamma[[i]]) +
      Gamma0[[i]] %*% Omega0[[i]] %*% t(Gamma0[[i]]) 
    Sig[[i]] <- 40*Sig[[i]]/norm(Sig[[i]], type="F")
  }
  Siginv[[i]] <- ginv(Sig[[i]])
  Sigsqrtm[[i]] <- pracma::sqrtm(Sig[[i]])$B
}
# enerate the mean parameters
muk <- array(NA, c(r, K))
for (k in 1:K) {
  eta <- as.tensor(array(runif(prod(u)*p), c(u, p)))
  muk[, , k] <- ttl(eta, Gamma, 1:m)@data
}
mubar <- nk[1]/n*muk[, , 1]+nk[2]/n*muk[, , 2]
muk <- muk - array(unlist(lapply(1:K, function(x) mubar)), c(r, K))

#number of replicates
nsim <- 1
dated_err <- datel_err <- rep(0, nsim)

#data generating
for (iter in 1:nsim) {
  set.seed(iter)
  
  Epsilon <- array(rnorm(prod(r)*n), c(r, n))
  Epsilon <- as.tensor(Epsilon)
  Epsilon <- ttl(Epsilon, Sigsqrtm, ms=1:m)
  
  Epsilon_test <- array(rnorm(prod(r)*ntest), c(r, ntest))
  Epsilon_test <- as.tensor(Epsilon_test)
  Epsilon_test <- ttl(Epsilon_test, Sigsqrtm, ms=1:m)
  
  Xn <- array(NA, c(r, n))
  Xntest <- array(NA, c(r, ntest))
  for (k in 1:K) {
    idx <- 1:nk[k] + sum(nk[0:(k-1)])
    tpk  <- array(unlist(lapply(1:nk[k], function(x) muk[, , k])), c(r, nk[k]))
    Xn[, , idx] <- tpk + Epsilon@data[, , idx]
    idx <- 1:nktest[k] + sum(nktest[0:(k-1)])
    tpk  <- array(unlist(lapply(1:nktest[k], function(x) muk[, , k])), c(r, nktest[k]))
    Xntest[, , idx] <- tpk + Epsilon_test@data[, , idx]
  }

}

DATE-L

##################date-l#############################
datel_pred <- datel(dimen=r, K, Etrain=Xn, Etest=Xntest, ytrain=Yn, ytest=Yntest, ztr=NULL, zte=NULL, u)
(datel_err <- datel_pred$pred_err)
## [1] 0.144

DATE-D

##################date-d#############################
dated_pred <- dated(dimen=r, K, Etrain=Xn, Etest=Xntest, ytrain=Yn, ytest=Yntest, ztr=NULL, zte=NULL, u=u)
(dated_err=dated_pred$pred_err)
## [1] 0.1415