Skip to content

Commit

Permalink
Merge pull request #322 from Roche-GSK/devel
Browse files Browse the repository at this point in the history
Version 0.2.0 addendum
bundfussr authored Jul 6, 2021

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature. The key has expired.
2 parents 0ab6e12 + 2844fa8 commit 69a320b
Showing 85 changed files with 684 additions and 360 deletions.
5 changes: 2 additions & 3 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,6 +1,5 @@
# Generated by roxygen2: do not edit by hand

export("%!in%")
export(assert_character_scalar)
export(assert_character_vector)
export(assert_data_frame)
@@ -52,6 +51,8 @@ export(expect_dfs_equal)
export(exprs)
export(extract_duplicate_records)
export(filter_extreme)
export(format_eoxxstt_default)
export(format_reason_default)
export(get_duplicates_dataset)
export(impute_dtc)
export(is_date)
@@ -65,11 +66,9 @@ export(is_valid_time_entry)
export(is_varval_list)
export(list_all_templates)
export(lstalvdt_source)
export(quo_not_missing)
export(signal_duplicate_records)
export(suppress_warning)
export(use_ad_template)
export(validate_lstalvdt_source)
export(vars)
export(warn_if_inconsistent_list)
export(warn_if_invalid_dtc)
2 changes: 1 addition & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# admiral (0.2.0)
# admiral 0.2.0

## New Features

24 changes: 13 additions & 11 deletions R/assertions.R
Original file line number Diff line number Diff line change
@@ -277,7 +277,7 @@ assert_symbol <- function(arg, optional = FALSE) {
invisible(arg)
}

#' Is an argument a filtering condition?
#' Is an Argument a Filter Condition?
#'
#' @param arg Quosure - filtering condition.
#' @param optional Logical - is the argument optional? Defaults to `FALSE`.
@@ -330,7 +330,7 @@ assert_filter_cond <- function(arg, optional = FALSE) {
invisible(arg)
}

#' Is an Argument a valid list of variables created using `vars()`?
#' Is an Argument a List of Variables?
#'
#' Checks if an argument is a valid list of variables created using `vars()`
#'
@@ -394,7 +394,7 @@ assert_vars <- function(arg, optional = FALSE) {
invisible(arg)
}

#' Is an Argument a valid list of order variables created using `vars()`?
#' Is an Argument a List of Order Variables?
#'
#' Checks if an argument is a valid list of order variables created using `vars()`
#'
@@ -629,7 +629,7 @@ on_failure(is_timeunit) <- function(call, env) {
)
}

#' Check validity of the date imputation input
#' Check Validity of the Date Imputation Input
#'
#' Date_imputation format should be specified as "dd-mm" (e.g. "01-01")
#' or as a keyword: "FISRT", "MID", "LAST"
@@ -663,7 +663,7 @@ on_failure(is_valid_date_entry) <- function(call, env) {
)
}

#' Check validity of the time imputation input
#' Check Validity of the Time Imputation Input
#'
#' Time_imputation format should be specified as "hh:mm:ss" (e.g. "00:00:00")
#' or as a keyword: "FISRT", "LAST"
@@ -697,7 +697,7 @@ on_failure(is_valid_time_entry) <- function(call, env) {
)
}

#' Check validity of the minute/second portion in the time input
#' Check Validity of the Minute/Second Portion of the Time Input
#'
#' Minutes and seconds are expected to range from 0 to 59
#'
@@ -727,7 +727,7 @@ on_failure(is_valid_sec_min) <- function(call, env) {
)
}

#' Check validity of the hour portion in the time input
#' Check Validity of the Hour Portion in the Time Input
#'
#' Hours are expected to range from 0 to 23
#'
@@ -757,7 +757,7 @@ on_failure(is_valid_hour) <- function(call, env) {
)
}

#' Check validity of the day portion in the date input
#' Check Validity of the Day Portion in the Date Input
#'
#' Days are expected to range from 1 to 31
#'
@@ -787,7 +787,7 @@ on_failure(is_valid_day) <- function(call, env) {
)
}

#' Check validity of the month portion in the date input
#' Check Validity of the Month Portion in the Date Input
#'
#' Days are expected to range from 1 to 12
#'
@@ -818,7 +818,7 @@ on_failure(is_valid_month) <- function(call, env) {
)
}

