R/glamer_4glm.R

Defines functions glamer_4glm

glamer_4glm <- function(X, y, clust.method, nlambda, lam, maxp, lambda){

  y <- prelasso_binomial(y)

  out <- prelasso_common(X, y)
  n <-             out$n
  levels.listed <- out$levels.listed
  fl <-            out$fl
  x.full <-        out$x.full_normalized
  p <-             out$p
  ord <-           out$ord
  groups <-        out$groups
  X <-             out$X

  if (is.null(lambda)) {
    user.lambda<-substitute()    #make user.lambda - paradoxically - not present in a call to grpreg
  } else {
    nlambda <- length(lambda)   #override this parameter
    user.lambda <- lambda
  }

  mL <-  grpreg::grpreg(x.full[,-1, drop=FALSE], y, group=groups , penalty = "grLasso", family ="binomial", nlambda = nlambda, lambda = user.lambda)

  bb <-  postlasso_common(mL$lambda, n, mL$beta)
  fac <- postlasso_fac(bb, groups)   #fac must be computed on bb without intercept, it happens internally in postlasso_fac()
  out <- postlasso_glamer(bb, lam, fac, groups)
  bb <-  out$bb
  SS <-  out$SS

  mm <-  lapply(1:ncol(SS), function(i) glamer_4glm_help(SS[,i], bb[,i], X, y, fl, clust.method = clust.method, lam = lam))

  return(wrap_up_binomial(mm, p, maxp, SS, fl, x.full, ord, n, levels.listed, mL, list(family = "binomial", clust.method = clust.method, nlambda = nlambda, maxp = maxp, lambda=lambda)))
}

Try the DMRnet package in your browser

Any scripts or data that you put into this service are public.

DMRnet documentation built on Aug. 7, 2023, 5:11 p.m.