-
Notifications
You must be signed in to change notification settings - Fork 4
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #132 from OuhscBbmc/dev
`row_sum()`
- Loading branch information
Showing
9 changed files
with
595 additions
and
8 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,43 @@ | ||
| { | ||
| "version": "2.0.0", | ||
| "tasks": [ | ||
| { | ||
| "type": "R", | ||
| "code": [ | ||
| "devtools::build()" | ||
| ], | ||
| "group": "build", | ||
| "problemMatcher": [], | ||
| "label": "R: Build" | ||
| }, | ||
| { | ||
| "type": "R", | ||
| "code": [ | ||
| "devtools::test()" | ||
| ], | ||
| "problemMatcher": [ | ||
| "$testthat" | ||
| ], | ||
| "group": "test", | ||
| "label": "R: Test" | ||
| }, | ||
| { | ||
| "type": "R", | ||
| "code": [ | ||
| "devtools::check()" | ||
| ], | ||
| "group": "test", | ||
| "problemMatcher": [], | ||
| "label": "R: Check" | ||
| }, | ||
| { | ||
| "type": "R", | ||
| "code": [ | ||
| "devtools::document()" | ||
| ], | ||
| "group": "build", | ||
| "problemMatcher": [], | ||
| "label": "R: Document" | ||
| } | ||
| ] | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -31,6 +31,7 @@ Suggests: | |
| RODBC, | ||
| spelling, | ||
| testthat, | ||
| tidyr, | ||
| tinytex | ||
| Encoding: UTF-8 | ||
| Language: en-US | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,177 @@ | ||
| #' @name row_sum | ||
| #' @title Find the sum of selected columns within a row | ||
| #' | ||
| #' @description Sums across columns within a row, | ||
| #' while accounting for nonmissingness. | ||
| #' Specify the desired columns by passing their explicit column names or | ||
| #' 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. | ||
| #' If empty, `pattern` is used to select columns. Optional. | ||
| #' @param pattern A regular expression pattern passed to [base::grep()] | ||
| #' (with `perl = TRUE`). Optional | ||
| #' @param new_column_name The name of the new column that represents the sum | ||
| #' of the specified columns. Required. | ||
| #' @param threshold_proportion Designates the minimum proportion of columns | ||
| #' that have a nonmissing values (within each row) in order to return a sum. | ||
| #' Required; defaults to to 0.75. | ||
| #' In other words, by default, if less than 75% of the specified | ||
| #' cells are missing within a row, the row sum will be `NA`. | ||
| #' @param nonmissing_count_name If a non-NA value is passed, | ||
| #' a second column will be added to `d` that contains the row's count | ||
| #' of nonmissing items among the selected columns. | ||
| #' Must be a valid column name. Optional. | ||
| #' @param verbose a logical value to designate if extra information is | ||
| #' displayed in the console, | ||
| #' such as which columns are matched by `pattern`. | ||
| #' | ||
| #' @return The data.frame `d`, | ||
| #' with the additional column containing the row sum. | ||
| #' If a valid value is passed to `nonmissing_count_name`, | ||
| #' a second column will be added as well. | ||
| #' | ||
| #' @details | ||
| #' If the specified columns are all logicals or integers, | ||
| #' the new column will be an [integer]. | ||
| #' Otherwise the new column will be a [double]. | ||
| #' | ||
| #' @author Will Beasley | ||
| #' @importFrom rlang := | ||
| #' @examples | ||
| #' mtcars |> | ||
| #' OuhscMunge::row_sum( | ||
| #' columns_to_average = c("cyl", "disp", "vs", "carb"), | ||
| #' new_column_name = "engine_sum" | ||
| #' ) | ||
| #' | ||
| #' mtcars |> | ||
| #' OuhscMunge::row_sum( | ||
| #' columns_to_average = c("cyl", "disp", "vs", "carb"), | ||
| #' new_column_name = "engine_sum", | ||
| #' nonmissing_count_name = "engine_nonmissing_count" | ||
| #' ) | ||
| #' | ||
| #' if (require(tidyr)) | ||
| #' tidyr::billboard |> | ||
| #' OuhscMunge::row_sum( | ||
| #' pattern = "^wk\\d{1,2}$", | ||
| #' new_column_name = "week_sum", | ||
| #' threshold_proportion = .1, | ||
| #' verbose = TRUE | ||
| #' ) |> | ||
| #' dplyr::select( | ||
| #' artist, | ||
| #' date.entered, | ||
| #' week_sum, | ||
| #' ) | ||
| #' | ||
| #' tidyr::billboard |> | ||
| #' OuhscMunge::row_sum( | ||
| #' pattern = "^wk\\d$", | ||
| #' new_column_name = "week_sum", | ||
| #' verbose = TRUE | ||
| #' ) |> | ||
| #' dplyr::select( | ||
| #' artist, | ||
| #' date.entered, | ||
| #' week_sum, | ||
| #' ) | ||
|
|
||
| #' @export | ||
| row_sum <- function( | ||
| d, | ||
| columns_to_average = 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(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 <- | ||
| d |> | ||
| colnames() |> | ||
| grep( | ||
| x = _, | ||
| pattern = pattern, | ||
| value = TRUE, | ||
| perl = TRUE | ||
| ) | ||
|
|
||
| if (verbose) { | ||
| message( | ||
| "The following columns will be summed:\n- ", | ||
| paste(columns_to_average, collapse = "\n- ") | ||
| ) | ||
| } | ||
| } | ||
|
|
||
| cast_to_integer <- | ||
| d |> | ||
| dplyr::select(!!columns_to_average) |> | ||
| purrr::every( | ||
| \(x) { | ||
| is.logical(x) | is.integer(x) | ||
| } | ||
| ) | ||
|
|
||
| .rs <- .nonmissing_count <- .nonmissing_proportion <- NULL | ||
| d <- | ||
| d |> | ||
| dplyr::mutate( | ||
| .rs = | ||
| rowSums( | ||
| dplyr::across(!!columns_to_average), | ||
| na.rm = TRUE | ||
| ), | ||
| .nonmissing_count = | ||
| rowSums( | ||
| dplyr::across( | ||
| !!columns_to_average, | ||
| .fns = \(x) { !is.na(x) } | ||
| ) | ||
| ), | ||
| .nonmissing_proportion = .nonmissing_count / length(columns_to_average), | ||
| {{new_column_name}} := | ||
| dplyr::if_else( | ||
| threshold_proportion <= .nonmissing_proportion, | ||
| .rs, | ||
| # .rs / .nonmissing_count, | ||
| NA_real_ | ||
| ) | ||
| ) | ||
|
|
||
| if (!is.na(nonmissing_count_name)) { | ||
| d <- | ||
| d |> | ||
| dplyr::mutate( | ||
| {{nonmissing_count_name}} := .nonmissing_count, | ||
| ) | ||
| } | ||
|
|
||
| d <- | ||
| d |> | ||
| dplyr::select( | ||
| -.rs, | ||
| -.nonmissing_count, | ||
| -.nonmissing_proportion, | ||
| ) | ||
| # Alternatively, return just the new columns | ||
| # dplyr::pull({{new_column_name}}) | ||
|
|
||
| if (cast_to_integer) { | ||
| d[[new_column_name]] <- as.integer(d[[new_column_name]]) | ||
| } | ||
|
|
||
| d | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,13 +1,10 @@ | ||
| | [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) | [](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [](https://codecov.io/gh/OuhscBbmc/OuhscMunge) | | ||
| | [Dev](https://github.com/OuhscBbmc/OuhscMunge/tree/dev) | [](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge/tree/dev) | | ||
|
|
||
| OuhscMunge | ||
| ========== | ||
|
|
||
| Data manipulation operations commonly used by the [Biomedical and Behavioral Methodology Core](http://www.ouhsc.edu/bbmc/) within the [Department of Pediatrics](http://www.oumedicine.com/pediatrics) of the [University of Oklahoma Health Sciences Center](http://ouhsc.edu/). | ||
|
|
||
| ### Download and Installation Instructions | ||
|
|
||
| <!-- | ||
| The *release* version of OuhscMunge can be installed from [CRAN](http://cran.r-project.org/web/packages/OuhscMunge/). | ||
| ```r | ||
|
|
@@ -16,16 +13,21 @@ install.packages("OuhscMunge") | |
| --> | ||
|
|
||
| The *development* version of `OuhscMunge` can be installed from [GitHub](https://github.com/OuhscBbmc/OuhscMunge) after installing the `remotes` package. (The *release* version will be available on [CRAN](https://cran.r-project.org/) later.) | ||
|
|
||
| ```r | ||
| install.packages("remotes") # If it's not already installed. | ||
| remotes::install_github("OuhscBbmc/OuhscMunge") | ||
| ``` | ||
|
|
||
| ### Collaborative Development | ||
|
|
||
| We encourage input and collaboration from the overall community. If you're familiar with GitHub and R packages, feel free to submit a [pull request](https://github.com/OuhscBbmc/OuhscMunge/pulls). If you'd like to report a bug or make a suggestion, please create a GitHub [issue](https://github.com/OuhscBbmc/OuhscMunge/issues); issues are a usually a good place to ask public questions too. However, feel free to email Will (<[email protected]>). Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). By participating in this project you agree to abide by its terms. | ||
|
|
||
| ### Thanks to Funders | ||
| *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). | ||
|
|
||
| * *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). | ||
|
|
||
| (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. | ||
|
|
||
|
|
@@ -38,3 +40,10 @@ Main Branch: | |
| Dev Branch: | ||
|
|
||
|  | ||
|
|
||
| ### Build Status and Package Characteristics | ||
|
|
||
| | [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) | [](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [](https://codecov.io/gh/OuhscBbmc/OuhscMunge) | | ||
| | [Dev](https://github.com/OuhscBbmc/OuhscMunge/tree/dev) | [](https://github.com/OuhscBbmc/OuhscMunge/actions/workflows/check-release.yaml) | [](https://app.codecov.io/gh/OuhscBbmc/OuhscMunge/tree/dev) | | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.