#' Is Variable-value List?
#' Is Variable-Value List?
#'
#' Checks if the argument is a list of quosures where the expressions are
#' variable-value pairs. The value can be a symbol, a string, or NA. More general
@@ -926,6 +926,8 @@ on_failure(is_expr) <- function(call, env) {
#'
#' @return Logical value.
#'
#' @noRd
#'
#' @examples
#' \dontrun{
#' x <- list("x", "y")
@@ -950,7 +952,7 @@ on_failure(are_records_same) <- function(call, env) {
#'
#' @author Thomas Neitmann, Ondrej Slama
#'
#' @export
#' @noRd
#'
#' @examples
#' test_fun <- function(x) {x <- rlang::enquo(x); assertthat::assert_that(quo_not_missing(x))}
2 changes: 1 addition & 1 deletion R/derive_aage.R
Original file line number Diff line number Diff line change
@@ -71,7 +71,7 @@ derive_aage <- function(dataset,
}


#' Derive age groups
#' Derive Age Groups
#'
#' Functions for deriving standardized age groups.
#'
4 changes: 2 additions & 2 deletions R/derive_baseline.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
#' Derive BASE
#' Derive BASE Variable
#'
#' Derive the `BASE` variable in a BDS dataset
#'
@@ -31,7 +31,7 @@ derive_var_base <- function(dataset, by_vars) {
derive_baseline(dataset, by_vars = by_vars, source_var = AVAL, new_var = BASE)
}

#' Derive BASEC
#' Derive BASEC Variable
#'
#' Derive the `BASEC` variable in a BDS dataset
#'
15 changes: 8 additions & 7 deletions R/derive_date_vars.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
#' Impute partial date/time portion of a --DTC variable
#' Impute Partial Date(-time) Portion of a --DTC Variable
#'
#' Imputation partial date/time portion of a --DTC variable. based on user
#' input.
@@ -271,7 +271,7 @@ impute_dtc <- function(dtc,
imputed_dtc
}

#' Convert a date character vector into a Date object.
#' Convert a Date Character Vector into a Date Object
#'
#' Convert a date character vector (usually '--DTC') into a Date vector (usually '--DT').
#'
@@ -304,7 +304,7 @@ convert_dtc_to_dt <- function(dtc) {
)
}

#' Convert a date character vector into a Date time object.
#' Convert a Date Character Vector into a Datetime Object
#'
#' Convert a date character vector (usually '--DTC') into a Date vector (usually '--DTM').
#'
@@ -336,7 +336,8 @@ convert_dtc_to_dtm <- function(dtc) {
as_iso_dttm(ymd_hms(NA))
)
}
#' Derive the date imputation flag

#' Derive the Date Imputation Flag
#'
#' Derive the date imputation flag ('--DTF') comparing a date character vector
#' ('--DTC') with a Date vector ('--DT').
@@ -375,7 +376,7 @@ compute_dtf <- function(dtc, dt) {
)
}

#' Derive the time imputation flag
#' Derive the Time Imputation Flag
#'
#' Derive the time imputation flag ('--TMF') comparing a date character vector
#' ('--DTC') with a Datetime vector ('--DTM').
@@ -415,7 +416,7 @@ compute_tmf <- function(dtc, dtm) {
)
}

#' Derive/Impute a date from a date character vector
#' Derive/Impute a Date from a Date Character Vector
#'
#' Derive a date ('--DT') from a date character vector ('---DTC').
#' The date can be imputed (see date_imputation parameter)
@@ -561,7 +562,7 @@ derive_vars_dt <- function(dataset,
dataset
}

