#' A dataframe of the estimated shape parameters (Lambda) as well as expected improvement in OFV
#' when estimating a Box-Cox transformation for each subject-level random effect.
#'
#' @param directory A path of the qa run directory. Will search for the boxcox.ext file in the modelfit_run folder
#' and derivatives.ext file in the linearize_run/scm_dir1 folder.
#' @param dofv_boxcox A dofv value of the boxcox model.
#'
#' @return A list of two elements:
#' boxcox_lambdas_orig - A data frame with lambda and sd values from the boxcox and derivatives models.
#' boxcox_lambdas_table - A data frame with rounded lambda and sd values from the boxcox and derivatives models values, and added boxcox dofv value.
#' @export
get_boxcox_lambda_table <- function(directory,dofv_boxcox) {
#get lambda values (extra table for box-cox transformation)
if(file.exists(file.path(directory,"modelfit_run/boxcox.ext")) && file.exists(file.path(directory,"linearize_run/scm_dir1/derivatives.ext"))) {
ext_file <- read.table((file.path(directory,"modelfit_run/boxcox.ext")),header=TRUE,skip=1,stringsAsFactors = F) %>%
dplyr::filter(ITERATION==-1000000000)
lambdas <- ext_file[grep("^THETA[0-9]+$",colnames(ext_file))]
new_omega_values <- ext_file[,grep("^OMEGA",colnames(ext_file))]
#new_omega_values <- new_omega_values[,which(new_omega_values!=0)]
# omega values from original model
derivatives_table <-read.table((file.path(directory,"linearize_run/scm_dir1/derivatives.ext")),header=TRUE,skip=1,stringsAsFactors = F) %>%
dplyr::filter(ITERATION==-1000000000)
deriv_omega_values <- derivatives_table[,grep("^OMEGA",colnames(derivatives_table))]
#deriv_omega_values <- deriv_omega_values[,which(deriv_omega_values!=0)]
boxcox_lambdas_table <- as.data.frame(array(0,c(length(lambdas),4)))
colnames(boxcox_lambdas_table) <- c("","Lambda","New SD","Old SD")
for(i in 1:length(lambdas)) {
nr <- sub('*THETA','',colnames(lambdas)[i])
boxcox_lambdas_table[i,1] <- paste0("ETA(",nr,")")
boxcox_lambdas_table[i,2] <- lambdas[i]
boxcox_lambdas_table[i,3] <- sqrt(new_omega_values[,which(colnames(new_omega_values)==paste0("OMEGA.",nr,".",nr,"."))])
boxcox_lambdas_table[i,4] <- sqrt(deriv_omega_values[,which(colnames(deriv_omega_values)==paste0("OMEGA.",nr,".",nr,"."))])
}
boxcox_lambdas_orig <- boxcox_lambdas_table
colnames(boxcox_lambdas_orig) <- c("ETA","Lambda","New SD","Old SD")
boxcox_lambdas_table[,2] <- format(as.numeric(boxcox_lambdas_table[,2]),digits=1,trim=T,scientific = F,nsmall=2)
boxcox_lambdas_table[,3] <- format(as.numeric(boxcox_lambdas_table[,3]),digits=1,trim=T,scientific = F,nsmall=2)
boxcox_lambdas_table[,4] <- format(as.numeric(boxcox_lambdas_table[,4]),digits=1,trim=T,scientific = F,nsmall=2)
if(class(dofv_boxcox)!="character") {
boxcox_lambdas_table <- rbind(boxcox_lambdas_table,c("dOFV",format(dofv_boxcox,digits=1,scientific=F,nsmall=1),"",""))
}
} else {
boxcox_lambdas_table <- error_table(col=1)
boxcox_lambdas_orig <- boxcox_lambdas_table
}
out <- list(boxcox_lambdas_table=boxcox_lambdas_table,
boxcox_lambdas_orig=boxcox_lambdas_orig)
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.