Merge pull request #219 from rsquaredacademy/develop

CRAN release

Author: aravindhebbali

.Rbuildignore

@@ -17,3 +17,4 @@
 ^\.github$
 ^CODE_OF_CONDUCT\.md$
 ^revdep$
+TODO.md

.github/workflows/rhub.yaml

@@ -0,0 +1,95 @@
+# R-hub's generic GitHub Actions workflow file. It's canonical location is at
+# https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml
+# You can update this file to a newer version using the rhub2 package:
+#
+# rhub::rhub_setup()
+#
+# It is unlikely that you need to modify this file manually.
+
+name: R-hub
+run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}"
+
+on:
+  workflow_dispatch:
+    inputs:
+      config:
+        description: 'A comma separated list of R-hub platforms to use.'
+        type: string
+        default: 'linux,windows,macos'
+      name:
+        description: 'Run name. You can leave this empty now.'
+        type: string
+      id:
+        description: 'Unique ID. You can leave this empty now.'
+        type: string
+
+jobs:
+
+  setup:
+    runs-on: ubuntu-latest
+    outputs:
+      containers: ${{ steps.rhub-setup.outputs.containers }}
+      platforms: ${{ steps.rhub-setup.outputs.platforms }}
+
+    steps:
+    # NO NEED TO CHECKOUT HERE
+    - uses: r-hub/actions/setup@v1
+      with:
+        config: ${{ github.event.inputs.config }}
+      id: rhub-setup
+
+  linux-containers:
+    needs: setup
+    if: ${{ needs.setup.outputs.containers != '[]' }}
+    runs-on: ubuntu-latest
+    name: ${{ matrix.config.label }}
+    strategy:
+      fail-fast: false
+      matrix:
+        config: ${{ fromJson(needs.setup.outputs.containers) }}
+    container:
+      image: ${{ matrix.config.container }}
+
+    steps:
+      - uses: r-hub/actions/checkout@v1
+      - uses: r-hub/actions/platform-info@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/setup-deps@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/run-check@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+
+  other-platforms:
+    needs: setup
+    if: ${{ needs.setup.outputs.platforms != '[]' }}
+    runs-on: ${{ matrix.config.os }}
+    name: ${{ matrix.config.label }}
+    strategy:
+      fail-fast: false
+      matrix:
+        config: ${{ fromJson(needs.setup.outputs.platforms) }}
+
+    steps:
+      - uses: r-hub/actions/checkout@v1
+      - uses: r-hub/actions/setup-r@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}
+      - uses: r-hub/actions/platform-info@v1
+        with:
+          token: ${{ secrets.RHUB_TOKEN }}
+          job-config: ${{ matrix.config.job-config }}
+      - uses: r-hub/actions/setup-deps@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}
+      - uses: r-hub/actions/run-check@v1
+        with:
+          job-config: ${{ matrix.config.job-config }}
+          token: ${{ secrets.RHUB_TOKEN }}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: olsrr
 Type: Package
 Title: Tools for Building OLS Regression Models 
-Version: 0.6.0.9000
+Version: 0.6.1
 Authors@R: person("Aravind", "Hebbali", email = "hebbali.aravind@gmail.com", role = c("aut", "cre"))
 Description: Tools designed to make it easier for users, particularly beginner/intermediate R users 
     to build ordinary least squares regression models. Includes comprehensive regression output, 
@@ -33,5 +33,5 @@ Encoding: UTF-8
 LazyData: true
 VignetteBuilder: knitr
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Config/testthat/edition: 3

NAMESPACE

@@ -213,6 +213,7 @@ importFrom(stats,complete.cases)
 importFrom(stats,confint.lm)
 importFrom(stats,cooks.distance)
 importFrom(stats,cor)
+importFrom(stats,deviance)
 importFrom(stats,df.residual)
 importFrom(stats,dfbetas)
 importFrom(stats,dffits)
@@ -245,7 +246,4 @@ importFrom(stats,sd)
 importFrom(stats,shapiro.test)
 importFrom(stats,var)
 importFrom(utils,combn)
-importFrom(utils,install.packages)
-importFrom(utils,menu)
-importFrom(utils,packageVersion)
 importFrom(utils,tail)

NEWS.md

