Merge pull request #143 from OuhscBbmc/dev

`row_mean()`

DESCRIPTION

@@ -2,7 +2,7 @@ Package: OuhscMunge
 Title: Data Manipulation Operations
 Description: Data manipulation operations frequently used in OUHSC BBMC
     projects.
-Version: 1.0.0.9000
+Version: 1.0.1.9000
 Authors@R: person("Will", "Beasley", email="wibeasley@hotmail.com", role=c("aut", "cre"),
     comment = c(ORCID = "0000-0002-5613-5006"))
 URL: https://github.com/OuhscBbmc/OuhscMunge, http://ouhsc.edu/bbmc/
@@ -36,4 +36,4 @@ Suggests:
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.2

NAMESPACE

@@ -40,6 +40,7 @@ export(readr_spec_aligned)
 export(replace_nas_with_explicit)
 export(replace_with_nas)
 export(retrieve_key_value)
+export(row_mean)
 export(row_sum)
 export(snake_case)
 export(trim_character)

R/row.R

@@ -1,4 +1,4 @@
-#' @name row_sum
+#' @name row
 #' @title Find the sum of selected columns within a row
 #'
 #' @description Sums across columns within a row,
@@ -7,8 +7,8 @@
 #' by passing a regular expression to matches the column names.
 #'
 #' @param d The data.frame containing the values to sum. Required.
-#' @param columns_to_average A character vector containing the columns
-#' names to sum.
+#' @param columns_to_process A character vector containing the columns
+#' names to process (_e.g._, to average or to sum).
 #' If empty, `pattern` is used to select columns. Optional.
 #' @param pattern A regular expression pattern passed to [base::grep()]
 #' (with `perl = TRUE`).  Optional
@@ -42,17 +42,24 @@
 #' @examples
 #' mtcars |>
 #'   OuhscMunge::row_sum(
-#'     columns_to_average = c("cyl", "disp", "vs", "carb"),
+#'     columns_to_process = c("cyl", "disp", "vs", "carb"),
 #'     new_column_name    = "engine_sum"
 #'   )
 #'
 #' mtcars |>
 #'   OuhscMunge::row_sum(
-#'     columns_to_average     = c("cyl", "disp", "vs", "carb"),
+#'     columns_to_process     = c("cyl", "disp", "vs", "carb"),
 #'     new_column_name        = "engine_sum",
 #'     nonmissing_count_name  = "engine_nonmissing_count"
 #'   )
 #'
+#' mtcars |>
+#'   OuhscMunge::row_mean(
+#'     columns_to_process     = c("cyl", "disp", "vs", "carb"),
+#'     new_column_name        = "engine_mean",
+#'     nonmissing_count_name  = "engine_nonmissing_count"
+#'   )
+#'
 #' if (require(tidyr))
 #'   tidyr::billboard |>
 #'     OuhscMunge::row_sum(
@@ -79,26 +86,27 @@
 #'       week_sum,
 #'     )
 
