From 5a9dd010ff78bfa454cac48c533f023d8a09573c Mon Sep 17 00:00:00 2001 From: Brantly Callaway Date: Fri, 31 Jan 2025 13:40:30 -0500 Subject: [PATCH] add check and revdep workflows --- .github/workflows/check-package.yml | 67 +++++++++++++ .github/workflows/revdep-check-test.yml | 98 +++++++++++++++++++ R/attgt_functions.R | 16 ++-- R/pte.R | 4 +- man/did_attgt.Rd | 2 +- man/pte_default.Rd | 5 +- tests/testthat.R | 2 +- tests/testthat/test-did-inference.R | 24 ++--- tests/testthat/test-did.R | 120 +++++++++++++----------- 9 files changed, 257 insertions(+), 81 deletions(-) create mode 100644 .github/workflows/check-package.yml create mode 100644 .github/workflows/revdep-check-test.yml diff --git a/.github/workflows/check-package.yml b/.github/workflows/check-package.yml new file mode 100644 index 0000000..fca302b --- /dev/null +++ b/.github/workflows/check-package.yml @@ -0,0 +1,67 @@ +name: R Package Checks and Coverage + +on: + push: + pull_request: + workflow_dispatch: + +jobs: + check: + runs-on: ${{ matrix.config.os }} + + strategy: + fail-fast: false + matrix: + config: + - {os: windows-latest, r: 'release'} + - {os: windows-latest, r: 'devel'} + - {os: macOS-latest, r: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel'} + + name: ${{ matrix.config.os }} (R ${{ matrix.config.r }}) + steps: + - uses: actions/checkout@v4 + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + - name: Install dependencies + run: | + Rscript -e "install.packages('remotes')" + Rscript -e "remotes::install_deps(dependencies = TRUE)" + - name: Install system dependencies (Ubuntu only) + if: runner.os == 'Linux' + run: sudo apt-get install -y libcurl4-openssl-dev libssl-dev libxml2-dev libfreetype6-dev libfontconfig1-dev libharfbuzz-dev libfribidi-dev libpng-dev libjpeg-dev libtiff5-dev + - name: Setup Check + run: | + Rscript -e "install.packages('rcmdcheck')" + mkdir -p "check-${{ matrix.config.os }}" + - name: Check + run: | + Rscript -e "rcmdcheck::rcmdcheck(args = '--no-manual', error_on = 'error', check_dir = 'check-${{ matrix.config.os }}')" + - name: Setup Test + run: | + mkdir -p "test-results-${{ matrix.config.os }}" + Rscript -e "install.packages('testthat')" + Rscript -e "install.packages('devtools')" + Rscript -e "devtools::install('.', dependencies = TRUE)" + - name: Test + run: | + Rscript -e "testthat::test_dir('tests', reporter = testthat::SummaryReporter)" + - name: Code Coverage + if: matrix.config.os == 'ubuntu-latest' && matrix.config.r == 'release' + run: | + Rscript -e "install.packages('covr')" + Rscript -e "covr::codecov()" + - name: Upload check results + if: always() + uses: actions/upload-artifact@v4 + with: + name: R-CMD-check-results-${{ matrix.config.os }}-${{ matrix.config.r }} + path: check-* + - name: Upload test results + if: always() + uses: actions/upload-artifact@v4 + with: + name: R-test-results-${{ matrix.config.os }}-${{ matrix.config.r }} + path: test-results-* diff --git a/.github/workflows/revdep-check-test.yml b/.github/workflows/revdep-check-test.yml new file mode 100644 index 0000000..f3b5561 --- /dev/null +++ b/.github/workflows/revdep-check-test.yml @@ -0,0 +1,98 @@ +name: Reverse Dependency Check + +on: + workflow_dispatch: + +jobs: + revdep_check: + runs-on: ubuntu-latest + + name: Reverse check ${{ inputs.which }} dependents + + steps: + - name: Checkout repository + uses: actions/checkout@v4 + + - name: Set up R + uses: r-lib/actions/setup-r@v2 + with: + r-version: 'release' + + - name: Install system dependencies + run: | + sudo apt-get update + sudo apt-get install -y \ + libcurl4-openssl-dev \ + libssl-dev \ + libxml2-dev \ + libfreetype6-dev \ + libfontconfig1-dev \ + libharfbuzz-dev \ + libfribidi-dev \ + libpng-dev \ + libjpeg-dev \ + libtiff5-dev \ + gfortran \ + libblas-dev \ + liblapack-dev + + - name: Install R dependencies + run: | + Rscript -e "install.packages(c('remotes', 'revdepcheck', 'testthat', 'rcmdcheck'))" + Rscript -e "remotes::install_deps(dependencies = TRUE)" + + - name: Setup Reverse Dependency Check + run: | + Rscript -e " + rev_deps <- tools::package_dependencies( + packages = 'ptetools', + db = available.packages(), + reverse = TRUE + ) + rev_deps <- rev_deps[['ptetools']] + cat('Testing the following reverse dependencies:', rev_deps, '\n') + + for (pkg in rev_deps) { + cat('Installing package:', pkg, '\n') + install.packages(pkg, dependencies = TRUE) + } + " + - name: Reverse Dependency Check + run: | + Rscript -e " + rev_deps <- tools::package_dependencies( + packages = 'BMisc', + db = available.packages(), + reverse = TRUE + ) + rev_deps <- rev_deps[['BMisc']] + + dir.create('revdep_tarballs', showWarnings = FALSE) + + for (pkg in rev_deps) { + cat('Checking package:', pkg, '\n') + # Download the source tarball + tarball <- tryCatch({ + tarball_info <- download.packages(pkg, destdir = 'revdep_tarballs', type = 'source') + # Extract the correct tarball file path + tarball_path <- tarball_info[, 2] # The second column contains the file path + tarball_path # Return the correct path + }, error = function(e) { + cat('Error downloading source tarball for package:', pkg, '\n', conditionMessage(e), '\n') + next + }) + pkg_path <- find.package(pkg, quiet = TRUE) + tryCatch({ + rcmdcheck::rcmdcheck(tarball, error_on = 'never', args = '--no-manual') + }, error = function(e) { + cat('Error checking package:', pkg, '\n', conditionMessage(e), '\n') + }) + } + " + + - name: Upload Results + if: always() + uses: actions/upload-artifact@v4 + with: + name: Reverse-Dependency-Check-Results + path: revdep/ diff --git a/R/attgt_functions.R b/R/attgt_functions.R index 93bedbe..c89fc8c 100644 --- a/R/attgt_functions.R +++ b/R/attgt_functions.R @@ -16,19 +16,19 @@ #' #' @param gt_data data that is "local" to a particular group-time average #' treatment effect -#' @param xformla one-sided formula for covariates used in the propensity score +#' @param xformula one-sided formula for covariates used in the propensity score #' and outcome regression models #' @param ... extra function arguments; not used here #' #' @return attgt_if #' #' @export -did_attgt <- function(gt_data, xformla, ...) { +did_attgt <- function(gt_data, xformula = ~1, ...) { #----------------------------------------------------------------------------- # handle covariates #----------------------------------------------------------------------------- # for outcome regression, get pre-treatment values - Xpre <- model.frame(xformla, data = subset(gt_data, name == "pre")) + Xpre <- model.frame(xformula, data = subset(gt_data, name == "pre")) # convert two period panel into one period gt_data_outcomes <- tidyr::pivot_wider(gt_data[, c("D", "id", "period", "name", "Y")], @@ -54,7 +54,7 @@ did_attgt <- function(gt_data, xformla, ...) { y1 = Y_post, y0 = Y_pre, D = D, - covariates = model.matrix(xformla, + covariates = model.matrix(xformula, data = gt_dataX ), inffunc = TRUE @@ -83,7 +83,7 @@ did_attgt <- function(gt_data, xformla, ...) { #' #' @param gt_data data that is "local" to a particular group-time average #' treatment effect -#' @param xformla one-sided formula for covariates used in the propensity score +#' @param xformula one-sided formula for covariates used in the propensity score #' and outcome regression models #' @param d_outcome Whether or not to take the first difference of the outcome. #' The default is FALSE. To use difference-in-differences, set this to be TRUE. @@ -101,7 +101,7 @@ did_attgt <- function(gt_data, xformla, ...) { #' @export pte_attgt <- function( gt_data, - xformla, + xformula, d_outcome = FALSE, d_covs_formula = ~ -1, lagged_outcome_cov = FALSE, est_method = "dr", @@ -114,7 +114,7 @@ pte_attgt <- function( #----------------------------------------------------------------------------- # pre-treatment covariates - Xpre <- model.frame(xformla, data = subset(gt_data, name == "pre")) + Xpre <- model.frame(xformula, data = subset(gt_data, name == "pre")) .w <- subset(gt_data, name == "pre")$.w # change in covariates @@ -144,7 +144,7 @@ pte_attgt <- function( # to work in levels by just setting outcomes in "first period" # to be equal to 0 for all units gt_dataX <- droplevels(gt_dataX) - use_formula <- BMisc::toformula("", c(BMisc::rhs.vars(xformla), colnames(dX))) + use_formula <- BMisc::toformula("", c(BMisc::rhs.vars(xformula), colnames(dX))) if (lagged_outcome_cov) use_formula <- BMisc::addCovToFormla("pre", use_formula) covmat <- model.matrix(use_formula, data = gt_dataX) covmat2 <- covmat[D == 0, ] diff --git a/R/pte.R b/R/pte.R index 7c097a7..61b428c 100644 --- a/R/pte.R +++ b/R/pte.R @@ -662,7 +662,7 @@ pte_default <- function(yname, tname, idname, data, - xformla = ~1, + xformula = ~1, d_outcome = FALSE, d_covs_formula = ~ -1, lagged_outcome_cov = FALSE, @@ -685,7 +685,7 @@ pte_default <- function(yname, setup_pte_fun = setup_pte, subset_fun = two_by_two_subset, attgt_fun = pte_attgt, - xformla = xformla, + xformula = xformula, d_outcome = d_outcome, d_covs_formula = d_covs_formula, lagged_outcome_cov = lagged_outcome_cov, diff --git a/man/did_attgt.Rd b/man/did_attgt.Rd index 36b10bc..7de4cc7 100644 --- a/man/did_attgt.Rd +++ b/man/did_attgt.Rd @@ -4,7 +4,7 @@ \alias{did_attgt} \title{did_attgt} \usage{ -did_attgt(gt_data, xformla, ...) +did_attgt(gt_data, xformla = ~1, ...) } \arguments{ \item{gt_data}{data that is "local" to a particular group-time average diff --git a/man/pte_default.Rd b/man/pte_default.Rd index 9c0ac4a..299e91e 100644 --- a/man/pte_default.Rd +++ b/man/pte_default.Rd @@ -10,7 +10,7 @@ pte_default( tname, idname, data, - xformla = ~1, + xformula = ~1, d_outcome = FALSE, d_covs_formula = ~-1, lagged_outcome_cov = FALSE, @@ -37,9 +37,6 @@ pte_default( \item{data}{balanced panel data} -\item{xformla}{one-sided formula for covariates used in the propensity score -and outcome regression models} - \item{d_outcome}{Whether or not to take the first difference of the outcome. The default is FALSE. To use difference-in-differences, set this to be TRUE.} diff --git a/tests/testthat.R b/tests/testthat.R index 66f8706..a877a79 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -9,4 +9,4 @@ library(testthat) library(ptetools) -test_check("ptetool") +test_check("ptetools") diff --git a/tests/testthat/test-did-inference.R b/tests/testthat/test-did-inference.R index 8ade753..c9b3482 100644 --- a/tests/testthat/test-did-inference.R +++ b/tests/testthat/test-did-inference.R @@ -18,16 +18,18 @@ test_that("tests for inference", { sp <- did::reset.sim() data <- did::build_sim_dataset(sp) - res <- pte2( - yname = "Y", - gname = "G", - tname = "period", - idname = "id", - data = data, - setup_pte_fun = setup_pte, - subset_fun = two_by_two_subset, - attgt_fun = did_attgt, - xformla = ~X + res <- suppressWarnings( + pte2( + yname = "Y", + gname = "G", + tname = "period", + idname = "id", + data = data, + setup_pte_fun = setup_pte, + subset_fun = two_by_two_subset, + attgt_fun = did_attgt, + xformula = ~X + ) ) # truth is that att = 1 tstat <- (res$overall_att$overall.att - 1) / res$overall_att$overall.se @@ -37,5 +39,5 @@ test_that("tests for inference", { rej_frac <- mean(unlist(rejs)) - expect_equal(rej_frac, 0.06, tolerance = .05) # make test fail if reject 0 + expect_equal(rej_frac, 0.06, tolerance = 0.05) # make test fail if reject 0 }) diff --git a/tests/testthat/test-did.R b/tests/testthat/test-did.R index bc8abcf..d258df5 100644 --- a/tests/testthat/test-did.R +++ b/tests/testthat/test-did.R @@ -3,22 +3,23 @@ #------------------------------------------------------------------------ library(did) -devtools::load_all("~/Dropbox/ptetools") test_that("did basics", { sp <- did::reset.sim() data <- did::build_sim_dataset(sp) - res <- pte2( - yname = "Y", - gname = "G", - tname = "period", - idname = "id", - data = data, - setup_pte_fun = setup_pte, - subset_fun = two_by_two_subset, - attgt_fun = did_attgt, - xformla = ~X + res <- suppressWarnings( + pte2( + yname = "Y", + gname = "G", + tname = "period", + idname = "id", + data = data, + setup_pte_fun = setup_pte, + subset_fun = two_by_two_subset, + attgt_fun = did_attgt, + xformula = ~X + ) ) expect_equal(res$overall_att$overall.att, 1, tolerance = .5) @@ -32,7 +33,7 @@ test_that("did basics", { tname = "period", idname = "id", data = data, - xformla = ~X, + xformula = ~X, control_group = "notyettreated" ) @@ -43,22 +44,25 @@ test_that("did basics", { }) test_that("empirical bootstrap", { + skip_on_cran() sp <- did::reset.sim() data <- did::build_sim_dataset(sp) - res <- pte2( - yname = "Y", - gname = "G", - tname = "period", - idname = "id", - data = data, - setup_pte_fun = setup_pte, - subset_fun = two_by_two_subset, - attgt_fun = did_attgt, - xformla = ~X, - boot_type = "empirical", - biters = 10 - ) # just checking that this runs + res <- suppressWarnings( + pte2( + yname = "Y", + gname = "G", + tname = "period", + idname = "id", + data = data, + setup_pte_fun = setup_pte, + subset_fun = two_by_two_subset, + attgt_fun = did_attgt, + xformula = ~X, + boot_type = "empirical", + biters = 10 + ) # just checking that this runs + ) expect_equal(res$overall_att$overall.att, 1) message("this is failing because the names are not correct on the returns @@ -66,18 +70,22 @@ test_that("empirical bootstrap", { }) test_that("periods that look like years works ok and unbalanced groups", { + skip_on_cran() data(mpdta) - res <- pte2( - yname = "lemp", - gname = "first.treat", - tname = "year", - idname = "countyreal", - data = mpdta, - setup_pte_fun = setup_pte, - subset_fun = two_by_two_subset, - attgt_fun = did_attgt, - xformla = ~lpop + res <- suppressWarnings( + pte2( + yname = "lemp", + gname = "first.treat", + tname = "year", + idname = "countyreal", + data = mpdta, + setup_pte_fun = setup_pte, + subset_fun = two_by_two_subset, + attgt_fun = did_attgt, + xformula = ~lpop + ) ) + # this is to test if summary is working // had issues with ife version of this expect_equal(summary(res)$overall_att$overall_att, -0.0323) dyn_idx <- summary(res)$event_study[, "Event Time"] == 0 @@ -88,16 +96,18 @@ test_that("periods that look like years works ok and unbalanced groups", { #------------------------------------------------------------------------ data(mpdta) mpdta$G <- mpdta$first.treat - res <- pte2( - yname = "lemp", - gname = "G", - tname = "year", - idname = "countyreal", - data = mpdta, - setup_pte_fun = setup_pte, - subset_fun = two_by_two_subset, - attgt_fun = did_attgt, - xformla = ~lpop + res <- suppressWarnings( + pte2( + yname = "lemp", + gname = "G", + tname = "year", + idname = "countyreal", + data = mpdta, + setup_pte_fun = setup_pte, + subset_fun = two_by_two_subset, + attgt_fun = did_attgt, + xformula = ~lpop + ) ) # this is to test if summary is working // had issues with ife version of this expect_equal(summary(res)$overall_att$overall_att, -0.0323) @@ -109,15 +119,17 @@ test_that("no formula for covariates is ok", { sp <- did::reset.sim() data <- did::build_sim_dataset(sp) - res <- pte2( - yname = "Y", - gname = "G", - tname = "period", - idname = "id", - data = data, - setup_pte_fun = setup_pte, - subset_fun = two_by_two_subset, - attgt_fun = did_attgt + res <- suppressWarnings( + pte2( + yname = "Y", + gname = "G", + tname = "period", + idname = "id", + data = data, + setup_pte_fun = setup_pte, + subset_fun = two_by_two_subset, + attgt_fun = did_attgt + ) ) expect_equal(res$overall_att$overall.att, 1, tolerance = .5)