Run_simulation/compCL_test/KKT.R

In jiji6454/Rpac_compReg: Compositional Data Regression

source("C:/Users/zjiji/Dropbox/Shared-ZheSun/FuncCompReg/program/compReg/R/auxiliary.R")
set.seed(1)
Comp_data = comp_simulation(n = n, p = p, rho = rho, sigma = sigma, gamma  = gamma, add.on = add.on,
                            beta = beta, intercept = intercept)


#cv.compCL
foldid <- sample(rep(seq(nfolds), length = n))
comp_cvm <- cv.compCL(y = Comp_data$y, Z = Comp_data$X.comp, Zc = Comp_data$Zc, intercept = Comp_data$intercept,
                      pf = rep(1, times = p),
                      nlam = nlam, trim = trim,
                      #nfolds = nfolds,
                      foldid = foldid,
                      dfmax = dfmax,
                      mu_ratio = mu_ratio, tol = tol,
                      outer_maxiter = 1e8, outer_eps = 1e-14, inner_maxiter = 1e4, inner_eps = 1e-10)
B_minlam[l, ] <- coef(comp_cvm, trim = FALSE, s = "lam.min")$beta
pf = rep(1, times = p)
for(i in 1:length(comp_cvm$lam)) {
  if(length(which(abs(comp_cvm$compCL.fit$beta[, i]) > 0)) > 0) {
    KKT <- KKT_lasso(y = Comp_data$y, Z = cbind(comp_cvm$compCL.fit$Z_log, Comp_data$Zc), p = p,
                     lam = comp_cvm$lam[i] * pf, beta = comp_cvm$compCL.fit$beta[, i], tol = 1e-8)$summary
    cat("group", i, "KKT condition", KKT, "\r\n")
  } else {
    residual <- drop(Comp_data$y) -  cbind2(cbind(comp_cvm$compCL.fit$Z_log, Comp_data$Zc),1) %*% comp_cvm$compCL.fit$beta[, j]
    u <- t(comp_cvm$compCL.fit$Z_log) %*% residual / n
    u_upper <- max(u)
    u_lower <- min(u)
    lam_path <- comp_cvm$lam[j] * pf
    tao_upper <- lam_path - u
    tao_upper1 <- min(tao_upper)
    tao_lower <- -lam_path - u
    tao_lower1 <- max(tao_lower)
    tao_exist <- tao_upper1 >= tao_lower1
    cat("group", i, "tao_exist", tao_exist, "\r\n")
  }
}