R/exportRSA.fit.R

In RSAtools: Advanced Response Surface Analysis

#' @title Export fit indices and names of polynomials models
#' @description Utilitary function to easily export fit indices of polynomial models (predefined or user-specific), including their proper theoretical names (for predefined polynomial families) and the fit indices used for comparison.
#' @param RSAcompare_object A list generated by \code{RSAcompare(RSA_object)}
#' @return A table of fit indices and names of polynomial families or user model
#' @export


exportRSA.fit <- function(RSAcompare_object){
	
FIT_raw <- RSAcompare_object$FIT	

###Round up to zero decimal
zerodecimal <- "LRT_df"
	for(i in 1:length(zerodecimal)){
zerodecimal_i <- FIT_raw[, zerodecimal[i]]
	zerodecimal_i <- formatC(as.numeric(zerodecimal_i),digits=0,format="f")
	zerodecimal_i <- gsub("NA","", zerodecimal_i,fixed=T)
FIT_raw[,zerodecimal[i]] <- zerodecimal_i	
		 }

###Round up to one decimal
onedecimal <- c("LRT_chi2","AIC","BIC")
	for(i in 1:length(onedecimal)){
onedecimal_i <- FIT_raw[, onedecimal[i]]
	onedecimal_i <- formatC(as.numeric(onedecimal_i),digits=1,format="f")
	onedecimal_i <- gsub("NA","", onedecimal_i,fixed=T)
FIT_raw[,onedecimal[i]] <- onedecimal_i	
		 }

###Round up to three decimal
threedecimals <- c("LRT_pvalue","wAIC","wBIC","R2","R2adj","CFI","TLI", "RMSEA","SRMR")
	for(i in 1:length(threedecimals)){
threedecimals_i <- FIT_raw[, threedecimals[i]]
	threedecimals_i <- formatC(as.numeric(threedecimals_i),digits=3,format="f")
	threedecimals_i <- gsub("NA","", threedecimals_i,fixed=T)
FIT_raw[,threedecimals[i]] <- threedecimals_i	
		 }

###Remove zero before decimals
nonzero <- c("LRT_pvalue","wAIC","wBIC","R2","R2adj")
	for(i in 1:length(nonzero)){
nonzero_i <- FIT_raw[,nonzero[i]]
	nonzero_i <- formatC(as.numeric(nonzero_i),digits=3,format="f")
	nonzero_i <- gsub("0.",".", as.factor(nonzero_i),fixed=T )
	nonzero_i <- gsub("NA","", nonzero_i,fixed=T)
FIT_raw[,nonzero[i]] <- nonzero_i	
		 }

###Rename models
    models_raw <- c("CUBIC","FM1_ONLYX","FM2_ONLYY","FM3_ADDITIVE","FM4_INTER","FM5_QUADX","FM6_QUADY","FM7_CONG","FM8_INCONG","FM9_CURVCONGX","FM10_CURVCONGY","FM11_CURVINCONGX","FM12_CURVINCONGY","FM13_QUADXQUADY","FM14_ROTCONG","FM15_ROTINCONG","FM16_CUBICX","FM17_CUBICY","FM18_LEVDEPQUADX","FM19_LEVDEPQUADY","FM20_ASYMCONG","FM21_ASYMINCONG","FM22_LEVDEPCONG","FM23_LEVDEPINCONG","FM24_PARALLELASYM","FM25_NONPARALLELASYM","FM26_PARALLELASYMWEAK","FM27_PARALLELASYMSTRONG","FM28_NONPARALLELASYMWEAK","FM29_NONPARALLELASYMSTRONG","FM30_ASYMCONGROTY","FM31_ASYMCONGROTX","FM32_ASYMINCONGROTY","FM33_ASYMINCONGROTX","FM34_LEVDEPCONGROTY","FM35_LEVDEPCONGROTX","FM36_LEVDEPINCONGROTY","FM37_LEVDEPINCONGROTX")

	models_clean <- c(
	"Cubic model (saturated model)","1. Main effect of X",	"2. Main effect of Y",	"3. Additive effects of X and Y",	"4. Interaction effect between X and Y",	"5. Quadratic effect of X",	"6. Quadratic effect of Y",	"7. Congruence effect",	"8. Incongruence effect",	"9. Congruence effect curved by X",	"10. Congruence effect curved by Y",	"11. Incongruence effect curved by X",	"12. Incongruence effect curved by Y",	"13. Quadratic effects of X and Y",	"14. Rotated congruence effect",	"15. Rotated incongruence effect",	"16. Cubic effect of X",	"17. Cubic effect of Y",	"18. Level-dependent quadratic effect of X",	"19. Level-dependent quadratic effect of Y",	"20. Asymmetric congruence effect",	"21. Asymmetric incongruence effect",	"22. Level-dependent congruence effect",	"23. Level-dependent incongruence effect",	"24. Parallel, asymmetric congruence and incongruence effects",	"25. Non-parallel, asymmetric congruence and incongruence effects",	"26. Parallel, asymmetric weak congruence and strong incongruence effects",	"27. Parallel, asymmetric strong congruence and weak incongruence effects",	"28. Non-parallel, asymmetric weak congruence and strong incongruence effects",	"29. Non-parallel, asymmetric strong congruence and weak incongruence effects",	"30. Asymmetric congruence effect rotated by Y",	"31. Asymmetric congruence effect rotated by X",	"32. Asymmetric incongruence effect rotated by Y",	"33. Asymmetric incongruence effect rotated by X",	"34. Level-dependent congruence effect rotated by Y",	"35. Level-dependent congruence effect rotated by X",	"36. Level-dependent incongruence effect rotated by Y",	"37. Level-dependent incongruence effect rotated by X"	)
	
for(i in 1:nrow(FIT_raw)){
oldname_i <- 	rownames(FIT_raw)[i] 
index_i <- which(models_raw==oldname_i)[1]
newname_i <- ifelse(!is.na(index_i),models_clean[index_i],oldname_i)
rownames(FIT_raw)[i] <- newname_i
}
FIT_out	 <- FIT_out #subset(FIT_raw,select=c(LRT_chi2: R2))
FIT_out[1,"LRT_pvalue"] <- "NA"
FIT_out	
}