#' Derive/Impute a datetime from a date character vector
#' Derive/Impute a Datetime from a Date Character Vector
#'
#' Derive a datetime object ('--DTM') from a date character vector ('---DTC').
#' The date and time can be imputed (see date_imputation/time_imputation parameters)
2 changes: 1 addition & 1 deletion R/derive_disposition_dt.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
#' Derive a disposition date
#' Derive a Disposition Date
#'
#' Derive a disposition status date from the the relevant records in the disposition domain.
#'
23 changes: 15 additions & 8 deletions R/derive_disposition_reason.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
#' Derive a disposition reason at a specific timepoint
#' Derive a Disposition Reason at a Specific Timepoint
#'
#' Derive a disposition reason from the the relevant records in the disposition domain.
#'
@@ -95,7 +95,7 @@
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dplyr, warn.conflicts = FALSE)
#' data("dm")
#' data("ds")
#'
@@ -111,7 +111,7 @@
#' format_dcsreas <- function(x, y = NULL) {
#' out <- if (is.null(y)) x else y
#' case_when(
#' x %!in% c("COMPLETED", "SCREEN FAILURE") & !is.na(x) ~ out,
#' !(x %in% c("COMPLETED", "SCREEN FAILURE")) & !is.na(x) ~ out,
#' TRUE ~ NA_character_
#' )
#' }
@@ -195,12 +195,19 @@ derive_disposition_reason <- function(dataset,
#' @param reason the disposition variable used for the mapping (e.g. `DSDECOD`).
#' @param reason_spe the disposition variable used for the mapping of the details
#' if required (e.g. `DSTERM`).
#'
#' @details
#' format_reason_default(DSDECOD) returns `DSDECOD` when `DSDECOD` != 'COMPLETED' nor NA.
#' format_reason_default(DSDECOD, DSTERM) returns `DSTERM` when `DSDECOD` != 'COMPLETED' nor NA.
#' e.g. DCSREAS = format_reason_default(DSDECOD)
#' e.g. DCSREASP = format_reason_default(DSDECOD, DSTERM)

#' `format_reason_default(DSDECOD)` returns `DSDECOD` when `DSDECOD` is not 'COMPLETED' or `NA`.
#' `format_reason_default(DSDECOD, DSTERM)` returns `DSTERM` when `DSDECOD` is not 'COMPLETED' or `NA`.
#' For example:
#' `DCSREAS = format_reason_default(DSDECOD)`
#' `DCSREASP = format_reason_default(DSDECOD, DSTERM)`
#'
#' @return A `character` vector
#'
#' @author Samia Kabi
#' @export
#' @keywords user_utility adsl computation
format_reason_default <- function(reason, reason_spe = NULL) {
out <- if (is.null(reason_spe)) reason else reason_spe
if_else(reason != "COMPLETED" & !is.na(reason), out, NA_character_)
21 changes: 18 additions & 3 deletions R/derive_disposition_status.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
#' Derive a disposition status at a specific timepoint
#' Derive a Disposition Status at a Specific Timepoint
#'
#' Derive a disposition status from the the relevant records in the disposition domain.
#'
@@ -39,6 +39,12 @@
#' Permitted Values: logical expression.
#'
#' @return The input dataset with the disposition status (`new_var`) added.
#' `new_var` is derived based on the values given in `status_var` and according to the format
#' defined by `format_new_var` (e.g. when the default format is used, the function will derive
#' `new_var` as:
#' "COMPLETED" if `status_var` == "COMPLETED",
#' "DISCONTINUED" if `status_var` is not "COMPLETED" or NA,
#' "ONGOING" otherwise).
#'
#' @keywords adsl
#'
@@ -47,7 +53,7 @@
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dplyr, warn.conflicts = FALSE)
#' data("dm")
#' data("ds")
#'
@@ -74,7 +80,7 @@
#' case_when(
#' x == "COMPLETED" ~ "COMPLETED",
#' x == "ADVERSE EVENT" ~ "DISCONTINUED DUE TO AE",
#' x %!in% c("ADVERSE EVENT", "COMPLETED") & !is.na(x) ~ "DISCONTINUED NOT DUE TO AE",
#' !(x %in% c("ADVERSE EVENT", "COMPLETED")) & !is.na(x) ~ "DISCONTINUED NOT DUE TO AE",
#' TRUE ~ "ONGOING"
#' )
#' }
@@ -126,6 +132,15 @@ derive_disposition_status <- function(dataset,
#' Define a function to map the disposition status.
#'
#' @param x the disposition variable used for the mapping (e.g. `DSDECOD`).
#'
#' @return A `character` vector derived based on the values given in `x`:
#' "COMPLETED" if `x` == "COMPLETED",
#' "DISCONTINUED" if `x` is not "COMPLETED" or NA,
#' "ONGOING" otherwise.
#'
#' @author Samia Kabi
#' @export
#' @keywords user_utility adsl computation
format_eoxxstt_default <- function(x) {
case_when(
x == "COMPLETED" ~ "COMPLETED",
2 changes: 1 addition & 1 deletion R/derive_extreme_flag.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
#' Adds a variable flagging the first or last observation within each by group
#' Adds a Variable Flagging the First or Last Observation Within Each By Group
#'
#' Adds a variable flagging the first or last observation within each by group
#'
5 changes: 3 additions & 2 deletions R/derive_last_dose.R
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@

#' Derive last dose date(-time)
#' Derive Last Dose Date(-time)
#'
#' @param dataset Input dataset.
#' @param dataset_ex Input EX dataset.
@@ -199,6 +198,8 @@ derive_last_dose <- function(dataset,
#' @param dose_end dose end date
#' @param analysis_date analysis date
#'
#' @noRd
#'
#' @return index. The last dose date is then `dose_end[return_value]`
compute_ldose_idx <- function(dose_end, analysis_date) {
if (any(!is.na(dose_end) & !is.na(analysis_date)) && any(dose_end <= analysis_date)) {
6 changes: 3 additions & 3 deletions R/derive_obs_number.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#' Adds a variable numbering the observations within by group
#' Adds a Variable Numbering the Observations Within Each By Group
#'
#' Adds a variable numbering the observations within by group
#' Adds a variable numbering the observations within each by group
#'
#' @param dataset Input dataset
#'
@@ -49,7 +49,7 @@
#' @export
#'
#' @examples
#' library(dplyr)
#' library(dplyr, warn.conflicts = FALSE)
#' data("vs")
#'
#' vs %>%
Loading

0 comments on commit 69a320b

Please sign in to comment.