File: det_range.R

package info (click to toggle)
r-cran-regsem 1.6.2+dfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 496 kB
  • sloc: cpp: 263; ansic: 15; makefile: 2
file content (44 lines) | stat: -rw-r--r-- 1,458 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
#'
#'
#' Determine the initial range for stability selection
#'
#' This function perform regsem on bootstrap samples to determine the initial range for stability selection. Interquartile range of the bootstrap optimal regularization amounts are uesd as the final range.
#' @param data data frame
#' @param model lavaan output object.
#' @param times number of bootstrap samples used.
#' @param ... Any additional arguments to pass to regsem() or cv_regsem().
#' @return result the lambda values and the upper bound and lower bound of the interquartile range.
#' @export


det_range<-function(data,
                    model,
                    times=50,
                    ...){
  nsize<-dim(data)[1]
  lam=rep(NA,times)
  for(i in 1:times){
    ids = sample(1:nsize,nsize,replace=T)
    datasub.boot <- data[ids,]
    est_model_boot <- sem(model, data = datasub.boot)
    try(cv.out.boot <- cv_regsem(est_model_boot,...))
    try(lam[i]<-cv.out.boot$fit[which.min(cv.out.boot$fits[cv.out.boot$fit[,2]==0,4])])
  }
  if (sum(lam!=0,na.rm=T)==0){
    warning("0 penalty is selected by all runs.")
    lb=0;ub=0;
  }else{
    lb<-min(lam[lam!=0],na.rm=T)
    ub<-max(lam[lam!=0],na.rm=T)
  }
  Lam<-c(lb,ub)
  result<-list()
  #result$times<-times
  #result$n.lambda<-n.lambda
  #result$jump<-jump
  result$lambdas<-lam
  result$lb<-lb
  result$ub<-ub
  result$zero_removed<-min(lam,na.rm=T)==0
  return(result)
}