inst/doc/Tlasso.R

In Tlasso: Non-Convex Optimization and Statistical Inference for Sparse Tensor Graphical Models

## -----------------------------------------------------------------------------
library(Tlasso)

## -----------------------------------------------------------------------------
m.vec = c(5,5,5)  # dimensionality of a tensor 
# m1, m2, m3
n = 5   # sample size 

Omega.true.list = list()
for (k in 1:length(m.vec)) {
  Omega.true.list[[k]] = ChainOmega(m.vec[k], sd = k)
}

Omega.true.list[[1]]

## -----------------------------------------------------------------------------
Sigma.true.list = list()
for (k in 1:length(m.vec)) {
  Sigma.true.list[[k]] = solve(Omega.true.list[[k]])
} # generate covariance matrices list

DATA=Trnorm(n,m.vec,Sigma.list=Sigma.true.list) 
# obersavations from tensor normal distribution

## ---- eval=FALSE--------------------------------------------------------------
#  DATA2=Trnorm(n,m.vec)
#  # default is triangle graph
#  # equivalent to DATA2 = Trnorm(n,m.vec, type='Chain', sd=1)
#  DATA3=Trnorm(n,m.vec,type='Neighbor')
#  # 4 nearest-neighbor graph
#  # equivalent to DATA3 = Trnorm(n,m.vec, type='Neighbor', sd=1, knn=4)

## -----------------------------------------------------------------------------
lambda.thm = 20*c( sqrt(log(m.vec[1])/(n*prod(m.vec))), 
                   sqrt(log(m.vec[2])/(n*prod(m.vec))), 
                   sqrt(log(m.vec[3])/(n*prod(m.vec))))
# lambda.thm is regularization parameter
out.tlasso = Tlasso.fit(DATA,T=1,lambda.vec = lambda.thm)   
# output is a list of estimation of precision matrices
out.tlasso[[1]]

## -----------------------------------------------------------------------------
# compare out.tlasso and Omega.true.list
# main diagnoal is taken into consideration
est.analysis(out.tlasso,Omega.true.list,offdiag=FALSE)

## -----------------------------------------------------------------------------
mat.list=list() # list of matrices of test statistic value  
for ( k in 1:length(m.vec)) {
  rho=covres(DATA, out.tlasso, k = k) 
  # sample covariance matrix of residuals, including diagnoal 
  bias_rho=biascor(rho,out.tlasso,k=k)
  # bias corrected sample covariance of residuals, excluding diagnoal
  
  varpi2=varcor(DATA, out.tlasso, k = k)
  # variance correction term for kth mode's sample covariance of residuals

  tautest=matrix(0,m.vec[k],m.vec[k])
  for( i in 1:(m.vec[k]-1)) {
    for ( j in (i+1):m.vec[k]){
      tautest[j,i]=tautest[i,j]=sqrt((n-1)*prod(m.vec[-k]))*
                      bias_rho[i,j]/sqrt(varpi2*rho[i,i]*rho[j,j])
      # compute final test statistic 
    }
  }
  
  mat.list[[k]]=tautest
}
mat.list[[1]]

## -----------------------------------------------------------------------------
# inference measures (off-diagnoal), critical value is 0.975 quantile of standard normal
infer.analysis(mat.list, qnorm(0.975), Omega.true.list, offdiag=TRUE)

## ---- eval=FALSE--------------------------------------------------------------
#  k=1 # interested mode
#  upsilon=0.1  # control level
#  
#  # compute the difference between FDP and upsilon
#  fun=function(varsigma,mk,upsilon,tautest) {
#    return((2*(1-pnorm(varsigma))*mk*(mk-1))/max(1,sum(sign(abs(tautest) > varsigma))) - upsilon)
#  }
#  
#  # select a critical value in (0,6) that has the samllest difference
#  diff=c();ind=1;inter=seq(0,6,0.0001)
#  for (varsigma in inter) {
#      diff[ind]=fun(varsigma,mk=m.vec[k],upsilon=upsilon,tautest=mat.list[[k]])
#      ind=ind+1
#  }
#  # the smallest critical value that constrains FDP under upsilon
#  critical=inter[min(which(diff < 0))]
#  
#  # testing hypothesis with the critcal value
#  # FDR will converge to the limit proved in Lyu et al. 2019.
#  inference.FDR=infer.analysis(mat.list, critical, Omega.true.list, offdiag=TRUE)

## ---- fig.height=5 , fig.width=5, fig.align='center'--------------------------
k=1 # interested mode
# true graph structure. 
# set thres=0 in case true edge is eliminated
graph.pattern(Omega.true.list[[1]],main='True graph of mode 1',thres=0)

inf.mat=mat.list[[k]] > qnorm(0.975)
# set thres=0 (<1) since inf.mat is logical
graph.pattern(inf.mat,main='Inference of mode 1',thres=0)