@@ -1,4 +1,15 @@
-# olsrr 0.6.0.9000
+# olsrr 0.6.1
+
+This is a patch release for urgent bug fixes.
+
+## Bug Fixes
+
+- Limit maximum subset order in `ols_step_all_possible()` ([#202](https://github.com/rsquaredacademy/olsrr/issues/202))
+- Check model type ([#204](https://github.com/rsquaredacademy/olsrr/issues/204))
+- Mismatch in column names in `ols_step_all_possible()` ([#211](https://github.com/rsquaredacademy/olsrr/issues/211))
+- RMSE is not square root of MSE in `ols_regress()` ([#213](https://github.com/rsquaredacademy/olsrr/issues/213))
+- `geom_segment()` warning in `ols_plot_obs_fit()` ([#217](https://github.com/rsquaredacademy/olsrr/issues/217))
+- New snapshot added every time tests are run ([#218](https://github.com/rsquaredacademy/olsrr/issues/218))
 
 # olsrr 0.6.0
 

R/ols-all-possible-regression.R

@@ -102,7 +102,7 @@ ols_step_all_possible.default <- function(model, max_order = NULL, ...) {
 print.ols_step_all_possible <- function(x, ...) {
 
   n <- max(x$result$mindex)
-  k <- data.frame(x$result)[, c(1:5, 7)]
+  k <- data.frame(x$result)[, c(1:5, 8)]
   names(k) <- c("Index", "N", "Predictors", "R-Square", "Adj. R-Square", "Mallow's Cp")
   print(k)
 
@@ -377,4 +377,4 @@ allpos_helper <- function(model, max_order = NULL) {
   )
 
   return(result)
-}
+}

R/ols-best-subsets-regression.R

@@ -32,7 +32,7 @@
 #' # maximum subset
 #' model <- lm(mpg ~ disp + hp + drat + wt + qsec, data = mtcars)
 #' ols_step_best_subset(model, max_order = 3)
-#' 
+#'
 #' # plot
 #' model <- lm(mpg ~ disp + hp + wt + qsec, data = mtcars)
 #' k <- ols_step_best_subset(model)
@@ -50,8 +50,8 @@ ols_step_best_subset <- function(model, ...) UseMethod("ols_step_best_subset")
 
 #' @export
 #' @rdname ols_step_best_subset
-#' 
-ols_step_best_subset.default <- function(model, max_order = NULL, 
+#'
+ols_step_best_subset.default <- function(model, max_order = NULL,
                                          include = NULL, exclude = NULL,
                                          metric = c("rsquare", "adjr", "predrsq",
                                                     "cp", "aic", "sbic", "sbc",
@@ -77,7 +77,7 @@ ols_step_best_subset.default <- function(model, max_order = NULL,
       stop(paste(paste(exclude[!npm], collapse = ", "), "not part of the model and hence cannot be forcibly excluded. Please verify the variable names."), call. = FALSE)
     }
   }
-  
+
   if (is.numeric(include)) {
     if (any(include > lenterms)) {
       stop(paste0("Index of variable to be included should be between 1 and ", lenterms, "."), call. = FALSE)
@@ -88,7 +88,7 @@ ols_step_best_subset.default <- function(model, max_order = NULL,
 
   if (is.numeric(exclude)) {
     if (any(exclude > lenterms)) {
-      stop(paste0("Index of variable to be excluded should be between 1 and ", lenterms, "."), call. = FALSE)  
+      stop(paste0("Index of variable to be excluded should be between 1 and ", lenterms, "."), call. = FALSE)
     } else {
       exclude <- indterms[exclude]
     }
@@ -152,23 +152,23 @@ ols_step_best_subset.default <- function(model, max_order = NULL,
   lpreds    <- c()
 
   for (i in seq_len(len_elig)) {
-      predictors        <- predicts[[i]]
-      lp                <- length(predictors)
-      out               <- ols_regress(paste(response, "~", paste(predictors, collapse = " + ")), data = data)
-      mcount            <- mcount + 1
-      lpreds[mcount]    <- lp
-      rsq[[mcount]]     <- out$rsq
-      adjr[[mcount]]    <- out$adjr
-      cp[[mcount]]      <- ols_mallows_cp(out$model, model)
-      aic[[mcount]]     <- ols_aic(out$model)
-      sbic[[mcount]]    <- ols_sbic(out$model, model)
-      sbc[[mcount]]     <- ols_sbc(out$model)
-      gmsep[[mcount]]   <- ols_msep(out$model)
-      jp[[mcount]]      <- ols_fpe(out$model)
-      pc[[mcount]]      <- ols_apc(out$model)
-      sp[[mcount]]      <- ols_hsp(out$model)
-      predrsq[[mcount]] <- ols_pred_rsq(out$model)
-      preds[[mcount]]   <- paste(predictors, collapse = " ")
+    predictors        <- predicts[[i]]
+    lp                <- length(predictors)
+    out               <- ols_regress(paste(response, "~", paste(predictors, collapse = " + ")), data = data)
+    mcount            <- mcount + 1
+    lpreds[mcount]    <- lp
+    rsq[[mcount]]     <- out$rsq
+    adjr[[mcount]]    <- out$adjr
+    cp[[mcount]]      <- ols_mallows_cp(out$model, model)
+    aic[[mcount]]     <- ols_aic(out$model)
+    sbic[[mcount]]    <- ols_sbic(out$model, model)
+    sbc[[mcount]]     <- ols_sbc(out$model)
+    gmsep[[mcount]]   <- ols_msep(out$model)
+    jp[[mcount]]      <- ols_fpe(out$model)
+    pc[[mcount]]      <- ols_apc(out$model)
+    sp[[mcount]]      <- ols_hsp(out$model)
+    predrsq[[mcount]] <- ols_pred_rsq(out$model)
+    preds[[mcount]]   <- paste(predictors, collapse = " ")
   }
 
   ui <- data.frame(
@@ -197,13 +197,13 @@ ols_step_best_subset.default <- function(model, max_order = NULL,
   } else {
     temp <- lapply(l, function(x) x[order(x[[metrics]]), ][1, ])
   }
-  
+
   sorted <- do.call(rbind, temp)
   mindex <- seq_len(nrow(sorted))
   sorted <- cbind(mindex, sorted)
   result <- list(metrics = sorted)
   class(result) <- c("ols_step_best_subset")
-  
+
   return(result)
 
 }
@@ -261,8 +261,8 @@ best_subset_plot <- function(d, var, title = "R-Square") {
   ggplot(d1, aes(x = a, y = b)) +
     geom_line(color = "blue") +
     geom_point(color = "blue", shape = 1, size = 2) +
-    xlab("") + 
-    ylab("") + 
+    xlab("") +
+    ylab("") +
     ggtitle(title) +
     theme(axis.ticks = element_blank())
 

R/ols-observed-vs-predicted-plot.R

@@ -27,19 +27,20 @@ ols_plot_obs_fit <- function(model, print_plot = TRUE) {
 
   oname <- names(model.frame(model))[1]
   d     <- obspred(model)
+  df    <- data.frame(x1 = min(d$x), x2 = max(d$x), y1 = min(d$y), y2 = max(d$y))
 
   p <-
     ggplot(d, aes(x = x, y = y)) +
     geom_point(color = "blue", shape = 1) +
-    geom_segment(data = d, aes(x = min(x), y = min(y), xend = max(x),
-                               yend = max(y)), colour = "red") +
+    geom_segment(data = df, aes(x = x1, y = y1, xend = x2,
+      yend = y2), colour = "red") +
     geom_abline(intercept = 0, slope = 1, color = "blue")
 
   p <-
     p +
     ylab("Fitted Value") +
     xlab(paste(oname)) +
-    ggtitle(paste("Actual vs Fitted for", oname)) 
+    ggtitle(paste("Actual vs Fitted for", oname))
 
   if (print_plot) {
     print(p)

R/ols-regress_compute.R

@@ -1,5 +1,5 @@
 #' @importFrom stats model.matrix confint.lm
-#' @importFrom stats as.formula
+#' @importFrom stats as.formula deviance
 reg_comp <- function(formula, data, conf.level = 0.95, iterm, title = "model") {
 
   model      <- lm(formula = formula, data = data)
@@ -20,7 +20,7 @@ reg_comp <- function(formula, data, conf.level = 0.95, iterm, title = "model") {
   sbic       <- ols_sbic(model, model)
   prsq       <- ols_pred_rsq(model)
   n          <- length(anovam$Df)
-  mse        <- anovam$`Mean Sq`[n]
+  mse        <- mean(model$residuals ^ 2)
   error_df   <- anovam$Df[n]
   model_df   <- sum(anovam$Df) - error_df
   total_df   <- sum(anovam$Df)

R/olsrr.R

@@ -20,5 +20,5 @@ if (getRversion() >= "2.15.1") {
     "txt", "cd", "fct_color", "ckd", "dbetas", "color", "pred", "ds", "dsr",
     "fstatistic", "hadi", "Df", "res", "pot", "lfit", "rerror", "ybar",
     "yhat", "predicted", "resid", "lev_thrsh", "leverage", "levrstud",
-    "sdres"))
+    "sdres", "x1", "x2", "y1", "y2"))
 }