Merge pull request #12 from OuhscBbmc/dev

Dev

.Rbuildignore

@@ -12,6 +12,7 @@ documentation-for-developers/
 playgrounds/
 utility/
 ^\.github$
+^\.lintr$
 ^\.markdownlist\.json$
 ^\.travis\.yml$
 ^appveyor\.yml$

.lintr

@@ -0,0 +1,5 @@
+linters: linters_with_defaults(
+    line_length_linter(120),
+    commas_linter = NULL,
+    commented_code_linter = NULL
+  )

DESCRIPTION

@@ -2,34 +2,32 @@ Package: codified
 Title: Produce Standard/Formalized Demographics Tables
 Description: Augment clinical data with metadata to create
     output used in conventional publications and reports.
-Version: 0.2.9001
+Version: 0.3.0
 Authors@R: c(person("Will", "Beasley", role = c("aut", "cre"), email =
     "wibeasley@hotmail.com", comment = c(ORCID = "0000-0002-5613-5006")),
     person("Peter", "Higgins", role = "ctb"))
 URL: https://ouhscbbmc.github.io/codified/, https://github.com/OuhscBbmc/codified, https://github.com/higgi13425/nih_enrollment_table
 BugReports: https://github.com/OuhscBbmc/codified/issues
 Depends:
-    R(>= 3.0.0),
-    stats
+    R(>= 4.1.0)
 Imports:
     checkmate (>= 1.8.4),
-    dplyr (>= 0.7.0),
+    dplyr (>= 1.0.0),
     kableExtra,
     knitr (>= 1.18.0),
-    magrittr,
     rlang,
     tibble (>= 1.4.0),
-    tidyr (>= 0.7.0)
+    tidyr (>= 1.0.0)
 Suggests:
-    covr (>= 3.4),
-    devtools,
+    covr,
     readr (>= 1.1.0),
     REDCapR,
     rmarkdown,
-    testthat (>= 2.0)
+    testthat (>= 3.0)
 License: MIT + file LICENSE
-LazyData: TRUE
 VignetteBuilder: knitr
 Encoding: UTF-8
 RoxygenNote: 7.2.1
 Roxygen: list(markdown = TRUE)
+Config/testthat/edition: 3
+Language: en-US

NAMESPACE

@@ -2,6 +2,5 @@
 
 export(table_nih_enrollment)
 export(table_nih_enrollment_pretty)
-importFrom(magrittr,"%>%")
 importFrom(rlang,.data)
 importFrom(tibble,tibble)

NEWS.md

@@ -1,7 +1,13 @@
+Version 0.3.0 (released 2022-08-11)
+==========================================================
 
