#' Comparison table for best models with different transformations
#'
#' \code{bestfits} creates a table with AIC, Adjusted R2 and other statistics
#' for model comparisons. In order to make possible far comparisons, an adjusted
#' version of AIC for transformations is used.
#' @param obj object of class bestfit
#'
#' @examples
#' library(appraiseR)
#' library(sf)
#' data(centro_2015)
#' centro_2015 <- st_drop_geometry(centro_2015)
#' centro_2015 <- within(centro_2015, PU <- valor/area_total)
#' best_fit <- bestfit(PU ~ area_total + quartos + suites + garagens +
#' dist_b_mar + padrao, data = centro_2015,
#' transf = c("rec", "log", "sqrt"))
#' (b <- bestfits(best_fit))
#'
#' library(sjPlot)
#' tab_model(b$models, show.aic = T)
#'
#' @export
bestfits <- function(obj, ...){
tabela <- obj$tab
preds <- obj$predictors
DepVarTransfs <- unique(tabela[, obj$response])
DF <- list()
for (i in DepVarTransfs){
tab <- tabela[which(tabela[, obj$response] == i), ]
DF[[i]] <- tab[which.min(tab$AIC), ]
}
DF <- as.data.frame(t(sapply(DF, FUN = rbind, simplify = T)))
models <- list()
for (i in seq_len(nrow(DF))) {
LHS <- paste0(base::subset(tabela, id == DF$id[i],
select = obj$response, drop = TRUE),
"(", obj$response, ")")
if (length(preds)>0) {
terms_x <- sapply(preds, function (x) paste0(base::subset(tabela,
id == DF$id[i],
select = x,
drop = TRUE),
"(", x, ")"))
RHS <- paste0(terms_x, collapse = " + ")
} else {
RHS <- " 1"
}
f <- as.formula(paste0(LHS, " ~ ", RHS))
if(!is.null(obj$call$extras)) {
extras <- eval(obj$call$extras, environment(formula(obj)))
ff <- foo ~ bar + baz
if (is.call(extras))
gg <- extras
else
gg <- parse(text=paste("~", paste(extras, collapse="+")))[[1L]]
ff[[2L]] <- f[[2L]]
ff[[3L]][[2L]] <- f[[3L]]
ff[[3L]][[3L]] <- gg[[2L]]
} else {
ff <- f
}
args <- list(ff, data = eval(stats::getCall(obj)$data,
environment(formula(obj))))
args$subset <- obj$subset
models[[i]] <- do.call("lm", args)
# g <- call("lm", ff, eval(stats::getCall(obj)$data,
# environment(formula(obj))))
# models[[i]] <- eval(g)
DF$adj_AIC[i] <- round(aic(models[[i]]), 2)
DF$adj_AICc[i] <- round(aicc(models[[i]]), 2)
}
DF <- DF[order(DF$adj_AIC), ]
z <- list()
z$df <- DF
z$models <- models
class(z) <- "bestfits"
return(z)
}
#' @export
print.bestfits <- function(x, ...){
cat("Bestfits:\n")
print(x$df[, setdiff(colnames(x$df), "BIC")])
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.