#' Internal, sort initial values from cxr_pm/er_fit in an appropriate way
#'
#' @inheritParams cxr_pm_fit
#' @param model_type either 'pm' or 'er'
#' @param neigh_intra name of neigh_intra column
#' @param neigh_inter names of neigh_inter_columns
#'
#' @return list with named initial values and fixed terms
#' @noRd
#'
cxr_get_init_params <- function(initial_values,
fixed_terms,
alpha_form,
lambda_cov_form,
alpha_cov_form,
model_type = "pm",
neigh_intra,
neigh_inter,
covariates){
# here I store values for fixed parameters
fixed_parameters <- list()
# here I store initial values for fitted parameters
init_lambda <- NULL
init_alpha_intra <- NULL
init_alpha_inter <- NULL
init_lambda_cov <- NULL
init_alpha_cov <- NULL
# initialize params with appropriate length,
# depending or not on whether they should be fixed
if("lambda" %in% names(fixed_terms)){
fixed_parameters[["lambda"]] <- fixed_terms[["lambda"]]
}else{
init_lambda <- initial_values[["lambda"]]
names(init_lambda) <- "lambda"
}
if(!is.null(initial_values$sigma)){
init_sigma <- initial_values[["sigma"]]
}else{
init_sigma <- 0.1
}
names(init_sigma) <- "sigma"
# return_init_length is an auxiliary function
# in case initial values are not of the same length of the expected parameters
# e.g. if we want to fit pairwise alphas but only provide a single initial value
if(alpha_form != "none"){
if(alpha_form == "global"){
# global alpha
# use alpha_inter as values
if("alpha_inter" %in% names(fixed_terms)){
fixed_parameters[["alpha_inter"]] <- fixed_terms[["alpha_inter"]]
}else{
init_alpha_inter <- initial_values[["alpha_inter"]]
names(init_alpha_inter) <- "alpha"
}
}else{
# pairwise alphas
# alpha_intra
if("alpha_intra" %in% names(fixed_terms)){
fixed_parameters[["alpha_intra"]] <- fixed_terms[["alpha_intra"]]
}else{
if(!is.null(neigh_intra)){
init_alpha_intra <- initial_values[["alpha_intra"]]
names(init_alpha_intra) <- neigh_intra
}
}
# alpha_inter
if("alpha_inter" %in% names(fixed_terms)){
fixed_parameters[["alpha_inter"]] <- cxr_return_init_length(alpha_form,
fixed_terms[["alpha_inter"]],
neigh_inter,"pm")
}else{
init_alpha_inter <- cxr_return_init_length(alpha_form,
initial_values[["alpha_inter"]],
neigh_inter,"pm")
}
}# if-else alpha form
}# if alpha_form != none
if(lambda_cov_form != "none" & !is.null(covariates)){
if("lambda_cov" %in% names(fixed_terms)){
fixed_parameters[["lambda_cov"]] <- cxr_return_init_length(lambda_cov_form,
fixed_terms[["lambda_cov"]],
colnames(covariates),"pm")
}else{
init_lambda_cov <- cxr_return_init_length(lambda_cov_form,
initial_values[["lambda_cov"]],
colnames(covariates),"pm")
names(init_lambda_cov) <- paste("lambda_cov_",colnames(covariates),sep="")
}
}
if(alpha_cov_form != "none" & !is.null(covariates)){
if(alpha_cov_form == "global"){
name.alpha.cov <- paste("alpha_cov_",colnames(covariates),sep="")
}else{
all_neigh <- c(neigh_intra,neigh_inter)
name.alpha.cov <- paste("alpha_cov",rep(colnames(covariates),
each = length(all_neigh)),
rep(all_neigh,ncol(covariates)),sep="_")
}
if("alpha_cov" %in% names(fixed_terms)){
fixed_parameters[["alpha_cov"]] <- cxr_return_init_length(alpha_cov_form,
fixed_terms[["alpha_cov"]],
name.alpha.cov,"pm")
}else{
init_alpha_cov <- cxr_return_init_length(par_type = alpha_cov_form,
par_value = initial_values[["alpha_cov"]],
par_names = name.alpha.cov,"pm")
}
}
list(init_lambda = init_lambda,
init_alpha_intra = init_alpha_intra,
init_alpha_inter = init_alpha_inter,
init_lambda_cov = init_lambda_cov,
init_alpha_cov = init_alpha_cov,
init_sigma = init_sigma,
fixed_parameters = fixed_parameters)
} # function
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.