Merge pull request #160 from gthopkins/main

Perform test of identical sample sizes in anova.uRegress() to address issue #158

Author: Sarah Teichman

.github/workflows/R-CMD-check.yml

@@ -33,7 +33,7 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - uses: r-lib/actions/setup-r@v2
         with:
@@ -50,7 +50,7 @@ jobs:
 
       - name: Restore R package cache
         if: runner.os != 'Windows'
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: ${{ env.R_LIBS_USER }}
           key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}

DESCRIPTION

@@ -29,7 +29,7 @@ Suggests:
     tidyverse,
     car
 VignetteBuilder: knitr
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.1
 Encoding: UTF-8
 Config/testthat/edition: 3
 LazyData: true

NAMESPACE

@@ -4,9 +4,11 @@ S3method(anova,uRegress)
 S3method(cooks.distance,uRegress)
 S3method(dfbeta,uRegress)
 S3method(dfbetas,uRegress)
+S3method(fitted,uRegress)
 S3method(hatvalues,uRegress)
 S3method(predict,uRegress)
 S3method(print,anova.uRegress)
+S3method(print,augCoefficients)
 S3method(print,lincom)
 S3method(print,lincom.joint)
 S3method(print,proptest)

R/anova.R

@@ -55,11 +55,17 @@ anova.uRegress <- function(object, full_object, test="LRT", robustSE = TRUE, use
     }
   }
 
-  # 
   if (object$fnctl != full_object$fnctl) {
     stop("uRegress objects must be created with the same fnctl!")
   }
 
+  if (NROW(object$fit$model) != NROW(full_object$fit$model)) {
+    stop(paste0("The full and reduced models are fit on data with different ",
+                "sample sizes, but the test is only valid when performed on the ",
+                "same dataset. This error often occurs when there is missing ",
+                "data in a variable that is included in the full model but not in the reduced model."))
+  }
+  
   # simple check for nested models
   if (object$fnctl != "hazard" & full_object$fnctl!= "hazard") {
     if (full_object$fit$rank<=object$fit$rank) {

R/regress_utils.R

@@ -1787,6 +1787,7 @@ printerGlm <- function (x, digits = max(3L, getOption("digits") - 3L), symbolic.
   invisible(x)
 }
 
+#' @export
 print.augCoefficients <-
   function (x,...,sigfigs=max(3,getOption("digits")-3),width=9,nonsci.limit=5,Psci=FALSE) {
 
@@ -1850,6 +1851,7 @@ print.augCoefficients <-
     invisible(frmtCoefficients)
   }
 
+#' @export
 fitted.uRegress <-
   function (object,...,X) {
 

R/rigr-package.R

@@ -23,7 +23,6 @@
 #'
 #' @name rigr-package
 #' @aliases rigr-package rigr
-#' @docType package
 #' @author Scott S. Emerson, Andrew J. Spieker, Brian D.
 #' Williamson, Amy D. Willis, Charles Wolock, and Taylor Okonek
 #'

man/rigr-package.Rd

@@ -7,6 +7,23 @@ reg_full <- regress("mean", y ~ x + z, data = dat, robustSE = FALSE)
 lm_null <- stats::lm(y ~ x, data = dat)
 lm_full <- stats::lm(y ~ x + z, data = dat)
 
+dat_miss <- dat
+dat_miss$x[sample(1:100, 10)] <- NA
+reg_full_miss <- regress("mean", y ~ x + z, data = dat_miss)
+reg_null_miss <- regress("mean", y ~ z, data = dat_miss)
+
+test_that("anova.uRegress() throws an error if models are fit on different sample sizes", {
+            expect_error(anova(reg_null_miss, reg_full_miss),
+                         paste0("The full and reduced models are fit on data with different ",
+                                "sample sizes, but the test is only valid when performed on the ",
+                                "same dataset. This error often occurs when there is missing ",
+                                "data in a variable that is included in the full model but not in the reduced model."))
+          })
+
+test_that("anova.uRegress() does not throw an error if models are fit on same sample size", {
+  expect_no_error(anova(reg_null, reg_full, robustSE = FALSE))
+})
+
 
 test_that("anova.uRegress() throws an error if at least one of the two input 
           objects is not of class uRegress", {
@@ -36,7 +53,6 @@ hazard_reg_null <- regress("hazard", Surv(obstime, death)~age, data=mri)
 hazard_reg_full <- regress("hazard", Surv(obstime, death)~age+height+weight, data=mri)
 rate_reg_full <- regress("rate", obstime ~ age+height+weight, data = mri, robustSE = FALSE)
 
-
 test_that("anova.uRegress() throws an error if the two input objects are 
            regressions with different fnctls", {
             expect_error(anova(hazard_reg_null, reg_full, robustSE = FALSE), 

tests/testthat/test_anova.R

@@ -367,7 +367,7 @@ test_that("regress() returns same output as coxph() for fnctl = hazard", {
 
 })
 
-mri2 <- read.table("http://www.emersonstatistics.com/datasets/mri.txt", header = T)
+mri2 <- read.table("https://rct-design.com/TeachingMaterials/Datasets/mri.txt", header = T)
 mri2$obstime_yrs <- mri2$obstime/365.25
 mri2$ldlcat <- cut(mri2$ldl, breaks=c(0, 70, 100, 130, 160, 190, 250), right=FALSE)
 mri2$surv <- Surv(mri2$obstime_yrs, mri2$death)