From 346f595dbdf662982cb3e1c8f4cfa3527321c959 Mon Sep 17 00:00:00 2001 From: Zelos Zhu Date: Thu, 26 Oct 2023 19:16:54 +0000 Subject: [PATCH] feat: #2142 working enhanced function --- R/derive_summary_records.R | 34 ++++++++---------- R/get_summary_records.R | 14 ++++---- man/derive_summary_records.Rd | 6 ++-- man/derive_var_extreme_flag.Rd | 3 +- man/derive_var_joined_exist_flag.Rd | 3 +- man/derive_var_merged_exist_flag.Rd | 3 +- man/derive_var_merged_summary.Rd | 3 +- man/derive_var_obs_number.Rd | 3 +- man/derive_var_relative_flag.Rd | 3 +- man/derive_vars_joined.Rd | 3 +- man/derive_vars_merged.Rd | 3 +- man/derive_vars_merged_lookup.Rd | 3 +- man/derive_vars_transposed.Rd | 3 +- man/get_summary_records.Rd | 18 ++-------- tests/testthat/test-derive_summary_records.R | 38 ++++++++++++++++++++ 15 files changed, 75 insertions(+), 65 deletions(-) diff --git a/R/derive_summary_records.R b/R/derive_summary_records.R index e359768872..7df704f641 100644 --- a/R/derive_summary_records.R +++ b/R/derive_summary_records.R @@ -155,9 +155,9 @@ derive_summary_records <- function(dataset, required_vars = expr_c(by_vars), optional = TRUE ) - assert_varval_list(set_values_to, optional = TRUE) - assert_expr_list(missing_values, named = TRUE, optional = TRUE) + assert_varval_list(set_values_to) + assert_expr_list(missing_values, named = TRUE, optional = TRUE) if (!missing(analysis_var) || !missing(summary_fun)) { deprecate_warn( @@ -170,29 +170,15 @@ derive_summary_records <- function(dataset, set_values_to <- exprs(!!analysis_var := {{ summary_fun }}(!!analysis_var), !!!set_values_to) } - # Summarise the analysis value and bind to the original dataset - # bind_rows( - # dataset, - # get_summary_records( - # dataset, - # by_vars = by_vars, - # filter = !!filter, - # set_values_to = set_values_to - # ) - # analysis_var <- assert_symbol(enexpr(analysis_var)) - # assert_s3_class(summary_fun, "function") - # set_values_to <- exprs(!!analysis_var := {{ summary_fun }}(!!analysis_var), !!!set_values_to) - # } - if (is.null(dataset_add)) { dataset_add <- dataset } summary_records <- dataset_add %>% group_by(!!!by_vars) %>% - filter_if(filter) %>% - ungroup() %>% - process_set_values_to(set_values_to) + filter_if(filter) %>% + summarise(!!!set_values_to) %>% + ungroup() df_return <- bind_rows( dataset, @@ -215,6 +201,16 @@ derive_summary_records <- function(dataset, ) } + if (!is.null(missing_values)) { + update_missings <- map2( + syms(names(missing_values)), + missing_values, + ~ expr(if_else(is.na(!!missing_var), !!.y, !!.x)) + ) + names(update_missings) <- names(missing_values) + df_return <- df_return %>% + mutate(!!!update_missings) + } return(df_return) } diff --git a/R/get_summary_records.R b/R/get_summary_records.R index eec0b0b634..21328e9f5f 100644 --- a/R/get_summary_records.R +++ b/R/get_summary_records.R @@ -163,13 +163,13 @@ get_summary_records <- function(dataset, summary_fun, set_values_to = NULL) { # lifecycle::signal_stage("superseded", "get_summary_records()", "derive_summary_records(dataset_add= )") - inform( - message = paste0( - "`get_summary_records()` has been superseded, ", - "please use the `dataset_add` argument in `derive_summary_records()`", - sep = "" - ) - ) + # inform( + # message = paste0( + # "`get_summary_records()` has been superseded, ", + # "please use the `dataset_add` argument in `derive_summary_records()`", + # sep = "" + # ) + # ) assert_vars(by_vars) filter <- assert_filter_cond(enexpr(filter), optional = TRUE) assert_data_frame( diff --git a/man/derive_summary_records.Rd b/man/derive_summary_records.Rd index 1a7ecb6563..e3ad7d1945 100644 --- a/man/derive_summary_records.Rd +++ b/man/derive_summary_records.Rd @@ -63,10 +63,6 @@ Set a list of variables to some specified value for the new records \itemize{ \item LHS refer to a variable. \item RHS refers to the values to set to the variable. This can be a string, a -symbol, a numeric value, an expression, or \code{NA}, e.g., \code{exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")}. -}} - -\item{missing_values}{} symbol, a numeric value, an expression or NA. If summary functions are used, the values are summarized by the variables specified for \code{by_vars}. } @@ -79,6 +75,8 @@ For example: PARCAT1 = "OVERALL" ) }\if{html}{\out{}}} + +\item{missing_values}{} } \value{ A data frame with derived records appended to original dataset. diff --git a/man/derive_var_extreme_flag.Rd b/man/derive_var_extreme_flag.Rd index 0375ef0309..05ea1d8359 100644 --- a/man/derive_var_extreme_flag.Rd +++ b/man/derive_var_extreme_flag.Rd @@ -267,8 +267,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_var_joined_exist_flag.Rd b/man/derive_var_joined_exist_flag.Rd index b1f6f4455d..1469dbdb93 100644 --- a/man/derive_var_joined_exist_flag.Rd +++ b/man/derive_var_joined_exist_flag.Rd @@ -362,8 +362,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_var_merged_exist_flag.Rd b/man/derive_var_merged_exist_flag.Rd index ae0728a4bd..76c08d7083 100644 --- a/man/derive_var_merged_exist_flag.Rd +++ b/man/derive_var_merged_exist_flag.Rd @@ -159,8 +159,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_var_merged_summary.Rd b/man/derive_var_merged_summary.Rd index 08220316cb..057bdf569c 100644 --- a/man/derive_var_merged_summary.Rd +++ b/man/derive_var_merged_summary.Rd @@ -175,8 +175,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_var_obs_number.Rd b/man/derive_var_obs_number.Rd index d4c54e6881..ebdd3375f1 100644 --- a/man/derive_var_obs_number.Rd +++ b/man/derive_var_obs_number.Rd @@ -102,8 +102,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_var_relative_flag.Rd b/man/derive_var_relative_flag.Rd index ac017c896d..679df63d95 100644 --- a/man/derive_var_relative_flag.Rd +++ b/man/derive_var_relative_flag.Rd @@ -178,8 +178,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_vars_joined.Rd b/man/derive_vars_joined.Rd index 5092e89ab8..7bd1c3f664 100644 --- a/man/derive_vars_joined.Rd +++ b/man/derive_vars_joined.Rd @@ -372,8 +372,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_relative_flag}()}, \code{\link{derive_vars_merged_lookup}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_vars_merged.Rd b/man/derive_vars_merged.Rd index dca45a6222..d021aba1fd 100644 --- a/man/derive_vars_merged.Rd +++ b/man/derive_vars_merged.Rd @@ -326,8 +326,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_relative_flag}()}, \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_vars_merged_lookup.Rd b/man/derive_vars_merged_lookup.Rd index 3024d10083..3016da5a55 100644 --- a/man/derive_vars_merged_lookup.Rd +++ b/man/derive_vars_merged_lookup.Rd @@ -182,8 +182,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_relative_flag}()}, \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_transposed}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/derive_vars_transposed.Rd b/man/derive_vars_transposed.Rd index 8195dd1166..9e7e753d5d 100644 --- a/man/derive_vars_transposed.Rd +++ b/man/derive_vars_transposed.Rd @@ -97,8 +97,7 @@ General Derivation Functions for all ADaMs that returns variable appended to dat \code{\link{derive_var_relative_flag}()}, \code{\link{derive_vars_joined}()}, \code{\link{derive_vars_merged_lookup}()}, -\code{\link{derive_vars_merged}()}, -\code{\link{get_summary_records}()} +\code{\link{derive_vars_merged}()} } \concept{der_gen} \keyword{der_gen} diff --git a/man/get_summary_records.Rd b/man/get_summary_records.Rd index 2f56e23183..beddbdf179 100644 --- a/man/get_summary_records.Rd +++ b/man/get_summary_records.Rd @@ -10,7 +10,7 @@ get_summary_records( filter = NULL, analysis_var, summary_fun, - set_values_to + set_values_to = NULL ) } \arguments{ @@ -169,18 +169,6 @@ get_summary_records( } \seealso{ \code{\link[=derive_summary_records]{derive_summary_records()}}, \code{\link[=derive_var_merged_summary]{derive_var_merged_summary()}} - -General Derivation Functions for all ADaMs that returns variable appended to dataset: -\code{\link{derive_var_extreme_flag}()}, -\code{\link{derive_var_joined_exist_flag}()}, -\code{\link{derive_var_merged_exist_flag}()}, -\code{\link{derive_var_merged_summary}()}, -\code{\link{derive_var_obs_number}()}, -\code{\link{derive_var_relative_flag}()}, -\code{\link{derive_vars_joined}()}, -\code{\link{derive_vars_merged_lookup}()}, -\code{\link{derive_vars_merged}()}, -\code{\link{derive_vars_transposed}()} } -\concept{der_gen} -\keyword{der_gen} +\concept{superseded} +\keyword{internal} diff --git a/tests/testthat/test-derive_summary_records.R b/tests/testthat/test-derive_summary_records.R index c7b26c927e..8bfcf00e71 100644 --- a/tests/testthat/test-derive_summary_records.R +++ b/tests/testthat/test-derive_summary_records.R @@ -143,3 +143,41 @@ test_that("derive_summary_records Test 4: deprecation warning for analysis_var a keys = c("subj", "visit", "seq", "type") ) }) + +test_that("make sure dataset_add works", { + input <- tibble::tribble( + ~subj, ~visit, ~val, ~seq, + "1", 1, 10, 1, + "1", 1, 14, 2, + "1", 1, 9, 3, + "1", 2, 11, 4, + "2", 2, NA_real_, 1 + ) + input_add <- tibble::tribble( + ~subj, ~visit, ~add_val, ~seq, + "1", 1, 100, 1, + "1", 1, 140, 2, + "1", 1, 90, 3 + ) + expected_output<- bind_rows( + input, + tibble::tribble( + ~subj, ~visit, ~val, ~type, + "1", 1, 110, "AVERAGE" + ) + ) + actual_output <- input %>% + derive_summary_records( + dataset_add = input_add, + by_vars = exprs(subj, visit), + set_values_to = exprs( + val = mean(add_val, na.rm = TRUE), + type = "AVERAGE" + ) + ) + expect_dfs_equal( + base = expected_output, + compare = actual_output, + keys = c("subj", "visit", "seq", "type") + ) +})