-# codified 0.2.0
+* Vignette mimics calling REDCap. (#9)
+* Small modernizations. (#9)
+
+Version 0.2.0 (released 2018-09-07)
+==========================================================
 
 * added `table_nih_enrollment()` and `table_nih_enrollment_pretty()`. #2
 * added `nih-enrollment-html` vignette. #6
 * started pkgdown site. #7
-* the idea was created by [Peter Higgins](http://www.med.umich.edu/higginslab/) (@higgi13425) for [R/Medicine 2018](http://r-medicine.com/).
+* the idea was created by [Peter Higgins](http://www.med.umich.edu/higginslab/) (@higgi13425) for [R/Medicine 2018](https://events.linuxfoundation.org/r-medicine/).

R/table-nih-enrollment.R

@@ -17,13 +17,11 @@
 #' @details
 #' https://grants.nih.gov/grants/how-to-apply-application-guide/forms-d/general/g.500-phs-inclusion-enrollment-report.htm
 #'
-#' @importFrom magrittr %>%
 #' @importFrom rlang .data
 #'
 #' @author Will Beasley, Peter Higgins, Andrew Peters, Sreeharsha Mandem
 #'
 #' @examples
-#' library(magrittr)
 #' ds_1 <- tibble::tribble(
 #'   ~subject_id,   ~gender  , ~race                      ,   ~ethnicity                     ,
 #'            1L,   "Male"   , "Black or African American",  "Not Hispanic or Latino"        ,
@@ -39,15 +37,15 @@
 #' table_nih_enrollment(ds_1)
 #' table_nih_enrollment_pretty(ds_1)
 #'
-#' table_nih_enrollment(ds_1) %>%
-#'   tidyr::spread(key=gender, value=n)
+#' table_nih_enrollment(ds_1) |>
+#'   tidyr::pivot_wider(names_from = gender, values_from = n)
 #'
-#' table_nih_enrollment(ds_1) %>%
+#' table_nih_enrollment(ds_1) |>
 #'   dplyr::mutate(
 #'     gender_ethnicity = paste0(gender, " by ", ethnicity)
-#'   ) %>%
-#'   dplyr::select(-gender, -ethnicity) %>%
-#'   tidyr::spread(key=gender_ethnicity, value=n)
+#'   ) |>
+#'   dplyr::select(-gender, -ethnicity) |>
+#'   tidyr::pivot_wider(names_from = gender_ethnicity, values_from = n)
 #'
 #' ds_2 <- tibble::tribble(
 #'   ~subject_id,  ~gender , ~race                      , ~ethnicity    ,
@@ -67,12 +65,12 @@
 #'   "Latino"    ,  "Hispanic or Latino"             ,
 #'   "Unknown"   ,  "Unknown/Not Reported Ethnicity"
 #' )
-#' table_nih_enrollment(ds_2, d_lu_ethnicity=ds_lu_ethnicity)
-#' table_nih_enrollment_pretty(ds_2, d_lu_ethnicity=ds_lu_ethnicity)
+#' table_nih_enrollment(ds_2, d_lu_ethnicity = ds_lu_ethnicity)
+#' table_nih_enrollment_pretty(ds_2, d_lu_ethnicity = ds_lu_ethnicity)
 #'
 #' ## Read a 500-patient fake dataset
-#' path <- system.file("misc/example-data-1.csv", package="codified")
-#' ds_3 <- readr::read_csv(path) %>%
+#' path <- system.file("misc/example-data-1.csv", package = "codified")
+#' ds_3 <- readr::read_csv(path) |>
 #'   dplyr::mutate(
 #'     gender     = as.character(gender),
 #'     race       = as.character(race),
@@ -120,16 +118,20 @@
 #' @export
 table_nih_enrollment <- function(
   d,
-  d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL,
-  variable_gender="gender", variable_race="race", variable_ethnicity="ethnicity"
+  d_lu_gender         = NULL,
+  d_lu_race           = NULL,
+  d_lu_ethnicity      = NULL,
+  variable_gender     = "gender",
+  variable_race       = "race",
+  variable_ethnicity  = "ethnicity"
 ) {
-  checkmate::assert_data_frame(d                  , any.missing=F)
-  checkmate::assert_data_frame(d_lu_gender        , any.missing=F, null.ok=T)
-  checkmate::assert_data_frame(d_lu_race          , any.missing=F, null.ok=T)
-  checkmate::assert_data_frame(d_lu_ethnicity     , any.missing=F, null.ok=T)
-  checkmate::assert_character( variable_gender    , any.missing=F, min.chars=1, len=1)
-  checkmate::assert_character( variable_race      , any.missing=F, min.chars=1, len=1)
-  checkmate::assert_character( variable_ethnicity , any.missing=F, min.chars=1, len=1)
+  checkmate::assert_data_frame(d                  , any.missing = FALSE)
+  checkmate::assert_data_frame(d_lu_gender        , any.missing = FALSE, null.ok    = TRUE)
+  checkmate::assert_data_frame(d_lu_race          , any.missing = FALSE, null.ok    = TRUE)
+  checkmate::assert_data_frame(d_lu_ethnicity     , any.missing = FALSE, null.ok    = TRUE)
+  checkmate::assert_character( variable_gender    , any.missing = FALSE, min.chars  = 1, len = 1)
+  checkmate::assert_character( variable_race      , any.missing = FALSE, min.chars  = 1, len = 1)
+  checkmate::assert_character( variable_ethnicity , any.missing = FALSE, min.chars  = 1, len = 1)
 
   levels_gender <- c(
     "Female",
@@ -158,51 +160,55 @@ table_nih_enrollment <- function(
     ethnicity = levels_ethnicity
   )
 
-  d <- d %>%
-    dplyr::select_(
-      "gender"      = variable_gender   ,
-      "race"        = variable_race     ,
-      "ethnicity"   = variable_ethnicity
+  d <- d |>
+    dplyr::select(
+      gender      = !!variable_gender   ,
+      race        = !!variable_race     ,
+      ethnicity   = !!variable_ethnicity
     )
-  if( !is.null(d_lu_gender) ) {
-    d <- d %>%
-      dplyr::left_join(d_lu_gender, by=c("gender" = "input")) %>%
-      dplyr::select(-.data$gender) %>%
+  if (!is.null(d_lu_gender)) {
+    d <- d |>
+      dplyr::left_join(d_lu_gender, by = c("gender" = "input")) |>
+      dplyr::select(-.data$gender) |>
       dplyr::rename(gender = .data$displayed)
   }
 
-  if( !is.null(d_lu_race) ) {
-    d <- d %>%
-      dplyr::left_join(d_lu_race, by=c("race" = "input")) %>%
-      dplyr::select(-.data$race) %>%
+  if (!is.null(d_lu_race)) {
+    d <- d |>
+      dplyr::left_join(d_lu_race, by = c("race" = "input")) |>
+      dplyr::select(-.data$race) |>
       dplyr::rename(race = .data$displayed)
   }
 
-  if( !is.null(d_lu_ethnicity) ) {
-    d <- d %>%
-      dplyr::left_join(d_lu_ethnicity, by=c("ethnicity" = "input")) %>%
-      dplyr::select(-.data$ethnicity) %>%
+  if (!is.null(d_lu_ethnicity)) {
+    d <- d |>
+      dplyr::left_join(d_lu_ethnicity, by = c("ethnicity" = "input")) |>
+      dplyr::select(-.data$ethnicity) |>
       dplyr::rename(ethnicity = .data$displayed)
   }
 
-  d_count <- d %>%
-    dplyr::count(.data$gender, .data$race, .data$ethnicity) %>%
-    dplyr::full_join(d_possible, by = c("gender", "race", "ethnicity")) %>%
+  d |>
+    dplyr::count(.data$gender, .data$race, .data$ethnicity) |>
+    dplyr::full_join(d_possible, by = c("gender", "race", "ethnicity")) |>
     dplyr::mutate(
-      gender    = factor(.data$gender   , levels=levels_gender    ),
-      race      = factor(.data$race     , levels=levels_race      ),
-      ethnicity = factor(.data$ethnicity, levels=levels_ethnicity ),
+      gender    = factor(.data$gender   , levels = levels_gender    ),
+      race      = factor(.data$race     , levels = levels_race      ),
+      ethnicity = factor(.data$ethnicity, levels = levels_ethnicity ),
       n         = dplyr::coalesce(.data$n, 0L)
-    ) %>%
-    dplyr::select(.data$gender, .data$race, .data$ethnicity, .data$n) %>%
+    ) |>
+    dplyr::select(.data$gender, .data$race, .data$ethnicity, .data$n) |>
     dplyr::arrange(.data$gender, .data$race, .data$ethnicity)
 }
 
 #' @export
 table_nih_enrollment_pretty <- function(
   d,
-  d_lu_gender=NULL, d_lu_race=NULL, d_lu_ethnicity=NULL,
-  variable_gender="gender", variable_race="race", variable_ethnicity="ethnicity"
+  d_lu_gender         = NULL,
+  d_lu_race           = NULL,
+  d_lu_ethnicity      = NULL,
+  variable_gender     = "gender",
+  variable_race       = "race",
+  variable_ethnicity  = "ethnicity"
 ) {
   column_order <- c(
     "race",
@@ -220,16 +226,19 @@ table_nih_enrollment_pretty <- function(
     "Unknown/Not Reported by Unknown/Not Reported Ethnicity"
   )
 
-  table_nih_enrollment(d, d_lu_gender, d_lu_race, d_lu_ethnicity, variable_gender, variable_race, variable_ethnicity) %>%
+  table_nih_enrollment(d, d_lu_gender, d_lu_race, d_lu_ethnicity, variable_gender, variable_race, variable_ethnicity) |>
     dplyr::mutate(
       gender_ethnicity  = paste0(.data$gender, " by ", .data$ethnicity)
-    ) %>%
-    dplyr::select(-.data$gender, -.data$ethnicity) %>%
-    tidyr::spread(key=.data$gender_ethnicity, value=.data$n) %>%
-    dplyr::select(!!column_order) %>%
+    ) |>
+    dplyr::select(-.data$gender, -.data$ethnicity) |>
+    tidyr::pivot_wider(
+      names_from  = .data$gender_ethnicity,
+      values_from = .data$n
+    ) |>
+    dplyr::select(!!column_order) |>
     knitr::kable(
       format      = "html",
-      format.args = list(big.mark=","),
+      format.args = list(big.mark = ","),
       escape      = FALSE,
       col.names   = c(
         "Racial\nCategories",
@@ -243,17 +252,17 @@ table_nih_enrollment_pretty <- function(
         "Male",
         "Unknown/<br/>Not Reported"
       )
-    ) %>%
+    ) |>
     kableExtra::kable_styling(
       bootstrap_options = c("striped", "hover", "condensed", "responsive"),
       full_width        = FALSE
-    ) %>%
-    kableExtra::column_spec(c(1, 4, 7), border_right = T) %>%
+    ) |>
+    kableExtra::column_spec(c(1, 4, 7), border_right = TRUE) |>
     kableExtra::add_header_above(c(
       " "                               = 1L,
       "Not Hispanic or Latino"          = 3L,
       "Hispanic or Latino"              = 3L,
       "Unknown/Not Reported Ethnicity"  = 3L
-    )) %>%
+    )) |>
     kableExtra::add_header_above(c(" " = 1L, "Ethnic Categories" = 9L))
 }

README.md

@@ -3,9 +3,9 @@ codified
 
 Produce standard/formalized demographics tables
 
-Clinical researchers often need to document and report the demographics of all consented subjects. A common use case is for reporting to funding agencies, including the National Institutes of Health (NIH). The NIH requires a particular format for the [PHS Inclusion Enrollment Report](https://grants.nih.gov/grants/how-to-apply-application-guide/forms-d/general/g.500-phs-inclusion-enrollment-report.htm) in each annual Research Performance Progress Report ([RPPR](https://grants.nih.gov/grants/rppr/index.htm)).
+Clinical researchers often need to document and report the demographics of all consented subjects. A common use case is for reporting to funding agencies, including the National Institutes of Health (NIH). The NIH requires a particular format for the [PHS Inclusion Enrollment Report](https://www.era.nih.gov/erahelp/assist/Content/ASSIST_Help_Topics/3_Form_Screens/PHS_HS_CT/PHS_Summary.htm) in each annual Research Performance Progress Report ([RPPR](https://grants.nih.gov/grants/rppr/index.htm)).
 
-The **codified** package, in combination with the **REDCapR** package, provides a pipeline to directly extract the demographics of consented subjects from a REDCap database, and to rapidly and reproducibly produce standard demographics tables.  This pipeline is demonstrated in the vignette, *[NIH Enrollment Tables in HTML](https://ouhscbbmc.github.io/codified/articles/nih-enrollment-html.html)*.
+The [codified](https://ouhscbbmc.github.io/codified/) package, in combination with the [REDCapR](https://ouhscbbmc.github.io/REDCapR/) package, provides a pipeline to directly extract the demographics of consented subjects from a REDCap database, and to rapidly and reproducibly produce standard demographics tables.  This pipeline is demonstrated in the vignette, *[NIH Enrollment Tables in HTML](https://ouhscbbmc.github.io/codified/articles/nih-enrollment-html.html)*.
 
 Installation and Documentation
 -----------------------
@@ -14,7 +14,7 @@ The *development* version can be installed from [GitHub](https://github.com/Ouhs
 
 ```r
 install.packages("remotes") # Run this line if the 'remotes' package isn't installed already.
-remotes::install_github(repo="OuhscBbmc/codified")
+remotes::install_github(repo = "OuhscBbmc/codified")
 ```
 
 The *release* version can be installed from [CRAN](https://cran.r-project.org/package=codified).
@@ -28,7 +28,7 @@ The package can be uninstalled from your local machine with `remove.packages("co
 Build Status and Package Characteristics
 -----------------------
 
-| [GitHub](https://github.com/OuhscBbmc/codified) | [Github Actions](https://github.com/OuhscBbmc/codified/actions) | [Coveralls](https://coveralls.io/r/OuhscBbmc/codified) |
+| [GitHub](https://github.com/OuhscBbmc/codified) | [GitHub Actions](https://github.com/OuhscBbmc/codified/actions) | [Coveralls](https://coveralls.io/github/OuhscBbmc/codified) |
 | :----- | :---------------------------: |  :-------: |
 | [Main](https://github.com/OuhscBbmc/codified/tree/main) | [![R-CMD-check](https://github.com/OuhscBbmc/codified/actions/workflows/check-release.yml/badge.svg)](https://github.com/OuhscBbmc/codified/actions/workflows/check-release.yml) | [![Coverage Status](https://coveralls.io/repos/github/OuhscBbmc/codified/badge.svg?branch=main)](https://coveralls.io/github/OuhscBbmc/codified?branch=main) |
 | [Dev](https://github.com/OuhscBbmc/codified/tree/dev) | [![R-CMD-check](https://github.com/OuhscBbmc/codified/actions/workflows/check-release.yml/badge.svg?branch=dev)](https://github.com/OuhscBbmc/codified/actions/workflows/check-release.yml) | [![Coverage Status](https://coveralls.io/repos/github/OuhscBbmc/codified/badge.svg?branch=dev)](https://coveralls.io/github/OuhscBbmc/codified?branch=dev) |
@@ -40,5 +40,5 @@ Build Status and Package Characteristics
 | [Development Doc](https://www.rdocumentation.org/) | [![Rdoc](https://img.shields.io/badge/pkgodwn-GitHub.io-orange.svg?longCache=true&style=style=for-the-badge)](https://ouhscbbmc.github.io/codified/) |
 | [Zenodo Archive](https://zenodo.org/search?ln=en&p=codified) | [![DOI](https://zenodo.org/badge/146359325.svg)](https://zenodo.org/badge/latestdoi/146359325) |
 | [CRAN Version](https://cran.r-project.org/package=codified) | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/codified)](https://cran.r-project.org/package=codified) |
-| [CRAN Rate](http://cranlogs.r-pkg.org/) | ![CRANPace](http://cranlogs.r-pkg.org/badges/codified) |
-| [Production Doc](https://www.rdocumentation.org/) | [![Rdoc](http://www.rdocumentation.org/badges/version/codified)](http://www.rdocumentation.org/packages/codified) |
+| [CRAN Rate](https://cranlogs.r-pkg.org:443/) | ![CRANPace](https://cranlogs.r-pkg.org:443/badges/codified) |
+| [Production Doc](https://www.rdocumentation.org/) | [![Rdoc](http://www.rdocumentation.org/badges/version/codified)](https://www.rdocumentation.org/packages/codified) |