+#' @rdname row
 #' @export
 row_sum <- function(
   d,
-  columns_to_average        = character(0),
+  columns_to_process        = character(0),
   pattern                   = "",
   new_column_name           = "row_sum",
   threshold_proportion      = .75,
   nonmissing_count_name     = NA_character_,
   verbose                   = FALSE
 ) {
   checkmate::assert_data_frame(d)
-  checkmate::assert_character(columns_to_average  , any.missing = FALSE)
+  checkmate::assert_character(columns_to_process  , any.missing = FALSE)
   checkmate::assert_character(pattern             , len = 1)
   checkmate::assert_character(new_column_name     , len = 1)
   checkmate::assert_double(   threshold_proportion, len = 1)
   checkmate::assert_character(nonmissing_count_name, len = 1, min.chars = 1, any.missing = TRUE)
   checkmate::assert_logical(  verbose             , len = 1)
 
-  if (length(columns_to_average) == 0L) {
-    columns_to_average <-
+  if (length(columns_to_process) == 0L) {
+    columns_to_process <-
       d |>
       colnames() |>
       grep(
@@ -110,15 +118,15 @@ row_sum <- function(
 
     if (verbose) {
       message(
-        "The following columns will be summed:\n- ",
-        paste(columns_to_average, collapse = "\n- ")
+        "The following columns will be processed:\n- ",
+        paste(columns_to_process, collapse = "\n- ")
       )
     }
   }
 
   cast_to_integer <-
     d |>
-    dplyr::select(!!columns_to_average) |>
+    dplyr::select(!!columns_to_process) |>
     purrr::every(
       \(x) {
         is.logical(x) | is.integer(x)
@@ -131,19 +139,19 @@ row_sum <- function(
     dplyr::mutate(
       .rs =
         rowSums(
-          dplyr::across(!!columns_to_average),
+          dplyr::across(!!columns_to_process),
           na.rm = TRUE
         ),
       .nonmissing_count =
         rowSums(
           dplyr::across(
-            !!columns_to_average,
+            !!columns_to_process,
             .fns = \(x) {
               !is.na(x)
             }
           )
         ),
-      .nonmissing_proportion = .nonmissing_count / length(columns_to_average),
+      .nonmissing_proportion = .nonmissing_count / length(columns_to_process),
       {{new_column_name}} :=
         dplyr::if_else(
           threshold_proportion <= .nonmissing_proportion,
@@ -177,3 +185,90 @@ row_sum <- function(
 
   d
 }
+
+#' @rdname row
+#' @export
+row_mean <- function(
+  d,
+  columns_to_process        = character(0),
+  pattern                   = "",
+  new_column_name           = "row_mean",
+  threshold_proportion      = .75,
+  nonmissing_count_name     = NA_character_,
+  verbose                   = FALSE
+) {
+  checkmate::assert_data_frame(d)
+  checkmate::assert_character(columns_to_process  , any.missing = FALSE)
+  checkmate::assert_character(pattern             , len = 1)
+  checkmate::assert_character(new_column_name     , len = 1)
+  checkmate::assert_double(   threshold_proportion, len = 1)
+  checkmate::assert_character(nonmissing_count_name, len = 1, min.chars = 1, any.missing = TRUE)
+  checkmate::assert_logical(  verbose             , len = 1)
+
+  if (length(columns_to_process) == 0L) {
+    columns_to_process <-
+      d |>
+      colnames() |>
+      grep(
+        x         = _,
+        pattern   = pattern,
+        value     = TRUE,
+        perl      = TRUE
+      )
+
+    if (verbose) {
+      message(
+        "The following columns will be processed:\n- ",
+        paste(columns_to_process, collapse = "\n- ")
+      )
+    }
+  }
+
+  .rm <- .nonmissing_count <- .nonmissing_proportion <- NULL
+  d <-
+    d |>
+    dplyr::mutate(
+      .rm =
+        rowMeans(
+          dplyr::across(!!columns_to_process),
+          na.rm = TRUE
+        ),
+      .nonmissing_count =
+        rowSums(
+          dplyr::across(
+            !!columns_to_process,
+            .fns = \(x) {
+              !is.na(x)
+            }
+          )
+        ),
+      .nonmissing_proportion = .nonmissing_count / length(columns_to_process),
+      {{new_column_name}} :=
+        dplyr::if_else(
+          threshold_proportion <= .nonmissing_proportion,
+          .rm,
+          # .rs / .nonmissing_count,
+          NA_real_
+        )
+    )
+
+  if (!is.na(nonmissing_count_name)) {
+    d <-
+      d |>
+      dplyr::mutate(
+        {{nonmissing_count_name}} := .nonmissing_count,
+      )
+  }
+
+  d <-
+    d |>
+    dplyr::select(
+      -.rm,
+      -.nonmissing_count,
+      -.nonmissing_proportion,
+    )
+  # Alternatively, return just the new columns
+  # dplyr::pull({{new_column_name}})
+
+  d
+}

README.md

@@ -27,7 +27,7 @@ We encourage input and collaboration from the overall community.  If you're fami
 
 * *Oklahoma Shared Clinical and Translational Resources*, sponsored by [NIH NIGMS; U54 GM104938](https://grantome.com/grant/NIH/U54-GM104938). Judith A. James, PI, OUHSC; 2013-2018.
 * *Oklahoma Shared Clinical and Translational Resources*, sponsored by [NIH U54GM104938](https://taggs.hhs.gov/Detail/AwardDetail?arg_AwardNum=U54GM104938&arg_ProgOfficeCode=127); 2020-2021.
-* *OUHSC CCAN Independent Evaluation of the State of Oklahoma Competitive Maternal, Infant, and Early Childhood Home Visiting ([MIECHV](https://mchb.hrsa.gov/programs-impact/programs/home-visiting)) Project.*: Evaluates MIECHV expansion and enhancement of Evidence-based Home Visitation programs in four Oklahoma counties. [HRSA/ACF D89MC23154](https://perf-data.hrsa.gov/mchb/DGISReports/Abstract/AbstractDetails.aspx?Source=TVIS&GrantNo=D89MC23154&FY=2012).
+* *OUHSC CCAN Independent Evaluation of the State of Oklahoma Competitive Maternal, Infant, and Early Childhood Home Visiting ([MIECHV](https://mchb.hrsa.gov/programs-impact/programs/home-visiting/maternal-infant-early-childhood-home-visiting-miechv-program)) Project.*: Evaluates MIECHV expansion and enhancement of Evidence-based Home Visitation programs in four Oklahoma counties. [HRSA/ACF D89MC23154](https://perf-data.hrsa.gov/mchb/DGISReports/Abstract/AbstractDetails.aspx?Source=TVIS&GrantNo=D89MC23154&FY=2012).
 
 (So far) the primary developers of OuhscMunge are the external evaluators for [Oklahoma's MIECHV](https://www.ok.gov/health/Child_and_Family_Health/Family_Support_and_Prevention_Service/MIECHV_Program_-_Federal_Home_Visiting_Grant/MIECHV_Program_Resources/index.html) program.
 
@@ -45,5 +45,5 @@ Dev Branch:
 
 | [GitHub](https://github.com/OuhscBbmc/OuhscMunge) | [Travis-CI](https://app.travis-ci.com/OuhscBbmc/OuhscMunge/builds) | [CodeCov](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge/) |
 | :----- | :---------------------------: | :-------: |
-| [Main](https://github.com/OuhscBbmc/OuhscMunge/tree/main) | [![R-CMD-check](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml/badge.svg)](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [![codecov](https://codecov.io/gh/OuhscBbmc/OuhscMunge/branch/main/graph/badge.svg?token=O1mkr31GRw)](https://codecov.io/gh/OuhscBbmc/OuhscMunge) |
-| [Dev](https://github.com/OuhscBbmc/OuhscMunge/tree/dev) | [![R-CMD-check](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml/badge.svg?branch=dev)](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [![codecov](https://codecov.io/gh/OuhscBbmc/OuhscMunge/branch/dev/graph/badge.svg?token=O1mkr31GRw)](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge/tree/dev) |
+| [Main](https://github.com/OuhscBbmc/OuhscMunge/tree/main) | [![R-CMD-check](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml/badge.svg)](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [![codecov](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge/branch/main/graph/badge.svg?token=O1mkr31GRw)](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge) |
+| [Dev](https://github.com/OuhscBbmc/OuhscMunge/tree/dev) | [![R-CMD-check](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml/badge.svg?branch=dev)](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [![codecov](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge/branch/dev/graph/badge.svg?token=O1mkr31GRw)](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge/tree/dev) |