From d491133c55fb66322c75f815cbdefdd20951ba6c Mon Sep 17 00:00:00 2001 From: AminHP Date: Sun, 7 Jun 2020 00:20:18 +0430 Subject: [PATCH] Add stepwise selection algorithms using Adjusted R-Squared metric --- NAMESPACE | 15 ++ R/ols-steparsq-backward-regression.R | 350 ++++++++++++++++++++++++ R/ols-steparsq-both-regression.R | 390 +++++++++++++++++++++++++++ R/ols-steparsq-forward-regression.R | 365 +++++++++++++++++++++++++ R/output.R | 5 + man/ols_step_backward_arsq.Rd | 84 ++++++ man/ols_step_both_arsq.Rd | 83 ++++++ man/ols_step_forward_arsq.Rd | 92 +++++++ 8 files changed, 1384 insertions(+) create mode 100644 R/ols-steparsq-backward-regression.R create mode 100644 R/ols-steparsq-both-regression.R create mode 100644 R/ols-steparsq-forward-regression.R create mode 100644 man/ols_step_backward_arsq.Rd create mode 100644 man/ols_step_both_arsq.Rd create mode 100644 man/ols_step_forward_arsq.Rd diff --git a/NAMESPACE b/NAMESPACE index 3374b98c..1c9bcb63 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,11 +7,14 @@ S3method(ols_regress,default) S3method(ols_regress,lm) S3method(ols_step_all_possible,default) S3method(ols_step_backward_aic,default) +S3method(ols_step_backward_arsq,default) S3method(ols_step_backward_p,default) S3method(ols_step_best_subset,default) S3method(ols_step_both_aic,default) +S3method(ols_step_both_arsq,default) S3method(ols_step_both_p,default) S3method(ols_step_forward_aic,default) +S3method(ols_step_forward_arsq,default) S3method(ols_step_forward_p,default) S3method(ols_test_bartlett,default) S3method(ols_test_breusch_pagan,default) @@ -21,11 +24,14 @@ S3method(ols_test_normality,lm) S3method(ols_test_score,default) S3method(plot,ols_step_all_possible) S3method(plot,ols_step_backward_aic) +S3method(plot,ols_step_backward_arsq) S3method(plot,ols_step_backward_p) S3method(plot,ols_step_best_subset) S3method(plot,ols_step_both_aic) +S3method(plot,ols_step_both_arsq) S3method(plot,ols_step_both_p) S3method(plot,ols_step_forward_aic) +S3method(plot,ols_step_forward_arsq) S3method(plot,ols_step_forward_p) S3method(print,ols_coll_diag) S3method(print,ols_correlations) @@ -33,11 +39,14 @@ S3method(print,ols_pure_error_anova) S3method(print,ols_regress) S3method(print,ols_step_all_possible) S3method(print,ols_step_backward_aic) +S3method(print,ols_step_backward_arsq) S3method(print,ols_step_backward_p) S3method(print,ols_step_best_subset) S3method(print,ols_step_both_aic) +S3method(print,ols_step_both_arsq) S3method(print,ols_step_both_p) S3method(print,ols_step_forward_aic) +S3method(print,ols_step_forward_arsq) S3method(print,ols_step_forward_p) S3method(print,ols_test_bartlett) S3method(print,ols_test_breusch_pagan) @@ -138,16 +147,22 @@ export(ols_step_all_possible) export(ols_step_all_possible_betas) export(ols_step_backward) export(ols_step_backward_aic) +export(ols_step_backward_arsq) export(ols_step_backward_p) export(ols_step_best_subset) export(ols_step_both_aic) +export(ols_step_both_arsq) export(ols_step_both_p) export(ols_step_forward) export(ols_step_forward_aic) +export(ols_step_forward_arsq) export(ols_step_forward_p) export(ols_stepaic_backward) export(ols_stepaic_both) export(ols_stepaic_forward) +export(ols_steparsq_backward) +export(ols_steparsq_both) +export(ols_steparsq_forward) export(ols_stepwise) export(ols_test_bartlett) export(ols_test_breusch_pagan) diff --git a/R/ols-steparsq-backward-regression.R b/R/ols-steparsq-backward-regression.R new file mode 100644 index 00000000..29d690a7 --- /dev/null +++ b/R/ols-steparsq-backward-regression.R @@ -0,0 +1,350 @@ +#' Stepwise Adjusted R-Squared backward regression +#' +#' @description +#' Build regression model from a set of candidate predictor variables by +#' removing predictors based on adjusted R-squared, in a stepwise +#' manner until there is no variable left to remove any more. +#' +#' @param model An object of class \code{lm}; the model should include all +#' candidate predictor variables. +#' @param progress Logical; if \code{TRUE}, will display variable selection progress. +#' @param details Logical; if \code{TRUE}, will print the regression result at +#' each step. +#' @param x An object of class \code{ols_step_backward_arsq}. +#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a plot object. +#' @param ... Other arguments. +#' +#' @return \code{ols_step_backward_arsq} returns an object of class \code{"ols_step_backward_arsq"}. +#' An object of class \code{"ols_step_backward_arsq"} is a list containing the +#' following components: +#' +#' \item{model}{model with the highest ARSQ; an object of class \code{lm}} +#' \item{steps}{total number of steps} +#' \item{predictors}{variables removed from the model} +#' \item{aics}{akaike information criteria} +#' \item{ess}{error sum of squares} +#' \item{rss}{regression sum of squares} +#' \item{rsq}{rsquare} +#' \item{arsq}{adjusted rsquare} +#' +#' @references +#' Venables, W. N. and Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth edition. Springer. +#' +#' @section Deprecated Function: +#' \code{ols_steparsq_backward()} has been deprecated. Instead use \code{ols_step_backward_arsq()}. +#' +#' @examples +#' # stepwise backward regression +#' model <- lm(y ~ ., data = surgical) +#' ols_step_backward_arsq(model) +#' +#' # stepwise backward regression plot +#' model <- lm(y ~ ., data = surgical) +#' k <- ols_step_backward_arsq(model) +#' plot(k) +#' +#' # final model +#' k$model +#' +#' @importFrom ggplot2 geom_text +#' @importFrom utils tail +#' +#' @family variable selection procedures +#' +#' @export +#' +ols_step_backward_arsq <- function(model, ...) UseMethod("ols_step_backward_arsq") + +#' @export +#' @rdname ols_step_backward_arsq +#' +ols_step_backward_arsq.default <- function(model, progress = FALSE, details = FALSE, ...) { + + if (details) { + progress <- TRUE + } + + check_model(model) + check_logic(details) + check_npredictors(model, 3) + + response <- names(model$model)[1] + l <- mod_sel_data(model) + nam <- coeff_names(model) + preds <- nam + arsq_f <- summary(model)$adj.r.squared + + mi <- ols_regress(paste(response, "~", paste(preds, collapse = " + ")), data = l) + rss_f <- mi$rss + laic <- ols_aic(model) + lrss <- rss_f + less <- mi$ess + lrsq <- mi$rsq + larsq <- arsq_f + + if (progress) { + cat(format("Backward Elimination Method", justify = "left", width = 27), "\n") + cat(rep("-", 27), sep = "", "\n\n") + cat(format("Candidate Terms:", justify = "left", width = 16), "\n\n") + for (i in seq_len(length(nam))) { + cat(paste(i, ".", nam[i]), "\n") + } + cat("\n") + } + + if (details) { + cat(" Step 0: ARSQ =", arsq_f, "\n", paste(response, "~", paste(preds, collapse = " + "), "\n\n")) + } + + ilp <- length(preds) + end <- FALSE + step <- 0 + rpred <- c() + aics <- c() + ess <- c() + rss <- c() + rsq <- c() + arsq <- c() + + for (i in seq_len(ilp)) { + + predictors <- preds[-i] + + m <- ols_regress(paste(response, "~", paste(predictors, collapse = " + ")), data = l) + + aics[i] <- ols_aic(m$model) + ess[i] <- m$ess + rss[i] <- rss_f - m$rss + rsq[i] <- m$rsq + arsq[i] <- m$adjr + } + + da <- data.frame(predictors = preds, aics = aics, ess = ess, rss = rss, rsq = rsq, arsq = arsq) + da2 <- da[order(da$rss), ] + # da2 <- arrange(da, rss) + + if (details) { + w1 <- max(nchar("Predictor"), nchar(predictors)) + w2 <- 2 + w3 <- max(nchar("AIC"), nchar(format(round(aics, 3), nsmall = 3))) + w4 <- max(nchar("Sum Sq"), nchar(format(round(rss, 3), nsmall = 3))) + w5 <- max(nchar("RSS"), nchar(format(round(ess, 3), nsmall = 3))) + w6 <- max(nchar("R-Sq"), nchar(format(round(rsq, 3), nsmall = 3))) + w7 <- max(nchar("Adj. R-Sq"), nchar(format(round(arsq, 3), nsmall = 3))) + w <- sum(w1, w2, w3, w4, w5, w6, w7, 24) + ln <- length(arsq) + + cat(rep("-", w), sep = "", "\n") + cat( + fl("Variable", w1), fs(), fc("DF", w2), fs(), fc("AIC", w3), fs(), + fc("Sum Sq", w4), fs(), fc("RSS", w5), fs(), fc("R-Sq", w6), fs(), + fc("Adj. R-Sq", w7), "\n" + ) + cat(rep("-", w), sep = "", "\n") + + for (i in seq_len(ln)) { + cat( + fl(da2[i, 1], w1), fs(), fc(1, w2), fs(), fg(format(round(da2[i, 2], 3), nsmall = 3), w3), fs(), + fg(format(round(da2[i, 4], 3), nsmall = 3), w4), fs(), fg(format(round(da2[i, 3], 3), nsmall = 3), w5), fs(), + fg(format(round(da2[i, 5], 3), nsmall = 3), w6), fs(), fg(format(round(da2[i, 6], 3), nsmall = 3), w7), "\n" + ) + } + + cat(rep("-", w), sep = "", "\n\n") + } + + if (progress) { + cat("\n") + cat("Variables Removed:", "\n\n") + } + + while (!end) { + maxc <- which(arsq == max(arsq)) + + if (arsq[maxc] > arsq_f) { + + rpred <- c(rpred, preds[maxc]) + preds <- preds[-maxc] + ilp <- length(preds) + step <- step + 1 + arsq_f <- arsq[maxc] + + mi <- ols_regress(paste(response, "~", paste(preds, collapse = " + ")), + data = l) + + rss_f <- mi$rss + laic <- c(laic, aics[maxc]) + lrss <- c(lrss, rss_f) + less <- c(less, mi$ess) + lrsq <- c(lrsq, mi$rsq) + larsq <- c(larsq, arsq_f) + aics <- c() + ess <- c() + rss <- c() + rsq <- c() + arsq <- c() + + if (progress) { + if (interactive()) { + cat("x", tail(rpred, n = 1), "\n") + } else { + cat(paste("-", tail(rpred, n = 1)), "\n") + } + } + + for (i in seq_len(ilp)) { + + predictors <- preds[-i] + + m <- ols_regress(paste(response, "~", + paste(predictors, collapse = " + ")), data = l) + + aics[i] <- ols_aic(m$model) + ess[i] <- m$ess + rss[i] <- rss_f - m$rss + rsq[i] <- m$rsq + arsq[i] <- m$adjr + } + + + if (details) { + cat("\n\n", " Step", step, ": ARSQ =", arsq_f, "\n", paste(response, "~", paste(preds, collapse = " + "), "\n\n")) + + + da <- data.frame(predictors = preds, aics = aics, ess = ess, rss = rss, rsq = rsq, arsq = arsq) + da2 <- da[order(da$rss), ] + # da2 <- arrange(da, rss) + w1 <- max(nchar("Predictor"), nchar(predictors)) + w2 <- 2 + w3 <- max(nchar("AIC"), nchar(format(round(aics, 3), nsmall = 3))) + w4 <- max(nchar("Sum Sq"), nchar(format(round(rss, 3), nsmall = 3))) + w5 <- max(nchar("RSS"), nchar(format(round(ess, 3), nsmall = 3))) + w6 <- max(nchar("R-Sq"), nchar(format(round(rsq, 3), nsmall = 3))) + w7 <- max(nchar("Adj. R-Sq"), nchar(format(round(arsq, 3), nsmall = 3))) + w <- sum(w1, w2, w3, w4, w5, w6, w7, 24) + ln <- length(arsq) + + cat(rep("-", w), sep = "", "\n") + cat( + fl("Variable", w1), fs(), fc("DF", w2), fs(), fc("ARSQ", w3), fs(), + fc("Sum Sq", w4), fs(), fc("RSS", w5), fs(), fc("R-Sq", w6), fs(), + fc("Adj. R-Sq", w7), "\n" + ) + cat(rep("-", w), sep = "", "\n") + + for (i in seq_len(ln)) { + cat( + fl(da2[i, 1], w1), fs(), fc(1, w2), fs(), fg(format(round(da2[i, 2], 3), nsmall = 3), w3), fs(), + fg(format(round(da2[i, 4], 3), nsmall = 3), w4), fs(), fg(format(round(da2[i, 3], 3), nsmall = 3), w5), fs(), + fg(format(round(da2[i, 5], 3), nsmall = 3), w6), fs(), fg(format(round(da2[i, 6], 3), nsmall = 3), w7), "\n" + ) + } + + cat(rep("-", w), sep = "", "\n\n") + } + } else { + end <- TRUE + if (progress) { + cat("\n") + cat("No more variables to be removed.") + } + } + } + + + if (details) { + cat("\n\n") + cat("Variables Removed:", "\n\n") + for (i in seq_len(length(rpred))) { + if (interactive()) { + cat("x", rpred[i], "\n") + } else { + cat(paste("-", rpred[i]), "\n") + } + } + } + + if (progress) { + cat("\n\n") + cat("Final Model Output", "\n") + cat(rep("-", 18), sep = "", "\n\n") + + fi <- ols_regress( + paste(response, "~", paste(preds, collapse = " + ")), + data = l + ) + print(fi) + } + + final_model <- lm(paste(response, "~", paste(preds, collapse = " + ")), data = l) + + out <- list(predictors = rpred, + steps = step, + arsq = larsq, + aics = laic, + ess = less, + rss = lrss, + rsq = lrsq, + model = final_model) + + class(out) <- "ols_step_backward_arsq" + + return(out) +} + +#' @export +#' +print.ols_step_backward_arsq <- function(x, ...) { + if (x$steps > 0) { + print_steparsq_backward(x) + } else { + print("No variables have been removed from the model.") + } +} + +#' @rdname ols_step_backward_arsq +#' @export +#' +plot.ols_step_backward_arsq <- function(x, print_plot = TRUE, ...) { + + steps <- NULL + arsq <- NULL + tx <- NULL + a <- NULL + b <- NULL + + y <- c(0, seq_len(x$steps)) + xloc <- y - 0.1 + yloc <- x$arsq - 0.2 + xmin <- min(y) - 0.4 + xmax <- max(y) + 1 + ymin <- min(x$arsq) - 1 + ymax <- max(x$arsq) + 1 + + predictors <- c("Full Model", x$predictors) + + d2 <- data.frame(x = xloc, y = yloc, tx = predictors) + d <- data.frame(a = y, b = x$arsq) + + p <- + ggplot(d, aes(x = a, y = b)) + geom_line(color = "blue") + + geom_point(color = "blue", shape = 1, size = 2) + xlim(c(xmin, xmax)) + + ylim(c(ymin, ymax)) + xlab("Step") + ylab("ARSQ") + + ggtitle("Stepwise Adj. R-Sq Backward Elimination") + + geom_text(data = d2, aes(x = x, y = y, label = tx), hjust = 0, nudge_x = 0.1) + + if (print_plot) { + print(p) + } else { + return(p) + } + +} + +#' @export +#' @rdname ols_step_backward_arsq +#' @usage NULL +#' +ols_steparsq_backward <- function(model, details = FALSE, ...) { + .Deprecated("ols_step_backward_arsq()") +} diff --git a/R/ols-steparsq-both-regression.R b/R/ols-steparsq-both-regression.R new file mode 100644 index 00000000..8b17b4e1 --- /dev/null +++ b/R/ols-steparsq-both-regression.R @@ -0,0 +1,390 @@ +#' Stepwise Adjusted R-Squared regression +#' +#' @description +#' Build regression model from a set of candidate predictor variables by +#' entering and removing predictors based on adjusted R-squared, in a +#' stepwise manner until there is no variable left to enter or remove any more. +#' +#' @param model An object of class \code{lm}. +#' @param x An object of class \code{ols_step_both_arsq}. +#' @param progress Logical; if \code{TRUE}, will display variable selection progress. +#' @param details Logical; if \code{TRUE}, details of variable selection will +#' be printed on screen. +#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a plot object. +#' @param ... Other arguments. +#' +#' @return \code{ols_step_both_arsq} returns an object of class \code{"ols_step_both_arsq"}. +#' An object of class \code{"ols_step_both_arsq"} is a list containing the +#' following components: +#' +#' \item{model}{model with the highest ARSQ; an object of class \code{lm}} +#' \item{predictors}{variables added/removed from the model} +#' \item{method}{addition/deletion} +#' \item{aics}{akaike information criteria} +#' \item{ess}{error sum of squares} +#' \item{rss}{regression sum of squares} +#' \item{rsq}{rsquare} +#' \item{arsq}{adjusted rsquare} +#' \item{steps}{total number of steps} +#' +#' @references +#' Venables, W. N. and Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth edition. Springer. +#' +#' @section Deprecated Function: +#' \code{ols_steparsq_both()} has been deprecated. Instead use \code{ols_step_both_arsq()}. +#' +#' @examples +#' \dontrun{ +#' # stepwise regression +#' model <- lm(y ~ ., data = stepdata) +#' ols_step_both_arsq(model) +#' +#' # stepwise regression plot +#' model <- lm(y ~ ., data = stepdata) +#' k <- ols_step_both_arsq(model) +#' plot(k) +#' +#' # final model +#' k$model +#' +#' } +#' @family variable selection procedures +#' +#' @export +#' +ols_step_both_arsq <- function(model, progress = FALSE, details = FALSE) UseMethod("ols_step_both_arsq") + +#' @export +#' +ols_step_both_arsq.default <- function(model, progress = FALSE, details = FALSE) { + + if (details) { + progress <- TRUE + } + + check_model(model) + check_logic(details) + check_npredictors(model, 3) + + response <- names(model$model)[1] + l <- mod_sel_data(model) + nam <- coeff_names(model) + predictors <- nam + mlen_p <- length(predictors) + tech <- c("addition", "removal") + mo <- lm(paste(response, "~", 1), data = l) + arsq_c <- summary(mo)$adj.r.squared + + if (progress) { + cat(format("Stepwise Selection Method", justify = "left", width = 25), "\n") + cat(rep("-", 25), sep = "", "\n\n") + cat(format("Candidate Terms:", justify = "left", width = 16), "\n\n") + for (i in seq_len(length(nam))) { + cat(paste(i, ".", nam[i]), "\n") + } + cat("\n") + } + + if (details) { + cat(" Step 0: ARSQ =", arsq_c, "\n", paste(response, "~", 1, "\n\n")) + } + + step <- 0 + all_step <- 0 + preds <- c() + var_index <- c() + method <- c() + laic <- c() + less <- c() + lrss <- c() + lrsq <- c() + larsq <- c() + + if (progress) { + cat("\n") + cat("Variables Entered/Removed:", "\n\n") + } + + while (step < mlen_p) { + + aics <- c() + ess <- c() + rss <- c() + rsq <- c() + arsq <- c() + lpds <- length(predictors) + + for (i in seq_len(lpds)) { + + predn <- c(preds, predictors[i]) + + m <- ols_regress(paste(response, "~", paste(predn, collapse = " + ")), data = l) + + aics[i] <- ols_aic(m$model) + ess[i] <- m$ess + rss[i] <- m$rss + rsq[i] <- m$rsq + arsq[i] <- m$adjr + } + + da <- data.frame(predictors = predictors, aics = aics, ess = ess, rss = rss, rsq = rsq, arsq = arsq) + # da2 <- arrange(da, desc(rss)) + da2 <- da[order(-da$rss), ] + + if (details) { + w1 <- max(nchar("Predictor"), nchar(predictors)) + w2 <- 2 + w3 <- max(nchar("AIC"), nchar(format(round(aics, 3), nsmall = 3))) + w4 <- max(nchar("Sum Sq"), nchar(format(round(rss, 3), nsmall = 3))) + w5 <- max(nchar("RSS"), nchar(format(round(ess, 3), nsmall = 3))) + w6 <- max(nchar("R-Sq"), nchar(format(round(rsq, 3), nsmall = 3))) + w7 <- max(nchar("Adj. R-Sq"), nchar(format(round(arsq, 3), nsmall = 3))) + w <- sum(w1, w2, w3, w4, w5, w6, w7, 24) + ln <- length(arsq) + + cat(fc(" Enter New Variables", w), sep = "", "\n") + cat(rep("-", w), sep = "", "\n") + cat( + fl("Variable", w1), fs(), fc("DF", w2), fs(), fc("AIC", w3), fs(), + fc("Sum Sq", w4), fs(), fc("RSS", w5), fs(), fc("R-Sq", w6), fs(), + fc("Adj. R-Sq", w7), "\n" + ) + cat(rep("-", w), sep = "", "\n") + + for (i in seq_len(ln)) { + cat( + fl(da2[i, 1], w1), fs(), fg(1, w2), fs(), fg(format(round(da2[i, 2], 3), nsmall = 3), w3), fs(), + fg(format(round(da2[i, 4], 3), nsmall = 3), w4), fs(), fg(format(round(da2[i, 3], 3), nsmall = 3), w5), fs(), + fg(format(round(da2[i, 5], 3), nsmall = 3), w6), fs(), + fg(format(round(da2[i, 6], 3), nsmall = 3), w7), "\n" + ) + } + + cat(rep("-", w), sep = "", "\n\n") + } + + + maxc <- which(arsq == max(arsq)) + + if (arsq[maxc] > arsq_c) { + arsq_c <- arsq[maxc] + preds <- c(preds, predictors[maxc]) + predictors <- predictors[-maxc] + lpds <- length(predictors) + method <- c(method, tech[1]) + lpreds <- length(preds) + var_index <- c(var_index, preds[lpreds]) + step <- step + 1 + all_step <- all_step + 1 + maic <- aics[maxc] + mess <- ess[maxc] + mrss <- rss[maxc] + mrsq <- rsq[maxc] + marsq <- arsq[maxc] + laic <- c(laic, maic) + less <- c(less, mess) + lrss <- c(lrss, mrss) + lrsq <- c(lrsq, mrsq) + larsq <- c(larsq, marsq) + + if (progress) { + if (interactive()) { + cat("+", tail(preds, n = 1), "\n") + } else { + cat(paste("-", tail(preds, n = 1), "added"), "\n") + } + } + + if (details) { + cat("\n\n", "Step", all_step, ": ARSQ =", marsq, "\n", paste(response, "~", paste(preds, collapse = " + ")), "\n\n") + } + + if (lpreds > 1) { + + aics <- c() + ess <- c() + rss <- c() + rsq <- c() + arsq <- c() + + for (i in seq_len(lpreds)) { + + preda <- preds[-i] + + m <- ols_regress(paste(response, "~", paste(preda, collapse = " + ")), data = l) + + aics[i] <- ols_aic(m$model) + ess[i] <- m$ess + rss[i] <- m$rss + rsq[i] <- m$rsq + arsq[i] <- m$adjr + } + + da <- data.frame(predictors = preds, aics = aics, ess = ess, rss = rss, rsq = rsq, arsq = arsq) + # da2 <- arrange(da, desc(rss)) + da2 <- da[order(-da$rss), ] + + if (details) { + w1 <- max(nchar("Predictor"), nchar(preds)) + w2 <- 2 + w3 <- max(nchar("AIC"), nchar(format(round(aics, 3), nsmall = 3))) + w4 <- max(nchar("Sum Sq"), nchar(format(round(rss, 3), nsmall = 3))) + w5 <- max(nchar("RSS"), nchar(format(round(ess, 3), nsmall = 3))) + w6 <- max(nchar("R-Sq"), nchar(format(round(rsq, 3), nsmall = 3))) + w7 <- max(nchar("Adj. R-Sq"), nchar(format(round(arsq, 3), nsmall = 3))) + w <- sum(w1, w2, w3, w4, w5, w6, w7, 24) + ln <- length(arsq) + + cat(fc("Remove Existing Variables", w), sep = "", "\n") + cat(rep("-", w), sep = "", "\n") + cat( + fl("Variable", w1), fs(), fc("DF", w2), fs(), fc("AIC", w3), fs(), + fc("Sum Sq", w4), fs(), fc("RSS", w5), fs(), fc("R-Sq", w6), fs(), + fc("Adj. R-Sq", w7), "\n" + ) + cat(rep("-", w), sep = "", "\n") + + for (i in seq_len(ln)) { + cat( + fl(da2[i, 1], w1), fs(), fg(1, w2), fs(), fg(format(round(da2[i, 2], 3), nsmall = 3), w3), fs(), + fg(format(round(da2[i, 4], 3), nsmall = 3), w4), fs(), fg(format(round(da2[i, 3], 3), nsmall = 3), w5), fs(), + fg(format(round(da2[i, 5], 3), nsmall = 3), w6), fs(), + fg(format(round(da2[i, 6], 3), nsmall = 3), w7), "\n" + ) + } + + cat(rep("-", w), sep = "", "\n\n") + } + + + maxc2 <- which(arsq == max(arsq)) + + + if (arsq[maxc2] > larsq[all_step]) { + arsq_c <- arsq[maxc2] + maic <- aics[maxc2] + mess <- ess[maxc2] + mrss <- rss[maxc2] + mrsq <- rsq[maxc2] + marsq <- arsq[maxc2] + laic <- c(laic, maic) + less <- c(less, mess) + lrss <- c(lrss, mrss) + lrsq <- c(lrsq, mrsq) + larsq <- c(larsq, marsq) + var_index <- c(var_index, preds[maxc2]) + method <- c(method, tech[2]) + all_step <- all_step + 1 + + if (progress) { + if (interactive()) { + cat("x", preds[maxc2], "\n") + } else { + cat(paste("-", preds[maxc2], "removed"), "\n") + } + } + + preds <- preds[-maxc2] + lpreds <- length(preds) + + if (details) { + cat("\n\n", "Step", all_step, ": ARSQ =", marsq, "\n", paste(response, "~", paste(preds, collapse = " + ")), "\n\n") + } + } + } else { + preds <- preds + all_step <- all_step + } + } else { + if (progress) { + cat("\n") + cat("No more variables to be added or removed.") + } + break + } + } + + if (progress) { + cat("\n\n") + cat("Final Model Output", "\n") + cat(rep("-", 18), sep = "", "\n\n") + + fi <- ols_regress( + paste(response, "~", paste(preds, collapse = " + ")), + data = l + ) + print(fi) + } + + final_model <- lm(paste(response, "~", paste(preds, collapse = " + ")), data = l) + + out <- list(predictors = var_index, + method = method, + steps = all_step, + arsq = larsq, + aic = laic, + ess = less, + rss = lrss, + rsq = lrsq) + + class(out) <- "ols_step_both_arsq" + + return(out) +} + +#' @export +#' +print.ols_step_both_arsq <- function(x, ...) { + if (x$steps > 0) { + print_steparsq_both(x) + } else { + print("No variables have been added to or removed from the model.") + } +} + +#' @rdname ols_step_both_arsq +#' @export +#' +plot.ols_step_both_arsq <- function(x, print_plot = TRUE, ...) { + + arsq <- NULL + tx <- NULL + a <- NULL + b <- NULL + + predictors <- x$predictors + + y <- seq_len(length(x$arsq)) + xloc <- y - 0.1 + yloc <- x$arsq - 0.2 + xmin <- min(y) - 0.4 + xmax <- max(y) + 1 + ymin <- min(x$arsq) - 1 + ymax <- max(x$arsq) + 1 + + d2 <- data.frame(x = xloc, y = yloc, tx = predictors) + d <- data.frame(a = y, b = x$arsq) + + p <- + ggplot(d, aes(x = a, y = b)) + geom_line(color = "blue") + + geom_point(color = "blue", shape = 1, size = 2) + xlim(c(xmin, xmax)) + + ylim(c(ymin, ymax)) + xlab("Step") + ylab("ARSQ") + + ggtitle("Stepwise Adj. R-Sq Both Direction Selection") + + geom_text(data = d2, aes(x = x, y = y, label = tx), hjust = 0, nudge_x = 0.1) + + if (print_plot) { + print(p) + } else { + return(p) + } + +} + + +#' @export +#' @rdname ols_step_both_arsq +#' @usage NULL +#' +ols_steparsq_both <- function(model, details = FALSE) { + .Deprecated("ols_step_both_arsq()") +} diff --git a/R/ols-steparsq-forward-regression.R b/R/ols-steparsq-forward-regression.R new file mode 100644 index 00000000..63cf49ec --- /dev/null +++ b/R/ols-steparsq-forward-regression.R @@ -0,0 +1,365 @@ +#' Stepwise Adjusted R-Squared forward regression +#' +#' @description +#' Build regression model from a set of candidate predictor variables by +#' entering predictors based on adjusted R-squared, in a stepwise +#' manner until there is no variable left to enter any more, or a maximum step has been reached. +#' +#' @param model An object of class \code{lm}. +#' @param max_steps Integer; if not \code{NULL}, will specify the maximum number of steps. +#' @param progress Logical; if \code{TRUE}, will display variable selection progress. +#' @param details Logical; if \code{TRUE}, will print the regression result at +#' each step. +#' @param x An object of class \code{ols_step_forward_arsq}. +#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a plot object. +#' @param ... Other arguments. +#' @return \code{ols_step_forward_arsq} returns an object of class \code{"ols_step_forward_arsq"}. +#' An object of class \code{"ols_step_forward_arsq"} is a list containing the +#' following components: +#' +#' \item{model}{model with the highest ARSQ; an object of class \code{lm}} +#' \item{steps}{total number of steps} +#' \item{predictors}{variables added to the model} +#' \item{aics}{akaike information criteria} +#' \item{ess}{error sum of squares} +#' \item{rss}{regression sum of squares} +#' \item{rsq}{rsquare} +#' \item{arsq}{adjusted rsquare} +#' +#' @references +#' Venables, W. N. and Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth edition. Springer. +#' +#' @section Deprecated Function: +#' \code{ols_steparsq_forward()} has been deprecated. Instead use \code{ols_step_forward_arsq()}. +#' +#' @examples +#' # stepwise forward regression +#' model <- lm(y ~ ., data = surgical) +#' ols_step_forward_arsq(model) +#' +#' # stepwise forward regression plot +#' model <- lm(y ~ ., data = surgical) +#' k <- ols_step_forward_arsq(model) +#' plot(k) +#' +#' # final model +#' k$model +#' +#' +#' @family variable selection procedures +#' +#' @export +#' +ols_step_forward_arsq <- function(model, ...) UseMethod("ols_step_forward_arsq") + +#' @export +#' @rdname ols_step_forward_arsq +#' +ols_step_forward_arsq.default <- function(model, max_steps = NULL, progress = FALSE, details = FALSE, ...) { + + if (details) { + progress <- TRUE + } + + check_model(model) + check_logic(details) + check_npredictors(model, 3) + + response <- names(model$model)[1] + l <- mod_sel_data(model) + nam <- coeff_names(model) + all_pred <- nam + mlen_p <- length(all_pred) + max_steps <- ifelse(is.null(max_steps), mlen_p, max_steps) + preds <- c() + step <- 1 + aics <- c() + ess <- c() + rss <- c() + rsq <- c() + arsq <- c() + mo <- lm(paste(response, "~", 1), data = l) + arsq1 <- summary(mo)$adj.r.squared + + if (progress) { + cat(format("Forward Selection Method", justify = "left", width = 24), "\n") + cat(rep("-", 24), sep = "", "\n\n") + cat(format("Candidate Terms:", justify = "left", width = 16), "\n\n") + for (i in seq_len(length(nam))) { + cat(paste(i, ".", nam[i]), "\n") + } + cat("\n") + + if (details == TRUE) { + cat(" Step 0: ARSQ =", arsq1, "\n", paste(response, "~", 1, "\n\n")) + } + } + + for (i in seq_len(mlen_p)) { + + predictors <- all_pred[i] + k <- ols_regress(paste(response, "~", paste(predictors, collapse = " + ")), data = l) + + aics[i] <- ols_aic(k$model) + ess[i] <- k$ess + rss[i] <- k$rss + rsq[i] <- k$rsq + arsq[i] <- k$adjr + } + + da <- data.frame(predictors = all_pred, aics = aics, ess = ess, rss = rss, rsq = rsq, arsq = arsq) + da2 <- da[order(-da$rss), ] + + if (details) { + w1 <- max(nchar("Predictor"), nchar(all_pred)) + w2 <- 2 + w3 <- max(nchar("AIC"), nchar(format(round(aics, 3), nsmall = 3))) + w4 <- max(nchar("Sum Sq"), nchar(format(round(rss, 3), nsmall = 3))) + w5 <- max(nchar("RSS"), nchar(format(round(ess, 3), nsmall = 3))) + w6 <- max(nchar("R-Sq"), nchar(format(round(rsq, 3), nsmall = 3))) + w7 <- max(nchar("Adj. R-Sq"), nchar(format(round(arsq, 3), nsmall = 3))) + w <- sum(w1, w2, w3, w4, w5, w6, w7, 24) + ln <- length(arsq) + + cat(rep("-", w), sep = "", "\n") + cat( + fl("Variable", w1), fs(), fc("DF", w2), fs(), fc("AIC", w3), fs(), + fc("Sum Sq", w4), fs(), fc("RSS", w5), fs(), fc("R-Sq", w6), fs(), + fc("Adj. R-Sq", w7), "\n" + ) + cat(rep("-", w), sep = "", "\n") + + for (i in seq_len(ln)) { + cat( + fl(da2[i, 1], w1), fs(), fg(1, w2), fs(), fg(format(round(da2[i, 2], 3), nsmall = 3), w3), fs(), + fg(format(round(da2[i, 4], 3), nsmall = 3), w4), fs(), fg(format(round(da2[i, 3], 3), nsmall = 3), w5), fs(), + fg(format(round(da2[i, 5], 3), nsmall = 3), w6), fs(), + fg(format(round(da2[i, 6], 3), nsmall = 3), w7), "\n" + ) + } + + cat(rep("-", w), sep = "", "\n\n") + } + + maxa <- which(arsq == max(arsq)) + laic <- aics[maxa] + less <- ess[maxa] + lrss <- rss[maxa] + lrsq <- rsq[maxa] + larsq <- arsq[maxa] + preds <- all_pred[maxa] + lpreds <- length(preds) + all_pred <- all_pred[-maxa] + len_p <- length(all_pred) + step <- 1 + + if (progress) { + cat("\n") + if (!details) { + cat("Variables Entered:", "\n\n") + } + } + + if (progress) { + if (interactive()) { + cat("+", tail(preds, n = 1), "\n") + } else { + cat(paste("-", tail(preds, n = 1)), "\n") + } + } + + while (step < max_steps) { + + aics <- c() + ess <- c() + rss <- c() + rsst <- c() + rsq <- c() + arsq <- c() + mo <- ols_regress(paste(response, "~", + paste(preds, collapse = " + ")), data = l) + arsq1 <- summary(mo$model)$adj.r.squared + + if (details) { + cat("\n\n", "Step", step, ": ARSQ =", arsq1, "\n", paste(response, "~", paste(preds, collapse = " + "), "\n\n")) + } + + for (i in seq_len(len_p)) { + + predictors <- c(preds, all_pred[i]) + k <- ols_regress(paste(response, "~", + paste(predictors, collapse = " + ")), data = l) + + aics[i] <- ols_aic(k$model) + ess[i] <- k$ess + rsst[i] <- k$rss + rss[i] <- round(k$rss - mo$rss, 3) + rsq[i] <- k$rsq + arsq[i] <- k$adjr + } + + if (details) { + + da <- data.frame(predictors = all_pred, aics = aics, ess = ess, rss = rss, rsq = rsq, arsq = arsq) + # da2 <- arrange(da, desc(rss)) + da2 <- da[order(-da$rss), ] + w1 <- max(nchar("Predictor"), nchar(as.character(da2$predictors))) + w2 <- 2 + w3 <- max(nchar("AIC"), nchar(format(round(aics, 3), nsmall = 3))) + w4 <- max(nchar("Sum Sq"), nchar(format(round(rss, 3), nsmall = 3))) + w5 <- max(nchar("RSS"), nchar(format(round(ess, 3), nsmall = 3))) + w6 <- max(nchar("R-Sq"), nchar(format(round(rsq, 3), nsmall = 3))) + w7 <- max(nchar("Adj. R-Sq"), nchar(format(round(arsq, 3), nsmall = 3))) + w <- sum(w1, w2, w3, w4, w5, w6, w7, 24) + ln <- length(arsq) + + cat(rep("-", w), sep = "", "\n") + cat( + fl("Variable", w1), fs(), fc("DF", w2), fs(), fc("AIC", w3), fs(), + fc("Sum Sq", w4), fs(), fc("RSS", w5), fs(), fc("R-Sq", w6), fs(), + fc("Adj. R-Sq", w7), "\n" + ) + cat(rep("-", w), sep = "", "\n") + + for (i in seq_len(ln)) { + cat( + fl(da2[i, 1], w1), fs(), fg(1, w2), fs(), fg(format(round(da2[i, 2], 3), nsmall = 3), w3), fs(), + fg(format(round(da2[i, 4], 3), nsmall = 3), w4), fs(), fg(format(round(da2[i, 3], 3), nsmall = 3), w5), fs(), + fg(format(round(da2[i, 5], 3), nsmall = 3), w6), fs(), + fg(format(round(da2[i, 6], 3), nsmall = 3), w7), "\n" + ) + } + + cat(rep("-", w), sep = "", "\n\n") + } + + maxarsq <- which(arsq == max(arsq)) + + if (arsq[maxarsq] > larsq[lpreds]) { + + preds <- c(preds, all_pred[maxarsq]) + maxc <- aics[maxarsq] + mess <- ess[maxarsq] + mrss <- round(rsst[maxarsq], 3) + mrsq <- rsq[maxarsq] + marsq <- arsq[maxarsq] + laic <- c(laic, maxc) + less <- c(less, mess) + lrss <- c(lrss, mrss) + lrsq <- c(lrsq, mrsq) + larsq <- c(larsq, marsq) + lpreds <- length(preds) + all_pred <- all_pred[-maxarsq] + len_p <- length(all_pred) + step <- step + 1 + + if (progress) { + if (interactive()) { + cat("+", tail(preds, n = 1), "\n") + } else { + cat(paste("-", tail(preds, n = 1)), "\n") + } + } + } else { + if (progress) { + cat("\n") + cat("No more variables to be added.") + } + break + } + } + + if (details) { + cat("\n\n") + cat("Variables Entered:", "\n\n") + for (i in seq_len(length(preds))) { + if (interactive()) { + cat("+", preds[i], "\n") + } else { + cat(paste("-", preds[i]), "\n") + } + } + } + + if (progress) { + cat("\n\n") + cat("Final Model Output", "\n") + cat(rep("-", 18), sep = "", "\n\n") + + fi <- ols_regress(paste(response, "~", paste(preds, collapse = " + ")), data = l) + print(fi) + } + + final_model <- lm(paste(response, "~", paste(preds, collapse = " + ")), data = l) + + out <- list(predictors = preds, + steps = step, + arsq = larsq, + aics = laic, + ess = less, + rss = lrss, + rsq = lrsq, + model = final_model) + + + class(out) <- "ols_step_forward_arsq" + + return(out) +} + +#' @export +#' +print.ols_step_forward_arsq <- function(x, ...) { + if (x$steps > 0) { + print_steparsq_forward(x) + } else { + print("No variables have been added to the model.") + } +} + +#' @rdname ols_step_forward_arsq +#' @export +#' +plot.ols_step_forward_arsq <- function(x, print_plot = TRUE, ...) { + + arsq <- NULL + tx <- NULL + a <- NULL + b <- NULL + + y <- seq_len(x$steps) + xloc <- y - 0.1 + yloc <- x$arsq - 0.2 + xmin <- min(y) - 1 + xmax <- max(y) + 1 + ymin <- min(x$arsq) - 1 + ymax <- max(x$arsq) + 1 + + predictors <- x$predictors + + d2 <- data.frame(x = xloc, y = yloc, tx = predictors) + d <- data.frame(a = y, b = x$arsq) + + p <- + ggplot(d, aes(x = a, y = b)) + geom_line(color = "blue") + + geom_point(color = "blue", shape = 1, size = 2) + xlim(c(xmin, xmax)) + + ylim(c(ymin, ymax)) + xlab("Step") + ylab("ARSQ") + + ggtitle("Stepwise Adj. R-Sq Forward Selection") + + geom_text(data = d2, aes(x = x, y = y, label = tx), hjust = 0, nudge_x = 0.1) + + if (print_plot) { + print(p) + } else { + return(p) + } + +} + + +#' @export +#' @rdname ols_step_forward_arsq +#' @usage NULL +#' +ols_steparsq_forward <- function(model, ...) { + .Deprecated("ols_step_forward_arsq()") +} diff --git a/R/output.R b/R/output.R index fdb074a4..dc3c5078 100644 --- a/R/output.R +++ b/R/output.R @@ -934,6 +934,11 @@ print_stepaic_both <- function(data) { +print_steparsq_forward <- print_stepaic_forward +print_steparsq_backward <- print_stepaic_backward +print_steparsq_both <- print_stepaic_both + + print_norm_test <- function(data) { # width diff --git a/man/ols_step_backward_arsq.Rd b/man/ols_step_backward_arsq.Rd new file mode 100644 index 00000000..0665138c --- /dev/null +++ b/man/ols_step_backward_arsq.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ols-steparsq-backward-regression.R +\name{ols_step_backward_arsq} +\alias{ols_step_backward_arsq} +\alias{ols_step_backward_arsq.default} +\alias{plot.ols_step_backward_arsq} +\alias{ols_steparsq_backward} +\title{Stepwise Adjusted R-Squared backward regression} +\usage{ +ols_step_backward_arsq(model, ...) + +\method{ols_step_backward_arsq}{default}(model, progress = FALSE, details = FALSE, ...) + +\method{plot}{ols_step_backward_arsq}(x, print_plot = TRUE, ...) +} +\arguments{ +\item{model}{An object of class \code{lm}; the model should include all +candidate predictor variables.} + +\item{...}{Other arguments.} + +\item{progress}{Logical; if \code{TRUE}, will display variable selection progress.} + +\item{details}{Logical; if \code{TRUE}, will print the regression result at +each step.} + +\item{x}{An object of class \code{ols_step_backward_arsq}.} + +\item{print_plot}{logical; if \code{TRUE}, prints the plot else returns a plot object.} +} +\value{ +\code{ols_step_backward_arsq} returns an object of class \code{"ols_step_backward_arsq"}. +An object of class \code{"ols_step_backward_arsq"} is a list containing the +following components: + +\item{model}{model with the highest ARSQ; an object of class \code{lm}} +\item{steps}{total number of steps} +\item{predictors}{variables removed from the model} +\item{aics}{akaike information criteria} +\item{ess}{error sum of squares} +\item{rss}{regression sum of squares} +\item{rsq}{rsquare} +\item{arsq}{adjusted rsquare} +} +\description{ +Build regression model from a set of candidate predictor variables by +removing predictors based on adjusted R-squared, in a stepwise +manner until there is no variable left to remove any more. +} +\section{Deprecated Function}{ + +\code{ols_steparsq_backward()} has been deprecated. Instead use \code{ols_step_backward_arsq()}. +} + +\examples{ +# stepwise backward regression +model <- lm(y ~ ., data = surgical) +ols_step_backward_arsq(model) + +# stepwise backward regression plot +model <- lm(y ~ ., data = surgical) +k <- ols_step_backward_arsq(model) +plot(k) + +# final model +k$model + +} +\references{ +Venables, W. N. and Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth edition. Springer. +} +\seealso{ +Other variable selection procedures: +\code{\link{ols_step_all_possible}()}, +\code{\link{ols_step_backward_aic}()}, +\code{\link{ols_step_backward_p}()}, +\code{\link{ols_step_best_subset}()}, +\code{\link{ols_step_both_aic}()}, +\code{\link{ols_step_both_arsq}()}, +\code{\link{ols_step_forward_aic}()}, +\code{\link{ols_step_forward_arsq}()}, +\code{\link{ols_step_forward_p}()} +} +\concept{variable selection procedures} diff --git a/man/ols_step_both_arsq.Rd b/man/ols_step_both_arsq.Rd new file mode 100644 index 00000000..cc387ec1 --- /dev/null +++ b/man/ols_step_both_arsq.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ols-steparsq-both-regression.R +\name{ols_step_both_arsq} +\alias{ols_step_both_arsq} +\alias{plot.ols_step_both_arsq} +\alias{ols_steparsq_both} +\title{Stepwise Adjusted R-Squared regression} +\usage{ +ols_step_both_arsq(model, progress = FALSE, details = FALSE) + +\method{plot}{ols_step_both_arsq}(x, print_plot = TRUE, ...) +} +\arguments{ +\item{model}{An object of class \code{lm}.} + +\item{progress}{Logical; if \code{TRUE}, will display variable selection progress.} + +\item{details}{Logical; if \code{TRUE}, details of variable selection will +be printed on screen.} + +\item{x}{An object of class \code{ols_step_both_arsq}.} + +\item{print_plot}{logical; if \code{TRUE}, prints the plot else returns a plot object.} + +\item{...}{Other arguments.} +} +\value{ +\code{ols_step_both_arsq} returns an object of class \code{"ols_step_both_arsq"}. +An object of class \code{"ols_step_both_arsq"} is a list containing the +following components: + +\item{model}{model with the highest ARSQ; an object of class \code{lm}} +\item{predictors}{variables added/removed from the model} +\item{method}{addition/deletion} +\item{aics}{akaike information criteria} +\item{ess}{error sum of squares} +\item{rss}{regression sum of squares} +\item{rsq}{rsquare} +\item{arsq}{adjusted rsquare} +\item{steps}{total number of steps} +} +\description{ +Build regression model from a set of candidate predictor variables by +entering and removing predictors based on adjusted R-squared, in a +stepwise manner until there is no variable left to enter or remove any more. +} +\section{Deprecated Function}{ + +\code{ols_steparsq_both()} has been deprecated. Instead use \code{ols_step_both_arsq()}. +} + +\examples{ +\dontrun{ +# stepwise regression +model <- lm(y ~ ., data = stepdata) +ols_step_both_arsq(model) + +# stepwise regression plot +model <- lm(y ~ ., data = stepdata) +k <- ols_step_both_arsq(model) +plot(k) + +# final model +k$model + +} +} +\references{ +Venables, W. N. and Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth edition. Springer. +} +\seealso{ +Other variable selection procedures: +\code{\link{ols_step_all_possible}()}, +\code{\link{ols_step_backward_aic}()}, +\code{\link{ols_step_backward_arsq}()}, +\code{\link{ols_step_backward_p}()}, +\code{\link{ols_step_best_subset}()}, +\code{\link{ols_step_both_aic}()}, +\code{\link{ols_step_forward_aic}()}, +\code{\link{ols_step_forward_arsq}()}, +\code{\link{ols_step_forward_p}()} +} +\concept{variable selection procedures} diff --git a/man/ols_step_forward_arsq.Rd b/man/ols_step_forward_arsq.Rd new file mode 100644 index 00000000..2178f6a5 --- /dev/null +++ b/man/ols_step_forward_arsq.Rd @@ -0,0 +1,92 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ols-steparsq-forward-regression.R +\name{ols_step_forward_arsq} +\alias{ols_step_forward_arsq} +\alias{ols_step_forward_arsq.default} +\alias{plot.ols_step_forward_arsq} +\alias{ols_steparsq_forward} +\title{Stepwise Adjusted R-Squared forward regression} +\usage{ +ols_step_forward_arsq(model, ...) + +\method{ols_step_forward_arsq}{default}( + model, + max_steps = NULL, + progress = FALSE, + details = FALSE, + ... +) + +\method{plot}{ols_step_forward_arsq}(x, print_plot = TRUE, ...) +} +\arguments{ +\item{model}{An object of class \code{lm}.} + +\item{...}{Other arguments.} + +\item{max_steps}{Integer; if not \code{NULL}, will specify the maximum number of steps.} + +\item{progress}{Logical; if \code{TRUE}, will display variable selection progress.} + +\item{details}{Logical; if \code{TRUE}, will print the regression result at +each step.} + +\item{x}{An object of class \code{ols_step_forward_arsq}.} + +\item{print_plot}{logical; if \code{TRUE}, prints the plot else returns a plot object.} +} +\value{ +\code{ols_step_forward_arsq} returns an object of class \code{"ols_step_forward_arsq"}. +An object of class \code{"ols_step_forward_arsq"} is a list containing the +following components: + +\item{model}{model with the highest ARSQ; an object of class \code{lm}} +\item{steps}{total number of steps} +\item{predictors}{variables added to the model} +\item{aics}{akaike information criteria} +\item{ess}{error sum of squares} +\item{rss}{regression sum of squares} +\item{rsq}{rsquare} +\item{arsq}{adjusted rsquare} +} +\description{ +Build regression model from a set of candidate predictor variables by +entering predictors based on adjusted R-squared, in a stepwise +manner until there is no variable left to enter any more, or a maximum step has been reached. +} +\section{Deprecated Function}{ + +\code{ols_steparsq_forward()} has been deprecated. Instead use \code{ols_step_forward_arsq()}. +} + +\examples{ +# stepwise forward regression +model <- lm(y ~ ., data = surgical) +ols_step_forward_arsq(model) + +# stepwise forward regression plot +model <- lm(y ~ ., data = surgical) +k <- ols_step_forward_arsq(model) +plot(k) + +# final model +k$model + + +} +\references{ +Venables, W. N. and Ripley, B. D. (2002) Modern Applied Statistics with S. Fourth edition. Springer. +} +\seealso{ +Other variable selection procedures: +\code{\link{ols_step_all_possible}()}, +\code{\link{ols_step_backward_aic}()}, +\code{\link{ols_step_backward_arsq}()}, +\code{\link{ols_step_backward_p}()}, +\code{\link{ols_step_best_subset}()}, +\code{\link{ols_step_both_aic}()}, +\code{\link{ols_step_both_arsq}()}, +\code{\link{ols_step_forward_aic}()}, +\code{\link{ols_step_forward_p}()} +} +\concept{variable selection procedures}