R/aldvmm.getpar.R

In aldvmm: Adjusted Limited Dependent Variable Mixture Models

#' Extracting Parameters from Parameter Vector into Nested List.
#'
#' \code{aldvmm.getpar()} extracts parameters from parameter vectors into nested
#' lists.
#'
#' @inheritParams aldvmm.ll
#'
#' @details
#' \ifelse{html}{\code{\link[aldvmm]{aldvmm.getpar}}}{\code{aldvmm.getpar()}}
#' identifies parameters that belong to coefficients of component distributions
#' (label \code{"beta"}), coefficients of the multinomial logit model of
#' probabilities of component membership (label \code{"delta"}), constant
#' parameters of component distributions (label \code{"lnsigma"} for
#' \code{dist=="normal"}), and \code{1:K} components (labels "Comp1" ...
#' "CompK")) based on parameter names generated by
#' \ifelse{html}{\code{\link[aldvmm]{aldvmm.getnames}}}{\code{aldvmm.getnames()}}.
#'
#'
#' @return a named nested list with parameter vectors for \code{"beta"},
#'   \code{"delta"} and \code{"lnsigma"} within all \code{1:K} components. The
#'   names of the list correspond to the labels in \code{'lcoef'},
#'   \code{'lcpar'} and \code{'lcmp'}.
#'
#' @export

aldvmm.getpar <- function(par,
                          lcoef,
                          lcmp,
                          lcpar,
                          ncmp) {
  
  # Create vector of first characters of names to identify groups of values
  #------------------------------------------------------------------------
  
  stubs <- apply(expand.grid(paste0(lcmp, 1:ncmp), c(lcoef, lcpar)), 
                        1, 
                        paste, 
                        collapse = "_")
           
  parlist <- list()
  
  # Betas (coefficients on distribution parameters)
  #------------------------------------------------
  
  for (i in paste0(lcmp, 1:ncmp)) {
    
    val <- par[base::startsWith(names(par), stubs[grepl(lcoef[1], stubs) &
                                                    grepl(i, stubs)])]
    parlist[[lcoef[1]]][[i]] <- val
  }
  
  rm(val)
  
  # Deltas (coefficients for multinomial logit for group membership)
  #-----------------------------------------------------------------
  
  if (ncmp > 1) {
    for (i in paste0(lcmp, 1:(ncmp - 1))) {
      val <- par[base::startsWith(names(par), stubs[grepl(lcoef[2], stubs) &
                                                      grepl(i, stubs)])]
      parlist[[lcoef[2]]][[i]] <- val
    }
    rm(val)
  }
  
  # Constant distribution parameters
  #---------------------------------
  
  for (i in lcpar) {
    for (j in paste0(lcmp, 1:ncmp)) {
      val <- par[base::startsWith(names(par), stubs[grepl(i, stubs) &
                                                      grepl(j, stubs)])]
      parlist[[i]][[j]] <- val
    }
  }
  
  rm(val)
  
  return(parlist)
  
}