# NOT RUN {
p <- 50 # data dimension
k1 <- 8 # sparsity of each induvidual component
v1 <- 1/sqrt(k1)*c(rep(1, k1), rep(0, p-k1)) # first principal compnent (PC)
v2 <- 1/sqrt(k1)*c(rep(0,4), 1, -1, 1, -1, rep(1,4), rep(0,p-12)) # 2nd PC
v3 <- 1/sqrt(k1)*c(rep(0,6), 1, -rep(1,4), rep(1,3), rep(0,p-14)) # 3rd PC
Sigma <- diag(p) + 40*tcrossprod(v1) + 20*tcrossprod(v2) + 5*tcrossprod(v3) # population covariance
mu <- rep(0, p) # pupulation mean
n <- 2000 # number of observations
loss = function(u,v){
sqrt(abs(1-sum(v*u)^2))
}
loss_sub = function(U,V){
U<-qr.Q(qr(U)); V<-qr.Q(qr(V))
norm(tcrossprod(U)-tcrossprod(V),"2")
}
set.seed(1)
X <- mvrnorm(n, mu, Sigma) # data matrix
spcavrp.sub <- SPCAvRP_subspace(data = X, cov = FALSE, m = 2, l = 12, d = 12,
A = 200, B = 70, center_data = FALSE)
subspace_estimation<-data.frame(
loss_sub(matrix(c(v1,v2),ncol=2),spcavrp.sub$vector),
loss(spcavrp.sub$vector[,1],v1),
loss(spcavrp.sub$vector[,2],v2),
crossprod(spcavrp.sub$vector[,1],spcavrp.sub$vector[,2]))
colnames(subspace_estimation)<-c("loss_sub","loss_v1","loss_v2","inner_prod")
rownames(subspace_estimation)<-c("")
print(subspace_estimation)
plot(1:p,spcavrp.sub$importance_scores,xlab='variable',ylab='w',
main='importance scores w \n (may use to choose l when k unknown)')
# }
Run the code above in your browser using DataLab