From 8dfa57f03a8b603aa78a62e3892e57c2a6215a0a Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Fri, 24 May 2024 01:01:40 +0100 Subject: [PATCH 01/12] Basic support for "conditioned" data frames - Adds a new S3 class (cnd_df) for represented conditioned data frames, i.e. data frames that carry metadata about what records should be used for derivations - Adds support for basic pretty printing of cnd_df objects - Adds a user-facing function for creating such cnd_df objects: `condition_by` - Adds experimental "mutate"-version function for these conditioned data frames: `derive_by_condition()` --- DESCRIPTION | 3 +- NAMESPACE | 4 + R/assertions.R | 16 + R/cnd_df.R | 299 +++++++ man/condition_by.Rd | 27 + man/eval_conditions.Rd | 74 ++ man/new_cnd_df.Rd | 40 + man/rm_cnd_df.Rd | 18 + man/tbl_sum.cnd_df.Rd | 16 + renv/profiles/4.4/renv.lock | 1279 +++++++++++++++++++++++++++++ renv/profiles/4.4/renv/.gitignore | 7 + 11 files changed, 1782 insertions(+), 1 deletion(-) create mode 100644 R/assertions.R create mode 100644 R/cnd_df.R create mode 100644 man/condition_by.Rd create mode 100644 man/eval_conditions.Rd create mode 100644 man/new_cnd_df.Rd create mode 100644 man/rm_cnd_df.Rd create mode 100644 man/tbl_sum.cnd_df.Rd create mode 100644 renv/profiles/4.4/renv.lock create mode 100644 renv/profiles/4.4/renv/.gitignore diff --git a/DESCRIPTION b/DESCRIPTION index 721a589a..4cd995cb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,8 @@ Imports: tibble, vctrs, readr, - glue + glue, + pillar Suggests: knitr, rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index 41e0d4cd..472cb825 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,10 +1,12 @@ # Generated by roxygen2: do not edit by hand S3method(print,iso8601) +S3method(tbl_sum,cnd_df) export(assign_ct) export(assign_datetime) export(assign_no_ct) export(clear_cache) +export(condition_by) export(create_iso8601) export(ct_map) export(ct_spec_example) @@ -16,6 +18,8 @@ export(hardcode_no_ct) export(problems) export(read_ct_spec) export(read_ct_spec_example) +export(rm_cnd_df) +importFrom(pillar,tbl_sum) importFrom(rlang,"%||%") importFrom(rlang,":=") importFrom(rlang,.data) diff --git a/R/assertions.R b/R/assertions.R new file mode 100644 index 00000000..8228c4ee --- /dev/null +++ b/R/assertions.R @@ -0,0 +1,16 @@ +# Surprisingly, admiraldev doesn't provide `assert_logical_vector`. +assert_logical_vector <- function(arg, optional = FALSE) { + if (optional && is.null(arg)) { + return(invisible(arg)) + } + + if (!is.logical(arg)) { + err_msg <- sprintf( + "`arg` must be a logical vector but is %s.", + admiraldev::what_is_it(arg) + ) + rlang::abort(err_msg) + } + + invisible(arg) +} diff --git a/R/cnd_df.R b/R/cnd_df.R new file mode 100644 index 00000000..f9640294 --- /dev/null +++ b/R/cnd_df.R @@ -0,0 +1,299 @@ +# ------------------------------------------------------------------------------ +# File: cnd_df.R +# Package: sdtm.oak +# Author: Ramiro Magno +# Created: 2024-05-23 +# Last Modified: 2024-05-23 +# ------------------------------------------------------------------------------ +# Description: +# +# This file contains functions and scripts related to the so-called conditioned +# data frames, i.e. those data frames extended with class `cnd_df`. +# +# Functions: +# +# - `new_cnd_df()`: Create a "conditioned data set" (class cnd_df). +# - `is_cnd_df()`: Assess whether the argument is a `cnd_df` data frame. +# - `get_cnd_df_cnd()`: Extract the attribute "cnd" from a `cnd_df` data frame. +# - `get_cnd_df_cnd_sum()`: Extract the attribute "cnd_sum" from a `cnd_df` data frame. +# - `rm_cnd_df()`: De-class a cnd_df data frame. +# - `tbl_sum.cnd_df()`: Provide a tibble header print method for `cnd_df` tibbles. +# - `ctl_new_rowid_pillar.cnd_df()`: A print method for the row ids cnd_df` tibbles. +# - `eval_conditions()`: Find which rows match a set of conditions. +# - `condition_by()`: Create a conditioned data frame (user facing). +# - `derive_by_condition()`: Perform a derivation on a conditioned data frame. + +#' Create a data frame with filtering tags +#' +#' [new_cnd_df()] creates a _conditioned_ data frame, classed `cnd_df`, meaning +#' that this function extends the data frame passed as argument by storing a +#' logical vector `cnd` (as attribute) that marks rows for posterior conditional +#' transformation by methods that support _conditioned_ data frames. +#' +#' @param dat A data frame. +#' @param cnd A logical vector. Length must match the number of rows in `dat`. +#' @param .warn Whether to warn about creating a new _conditioned_ data frame +#' in case that `dat` already is one. +#' +#' @returns A data frame `dat` with the additional class `"cnd_df"` and the +#' following attributes: +#' +#' - `cnd`: The logical vector passed as argument `cnd`: `TRUE` values mark +#' rows in `dat` to be used for transformations; rows marked with `FALSE` are +#' not transformed; and `NA` mark rows whose transformations are to be applied +#' resulting in `NA`. +#' - `cnd_sum`: An integer vector of three elements providing the sum of `TRUE`, +#' `FALSE` and `NA` values in `cnd`, respectively. +#' +#' @examples +#' df <- data.frame(x = 1:3, y = letters[1:3]) +#' sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +#' +#' @keywords internal +new_cnd_df <- function(dat, cnd, .warn = TRUE) { + + admiraldev::assert_data_frame(dat) + assert_logical_vector(cnd) + + if (!identical(nrow(dat), length(cnd))) { + msg <- c( + "Number of rows in `dat` must match length of `cond`." + ) + rlang::abort(message = msg) + } + + is_cnd_df <- inherits(dat, "cnd_df") + if (.warn && is_cnd_df) { + msg <- "`dat` is already a conditioned data frame (`cnd_df`)." + rlang::warn(message = msg) + } + + if (!is_cnd_df) { + class(dat) <- c("cnd_df", class(dat)) + } + + n_true <- sum(cnd, na.rm = TRUE) + n_false <- sum(!cnd, na.rm = TRUE) + n_na <- length(cnd) - (n_true + n_false) + cnd_sum <- c(n_true = n_true, n_false = n_false, n_na = n_na) + + attr(dat, "cnd") <- cnd + attr(dat, "cnd_sum") <- cnd_sum + + return(dat) +} + +is_cnd_df <- function(dat) { + inherits(dat, "cnd_df") +} + +get_cnd_df_cnd <- function(dat) { + if (is_cnd_df(dat)) { + attr(dat, "cnd") + } else { + NULL + } +} + +get_cnd_df_cnd_sum <- function(dat) { + if (is_cnd_df(dat)) { + attr(dat, "cnd_sum") + } else { + NULL + } +} + +#' Remove the cnd_df class from a data frame +#' +#' This function removes the 'cnd_df' class, along with its attributes, if +#' applicable. +#' +#' @param dat A data frame. +#' @return The input `dat` without the 'cnd_df' class. +#' +#' @export +rm_cnd_df <- function(dat) { + if (is_cnd_df(dat)) { + class(dat) <- class(dat)[class(dat) != "cnd_df"] + attr(dat, "cnd") <- NULL + attr(dat, "cnd_sum") <- NULL + } + return(dat) +} + +#' Print +#' +#' Blah +#' +#' @param x A conditioned tibble of class 'cnd_df'. +#' @param ... Additional arguments passed to the default print method. +#' +#' @importFrom pillar tbl_sum +#' @export +tbl_sum.cnd_df <- function(x, ...) { + default_header <- NextMethod() + + tally <- get_cnd_df_cnd_sum(x) + h2 <- sprintf("%d/%d/%d", tally[1], tally[2], tally[3]) + c(default_header, "Cond. tbl" = h2) +} + +lgl_to_chr <- function(x) { + ifelse(is.na(x), "-", ifelse(x, "T", "F")) +} + +ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { + + out <- NextMethod() + n_row <- nrow(x) + idx <- seq_len(n_row) + i <- sprintf("%d", idx) + i_width <- nchar(as.character(i)) + i_max_width <- max(i_width) + max_width <- i_max_width + 2 + ws <- strrep(" ", max_width - i_width - 1) + abb_lgl <- lgl_to_chr(attr(controller, "cnd")[idx]) + + row_ids <- paste0(i, ws, abb_lgl) + width <- max(nchar(as.character(row_ids))) + pillar::new_pillar( + list( + title = out$title, + type = out$type, + data = pillar::pillar_component( + pillar::new_pillar_shaft(list(row_ids = row_ids), + width = width, + class = "pillar_rif_shaft" + ) + ) + ), + width = width + ) +} + +#' Evaluate conditions +#' +#' @description +#' [eval_conditions()] evaluates a set of conditions in the context of a +#' data frame and an optional environment. +#' +#' The utility of this function is to provide an easy way to generate a logical +#' vector of matching records from a set of logical conditions involving +#' variables in a data frame (`dat`) and optionally in a supplementary +#' environment (`.env`). The set of logical conditions are provided as +#' expressions to be evaluated in the context of `dat` and `.env`. +#' +#' Variables are looked up in `dat`, then in `.env`, then in the calling +#' function's environment, followed by its parent environments. +#' +#' @param dat A data frame +#' @param ... A set of logical conditions, e.g. `y & z, x | z` (`x`, `y`, `z` +#' would have to exist either as columns in `dat` or in the enviroment +#' `.env`). If multiple expressions are included, they are combined with the +#' `&` operator. +#' @param .na Return value to be used when the conditions evalute to `NA`. +#' @param .env An optional environment to look for variables involved in logical +#' expression passed in `...`. A data frame or a list can also be passed that +#' will be coerced to an environment internally. +#' +#' @returns A logical vector reflecting matching rows in `dat`. +#' +#' @examples +#' # Create a sample data frame +#' df <- data.frame( +#' x = c(1, 2, 3, 4, 5), +#' y = c(TRUE, FALSE, TRUE, FALSE, TRUE), +#' z = c("a", "b", "a", "b", "a") +#' ) +#' +#' # Simple condition on one column +#' sdtm.oak:::eval_conditions(df, x > 2) +#' +#' # Combined conditions on multiple columns +#' sdtm.oak:::eval_conditions(df, x > 2, y) +#' +#' # Using conditions with NA handling +#' df_with_na <- data.frame( +#' x = c(1, 2, NA, 4, 5), +#' y = c(TRUE, FALSE, TRUE, FALSE, TRUE) +#' ) +#' sdtm.oak:::eval_conditions(df_with_na, x > 2, .na = FALSE) +#' +#' # The environment where `eval_conditions()` is called is also inspected +#' # when evaluating conditions in `...`. +#' w <- 1 +#' sdtm.oak:::eval_conditions(df, x > w) +#' +#' # Using an environment +#' env <- rlang::env(w = 2) +#' sdtm.oak:::eval_conditions(df, x > w, .env = env) +#' +#' # In place of an environment, you may alternatively pass a list or data frame. +#' sdtm.oak:::eval_conditions(df, x > w, .env = list(w = 3)) +#' sdtm.oak:::eval_conditions(df, x > w, .env = tibble::tibble(w = 4)) +#' +#' @keywords internal +eval_conditions <- function(dat, + ..., + .na = NA, + .env = rlang::env()) { + + conditions <- rlang::enexprs(...) + + # List (or data frame). + if (is.list(.env)) { + .env <- rlang::as_environment(.env, parent = rlang::env()) + } + + lgl_vctrs <- + conditions |> + purrr::map(~ rlang::eval_tidy(.x, dat, env = .env)) |> + purrr::map(~ dplyr::if_else(is.na(.x), .na, .x)) + + cnd <- purrr::reduce(lgl_vctrs, `&`, .init = rep(TRUE, nrow(dat))) + + cnd +} + +#' Condition a data set based on specified conditions +#' +#' This function tags records in a data set, indicating which rows match the +#' specified conditions. +#' +#' @param dat A tibble. +#' @param ... Conditions to filter the tibble. +#' @return A tibble with an additional class 'cnd_df' and a logical vector +#' attribute indicating matching rows. +#' @param .na Return value to be used when the conditions evalute to `NA`. +#' @param .env An optional environment to look for variables involved in logical +#' expression passed in `...`. A data frame or a list can also be passed that +#' will be coerced to an environment internally. +#' +#' @export +condition_by <- function(dat, ..., .na = NA, .env = rlang::env()) { + + if (is_cnd_df(dat)) { + rlang::warn( + c("`dat` is already a conditioned data frame (`cnd_df`).", + "The previous condition will be replaced by the new one.") + ) + } + + cnd <- eval_conditions(dat = dat, ..., .na = .na, .env = .env) + new_cnd_df(dat, cnd = cnd, .warn = FALSE) +} + +#' @keywords internal +derive_by_condition <- function(dat, ...) { + + cnd <- get_cnd_df_cnd(dat) + derivations <- rlang::enquos(...) + derived_vars <- names(derivations) + + lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else({{cnd}}, !!.x, NA))) + lst <- rlang::set_names(lst, derived_vars) + dat2 <- dplyr::mutate({{dat}}, !!!lst) + rm_cnd_df(dat2) +} + + diff --git a/man/condition_by.Rd b/man/condition_by.Rd new file mode 100644 index 00000000..f3d0cf7e --- /dev/null +++ b/man/condition_by.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{condition_by} +\alias{condition_by} +\title{Condition a data set based on specified conditions} +\usage{ +condition_by(dat, ..., .na = NA, .env = rlang::env()) +} +\arguments{ +\item{dat}{A tibble.} + +\item{...}{Conditions to filter the tibble.} + +\item{.na}{Return value to be used when the conditions evalute to \code{NA}.} + +\item{.env}{An optional environment to look for variables involved in logical +expression passed in \code{...}. A data frame or a list can also be passed that +will be coerced to an environment internally.} +} +\value{ +A tibble with an additional class 'cnd_df' and a logical vector +attribute indicating matching rows. +} +\description{ +This function tags records in a data set, indicating which rows match the +specified conditions. +} diff --git a/man/eval_conditions.Rd b/man/eval_conditions.Rd new file mode 100644 index 00000000..3de50b96 --- /dev/null +++ b/man/eval_conditions.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{eval_conditions} +\alias{eval_conditions} +\title{Evaluate conditions} +\usage{ +eval_conditions(dat, ..., .na = NA, .env = rlang::env()) +} +\arguments{ +\item{dat}{A data frame} + +\item{...}{A set of logical conditions, e.g. \verb{y & z, x | z} (\code{x}, \code{y}, \code{z} +would have to exist either as columns in \code{dat} or in the enviroment +\code{.env}). If multiple expressions are included, they are combined with the +\code{&} operator.} + +\item{.na}{Return value to be used when the conditions evalute to \code{NA}.} + +\item{.env}{An optional environment to look for variables involved in logical +expression passed in \code{...}. A data frame or a list can also be passed that +will be coerced to an environment internally.} +} +\value{ +A logical vector reflecting matching rows in \code{dat}. +} +\description{ +\code{\link[=eval_conditions]{eval_conditions()}} evaluates a set of conditions in the context of a +data frame and an optional environment. + +The utility of this function is to provide an easy way to generate a logical +vector of matching records from a set of logical conditions involving +variables in a data frame (\code{dat}) and optionally in a supplementary +environment (\code{.env}). The set of logical conditions are provided as +expressions to be evaluated in the context of \code{dat} and \code{.env}. + +Variables are looked up in \code{dat}, then in \code{.env}, then in the calling +function's environment, followed by its parent environments. +} +\examples{ +# Create a sample data frame +df <- data.frame( + x = c(1, 2, 3, 4, 5), + y = c(TRUE, FALSE, TRUE, FALSE, TRUE), + z = c("a", "b", "a", "b", "a") +) + +# Simple condition on one column +sdtm.oak:::eval_conditions(df, x > 2) + +# Combined conditions on multiple columns +sdtm.oak:::eval_conditions(df, x > 2, y) + +# Using conditions with NA handling +df_with_na <- data.frame( + x = c(1, 2, NA, 4, 5), + y = c(TRUE, FALSE, TRUE, FALSE, TRUE) +) +sdtm.oak:::eval_conditions(df_with_na, x > 2, .na = FALSE) + +# The environment where `eval_conditions()` is called is also inspected +# when evaluating conditions in `...`. +w <- 1 +sdtm.oak:::eval_conditions(df, x > w) + +# Using an environment +env <- rlang::env(w = 2) +sdtm.oak:::eval_conditions(df, x > w, .env = env) + +# In place of an environment, you may alternatively pass a list or data frame. +sdtm.oak:::eval_conditions(df, x > w, .env = list(w = 3)) +sdtm.oak:::eval_conditions(df, x > w, .env = tibble::tibble(w = 4)) + +} +\keyword{internal} diff --git a/man/new_cnd_df.Rd b/man/new_cnd_df.Rd new file mode 100644 index 00000000..f40b140b --- /dev/null +++ b/man/new_cnd_df.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{new_cnd_df} +\alias{new_cnd_df} +\title{Create a data frame with filtering tags} +\usage{ +new_cnd_df(dat, cnd, .warn = TRUE) +} +\arguments{ +\item{dat}{A data frame.} + +\item{cnd}{A logical vector. Length must match the number of rows in \code{dat}.} + +\item{.warn}{Whether to warn about creating a new \emph{conditioned} data frame +in case that \code{dat} already is one.} +} +\value{ +A data frame \code{dat} with the additional class \code{"cnd_df"} and the +following attributes: +\itemize{ +\item \code{cnd}: The logical vector passed as argument \code{cnd}: \code{TRUE} values mark +rows in \code{dat} to be used for transformations; rows marked with \code{FALSE} are +not transformed; and \code{NA} mark rows whose transformations are to be applied +resulting in \code{NA}. +\item \code{cnd_sum}: An integer vector of three elements providing the sum of \code{TRUE}, +\code{FALSE} and \code{NA} values in \code{cnd}, respectively. +} +} +\description{ +\code{\link[=new_cnd_df]{new_cnd_df()}} creates a \emph{conditioned} data frame, classed \code{cnd_df}, meaning +that this function extends the data frame passed as argument by storing a +logical vector \code{cnd} (as attribute) that marks rows for posterior conditional +transformation by methods that support \emph{conditioned} data frames. +} +\examples{ +df <- data.frame(x = 1:3, y = letters[1:3]) +sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) + +} +\keyword{internal} diff --git a/man/rm_cnd_df.Rd b/man/rm_cnd_df.Rd new file mode 100644 index 00000000..21f096b6 --- /dev/null +++ b/man/rm_cnd_df.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{rm_cnd_df} +\alias{rm_cnd_df} +\title{Remove the cnd_df class from a data frame} +\usage{ +rm_cnd_df(dat) +} +\arguments{ +\item{dat}{A data frame.} +} +\value{ +The input \code{dat} without the 'cnd_df' class. +} +\description{ +This function removes the 'cnd_df' class, along with its attributes, if +applicable. +} diff --git a/man/tbl_sum.cnd_df.Rd b/man/tbl_sum.cnd_df.Rd new file mode 100644 index 00000000..5a0f301f --- /dev/null +++ b/man/tbl_sum.cnd_df.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{tbl_sum.cnd_df} +\alias{tbl_sum.cnd_df} +\title{Print} +\usage{ +\method{tbl_sum}{cnd_df}(x, ...) +} +\arguments{ +\item{x}{A conditioned tibble of class 'cnd_df'.} + +\item{...}{Additional arguments passed to the default print method.} +} +\description{ +Blah +} diff --git a/renv/profiles/4.4/renv.lock b/renv/profiles/4.4/renv.lock new file mode 100644 index 00000000..aafeeb4b --- /dev/null +++ b/renv/profiles/4.4/renv.lock @@ -0,0 +1,1279 @@ +{ + "R": { + "Version": "4.4.0", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://cloud.r-project.org" + } + ] + }, + "Packages": { + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "5ea2700d21e038ace58269ecdbeb9ec0" + }, + "admiraldev": { + "Package": "admiraldev", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "dplyr", + "hms", + "lifecycle", + "lubridate", + "magrittr", + "purrr", + "rlang", + "stringr", + "tidyr", + "tidyselect" + ], + "Hash": "4ab0476ca36f502f6cdd2080f8d0f261" + }, + "askpass": { + "Package": "askpass", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "sys" + ], + "Hash": "cad6cf7f1d5f6e906700b9d3e718c796" + }, + "assertthat": { + "Package": "assertthat", + "Version": "0.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "tools" + ], + "Hash": "50c838a310445e954bc13f26f26a6ecf" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "bit": { + "Package": "bit", + "Version": "4.0.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "d242abec29412ce988848d0294b208fd" + }, + "bit64": { + "Package": "bit64", + "Version": "4.0.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "bit", + "methods", + "stats", + "utils" + ], + "Hash": "9fe98599ca456d6552421db0d6772d8f" + }, + "brio": { + "Package": "brio", + "Version": "1.1.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "c1ee497a6d999947c2c224ae46799b1a" + }, + "bslib": { + "Package": "bslib", + "Version": "0.7.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "cachem", + "fastmap", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "lifecycle", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "8644cc53f43828f19133548195d7e59e" + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.8", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "c35768291560ce302c0a6589f92e837d" + }, + "callr": { + "Package": "callr", + "Version": "3.7.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "d7e13f49c19103ece9e58ad2d83a7354" + }, + "cli": { + "Package": "cli", + "Version": "3.6.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "1216ac65ac55ec0058a6f75d7ca0fd52" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042" + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.9.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "5d8225445acb167abf7797de48b2ee3c" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.4.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "5a295d7d963cc5035284dcdbaf334f4e" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "e8a1e41acf02548751f45c718d55aa6a" + }, + "credentials": { + "Package": "credentials", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ], + "Hash": "c7844b32098dcbd1c59cbd8dddb4ecc6" + }, + "curl": { + "Package": "curl", + "Version": "5.2.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "411ca2c03b1ce5f548345d2fc2685f7a" + }, + "desc": { + "Package": "desc", + "Version": "1.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "utils" + ], + "Hash": "99b79fcbd6c4d1ce087f5c5c758b384f" + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" + }, + "digest": { + "Package": "digest", + "Version": "0.6.35", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "698ece7ba5a4fa4559e3d537e7ec3d31" + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ], + "Hash": "14fa1f248b60ed67e1f5418391a17b14" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "fedd9d00c2944ff00a0e2696ccf048ec" + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.23", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "daf4a1246be12c1fa8c7705a0935c1a0" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.6", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "962174cf2aeb5b9eea581522286a911f" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "RSPM", + "Hash": "f7736a18de97dea803bde0a2daaafb27" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "c2efdd5f0bcd1ea861c2d4e2a883a67d" + }, + "fs": { + "Package": "fs", + "Version": "1.6.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15aeb8c27f5ea5161f9f6a641fafd93a" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" + }, + "gert": { + "Package": "gert", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ], + "Hash": "f70d3fe2d9e7654213a946963d1591eb" + }, + "gh": { + "Package": "gh", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "gitcreds", + "glue", + "httr2", + "ini", + "jsonlite", + "lifecycle", + "rlang" + ], + "Hash": "fbbbc48eba7a6626a08bb365e44b563b" + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "ab08ac61f3e1be454ae21911eb8bc2fe" + }, + "glue": { + "Package": "glue", + "Version": "1.7.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "methods" + ], + "Hash": "e0b3a53876554bd45879e596cdb10a52" + }, + "highr": { + "Package": "highr", + "Version": "0.10", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "06230136b2d2b9ba5805e1963fa6e890" + }, + "hms": { + "Package": "hms", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "lifecycle", + "methods", + "pkgconfig", + "rlang", + "vctrs" + ], + "Hash": "b59377caa7ed00fa41808342002138f9" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.8.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "base64enc", + "digest", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "81d371a9cc60640e74e4ab6ac46dcedc" + }, + "httr": { + "Package": "httr", + "Version": "1.4.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "ac107251d9d9fd72f0ca8049988f1d7f" + }, + "httr2": { + "Package": "httr2", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "cli", + "curl", + "glue", + "lifecycle", + "magrittr", + "openssl", + "rappdirs", + "rlang", + "vctrs", + "withr" + ], + "Hash": "03d741c92fda96d98c3a3f22494e3b4a" + }, + "hunspell": { + "Package": "hunspell", + "Version": "3.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "Rcpp", + "digest" + ], + "Hash": "e957e989ea17f937964f0d46b0f0bca0" + }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "6154ec2223172bce8162d4153cda21f7" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.8", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "methods" + ], + "Hash": "e1b9c55281c5adc4dd113652d9e26768" + }, + "knitr": { + "Package": "knitr", + "Version": "1.46", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "6e008ab1d696a5283c79765fa7b56b47" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "b8552d117e1b808b09a832f589b79035" + }, + "lubridate": { + "Package": "lubridate", + "Version": "1.9.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "generics", + "methods", + "timechange" + ], + "Hash": "680ad542fbcf801442c83a6ac5a2126c" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "openssl": { + "Package": "openssl", + "Version": "2.2.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "askpass" + ], + "Hash": "2bcca3848e4734eb3b16103bc9aa4b8e" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.4.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "callr", + "cli", + "desc", + "processx" + ], + "Hash": "a29e8e134a460a01e0ca67a4763c595b" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ], + "Hash": "8bf1151ed1a48328d71b937e651117a6" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.3.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "crayon", + "desc", + "fs", + "glue", + "methods", + "pkgbuild", + "rlang", + "rprojroot", + "utils", + "withr" + ], + "Hash": "876c618df5ae610be84356d5d7a5d124" + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "a555924add98c99d2f411e37e7d25e9f" + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "6b01fc98b1e86c4f705ce9dcfd2f57c7" + }, + "processx": { + "Package": "processx", + "Version": "3.8.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "0c90a7d71988856bad2a2a45dd871bb9" + }, + "progress": { + "Package": "progress", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "crayon", + "hms", + "prettyunits" + ], + "Hash": "f4625e061cb2865f111b47ff163a5ca6" + }, + "ps": { + "Package": "ps", + "Version": "1.7.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "dd2b9319ee0656c8acf45c7f40c59de7" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "1cba04a4e9414bdefc9dcaa99649a8dc" + }, + "ragg": { + "Package": "ragg", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "systemfonts", + "textshaping" + ], + "Hash": "e3087db406e079a8a2fd87f413918ed3" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "readr": { + "Package": "readr", + "Version": "2.1.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "cli", + "clipr", + "cpp11", + "crayon", + "hms", + "lifecycle", + "methods", + "rlang", + "tibble", + "tzdb", + "utils", + "vroom" + ], + "Hash": "9de96463d2117f6ac49980577939dfb3" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" + }, + "renv": { + "Package": "renv", + "Version": "1.0.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "utils" + ], + "Hash": "41b847654f567341725473431dd0d5ab" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "utils" + ], + "Hash": "42548638fae05fd9a9b5f3f437fbbbe2" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.26", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "9b148e7f95d33aac01f31282d49e4f44" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.4", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R" + ], + "Hash": "4c8415e0ec1e29f3f4f6fc108bef0144" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.16.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "96710351d642b70e8f02ddeb237c46a7" + }, + "sass": { + "Package": "sass", + "Version": "0.4.9", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "d53dbfddf695303ea4ad66f86e99b95d" + }, + "spelling": { + "Package": "spelling", + "Version": "2.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "commonmark", + "hunspell", + "knitr", + "xml2" + ], + "Hash": "632e9e83d3dc774d361b9415b15642bb" + }, + "stringi": { + "Package": "stringi", + "Version": "1.8.3", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "058aebddea264f4c99401515182e656a" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "960e2ae9e09656611e0b8214ad543207" + }, + "sys": { + "Package": "sys", + "Version": "3.4.2", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3a1be13d68d47a8cd0bfd74739ca1555" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11", + "lifecycle" + ], + "Hash": "213b6b8ed5afbf934843e6c3b090d418" + }, + "testthat": { + "Package": "testthat", + "Version": "3.2.1.1", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "3f6e7e5e2220856ff865e4834766bf2b" + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.7", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cpp11", + "systemfonts" + ], + "Hash": "997aac9ad649e0ef3b97f96cddd5622b" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "915fb7ce036c22a6a33b5a8adb712eb1" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "829f27b9c4919c16b593794a6344d6c0" + }, + "timechange": { + "Package": "timechange", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "c5f3c201b931cd6474d17d8700ccb1c8" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.51", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "xfun" + ], + "Hash": "d44e2fcd2e4e076f0aac540208559d1d" + }, + "tzdb": { + "Package": "tzdb", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "f561504ec2897f4d46f0c7657e488ae1" + }, + "usethis": { + "Package": "usethis", + "Version": "2.2.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "stats", + "utils", + "whisker", + "withr", + "yaml" + ], + "Hash": "d524fd42c517035027f866064417d7e6" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.4", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R" + ], + "Hash": "62b65c52671e6665f803ff02954446e9" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "c03fa420630029418f7e6da3667aac4a" + }, + "vroom": { + "Package": "vroom", + "Version": "1.6.5", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "bit64", + "cli", + "cpp11", + "crayon", + "glue", + "hms", + "lifecycle", + "methods", + "progress", + "rlang", + "stats", + "tibble", + "tidyselect", + "tzdb", + "vctrs", + "withr" + ], + "Hash": "390f9315bc0025be03012054103d227c" + }, + "waldo": { + "Package": "waldo", + "Version": "0.5.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "diffobj", + "fansi", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "c7d3fd6d29ab077cbac8f0e2751449e6" + }, + "whisker": { + "Package": "whisker", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "c6abfa47a46d281a7d5159d0a8891e88" + }, + "withr": { + "Package": "withr", + "Version": "3.0.0", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "grDevices", + "graphics" + ], + "Hash": "d31b6c62c10dcf11ec530ca6b0dd5d35" + }, + "xfun": { + "Package": "xfun", + "Version": "0.44", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "grDevices", + "stats", + "tools" + ], + "Hash": "317a0538d32f4a009658bcedb7923f4b" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.6", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "cli", + "methods", + "rlang" + ], + "Hash": "1d0336142f4cd25d8d23cd3ba7a8fb61" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.8", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "29240487a071f535f5e5d5a323b7afbd" + }, + "zip": { + "Package": "zip", + "Version": "2.3.1", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "fcc4bd8e6da2d2011eb64a5e5cc685ab" + } + } +} diff --git a/renv/profiles/4.4/renv/.gitignore b/renv/profiles/4.4/renv/.gitignore new file mode 100644 index 00000000..0ec0cbba --- /dev/null +++ b/renv/profiles/4.4/renv/.gitignore @@ -0,0 +1,7 @@ +library/ +local/ +cellar/ +lock/ +python/ +sandbox/ +staging/ From d08794b4519f84dcc0880196f9bb99024a64e688 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Sun, 26 May 2024 01:54:45 +0100 Subject: [PATCH 02/12] Basic support for conditioned data sets --- NAMESPACE | 4 ++ R/assign.R | 6 ++- R/assign_datetime.R | 7 ++- R/cnd_df.R | 39 +++++++++------- R/hardcode.R | 10 +++-- man/condition_by.Rd | 4 +- man/eval_conditions.Rd | 4 +- man/rm_cnd_df.Rd | 6 +-- man/tbl_sum.cnd_df.Rd | 2 +- tests/testthat/test-hardcode.R | 81 ++++++++++++++++++++++++++++++++++ 10 files changed, 134 insertions(+), 29 deletions(-) create mode 100644 tests/testthat/test-hardcode.R diff --git a/NAMESPACE b/NAMESPACE index 472cb825..5ec1b0bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +S3method(ctl_new_rowid_pillar,cnd_df) +S3method(mutate,cnd_df) S3method(print,iso8601) S3method(tbl_sum,cnd_df) export(assign_ct) @@ -19,6 +21,8 @@ export(problems) export(read_ct_spec) export(read_ct_spec_example) export(rm_cnd_df) +importFrom(dplyr,mutate) +importFrom(pillar,ctl_new_rowid_pillar) importFrom(pillar,tbl_sum) importFrom(rlang,"%||%") importFrom(rlang,":=") diff --git a/R/assign.R b/R/assign.R index a91eacaf..c9c1d831 100644 --- a/R/assign.R +++ b/R/assign.R @@ -61,13 +61,17 @@ sdtm_assign <- function(raw_dat, der_dat <- raw_dat |> dplyr::select(c(id_vars, raw_var)) |> - dplyr::mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() + mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() dplyr::select(-rlang::sym(raw_var)) # If a target dataset is supplied, then join the so far derived dataset with # the target dataset (`tgt_dat`), otherwise leave it be. der_dat <- if (!is.null(tgt_dat)) { + # If variable `tgt_var` exists in `tgt_dat` remove it as we want to + # keep the derived variable in `der_dat`. + tgt_dat <- dplyr::select(tgt_dat, -dplyr::any_of(tgt_var)) + der_dat |> dplyr::right_join(y = tgt_dat, by = id_vars) |> dplyr::relocate(tgt_var, .after = dplyr::last_col()) diff --git a/R/assign_datetime.R b/R/assign_datetime.R index 4622f579..d8d4ec8b 100644 --- a/R/assign_datetime.R +++ b/R/assign_datetime.R @@ -179,12 +179,15 @@ assign_datetime <- der_dat <- raw_dat |> - dplyr::select(c(id_vars, raw_var)) |> + dplyr::select(dplyr::all_of(c(id_vars, raw_var))) |> dplyr::mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() - dplyr::select(-raw_var) + dplyr::select(-dplyr::any_of(raw_var)) der_dat <- if (!is.null(tgt_dat)) { + # If variable `tgt_var` exists in `tgt_dat` remove it as we want to + # keep the derived variable in `der_dat`. + tgt_dat <- dplyr::select(tgt_dat, -dplyr::any_of(tgt_var)) der_dat |> dplyr::right_join(y = tgt_dat, by = id_vars) |> dplyr::relocate(tgt_var, .after = dplyr::last_col()) diff --git a/R/cnd_df.R b/R/cnd_df.R index f9640294..9ef23a83 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -69,6 +69,7 @@ new_cnd_df <- function(dat, cnd, .warn = TRUE) { } if (!is_cnd_df) { + dat <- tibble::as_tibble(dat) class(dat) <- c("cnd_df", class(dat)) } @@ -103,13 +104,13 @@ get_cnd_df_cnd_sum <- function(dat) { } } -#' Remove the cnd_df class from a data frame +#' Remove the `cnd_df` class from a data frame #' -#' This function removes the 'cnd_df' class, along with its attributes, if +#' This function removes the `cnd_df` class, along with its attributes, if #' applicable. #' #' @param dat A data frame. -#' @return The input `dat` without the 'cnd_df' class. +#' @return The input `dat` without the `cnd_df` class. #' #' @export rm_cnd_df <- function(dat) { @@ -125,7 +126,7 @@ rm_cnd_df <- function(dat) { #' #' Blah #' -#' @param x A conditioned tibble of class 'cnd_df'. +#' @param x A conditioned tibble of class `cnd_df`. #' @param ... Additional arguments passed to the default print method. #' #' @importFrom pillar tbl_sum @@ -142,6 +143,8 @@ lgl_to_chr <- function(x) { ifelse(is.na(x), "-", ifelse(x, "T", "F")) } +#' @importFrom pillar ctl_new_rowid_pillar +#' @export ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { out <- NextMethod() @@ -188,10 +191,10 @@ ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { #' #' @param dat A data frame #' @param ... A set of logical conditions, e.g. `y & z, x | z` (`x`, `y`, `z` -#' would have to exist either as columns in `dat` or in the enviroment +#' would have to exist either as columns in `dat` or in the environment #' `.env`). If multiple expressions are included, they are combined with the #' `&` operator. -#' @param .na Return value to be used when the conditions evalute to `NA`. +#' @param .na Return value to be used when the conditions evaluate to `NA`. #' @param .env An optional environment to look for variables involved in logical #' expression passed in `...`. A data frame or a list can also be passed that #' will be coerced to an environment internally. @@ -262,9 +265,9 @@ eval_conditions <- function(dat, #' #' @param dat A tibble. #' @param ... Conditions to filter the tibble. -#' @return A tibble with an additional class 'cnd_df' and a logical vector +#' @return A tibble with an additional class `cnd_df` and a logical vector #' attribute indicating matching rows. -#' @param .na Return value to be used when the conditions evalute to `NA`. +#' @param .na Return value to be used when the conditions evaluate to `NA`. #' @param .env An optional environment to look for variables involved in logical #' expression passed in `...`. A data frame or a list can also be passed that #' will be coerced to an environment internally. @@ -283,17 +286,23 @@ condition_by <- function(dat, ..., .na = NA, .env = rlang::env()) { new_cnd_df(dat, cnd = cnd, .warn = FALSE) } -#' @keywords internal -derive_by_condition <- function(dat, ...) { +#' @importFrom dplyr mutate +#' @export +mutate.cnd_df <- function(.data, + ..., + .by = NULL, + .keep = c("all", "used", "unused", "none"), + .before = NULL, + .after = NULL) { + + cnd <- get_cnd_df_cnd(.data) + dat <- rm_cnd_df(.data) # avoids recursive S3 method dispatch. - cnd <- get_cnd_df_cnd(dat) derivations <- rlang::enquos(...) derived_vars <- names(derivations) lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else({{cnd}}, !!.x, NA))) lst <- rlang::set_names(lst, derived_vars) - dat2 <- dplyr::mutate({{dat}}, !!!lst) - rm_cnd_df(dat2) -} - + dplyr::mutate(dat, !!!lst) +} diff --git a/R/hardcode.R b/R/hardcode.R index 31938689..ffce1bd7 100644 --- a/R/hardcode.R +++ b/R/hardcode.R @@ -63,14 +63,18 @@ sdtm_hardcode <- function(raw_dat, # `der_dat`: derived dataset. der_dat <- raw_dat |> - dplyr::select(c(id_vars, raw_var)) |> - dplyr::mutate("{tgt_var}" := recode(x = !!rlang::sym(raw_var), to = tgt_val)) |> # nolint object_name_linter() - dplyr::select(-rlang::sym(raw_var)) + dplyr::select(dplyr::all_of(c(id_vars, raw_var))) |> + mutate("{tgt_var}" := recode(x = !!rlang::sym(raw_var), to = tgt_val)) |> # nolint object_name_linter() + dplyr::select(-dplyr::any_of(raw_var)) # If a target dataset is supplied, then join the so far derived dataset with # the target dataset (`tgt_dat`), otherwise leave it be. der_dat <- if (!is.null(tgt_dat)) { + # If variable `tgt_var` exists in `tgt_dat` remove it as we want to + # keep the derived variable in `der_dat`. + tgt_dat <- dplyr::select(tgt_dat, -dplyr::any_of(tgt_var)) + der_dat |> dplyr::right_join(y = tgt_dat, by = id_vars) |> dplyr::relocate(tgt_var, .after = dplyr::last_col()) diff --git a/man/condition_by.Rd b/man/condition_by.Rd index f3d0cf7e..e1b7cb2a 100644 --- a/man/condition_by.Rd +++ b/man/condition_by.Rd @@ -11,14 +11,14 @@ condition_by(dat, ..., .na = NA, .env = rlang::env()) \item{...}{Conditions to filter the tibble.} -\item{.na}{Return value to be used when the conditions evalute to \code{NA}.} +\item{.na}{Return value to be used when the conditions evaluate to \code{NA}.} \item{.env}{An optional environment to look for variables involved in logical expression passed in \code{...}. A data frame or a list can also be passed that will be coerced to an environment internally.} } \value{ -A tibble with an additional class 'cnd_df' and a logical vector +A tibble with an additional class \code{cnd_df} and a logical vector attribute indicating matching rows. } \description{ diff --git a/man/eval_conditions.Rd b/man/eval_conditions.Rd index 3de50b96..ce5286d4 100644 --- a/man/eval_conditions.Rd +++ b/man/eval_conditions.Rd @@ -10,11 +10,11 @@ eval_conditions(dat, ..., .na = NA, .env = rlang::env()) \item{dat}{A data frame} \item{...}{A set of logical conditions, e.g. \verb{y & z, x | z} (\code{x}, \code{y}, \code{z} -would have to exist either as columns in \code{dat} or in the enviroment +would have to exist either as columns in \code{dat} or in the environment \code{.env}). If multiple expressions are included, they are combined with the \code{&} operator.} -\item{.na}{Return value to be used when the conditions evalute to \code{NA}.} +\item{.na}{Return value to be used when the conditions evaluate to \code{NA}.} \item{.env}{An optional environment to look for variables involved in logical expression passed in \code{...}. A data frame or a list can also be passed that diff --git a/man/rm_cnd_df.Rd b/man/rm_cnd_df.Rd index 21f096b6..531c972d 100644 --- a/man/rm_cnd_df.Rd +++ b/man/rm_cnd_df.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/cnd_df.R \name{rm_cnd_df} \alias{rm_cnd_df} -\title{Remove the cnd_df class from a data frame} +\title{Remove the \code{cnd_df} class from a data frame} \usage{ rm_cnd_df(dat) } @@ -10,9 +10,9 @@ rm_cnd_df(dat) \item{dat}{A data frame.} } \value{ -The input \code{dat} without the 'cnd_df' class. +The input \code{dat} without the \code{cnd_df} class. } \description{ -This function removes the 'cnd_df' class, along with its attributes, if +This function removes the \code{cnd_df} class, along with its attributes, if applicable. } diff --git a/man/tbl_sum.cnd_df.Rd b/man/tbl_sum.cnd_df.Rd index 5a0f301f..f8a50544 100644 --- a/man/tbl_sum.cnd_df.Rd +++ b/man/tbl_sum.cnd_df.Rd @@ -7,7 +7,7 @@ \method{tbl_sum}{cnd_df}(x, ...) } \arguments{ -\item{x}{A conditioned tibble of class 'cnd_df'.} +\item{x}{A conditioned tibble of class \code{cnd_df}.} \item{...}{Additional arguments passed to the default print method.} } diff --git a/tests/testthat/test-hardcode.R b/tests/testthat/test-hardcode.R new file mode 100644 index 00000000..29af4b32 --- /dev/null +++ b/tests/testthat/test-hardcode.R @@ -0,0 +1,81 @@ +# `aesos`: example raw data set. +aesos <- tibble::tribble( + ~oak_id, ~raw_source, ~patient_number, ~AESO, ~AESOSP, ~AESEV, ~AESER, ~AETERM, + 1L, "RS1", 101L, 0L, "Pain", "Mild", "No", "Headache", + 2L, "RS1", 102L, 0L, NA, "Severe", "Yes", "Dizziness", + 3L, "RS2", 103L, 1L, NA, "Moderate", "No", NA, + 4L, "RS2", 104L, 1L, NA, "Mild", "No", "Eye issues", + 5L, "RS3", 105L, 1L, "Nausea", "Severe", "Yes", "Food Poisoning" +) + +# `oe_inter`: example target data set. +oe_inter <- tibble::tribble( + ~oak_id, ~raw_source, ~patient_number, + 1L, "RS1", 101L, + 3L, "RS2", 103L, + 4L, "RS2", 104L, + 5L, "RS3", 105L, +) + +test_that("hardcode_no_ct works as expected", { + aesos_cnd <- condition_by(aesos, AESO == 1L & !is.na(AESOSP)) + + result <- hardcode_no_ct( + raw_dat = aesos_cnd, + raw_var = "AESO", + tgt_var = "OEORRES", + tgt_val = "Y", + tgt_dat = oe_inter + ) + + expected_result <- tibble::tribble( + ~oak_id, ~raw_source, ~patient_number, ~OEORRES, + # NA because `aesos_cnd` is conditioned to be FALSE on this record. + 1L, "RS1", 101L, NA_character_, + # NA because `aesos_cnd` is conditioned to be FALSE on this record. + 3L, "RS2", 103L, NA_character_, + # NA because `aesos_cnd` is conditioned to be FALSE on this record. + 4L, "RS2", 104L, NA_character_, + # Successful derivation + 5L, "RS3", 105L, "Y" + ) + + expect_equal(result, expected_result) +}) + +test_that("hardcode_ct works as expected", { + aesos_cnd <- condition_by(aesos, AESO == 1L & is.na(AESOSP)) + ct_spec <- tibble::tibble( + codelist_code = "C117743", + term_code = "C178048", + CodedData = "HYPERMIA", + term_value = "HYPERMIA", + collected_value = "IOISYMPO", + term_synonyms = "IOISYMPO" + ) + + result <- + hardcode_ct( + raw_dat = aesos_cnd, + raw_var = "AETERM", + tgt_var = "OETESTCD", + tgt_val = "IOISYMPO", + ct_spec = ct_spec, + ct_clst = "C117743", + tgt_dat = oe_inter + ) + + expected_result <- tibble::tribble( + ~oak_id, ~raw_source, ~patient_number, ~OETESTCD, + # `NA` because `aesos_cnd` is conditioned to be FALSE for this record. + 1L, "RS1", 101L, NA_character_, + # `NA` because AETERM == NA for this record in `aesos_cnd`. + 3L, "RS2", 103L, NA_character_, + # Successful derivation: IOISYMPO -> HYPERMIA. + 4L, "RS2", 104L, "HYPERMIA", + # `NA` because `aesos_cnd` is conditioned to be FALSE for this record. + 5L, "RS3", 105L, NA_character_ + ) + + expect_equal(result, expected_result) +}) From 00e758af9974786b6cd921df54bed004e11583d8 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Wed, 29 May 2024 03:11:48 +0100 Subject: [PATCH 03/12] Extensive support for conditioned tibbles - Joins by raw and target data sets are now aware of conditioned tibbles - Transformation functions, namely `assign_datetime()`, `hardcode*()` and `assign*` are also conditioned-tibble aware - Unit test coverage for most cases indicated at #54 I believe the essential components are here to support the if_then_else algorithm via conditioned tibbles. Now, further testing, assertions and documentation is needed. --- R/assign.R | 34 ++---- R/assign_datetime.R | 34 +++--- R/cnd_df.R | 23 +++- R/hardcode.R | 33 ++---- R/join.R | 39 +++++++ R/sdtm_join.R | 39 +++++++ inst/WORDLIST | 1 + man/condition_by.Rd | 4 +- man/ctl_new_rowid_pillar.cnd_df.Rd | 20 ++++ man/mutate.cnd_df.Rd | 60 +++++++++++ man/sdtm_assign.Rd | 2 +- man/sdtm_hardcode.Rd | 2 +- man/sdtm_join.Rd | 35 ++++++ man/tbl_sum.cnd_df.Rd | 4 +- tests/testthat/test-assign.R | 167 +++++++++++++++++++++++++++++ tests/testthat/test-hardcode.R | 3 + 16 files changed, 420 insertions(+), 80 deletions(-) create mode 100644 R/join.R create mode 100644 R/sdtm_join.R create mode 100644 man/ctl_new_rowid_pillar.cnd_df.Rd create mode 100644 man/mutate.cnd_df.Rd create mode 100644 man/sdtm_join.Rd create mode 100644 tests/testthat/test-assign.R diff --git a/R/assign.R b/R/assign.R index c9c1d831..88dbf8c4 100644 --- a/R/assign.R +++ b/R/assign.R @@ -21,7 +21,7 @@ #' the variables indicated in `id_vars`. This parameter is optional, see #' section Value for how the output changes depending on this argument value. #' @param id_vars Key variables to be used in the join between the raw dataset -#' (`raw_dat`) and the target data set (`raw_dat`). +#' (`raw_dat`) and the target data set (`tgt_dat`). #' #' @returns The returned data set depends on the value of `tgt_dat`: #' - If no target dataset is supplied, meaning that `tgt_dat` defaults to @@ -53,33 +53,19 @@ sdtm_assign <- function(raw_dat, assert_ct_spec(ct_spec, optional = TRUE) assert_ct_clst(ct_spec = ct_spec, ct_clst = ct_clst, optional = TRUE) - # Recode the raw variable following terminology. - tgt_val <- ct_map(raw_dat[[raw_var]], ct_spec = ct_spec, ct_clst = ct_clst) - - # Apply derivation by assigning `raw_var` to `tgt_var`. - # `der_dat`: derived dataset. - der_dat <- + join_dat <- raw_dat |> - dplyr::select(c(id_vars, raw_var)) |> - mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() - dplyr::select(-rlang::sym(raw_var)) + dplyr::select(dplyr::all_of(c(id_vars, raw_var))) |> + sdtm_join(tgt_dat = tgt_dat, id_vars = id_vars) - # If a target dataset is supplied, then join the so far derived dataset with - # the target dataset (`tgt_dat`), otherwise leave it be. - der_dat <- - if (!is.null(tgt_dat)) { - # If variable `tgt_var` exists in `tgt_dat` remove it as we want to - # keep the derived variable in `der_dat`. - tgt_dat <- dplyr::select(tgt_dat, -dplyr::any_of(tgt_var)) + # Recode the raw variable following terminology. + tgt_val <- ct_map(join_dat[[raw_var]], ct_spec = ct_spec, ct_clst = ct_clst) - der_dat |> - dplyr::right_join(y = tgt_dat, by = id_vars) |> - dplyr::relocate(tgt_var, .after = dplyr::last_col()) - } else { - der_dat - } + join_dat |> + mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() + dplyr::select(-dplyr::any_of(setdiff(raw_var, tgt_var))) |> + dplyr::relocate(dplyr::all_of(tgt_var), .after = dplyr::last_col()) - der_dat } #' Derive an SDTM variable diff --git a/R/assign_datetime.R b/R/assign_datetime.R index d8d4ec8b..e6881e8b 100644 --- a/R/assign_datetime.R +++ b/R/assign_datetime.R @@ -170,30 +170,20 @@ assign_datetime <- admiraldev::assert_character_vector(raw_unk) admiraldev::assert_logical_scalar(.warn) - tgt_val <- - create_iso8601(!!!raw_dat[raw_var], - .format = raw_fmt, - .na = raw_unk, - .warn = .warn - ) - - der_dat <- + join_dat <- raw_dat |> dplyr::select(dplyr::all_of(c(id_vars, raw_var))) |> - dplyr::mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() - dplyr::select(-dplyr::any_of(raw_var)) + sdtm_join(tgt_dat = tgt_dat, id_vars = id_vars) - der_dat <- - if (!is.null(tgt_dat)) { - # If variable `tgt_var` exists in `tgt_dat` remove it as we want to - # keep the derived variable in `der_dat`. - tgt_dat <- dplyr::select(tgt_dat, -dplyr::any_of(tgt_var)) - der_dat |> - dplyr::right_join(y = tgt_dat, by = id_vars) |> - dplyr::relocate(tgt_var, .after = dplyr::last_col()) - } else { - der_dat - } + tgt_val <- + create_iso8601(!!!join_dat[raw_var], + .format = raw_fmt, + .na = raw_unk, + .warn = .warn + ) - der_dat + join_dat |> + mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() + dplyr::select(-dplyr::any_of(setdiff(raw_var, tgt_var))) |> + dplyr::relocate(dplyr::all_of(tgt_var), .after = dplyr::last_col()) } diff --git a/R/cnd_df.R b/R/cnd_df.R index 9ef23a83..54dfc1d0 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -122,9 +122,7 @@ rm_cnd_df <- function(dat) { return(dat) } -#' Print -#' -#' Blah +#' Conditioned tibble header print method #' #' @param x A conditioned tibble of class `cnd_df`. #' @param ... Additional arguments passed to the default print method. @@ -143,6 +141,9 @@ lgl_to_chr <- function(x) { ifelse(is.na(x), "-", ifelse(x, "T", "F")) } +#' Conditioned tibble pillar print method +#' +#' @inheritParams pillar::ctl_new_rowid_pillar #' @importFrom pillar ctl_new_rowid_pillar #' @export ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { @@ -261,7 +262,7 @@ eval_conditions <- function(dat, #' Condition a data set based on specified conditions #' #' This function tags records in a data set, indicating which rows match the -#' specified conditions. +#' specified conditions, resulting in a conditioned data frame. #' #' @param dat A tibble. #' @param ... Conditions to filter the tibble. @@ -272,6 +273,8 @@ eval_conditions <- function(dat, #' expression passed in `...`. A data frame or a list can also be passed that #' will be coerced to an environment internally. #' +#' @returns A conditioned data frame. +#' #' @export condition_by <- function(dat, ..., .na = NA, .env = rlang::env()) { @@ -286,6 +289,16 @@ condition_by <- function(dat, ..., .na = NA, .env = rlang::env()) { new_cnd_df(dat, cnd = cnd, .warn = FALSE) } +#' Mutate method for conditioned data frames +#' +#' [mutate.cnd_df()] is an S3 method to be dispatched by [mutate][dplyr::mutate] +#' generic on conditioned data frames. This function implements a conditional +#' mutate by only changing rows for which the condition stored in the +#' conditioned data frame is `TRUE`. +#' +#' @param .data A conditioned data frame. +#' +#' @inheritParams dplyr::mutate #' @importFrom dplyr mutate #' @export mutate.cnd_df <- function(.data, @@ -304,5 +317,5 @@ mutate.cnd_df <- function(.data, lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else({{cnd}}, !!.x, NA))) lst <- rlang::set_names(lst, derived_vars) - dplyr::mutate(dat, !!!lst) + dplyr::mutate(dat, !!!lst, .by = .by, .keep = .keep, .after = .after) } diff --git a/R/hardcode.R b/R/hardcode.R index ffce1bd7..e893f6b7 100644 --- a/R/hardcode.R +++ b/R/hardcode.R @@ -23,7 +23,7 @@ #' the variables indicated in `id_vars`. This parameter is optional, see #' section Value for how the output changes depending on this argument value. #' @param id_vars Key variables to be used in the join between the raw dataset -#' (`raw_dat`) and the target data set (`raw_dat`). +#' (`raw_dat`) and the target data set (`tgt_dat`). #' #' @returns The returned data set depends on the value of `tgt_dat`: #' - If no target dataset is supplied, meaning that `tgt_dat` defaults to @@ -56,33 +56,18 @@ sdtm_hardcode <- function(raw_dat, assert_ct_spec(ct_spec, optional = TRUE) assert_ct_clst(ct_spec = ct_spec, ct_clst = ct_clst, optional = TRUE) - # Recode the hardcoded value following terminology. - tgt_val <- ct_map(tgt_val, ct_spec = ct_spec, ct_clst = ct_clst) - - # Apply derivation of the hardcoded value. - # `der_dat`: derived dataset. - der_dat <- + join_dat <- raw_dat |> dplyr::select(dplyr::all_of(c(id_vars, raw_var))) |> - mutate("{tgt_var}" := recode(x = !!rlang::sym(raw_var), to = tgt_val)) |> # nolint object_name_linter() - dplyr::select(-dplyr::any_of(raw_var)) + sdtm_join(tgt_dat = tgt_dat, id_vars = id_vars) - # If a target dataset is supplied, then join the so far derived dataset with - # the target dataset (`tgt_dat`), otherwise leave it be. - der_dat <- - if (!is.null(tgt_dat)) { - # If variable `tgt_var` exists in `tgt_dat` remove it as we want to - # keep the derived variable in `der_dat`. - tgt_dat <- dplyr::select(tgt_dat, -dplyr::any_of(tgt_var)) - - der_dat |> - dplyr::right_join(y = tgt_dat, by = id_vars) |> - dplyr::relocate(tgt_var, .after = dplyr::last_col()) - } else { - der_dat - } + # Recode the hardcoded value following terminology. + tgt_val <- ct_map(tgt_val, ct_spec = ct_spec, ct_clst = ct_clst) - der_dat + join_dat |> + mutate("{tgt_var}" := recode(x = !!rlang::sym(raw_var), to = tgt_val)) |> # nolint object_name_linter() + dplyr::select(-dplyr::any_of(setdiff(raw_var, tgt_var))) |> + dplyr::relocate(dplyr::all_of(tgt_var), .after = dplyr::last_col()) } #' Derive an SDTM variable with a hardcoded value diff --git a/R/join.R b/R/join.R new file mode 100644 index 00000000..1e0e64b9 --- /dev/null +++ b/R/join.R @@ -0,0 +1,39 @@ +#' SDTM join +#' +#' [sdtm_join()] is a special join between a raw data set and a target data +#' set. This function supports conditioned data frames. +#' +#' @param raw_dat The raw dataset: a dataframe or a conditioned data frame. Must +#' include the variables passed in `id_vars`. +#' @param tgt_dat Target dataset: a data frame or a conditioned data frame to be +#' merged against `raw_dat` by the variables indicated in `id_vars`. +#' @param id_vars Key variables to be used in the join between the raw dataset +#' (`raw_dat`) and the target data set (`raw_dat`). +#' +#' @returns A data frame, or a conditioned data frame if at least one of the +#' input data sets is a conditioned data frame. +#' +#' @keywords internal +#' @importFrom rlang %||% +sdtm_join <- function(raw_dat, + tgt_dat = NULL, + id_vars = oak_id_vars()) { + raw_dat_cnd <- get_cnd_df_cnd(raw_dat) %||% rep(TRUE, nrow(raw_dat)) + tgt_dat <- tgt_dat %||% raw_dat[id_vars] + tgt_dat_cnd <- get_cnd_df_cnd(tgt_dat) %||% rep(TRUE, nrow(tgt_dat)) + + # `rm_cnd_df()` prevents `mutate` from dispatching. + raw_dat <- dplyr::mutate(rm_cnd_df(raw_dat), `__raw_dat_cond__` = raw_dat_cnd) + tgt_dat <- dplyr::mutate(rm_cnd_df(tgt_dat), `__tgt_dat_cond__` = tgt_dat_cnd) + + res <- dplyr::right_join(raw_dat, y = tgt_dat, by = id_vars) + + cnd <- res$`__raw_dat_cond__` & res$`__tgt_dat_cond__` + res |> + dplyr::select(-dplyr::all_of(c( + "__raw_dat_cond__", "__tgt_dat_cond__" + ))) |> + new_cnd_df(cnd = cnd, .warn = FALSE) + +} + diff --git a/R/sdtm_join.R b/R/sdtm_join.R new file mode 100644 index 00000000..fc973ead --- /dev/null +++ b/R/sdtm_join.R @@ -0,0 +1,39 @@ +#' SDTM join +#' +#' [sdtm_join()] is a special join between a raw data set and a target data +#' set. This function supports conditioned data frames. +#' +#' @param raw_dat The raw dataset: a dataframe or a conditioned data frame. Must +#' include the variables passed in `id_vars`. +#' @param tgt_dat Target dataset: a data frame or a conditioned data frame to be +#' merged against `raw_dat` by the variables indicated in `id_vars`. +#' @param id_vars Key variables to be used in the join between the raw dataset +#' (`raw_dat`) and the target data set (`tgt_dat`). +#' +#' @returns A data frame, or a conditioned data frame if, at least, one of the +#' input data sets is a conditioned data frame. +#' +#' @keywords internal +#' @importFrom rlang %||% +sdtm_join <- function(raw_dat, + tgt_dat = NULL, + id_vars = oak_id_vars()) { + raw_dat_cnd <- get_cnd_df_cnd(raw_dat) %||% rep(TRUE, nrow(raw_dat)) + tgt_dat <- tgt_dat %||% raw_dat[id_vars] + tgt_dat_cnd <- get_cnd_df_cnd(tgt_dat) %||% rep(TRUE, nrow(tgt_dat)) + + # `rm_cnd_df()` prevents `mutate` from dispatching. + raw_dat <- dplyr::mutate(rm_cnd_df(raw_dat), `__raw_dat_cond__` = raw_dat_cnd) + tgt_dat <- dplyr::mutate(rm_cnd_df(tgt_dat), `__tgt_dat_cond__` = tgt_dat_cnd) + + res <- dplyr::right_join(raw_dat, y = tgt_dat, by = id_vars) + + cnd <- res$`__raw_dat_cond__` & res$`__tgt_dat_cond__` + res |> + dplyr::select(-dplyr::all_of(c( + "__raw_dat_cond__", "__tgt_dat_cond__" + ))) |> + new_cnd_df(cnd = cnd, .warn = FALSE) + +} + diff --git a/inst/WORDLIST b/inst/WORDLIST index 538f7a2e..78f8f566 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -25,3 +25,4 @@ AE AESTDY CMSTDY DM +ungrouped diff --git a/man/condition_by.Rd b/man/condition_by.Rd index e1b7cb2a..7a5ff82c 100644 --- a/man/condition_by.Rd +++ b/man/condition_by.Rd @@ -20,8 +20,10 @@ will be coerced to an environment internally.} \value{ A tibble with an additional class \code{cnd_df} and a logical vector attribute indicating matching rows. + +A conditioned data frame. } \description{ This function tags records in a data set, indicating which rows match the -specified conditions. +specified conditions, resulting in a conditioned data frame. } diff --git a/man/ctl_new_rowid_pillar.cnd_df.Rd b/man/ctl_new_rowid_pillar.cnd_df.Rd new file mode 100644 index 00000000..dc70aa27 --- /dev/null +++ b/man/ctl_new_rowid_pillar.cnd_df.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{ctl_new_rowid_pillar.cnd_df} +\alias{ctl_new_rowid_pillar.cnd_df} +\title{Conditioned tibble pillar print method} +\usage{ +\method{ctl_new_rowid_pillar}{cnd_df}(controller, x, width, ...) +} +\arguments{ +\item{controller}{The object of class \code{"tbl"} currently printed.} + +\item{x}{A simple (one-dimensional) vector.} + +\item{width}{The available width, can be a vector for multiple tiers.} + +\item{...}{These dots are for future extensions and must be empty.} +} +\description{ +Conditioned tibble pillar print method +} diff --git a/man/mutate.cnd_df.Rd b/man/mutate.cnd_df.Rd new file mode 100644 index 00000000..d55b2134 --- /dev/null +++ b/man/mutate.cnd_df.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{mutate.cnd_df} +\alias{mutate.cnd_df} +\title{Mutate method for conditioned data frames} +\usage{ +\method{mutate}{cnd_df}( + .data, + ..., + .by = NULL, + .keep = c("all", "used", "unused", "none"), + .before = NULL, + .after = NULL +) +} +\arguments{ +\item{.data}{A conditioned data frame.} + +\item{...}{<\code{\link[rlang:args_data_masking]{data-masking}}> Name-value pairs. +The name gives the name of the column in the output. + +The value can be: +\itemize{ +\item A vector of length 1, which will be recycled to the correct length. +\item A vector the same length as the current group (or the whole data frame +if ungrouped). +\item \code{NULL}, to remove the column. +\item A data frame or tibble, to create multiple columns in the output. +}} + +\item{.by}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> Optionally, a selection of columns to +group by for just this operation, functioning as an alternative to \code{\link[dplyr:group_by]{group_by()}}. For +details and examples, see \link[dplyr:dplyr_by]{?dplyr_by}.} + +\item{.keep}{Control which columns from \code{.data} are retained in the output. Grouping +columns and columns created by \code{...} are always kept. +\itemize{ +\item \code{"all"} retains all columns from \code{.data}. This is the default. +\item \code{"used"} retains only the columns used in \code{...} to create new +columns. This is useful for checking your work, as it displays inputs +and outputs side-by-side. +\item \code{"unused"} retains only the columns \emph{not} used in \code{...} to create new +columns. This is useful if you generate new columns, but no longer need +the columns used to generate them. +\item \code{"none"} doesn't retain any extra columns from \code{.data}. Only the grouping +variables and columns created by \code{...} are kept. +}} + +\item{.before, .after}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> Optionally, control where new columns +should appear (the default is to add to the right hand side). See +\code{\link[dplyr:relocate]{relocate()}} for more details.} +} +\description{ +\code{\link[=mutate.cnd_df]{mutate.cnd_df()}} is an S3 method to be dispatched by \link[dplyr:mutate]{mutate} +generic on conditioned data frames. This function implements a conditional +mutate by only changing rows for which the condition stored in the +conditioned data frame is \code{TRUE}. +} diff --git a/man/sdtm_assign.Rd b/man/sdtm_assign.Rd index 676979dc..85601e3c 100644 --- a/man/sdtm_assign.Rd +++ b/man/sdtm_assign.Rd @@ -37,7 +37,7 @@ the variables indicated in \code{id_vars}. This parameter is optional, see section Value for how the output changes depending on this argument value.} \item{id_vars}{Key variables to be used in the join between the raw dataset -(\code{raw_dat}) and the target data set (\code{raw_dat}).} +(\code{raw_dat}) and the target data set (\code{tgt_dat}).} } \value{ The returned data set depends on the value of \code{tgt_dat}: diff --git a/man/sdtm_hardcode.Rd b/man/sdtm_hardcode.Rd index 5c3435b5..d8cb59a6 100644 --- a/man/sdtm_hardcode.Rd +++ b/man/sdtm_hardcode.Rd @@ -41,7 +41,7 @@ the variables indicated in \code{id_vars}. This parameter is optional, see section Value for how the output changes depending on this argument value.} \item{id_vars}{Key variables to be used in the join between the raw dataset -(\code{raw_dat}) and the target data set (\code{raw_dat}).} +(\code{raw_dat}) and the target data set (\code{tgt_dat}).} } \value{ The returned data set depends on the value of \code{tgt_dat}: diff --git a/man/sdtm_join.Rd b/man/sdtm_join.Rd new file mode 100644 index 00000000..1c7c02e7 --- /dev/null +++ b/man/sdtm_join.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/join.R, R/sdtm_join.R +\name{sdtm_join} +\alias{sdtm_join} +\title{SDTM join} +\usage{ +sdtm_join(raw_dat, tgt_dat = NULL, id_vars = oak_id_vars()) + +sdtm_join(raw_dat, tgt_dat = NULL, id_vars = oak_id_vars()) +} +\arguments{ +\item{raw_dat}{The raw dataset: a dataframe or a conditioned data frame. Must +include the variables passed in \code{id_vars}.} + +\item{tgt_dat}{Target dataset: a data frame or a conditioned data frame to be +merged against \code{raw_dat} by the variables indicated in \code{id_vars}.} + +\item{id_vars}{Key variables to be used in the join between the raw dataset +(\code{raw_dat}) and the target data set (\code{tgt_dat}).} +} +\value{ +A data frame, or a conditioned data frame if at least one of the +input data sets is a conditioned data frame. + +A data frame, or a conditioned data frame if, at least, one of the +input data sets is a conditioned data frame. +} +\description{ +\code{\link[=sdtm_join]{sdtm_join()}} is a special join between a raw data set and a target data +set. This function supports conditioned data frames. + +\code{\link[=sdtm_join]{sdtm_join()}} is a special join between a raw data set and a target data +set. This function supports conditioned data frames. +} +\keyword{internal} diff --git a/man/tbl_sum.cnd_df.Rd b/man/tbl_sum.cnd_df.Rd index f8a50544..760e5507 100644 --- a/man/tbl_sum.cnd_df.Rd +++ b/man/tbl_sum.cnd_df.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/cnd_df.R \name{tbl_sum.cnd_df} \alias{tbl_sum.cnd_df} -\title{Print} +\title{Conditioned tibble header print method} \usage{ \method{tbl_sum}{cnd_df}(x, ...) } @@ -12,5 +12,5 @@ \item{...}{Additional arguments passed to the default print method.} } \description{ -Blah +Conditioned tibble header print method } diff --git a/tests/testthat/test-assign.R b/tests/testthat/test-assign.R new file mode 100644 index 00000000..46d86a87 --- /dev/null +++ b/tests/testthat/test-assign.R @@ -0,0 +1,167 @@ +test_that("assign_ct works as expected with a conditioned `tgt_dat`", { + + vs_raw_dat <- tibble::tibble( + oak_id = 1:5, + raw_source = c("VS1", "VS2", "VS3", "VS4", "VS5"), + patient_number = c(101L, 102L, 103L, 104L, 105L), + TEMPLOC = c("Oral", "Axillary", "Rectal", "Tympanic", "Temporal") + ) + + vs_tgt_dat <- tibble::tibble( + oak_id = as.integer(rep(1:5, each = 4)), + raw_source = rep(c("VS1", "VS2", "VS3", "VS4", "VS5"), each = 4), + patient_number = as.integer(rep(c(101L, 102L, 103L, 104L, 105L), each = 4)), + VSTESTCD = c("TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR") + ) + + # vital signs' locations + vs_loc_raw <- c("Mouth", "Arm", "Arm", "Arm", "Armpit", "Arm", "Arm", "Arm", + "Rectum", "Arm", "Arm", "Arm", "auris", "Arm", "Arm", "Arm", "brow", "Arm", + "Arm", "Arm") + + vs_loc_tgt <- c( + "ORAL", + rep(NA, 3L), + "AXILLA", + rep(NA, 3L), + "ANUS", + rep(NA, 3L), + "EAR", + rep(NA, 3L), + "FOREHEAD", + rep(NA, 3L) + ) + + ct_spec <- tibble::tibble( + codelist_code = "C74456", + term_code = c("C32141", "C12674", "C12394", "C89803", "C43362"), + CodedData = c("ARM", "AXILLA", "EAR", "FOREHEAD", "ANUS"), + term_value = c("ARM", "AXILLA", "EAR", "FOREHEAD", "ANUS"), + collected_value = c("Arm", "Armpit", "auris", "brow", "anus"), + term_synonyms = c("Arm", "Axillary", "Tympanic", "Temporal", "Rectal") + ) + + result <- + assign_ct( + raw_dat = vs_raw_dat, + raw_var = "TEMPLOC", + tgt_var = "VSLOC", + ct_spec = ct_spec, + ct_clst = "C74456", + tgt_dat = condition_by(vs_tgt_dat, VSTESTCD == "TEMP") + ) + + expected_result <- + tibble::add_column( + vs_tgt_dat, + VSLOC = vs_loc_tgt + ) + + expect_equal(result, expected_result) +}) + + +test_that("assign_ct works as expected with both `raw_dat` and `tgt_dat` as conditioned data frames", { + + ct_spec <- tibble::tibble( + codelist_code = "C78734", + term_code = c("C150895", "C12434", "C13275", "C89803", "C12801"), + CodedData = c("SWABBED MATERIAL", "BLOOD", "SALIVA", "URINE", "TISSUE"), + term_value = c("SWABBED MATERIAL", "BLOOD", "SALIVA", "URINE", "TISSUE"), + collected_value = c("Nasopharyngeal Swab", "blood", "drool", "urine sample", "tissue"), + term_synonyms = c("Swab", "Blood", "Spit", "urinary excretion", "tissue sample") + ) + + fa_raw_dat <- tibble::tibble( + oak_id = as.integer(1:5), + raw_source = c("FA1", "FA2", "FA3", "FA4", "FA5"), + patient_number = 101:105, + SPCNM = c("Nasopharyngeal Swab", "Blood", "Saliva", "Urine", "Tissue"), + SPECTYP = c(NA, NA, "Swab", NA, NA) + ) + + fa_tgt_dat <- tibble::tibble( + oak_id = 1:5, + raw_source = c("FA1", "FA2", "FA3", "FA4", "FA5"), + patient_number = 101:105, + FATESTCD = c("STATUS", "OTHER", "STATUS", "STATUS", "OTHER"), + FAOBJ = c( + "Severe Acute Resp Syndrome Coronavirus 2", + "Other Condition", + "Severe Acute Resp Syndrome Coronavirus 2", + "Severe Acute Resp Syndrome Coronavirus 2", + "Other Condition" + ) + ) + + result <- + assign_ct( + raw_dat = condition_by(fa_raw_dat, is.na(SPECTYP)), + raw_var = "SPCNM", + tgt_var = "FASPEC", + ct_spec = ct_spec, + ct_clst = "C78734", + tgt_dat = condition_by( + fa_tgt_dat, + FATESTCD == "STATUS" & + FAOBJ == "Severe Acute Resp Syndrome Coronavirus 2" + ) + ) + + expected_result <- + fa_tgt_dat |> + tibble::add_column(FASPEC = c("SWABBED MATERIAL", NA, NA, "URINE", NA)) + + expect_equal(result, expected_result) +}) + +test_that("assign_ct works as expected with conditions across both data sets", { + + cm_raw_dat <- tibble::tibble( + oak_id = 1:5, + raw_source = paste0("MD", 1:5), + patient_number = 101:105, + CMMODIFY = c("ASPIRIN EC", "IBUPROFEN LYSINE" , "PARACETAMOL", "DICLOFENAC", "NAPROXEN") + ) + + cm_tgt_dat <- tibble::tibble( + oak_id = 1:5, + raw_source = paste0("MD", 1:5), + patient_number = 101:105, + CMTRT = c("ASPIRIN", "IBUPROFEN", "PARACETAMOL", "DICLOFENAC", "NAPROXEN") + ) + + # This only works if the raw data set and the target data set have the same + # number of records, otherwise the comparison CMMODIFY != CMTRT is not + # meaningful. + result1 <- + assign_no_ct( + raw_dat = cm_raw_dat, + raw_var = "CMMODIFY", + tgt_var = "CMMODIFY", + tgt_dat = condition_by(cm_tgt_dat, CMMODIFY != CMTRT, .env = cm_raw_dat) + ) + + # Because both data sets have to have the same number of records for the + # comparison to be meaningful, then we can just as well condition the + # raw data set itself. + result2 <- + assign_no_ct( + raw_dat = condition_by(cm_raw_dat, CMMODIFY != CMTRT, .env = cm_tgt_dat), + raw_var = "CMMODIFY", + tgt_var = "CMMODIFY", + tgt_dat = cm_tgt_dat + ) + + expected_result <- + cm_tgt_dat |> + tibble::add_column(CMMODIFY = c("ASPIRIN EC", "IBUPROFEN LYSINE", NA, NA, NA)) + + expect_equal(result1, expected_result) + expect_equal(result2, expected_result) + +}) diff --git a/tests/testthat/test-hardcode.R b/tests/testthat/test-hardcode.R index 29af4b32..9f7ec73e 100644 --- a/tests/testthat/test-hardcode.R +++ b/tests/testthat/test-hardcode.R @@ -79,3 +79,6 @@ test_that("hardcode_ct works as expected", { expect_equal(result, expected_result) }) + + + From 0d7861ab54aae4d0825a29c47a9a7a035aac6ba7 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Wed, 12 Jun 2024 16:19:29 +0100 Subject: [PATCH 04/12] Ramm's feedback integration - Move `tgt_dat` to the first position in the argument list for cleaner command pipes. - Rename `condition_by()` to `condition_add()`. - Export `oak_id_vars()` for direct user access. - Update tidyselections to align with the latest practices. --- NAMESPACE | 3 +- R/assign.R | 39 +++++++++++--------- R/assign_datetime.R | 21 ++++++----- R/cnd_df.R | 7 ++-- R/ct.R | 4 +- R/hardcode.R | 45 ++++++++++++----------- R/oak_id_vars.R | 8 ++-- man/assign.Rd | 32 ++++++++-------- man/assign_datetime.Rd | 32 ++++++++-------- man/{condition_by.Rd => condition_add.Rd} | 8 ++-- man/contains_oak_id_vars.Rd | 2 +- man/harcode.Rd | 38 +++++++++---------- man/oak_id_vars.Rd | 5 +-- man/sdtm_assign.Rd | 18 ++++----- man/sdtm_hardcode.Rd | 18 ++++----- tests/testthat/test-assign.R | 33 +++++++++-------- tests/testthat/test-assign_datetime.R | 10 ++--- tests/testthat/test-hardcode.R | 4 +- 18 files changed, 168 insertions(+), 159 deletions(-) rename man/{condition_by.Rd => condition_add.Rd} (80%) diff --git a/NAMESPACE b/NAMESPACE index 5ec1b0bd..c8dd2b14 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,7 +8,7 @@ export(assign_ct) export(assign_datetime) export(assign_no_ct) export(clear_cache) -export(condition_by) +export(condition_add) export(create_iso8601) export(ct_map) export(ct_spec_example) @@ -17,6 +17,7 @@ export(derive_study_day) export(fmt_cmp) export(hardcode_ct) export(hardcode_no_ct) +export(oak_id_vars) export(problems) export(read_ct_spec) export(read_ct_spec_example) diff --git a/R/assign.R b/R/assign.R index 88dbf8c4..d381f79b 100644 --- a/R/assign.R +++ b/R/assign.R @@ -35,13 +35,14 @@ #' #' @importFrom rlang := #' @keywords internal -sdtm_assign <- function(raw_dat, - raw_var, +sdtm_assign <- function(tgt_dat = NULL, tgt_var, + raw_dat, + raw_var, ct_spec = NULL, ct_clst = NULL, - tgt_dat = NULL, id_vars = oak_id_vars()) { + admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) @@ -117,9 +118,9 @@ sdtm_assign <- function(raw_dat, #' ) #' #' assign_no_ct( -#' raw_dat = md1, -#' raw_var = "MDIND", #' tgt_var = "CMINDC", +#' raw_dat = md1, +#' raw_var = "MDIND" #' ) #' #' cm_inter <- @@ -165,12 +166,12 @@ sdtm_assign <- function(raw_dat, #' (ct_spec <- read_ct_spec_example("ct-01-cm")) #' #' assign_ct( +#' tgt_dat = cm_inter, +#' tgt_var = "CMINDC", #' raw_dat = md1, #' raw_var = "MDIND", -#' tgt_var = "CMINDC", #' ct_spec = ct_spec, -#' ct_clst = "C66729", -#' tgt_dat = cm_inter +#' ct_clst = "C66729" #' ) #' #' @name assign @@ -179,11 +180,12 @@ NULL #' @order 1 #' @export #' @rdname assign -assign_no_ct <- function(raw_dat, - raw_var, +assign_no_ct <- function(tgt_dat = NULL, tgt_var, - tgt_dat = NULL, + raw_dat, + raw_var, id_vars = oak_id_vars()) { + admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) @@ -194,10 +196,10 @@ assign_no_ct <- function(raw_dat, admiraldev::assert_data_frame(tgt_dat, required_vars = rlang::syms(id_vars), optional = TRUE) sdtm_assign( + tgt_dat = tgt_dat, + tgt_var = tgt_var, raw_dat = raw_dat, raw_var = raw_var, - tgt_var = tgt_var, - tgt_dat = tgt_dat, id_vars = id_vars ) } @@ -205,13 +207,14 @@ assign_no_ct <- function(raw_dat, #' @order 2 #' @export #' @rdname assign -assign_ct <- function(raw_dat, - raw_var, +assign_ct <- function(tgt_dat = NULL, tgt_var, + raw_dat, + raw_var, ct_spec, ct_clst, - tgt_dat = NULL, id_vars = oak_id_vars()) { + admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) @@ -222,10 +225,10 @@ assign_ct <- function(raw_dat, admiraldev::assert_data_frame(tgt_dat, required_vars = rlang::syms(id_vars), optional = TRUE) sdtm_assign( + tgt_dat = tgt_dat, + tgt_var = tgt_var, raw_dat = raw_dat, raw_var = raw_var, - tgt_var = tgt_var, - tgt_dat = tgt_dat, id_vars = id_vars, ct_spec = ct_spec, ct_clst = ct_clst diff --git a/R/assign_datetime.R b/R/assign_datetime.R index e6881e8b..5af4f9e2 100644 --- a/R/assign_datetime.R +++ b/R/assign_datetime.R @@ -61,11 +61,11 @@ #' # indicating that these values are missing/unknown (unk). #' cm1 <- #' assign_datetime( +#' tgt_var = "CMSTDTC", #' raw_dat = md1, #' raw_var = "MDBDR", #' raw_fmt = "d-m-y", -#' raw_unk = c("UN", "UNK"), -#' tgt_var = "CMSTDTC" +#' raw_unk = c("UN", "UNK") #' ) #' #' cm1 @@ -120,11 +120,11 @@ #' # data set `cm_inter`. #' cm2 <- #' assign_datetime( +#' tgt_dat = cm_inter, +#' tgt_var = "CMSTDTC", #' raw_dat = md1, #' raw_var = "MDBDR", -#' raw_fmt = "d-m-y", -#' tgt_var = "CMSTDTC", -#' tgt_dat = cm_inter +#' raw_fmt = "d-m-y" #' ) #' #' cm2 @@ -137,11 +137,11 @@ #' # MDETM (correspondence is by positional matching). #' cm3 <- #' assign_datetime( +#' tgt_var = "CMSTDTC", #' raw_dat = md1, #' raw_var = c("MDEDR", "MDETM"), #' raw_fmt = c("d-m-y", "H:M:S"), -#' raw_unk = c("UN", "UNK"), -#' tgt_var = "CMSTDTC" +#' raw_unk = c("UN", "UNK") #' ) #' #' cm3 @@ -151,14 +151,15 @@ #' #' @export assign_datetime <- - function(raw_dat, + function(tgt_dat = NULL, + tgt_var, + raw_dat, raw_var, raw_fmt, - tgt_var, raw_unk = c("UN", "UNK"), - tgt_dat = NULL, id_vars = oak_id_vars(), .warn = TRUE) { + admiraldev::assert_character_vector(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) diff --git a/R/cnd_df.R b/R/cnd_df.R index 54dfc1d0..2f8e87dd 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -20,7 +20,7 @@ # - `tbl_sum.cnd_df()`: Provide a tibble header print method for `cnd_df` tibbles. # - `ctl_new_rowid_pillar.cnd_df()`: A print method for the row ids cnd_df` tibbles. # - `eval_conditions()`: Find which rows match a set of conditions. -# - `condition_by()`: Create a conditioned data frame (user facing). +# - `condition_add()`: Create a conditioned data frame (user facing). # - `derive_by_condition()`: Perform a derivation on a conditioned data frame. #' Create a data frame with filtering tags @@ -269,14 +269,14 @@ eval_conditions <- function(dat, #' @return A tibble with an additional class `cnd_df` and a logical vector #' attribute indicating matching rows. #' @param .na Return value to be used when the conditions evaluate to `NA`. -#' @param .env An optional environment to look for variables involved in logical +#' @param .dat2 An optional environment to look for variables involved in logical #' expression passed in `...`. A data frame or a list can also be passed that #' will be coerced to an environment internally. #' #' @returns A conditioned data frame. #' #' @export -condition_by <- function(dat, ..., .na = NA, .env = rlang::env()) { +condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { if (is_cnd_df(dat)) { rlang::warn( @@ -284,6 +284,7 @@ condition_by <- function(dat, ..., .na = NA, .env = rlang::env()) { "The previous condition will be replaced by the new one.") ) } + .env <- .dat2 cnd <- eval_conditions(dat = dat, ..., .na = .na, .env = .env) new_cnd_df(dat, cnd = cnd, .warn = FALSE) diff --git a/R/ct.R b/R/ct.R index e66c2d6d..ab5efb00 100644 --- a/R/ct.R +++ b/R/ct.R @@ -232,10 +232,10 @@ ct_mappings <- function(ct_spec, from = ct_spec_vars("from"), to = ct_spec_vars( values_to = "from", names_to = "type" ) |> - dplyr::select(c("type", "from", "to")) |> + dplyr::select(dplyr::all_of(c("type", "from", "to"))) |> dplyr::mutate(type = factor(.data$type, levels = cols)) |> dplyr::arrange(.data$type) |> - dplyr::select(-"type") |> + dplyr::select(-dplyr::all_of("type")) |> tidyr::drop_na("from") |> dplyr::mutate(from = str_split(.data$from)) |> tidyr::unnest(from) |> diff --git a/R/hardcode.R b/R/hardcode.R index e893f6b7..3562192f 100644 --- a/R/hardcode.R +++ b/R/hardcode.R @@ -36,14 +36,15 @@ #' #' @importFrom rlang := #' @keywords internal -sdtm_hardcode <- function(raw_dat, - raw_var, +sdtm_hardcode <- function(tgt_dat = NULL, tgt_var, + raw_dat, + raw_var, tgt_val, ct_spec = NULL, ct_clst = NULL, - tgt_dat = NULL, id_vars = oak_id_vars()) { + admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_scalar(tgt_val) @@ -122,10 +123,10 @@ sdtm_hardcode <- function(raw_dat, #' # Derive a new variable `CMCAT` by overwriting `MDRAW` with the #' # hardcoded value "GENERAL CONCOMITANT MEDICATIONS". #' hardcode_no_ct( +#' tgt_val = "GENERAL CONCOMITANT MEDICATIONS", #' raw_dat = md1, #' raw_var = "MDRAW", -#' tgt_var = "CMCAT", -#' tgt_val = "GENERAL CONCOMITANT MEDICATIONS" +#' tgt_var = "CMCAT" #' ) #' #' cm_inter <- @@ -142,11 +143,11 @@ sdtm_hardcode <- function(raw_dat, #' # hardcoded value "GENERAL CONCOMITANT MEDICATIONS" with a prior join to #' # `target_dataset`. #' hardcode_no_ct( +#' tgt_dat = cm_inter, +#' tgt_val = "GENERAL CONCOMITANT MEDICATIONS", #' raw_dat = md1, #' raw_var = "MDRAW", -#' tgt_var = "CMCAT", -#' tgt_val = "GENERAL CONCOMITANT MEDICATIONS", -#' tgt_dat = cm_inter +#' tgt_var = "CMCAT" #' ) #' #' # Controlled terminology specification @@ -156,13 +157,13 @@ sdtm_hardcode <- function(raw_dat, #' # involving terminology recoding. `NA` values in `MDRAW` are preserved in #' # `CMCAT`. #' hardcode_ct( +#' tgt_dat = cm_inter, +#' tgt_var = "CMCAT", #' raw_dat = md1, #' raw_var = "MDRAW", -#' tgt_var = "CMCAT", #' tgt_val = "GENERAL CONCOMITANT MEDICATIONS", #' ct_spec = ct_spec, -#' ct_clst = "C66729", -#' tgt_dat = cm_inter +#' ct_clst = "C66729" #' ) #' #' @name harcode @@ -170,12 +171,13 @@ NULL #' @export #' @rdname harcode -hardcode_no_ct <- function(raw_dat, +hardcode_no_ct <- function(tgt_dat = NULL, + tgt_val, + raw_dat, raw_var, tgt_var, - tgt_val, - tgt_dat = NULL, id_vars = oak_id_vars()) { + admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) assertthat::assert_that(assertthat::is.scalar(tgt_val), @@ -189,11 +191,11 @@ hardcode_no_ct <- function(raw_dat, admiraldev::assert_data_frame(tgt_dat, required_vars = rlang::syms(id_vars), optional = TRUE) sdtm_hardcode( + tgt_dat = tgt_dat, + tgt_val = tgt_val, raw_dat = raw_dat, raw_var = raw_var, tgt_var = tgt_var, - tgt_val = tgt_val, - tgt_dat = tgt_dat, id_vars = id_vars ) } @@ -201,14 +203,15 @@ hardcode_no_ct <- function(raw_dat, #' @export #' @rdname harcode hardcode_ct <- - function(raw_dat, + function(tgt_dat = NULL, + tgt_val, + raw_dat, raw_var, tgt_var, - tgt_val, ct_spec, ct_clst, - tgt_dat = NULL, id_vars = oak_id_vars()) { + admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) assertthat::assert_that(assertthat::is.scalar(tgt_val), @@ -228,13 +231,13 @@ hardcode_ct <- assert_ct_clst(ct_spec = ct_spec, ct_clst = ct_clst, optional = FALSE) sdtm_hardcode( + tgt_dat = tgt_dat, + tgt_val = tgt_val, raw_dat = raw_dat, raw_var = raw_var, tgt_var = tgt_var, - tgt_val = tgt_val, ct_spec = ct_spec, ct_clst = ct_clst, - tgt_dat = tgt_dat, id_vars = id_vars ) } diff --git a/R/oak_id_vars.R b/R/oak_id_vars.R index 718d11da..c88007f8 100644 --- a/R/oak_id_vars.R +++ b/R/oak_id_vars.R @@ -13,11 +13,11 @@ #' as keys in raw datasets. #' #' @examples -#' sdtm.oak:::oak_id_vars() +#' oak_id_vars() #' -#' sdtm.oak:::oak_id_vars(extra_vars = "sample_id") +#' oak_id_vars(extra_vars = "sample_id") #' -#' @keywords internal +#' @export oak_id_vars <- function(extra_vars = NULL) { admiraldev::assert_character_vector(extra_vars, optional = TRUE) unique(c("oak_id", "raw_source", "patient_number", extra_vars)) @@ -37,7 +37,7 @@ oak_id_vars <- function(extra_vars = NULL) { #' # `oak_id_vars()` is the function that defines what are the minimal set of #' # oak keys. Hence, by definition, the following code should always return #' # `TRUE`. -#' sdtm.oak:::contains_oak_id_vars(sdtm.oak:::oak_id_vars()) +#' sdtm.oak:::contains_oak_id_vars(oak_id_vars()) #' #' # Returns `FALSE`. #' sdtm.oak:::contains_oak_id_vars(character()) diff --git a/man/assign.Rd b/man/assign.Rd index ff7df056..2f53ff73 100644 --- a/man/assign.Rd +++ b/man/assign.Rd @@ -7,37 +7,37 @@ \title{Derive an SDTM variable} \usage{ assign_no_ct( + tgt_dat = NULL, + tgt_var, raw_dat, raw_var, - tgt_var, - tgt_dat = NULL, id_vars = oak_id_vars() ) assign_ct( + tgt_dat = NULL, + tgt_var, raw_dat, raw_var, - tgt_var, ct_spec, ct_clst, - tgt_dat = NULL, id_vars = oak_id_vars() ) } \arguments{ +\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by +the variables indicated in \code{id_vars}. This parameter is optional, see +section Value for how the output changes depending on this argument value.} + +\item{tgt_var}{The target SDTM variable: a single string indicating the name +of variable to be derived.} + \item{raw_dat}{The raw dataset (dataframe); must include the variables passed in \code{id_vars} and \code{raw_var}.} \item{raw_var}{The raw variable: a single string indicating the name of the raw variable in \code{raw_dat}.} -\item{tgt_var}{The target SDTM variable: a single string indicating the name -of variable to be derived.} - -\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by -the variables indicated in \code{id_vars}. This parameter is optional, see -section Value for how the output changes depending on this argument value.} - \item{id_vars}{Key variables to be used in the join between the raw dataset (\code{raw_dat}) and the target data set (\code{raw_dat}).} @@ -82,9 +82,9 @@ md1 <- ) assign_no_ct( - raw_dat = md1, - raw_var = "MDIND", tgt_var = "CMINDC", + raw_dat = md1, + raw_var = "MDIND" ) cm_inter <- @@ -130,12 +130,12 @@ cm_inter <- (ct_spec <- read_ct_spec_example("ct-01-cm")) assign_ct( + tgt_dat = cm_inter, + tgt_var = "CMINDC", raw_dat = md1, raw_var = "MDIND", - tgt_var = "CMINDC", ct_spec = ct_spec, - ct_clst = "C66729", - tgt_dat = cm_inter + ct_clst = "C66729" ) } diff --git a/man/assign_datetime.Rd b/man/assign_datetime.Rd index 9130e775..b3564ddf 100644 --- a/man/assign_datetime.Rd +++ b/man/assign_datetime.Rd @@ -5,17 +5,24 @@ \title{Derive an ISO8601 date-time variable} \usage{ assign_datetime( + tgt_dat = NULL, + tgt_var, raw_dat, raw_var, raw_fmt, - tgt_var, raw_unk = c("UN", "UNK"), - tgt_dat = NULL, id_vars = oak_id_vars(), .warn = TRUE ) } \arguments{ +\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by +the variables indicated in \code{id_vars}. This parameter is optional, see +section Value for how the output changes depending on this argument value.} + +\item{tgt_var}{The target SDTM variable: a single string indicating the name +of variable to be derived.} + \item{raw_dat}{The raw dataset (dataframe); must include the variables passed in \code{id_vars} and \code{raw_var}.} @@ -30,16 +37,9 @@ element is taken as parsing format for each variable indicated in vector of formats. The first vector of formats is used for parsing the first variable in \code{raw_var}, and so on.} -\item{tgt_var}{The target SDTM variable: a single string indicating the name -of variable to be derived.} - \item{raw_unk}{A character vector of string literals to be regarded as missing values during parsing.} -\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by -the variables indicated in \code{id_vars}. This parameter is optional, see -section Value for how the output changes depending on this argument value.} - \item{id_vars}{Key variables to be used in the join between the raw dataset (\code{raw_dat}) and the target data set (\code{tgt_dat}).} @@ -88,11 +88,11 @@ md1 <- # indicating that these values are missing/unknown (unk). cm1 <- assign_datetime( + tgt_var = "CMSTDTC", raw_dat = md1, raw_var = "MDBDR", raw_fmt = "d-m-y", - raw_unk = c("UN", "UNK"), - tgt_var = "CMSTDTC" + raw_unk = c("UN", "UNK") ) cm1 @@ -147,11 +147,11 @@ cm_inter <- # data set `cm_inter`. cm2 <- assign_datetime( + tgt_dat = cm_inter, + tgt_var = "CMSTDTC", raw_dat = md1, raw_var = "MDBDR", - raw_fmt = "d-m-y", - tgt_var = "CMSTDTC", - tgt_dat = cm_inter + raw_fmt = "d-m-y" ) cm2 @@ -164,11 +164,11 @@ problems(cm2$CMSTDTC) # MDETM (correspondence is by positional matching). cm3 <- assign_datetime( + tgt_var = "CMSTDTC", raw_dat = md1, raw_var = c("MDEDR", "MDETM"), raw_fmt = c("d-m-y", "H:M:S"), - raw_unk = c("UN", "UNK"), - tgt_var = "CMSTDTC" + raw_unk = c("UN", "UNK") ) cm3 diff --git a/man/condition_by.Rd b/man/condition_add.Rd similarity index 80% rename from man/condition_by.Rd rename to man/condition_add.Rd index 7a5ff82c..900052ed 100644 --- a/man/condition_by.Rd +++ b/man/condition_add.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/cnd_df.R -\name{condition_by} -\alias{condition_by} +\name{condition_add} +\alias{condition_add} \title{Condition a data set based on specified conditions} \usage{ -condition_by(dat, ..., .na = NA, .env = rlang::env()) +condition_add(dat, ..., .na = NA, .dat2 = rlang::env()) } \arguments{ \item{dat}{A tibble.} @@ -13,7 +13,7 @@ condition_by(dat, ..., .na = NA, .env = rlang::env()) \item{.na}{Return value to be used when the conditions evaluate to \code{NA}.} -\item{.env}{An optional environment to look for variables involved in logical +\item{.dat2}{An optional environment to look for variables involved in logical expression passed in \code{...}. A data frame or a list can also be passed that will be coerced to an environment internally.} } diff --git a/man/contains_oak_id_vars.Rd b/man/contains_oak_id_vars.Rd index c872bbbe..21bc97fb 100644 --- a/man/contains_oak_id_vars.Rd +++ b/man/contains_oak_id_vars.Rd @@ -21,7 +21,7 @@ variables --- these are defined by the return value of \code{\link[=oak_id_vars] # `oak_id_vars()` is the function that defines what are the minimal set of # oak keys. Hence, by definition, the following code should always return # `TRUE`. -sdtm.oak:::contains_oak_id_vars(sdtm.oak:::oak_id_vars()) +sdtm.oak:::contains_oak_id_vars(oak_id_vars()) # Returns `FALSE`. sdtm.oak:::contains_oak_id_vars(character()) diff --git a/man/harcode.Rd b/man/harcode.Rd index e38424a5..573a267e 100644 --- a/man/harcode.Rd +++ b/man/harcode.Rd @@ -7,26 +7,33 @@ \title{Derive an SDTM variable with a hardcoded value} \usage{ hardcode_no_ct( + tgt_dat = NULL, + tgt_val, raw_dat, raw_var, tgt_var, - tgt_val, - tgt_dat = NULL, id_vars = oak_id_vars() ) hardcode_ct( + tgt_dat = NULL, + tgt_val, raw_dat, raw_var, tgt_var, - tgt_val, ct_spec, ct_clst, - tgt_dat = NULL, id_vars = oak_id_vars() ) } \arguments{ +\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by +the variables indicated in \code{id_vars}. This parameter is optional, see +section Value for how the output changes depending on this argument value.} + +\item{tgt_val}{The target SDTM value to be hardcoded into the variable +indicated in \code{tgt_var}.} + \item{raw_dat}{The raw dataset (dataframe); must include the variables passed in \code{id_vars} and \code{raw_var}.} @@ -36,13 +43,6 @@ raw variable in \code{raw_dat}.} \item{tgt_var}{The target SDTM variable: a single string indicating the name of variable to be derived.} -\item{tgt_val}{The target SDTM value to be hardcoded into the variable -indicated in \code{tgt_var}.} - -\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by -the variables indicated in \code{id_vars}. This parameter is optional, see -section Value for how the output changes depending on this argument value.} - \item{id_vars}{Key variables to be used in the join between the raw dataset (\code{raw_dat}) and the target data set (\code{raw_dat}).} @@ -87,10 +87,10 @@ md1 <- # Derive a new variable `CMCAT` by overwriting `MDRAW` with the # hardcoded value "GENERAL CONCOMITANT MEDICATIONS". hardcode_no_ct( + tgt_val = "GENERAL CONCOMITANT MEDICATIONS", raw_dat = md1, raw_var = "MDRAW", - tgt_var = "CMCAT", - tgt_val = "GENERAL CONCOMITANT MEDICATIONS" + tgt_var = "CMCAT" ) cm_inter <- @@ -107,11 +107,11 @@ cm_inter <- # hardcoded value "GENERAL CONCOMITANT MEDICATIONS" with a prior join to # `target_dataset`. hardcode_no_ct( + tgt_dat = cm_inter, + tgt_val = "GENERAL CONCOMITANT MEDICATIONS", raw_dat = md1, raw_var = "MDRAW", - tgt_var = "CMCAT", - tgt_val = "GENERAL CONCOMITANT MEDICATIONS", - tgt_dat = cm_inter + tgt_var = "CMCAT" ) # Controlled terminology specification @@ -121,13 +121,13 @@ hardcode_no_ct( # involving terminology recoding. `NA` values in `MDRAW` are preserved in # `CMCAT`. hardcode_ct( + tgt_dat = cm_inter, + tgt_var = "CMCAT", raw_dat = md1, raw_var = "MDRAW", - tgt_var = "CMCAT", tgt_val = "GENERAL CONCOMITANT MEDICATIONS", ct_spec = ct_spec, - ct_clst = "C66729", - tgt_dat = cm_inter + ct_clst = "C66729" ) } diff --git a/man/oak_id_vars.Rd b/man/oak_id_vars.Rd index af5550a3..86b9113b 100644 --- a/man/oak_id_vars.Rd +++ b/man/oak_id_vars.Rd @@ -22,9 +22,8 @@ oak_id, raw_source, and patient_number. Extra variable names may be indicated and passed in \code{extra_vars} which are appended to the default names. } \examples{ -sdtm.oak:::oak_id_vars() +oak_id_vars() -sdtm.oak:::oak_id_vars(extra_vars = "sample_id") +oak_id_vars(extra_vars = "sample_id") } -\keyword{internal} diff --git a/man/sdtm_assign.Rd b/man/sdtm_assign.Rd index 85601e3c..14b4ed03 100644 --- a/man/sdtm_assign.Rd +++ b/man/sdtm_assign.Rd @@ -5,25 +5,29 @@ \title{Derive an SDTM variable} \usage{ sdtm_assign( + tgt_dat = NULL, + tgt_var, raw_dat, raw_var, - tgt_var, ct_spec = NULL, ct_clst = NULL, - tgt_dat = NULL, id_vars = oak_id_vars() ) } \arguments{ +\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by +the variables indicated in \code{id_vars}. This parameter is optional, see +section Value for how the output changes depending on this argument value.} + +\item{tgt_var}{The target SDTM variable: a single string indicating the name +of variable to be derived.} + \item{raw_dat}{The raw dataset (dataframe); must include the variables passed in \code{id_vars} and \code{raw_var}.} \item{raw_var}{The raw variable: a single string indicating the name of the raw variable in \code{raw_dat}.} -\item{tgt_var}{The target SDTM variable: a single string indicating the name -of variable to be derived.} - \item{ct_spec}{Study controlled terminology specification: a dataframe with a minimal set of columns, see \code{\link[=ct_spec_vars]{ct_spec_vars()}} for details. This parameter is optional, if left as \code{NULL} no controlled terminology recoding is applied.} @@ -32,10 +36,6 @@ optional, if left as \code{NULL} no controlled terminology recoding is applied.} terminology to apply in the derivation. This parameter is optional, if left as \code{NULL}, all possible recodings in \code{ct_spec} are attempted.} -\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by -the variables indicated in \code{id_vars}. This parameter is optional, see -section Value for how the output changes depending on this argument value.} - \item{id_vars}{Key variables to be used in the join between the raw dataset (\code{raw_dat}) and the target data set (\code{tgt_dat}).} } diff --git a/man/sdtm_hardcode.Rd b/man/sdtm_hardcode.Rd index d8cb59a6..065d3942 100644 --- a/man/sdtm_hardcode.Rd +++ b/man/sdtm_hardcode.Rd @@ -5,26 +5,30 @@ \title{Derive an SDTM variable with a hardcoded value} \usage{ sdtm_hardcode( + tgt_dat = NULL, + tgt_var, raw_dat, raw_var, - tgt_var, tgt_val, ct_spec = NULL, ct_clst = NULL, - tgt_dat = NULL, id_vars = oak_id_vars() ) } \arguments{ +\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by +the variables indicated in \code{id_vars}. This parameter is optional, see +section Value for how the output changes depending on this argument value.} + +\item{tgt_var}{The target SDTM variable: a single string indicating the name +of variable to be derived.} + \item{raw_dat}{The raw dataset (dataframe); must include the variables passed in \code{id_vars} and \code{raw_var}.} \item{raw_var}{The raw variable: a single string indicating the name of the raw variable in \code{raw_dat}.} -\item{tgt_var}{The target SDTM variable: a single string indicating the name -of variable to be derived.} - \item{tgt_val}{The target SDTM value to be hardcoded into the variable indicated in \code{tgt_var}.} @@ -36,10 +40,6 @@ optional, if left as \code{NULL} no controlled terminology recoding is applied.} terminology to apply in the derivation. This parameter is optional, if left as \code{NULL}, all possible recodings in \code{ct_spec} are attempted.} -\item{tgt_dat}{Target dataset: a data frame to be merged against \code{raw_dat} by -the variables indicated in \code{id_vars}. This parameter is optional, see -section Value for how the output changes depending on this argument value.} - \item{id_vars}{Key variables to be used in the join between the raw dataset (\code{raw_dat}) and the target data set (\code{tgt_dat}).} } diff --git a/tests/testthat/test-assign.R b/tests/testthat/test-assign.R index 46d86a87..b26d7568 100644 --- a/tests/testthat/test-assign.R +++ b/tests/testthat/test-assign.R @@ -47,12 +47,12 @@ test_that("assign_ct works as expected with a conditioned `tgt_dat`", { result <- assign_ct( + tgt_dat = condition_add(vs_tgt_dat, VSTESTCD == "TEMP"), + tgt_var = "VSLOC", raw_dat = vs_raw_dat, raw_var = "TEMPLOC", - tgt_var = "VSLOC", ct_spec = ct_spec, - ct_clst = "C74456", - tgt_dat = condition_by(vs_tgt_dat, VSTESTCD == "TEMP") + ct_clst = "C74456" ) expected_result <- @@ -100,16 +100,16 @@ test_that("assign_ct works as expected with both `raw_dat` and `tgt_dat` as cond result <- assign_ct( - raw_dat = condition_by(fa_raw_dat, is.na(SPECTYP)), - raw_var = "SPCNM", - tgt_var = "FASPEC", - ct_spec = ct_spec, - ct_clst = "C78734", - tgt_dat = condition_by( + tgt_dat = condition_add( fa_tgt_dat, FATESTCD == "STATUS" & FAOBJ == "Severe Acute Resp Syndrome Coronavirus 2" - ) + ), + tgt_var = "FASPEC", + raw_dat = condition_add(fa_raw_dat, is.na(SPECTYP)), + raw_var = "SPCNM", + ct_spec = ct_spec, + ct_clst = "C78734" ) expected_result <- @@ -140,10 +140,10 @@ test_that("assign_ct works as expected with conditions across both data sets", { # meaningful. result1 <- assign_no_ct( - raw_dat = cm_raw_dat, - raw_var = "CMMODIFY", + tgt_dat = condition_add(cm_tgt_dat, CMMODIFY != CMTRT, .dat2 = cm_raw_dat), tgt_var = "CMMODIFY", - tgt_dat = condition_by(cm_tgt_dat, CMMODIFY != CMTRT, .env = cm_raw_dat) + raw_dat = cm_raw_dat, + raw_var = "CMMODIFY" ) # Because both data sets have to have the same number of records for the @@ -151,10 +151,10 @@ test_that("assign_ct works as expected with conditions across both data sets", { # raw data set itself. result2 <- assign_no_ct( - raw_dat = condition_by(cm_raw_dat, CMMODIFY != CMTRT, .env = cm_tgt_dat), - raw_var = "CMMODIFY", + tgt_dat = cm_tgt_dat, tgt_var = "CMMODIFY", - tgt_dat = cm_tgt_dat + raw_dat = condition_add(cm_raw_dat, CMMODIFY != CMTRT, .dat2 = cm_tgt_dat), + raw_var = "CMMODIFY" ) expected_result <- @@ -165,3 +165,4 @@ test_that("assign_ct works as expected with conditions across both data sets", { expect_equal(result2, expected_result) }) + diff --git a/tests/testthat/test-assign_datetime.R b/tests/testthat/test-assign_datetime.R index 5cb6e42c..36879636 100644 --- a/tests/testthat/test-assign_datetime.R +++ b/tests/testthat/test-assign_datetime.R @@ -22,22 +22,22 @@ test_that("assign_datetime: date and time conversion", { r"{There were 12 parsing problems\. Run `problems\(\)` on parsed results for details\.}" expect_warning(rlang::with_interactive( assign_datetime( + tgt_var = "CMSTDTC", raw_dat = md1, raw_var = c("MDEDR", "MDETM"), raw_fmt = c("d-m-y", "H:M:S"), - raw_unk = c("UN", "UNK"), - tgt_var = "CMSTDTC" + raw_unk = c("UN", "UNK") ) ), regexp = warning_msg) # If not run interactively then warnings should not be raised. expect_silent( cm1 <- assign_datetime( + tgt_var = "CMSTDTC", raw_dat = md1, raw_var = c("MDEDR", "MDETM"), raw_fmt = c("d-m-y", "H:M:S"), - raw_unk = c("UN", "UNK"), - tgt_var = "CMSTDTC" + raw_unk = c("UN", "UNK") ) ) @@ -72,7 +72,7 @@ test_that("assign_datetime: date and time conversion", { expected <- cm1 |> - dplyr::select("oak_id", "raw_source", "patient_number") |> + dplyr::select(dplyr::all_of(c("oak_id", "raw_source", "patient_number"))) |> dplyr::bind_cols(tibble::tibble(CMSTDTC = cmstdtc)) expect_equal(object = cm1, expected = expected) diff --git a/tests/testthat/test-hardcode.R b/tests/testthat/test-hardcode.R index 9f7ec73e..e95bb00f 100644 --- a/tests/testthat/test-hardcode.R +++ b/tests/testthat/test-hardcode.R @@ -18,7 +18,7 @@ oe_inter <- tibble::tribble( ) test_that("hardcode_no_ct works as expected", { - aesos_cnd <- condition_by(aesos, AESO == 1L & !is.na(AESOSP)) + aesos_cnd <- condition_add(aesos, AESO == 1L & !is.na(AESOSP)) result <- hardcode_no_ct( raw_dat = aesos_cnd, @@ -44,7 +44,7 @@ test_that("hardcode_no_ct works as expected", { }) test_that("hardcode_ct works as expected", { - aesos_cnd <- condition_by(aesos, AESO == 1L & is.na(AESOSP)) + aesos_cnd <- condition_add(aesos, AESO == 1L & is.na(AESOSP)) ct_spec <- tibble::tibble( codelist_code = "C117743", term_code = "C178048", From fd722ba3f6e75b2f03848f778db6eb78c39867c9 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Sun, 16 Jun 2024 23:48:12 +0100 Subject: [PATCH 05/12] Update on conditioned data frames - Documentation - Examples - New article about cnd_df (WIP) --- DESCRIPTION | 2 + NAMESPACE | 2 +- R/cnd_df.R | 143 +++++++++++++++++++--- R/pipe.R | 71 +++++++++++ R/sdtm.oak-package.R | 2 +- inst/WORDLIST | 2 + man/condition_add.Rd | 18 ++- man/ctl_new_rowid_pillar.cnd_df.Rd | 3 + man/dot_pipe.Rd | 61 +++++++++ man/eval_conditions.Rd | 5 +- man/figures/lifecycle-archived.svg | 21 ++++ man/figures/lifecycle-defunct.svg | 21 ++++ man/figures/lifecycle-deprecated.svg | 21 ++++ man/figures/lifecycle-experimental.svg | 21 ++++ man/figures/lifecycle-maturing.svg | 21 ++++ man/figures/lifecycle-questioning.svg | 21 ++++ man/figures/lifecycle-soft-deprecated.svg | 21 ++++ man/figures/lifecycle-stable.svg | 29 +++++ man/figures/lifecycle-superseded.svg | 21 ++++ man/get_cnd_df_cnd.Rd | 33 +++++ man/get_cnd_df_cnd_sum.Rd | 32 +++++ man/is_cnd_df.Rd | 32 +++++ man/mutate.cnd_df.Rd | 13 +- man/new_cnd_df.Rd | 4 + man/rm_cnd_df.Rd | 15 ++- man/tbl_sum.cnd_df.Rd | 14 ++- tests/testthat/test-cnd_df.R | 82 +++++++++++++ tests/testthat/test-condition_add.R | 87 +++++++++++++ tests/testthat/test-eval_conditions.R | 39 ++++++ tests/testthat/test-mutate_cnd_df.R | 103 ++++++++++++++++ tests/testthat/test-pipe.R | 73 +++++++++++ vignettes/articles/cnd_df.Rmd | 109 +++++++++++++++++ 32 files changed, 1098 insertions(+), 44 deletions(-) create mode 100644 R/pipe.R create mode 100644 man/dot_pipe.Rd create mode 100644 man/figures/lifecycle-archived.svg create mode 100644 man/figures/lifecycle-defunct.svg create mode 100644 man/figures/lifecycle-deprecated.svg create mode 100644 man/figures/lifecycle-experimental.svg create mode 100644 man/figures/lifecycle-maturing.svg create mode 100644 man/figures/lifecycle-questioning.svg create mode 100644 man/figures/lifecycle-soft-deprecated.svg create mode 100644 man/figures/lifecycle-stable.svg create mode 100644 man/figures/lifecycle-superseded.svg create mode 100644 man/get_cnd_df_cnd.Rd create mode 100644 man/get_cnd_df_cnd_sum.Rd create mode 100644 man/is_cnd_df.Rd create mode 100644 tests/testthat/test-cnd_df.R create mode 100644 tests/testthat/test-condition_add.R create mode 100644 tests/testthat/test-eval_conditions.R create mode 100644 tests/testthat/test-mutate_cnd_df.R create mode 100644 tests/testthat/test-pipe.R create mode 100644 vignettes/articles/cnd_df.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index 4cd995cb..f226c172 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,6 +50,8 @@ Imports: pillar Suggests: knitr, + lifecycle, + magrittr, rmarkdown, spelling, testthat (>= 3.1.7) diff --git a/NAMESPACE b/NAMESPACE index c8dd2b14..52a3a2ae 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ S3method(ctl_new_rowid_pillar,cnd_df) S3method(mutate,cnd_df) S3method(print,iso8601) S3method(tbl_sum,cnd_df) +export("%.>%") export(assign_ct) export(assign_datetime) export(assign_no_ct) @@ -21,7 +22,6 @@ export(oak_id_vars) export(problems) export(read_ct_spec) export(read_ct_spec_example) -export(rm_cnd_df) importFrom(dplyr,mutate) importFrom(pillar,ctl_new_rowid_pillar) importFrom(pillar,tbl_sum) diff --git a/R/cnd_df.R b/R/cnd_df.R index 2f8e87dd..9c863258 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -3,7 +3,7 @@ # Package: sdtm.oak # Author: Ramiro Magno # Created: 2024-05-23 -# Last Modified: 2024-05-23 +# Last Modified: 2024-05-15 # ------------------------------------------------------------------------------ # Description: # @@ -17,11 +17,11 @@ # - `get_cnd_df_cnd()`: Extract the attribute "cnd" from a `cnd_df` data frame. # - `get_cnd_df_cnd_sum()`: Extract the attribute "cnd_sum" from a `cnd_df` data frame. # - `rm_cnd_df()`: De-class a cnd_df data frame. -# - `tbl_sum.cnd_df()`: Provide a tibble header print method for `cnd_df` tibbles. -# - `ctl_new_rowid_pillar.cnd_df()`: A print method for the row ids cnd_df` tibbles. +# - `tbl_sum.cnd_df()`: Print method for `cnd_df` tibbles. +# - `ctl_new_rowid_pillar.cnd_df()`: Print method for the row ids cnd_df` tibbles. # - `eval_conditions()`: Find which rows match a set of conditions. # - `condition_add()`: Create a conditioned data frame (user facing). -# - `derive_by_condition()`: Perform a derivation on a conditioned data frame. +# - `mutate.cnd_df()`: Mutate a conditioned data frame. #' Create a data frame with filtering tags #' @@ -45,6 +45,9 @@ #' - `cnd_sum`: An integer vector of three elements providing the sum of `TRUE`, #' `FALSE` and `NA` values in `cnd`, respectively. #' +#' @seealso [is_cnd_df()], [get_cnd_df_cnd()], [get_cnd_df_cnd_sum()], +#' [rm_cnd_df()]. +#' #' @examples #' df <- data.frame(x = 1:3, y = letters[1:3]) #' sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) @@ -57,7 +60,7 @@ new_cnd_df <- function(dat, cnd, .warn = TRUE) { if (!identical(nrow(dat), length(cnd))) { msg <- c( - "Number of rows in `dat` must match length of `cond`." + "Number of rows in `dat` must match length of `cnd`." ) rlang::abort(message = msg) } @@ -84,10 +87,51 @@ new_cnd_df <- function(dat, cnd, .warn = TRUE) { return(dat) } +#' Check if a data frame is a conditioned data frame +#' +#' [is_cnd_df()] checks whether a data frame is a conditioned data frame, i.e. +#' of class `cnd_df`. +#' +#' @param dat A data frame. +#' @return `TRUE` if `dat` is a conditioned data frame (class `cnd_df`), +#' otherwise `FALSE`. +#' +#' @seealso [new_cnd_df()], [get_cnd_df_cnd()], [get_cnd_df_cnd_sum()], +#' [rm_cnd_df()]. +#' +#' @examples +#' df <- data.frame(x = 1:3, y = letters[1:3]) +#' sdtm.oak:::is_cnd_df(df) +#' +#' cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +#' sdtm.oak:::is_cnd_df(cnd_df) +#' +#' @keywords internal is_cnd_df <- function(dat) { inherits(dat, "cnd_df") } +#' Get the conditioning vector from a conditioned data frame +#' +#' [get_cnd_df_cnd()] extracts the conditioning vector from a conditioned data +#' frame, i.e. from an object of class `cnd_df`. +#' +#' @param dat A conditioned data frame (`cnd_df`). +#' @return The conditioning vector (`cnd`) if `dat` is a conditioned data frame +#' (`cnd_df`), otherwise `NULL`, or `NULL` if `dat` is not a conditioned data +#' frame (`cnd_df`). +#' +#' @seealso [new_cnd_df()], [is_cnd_df()], [get_cnd_df_cnd_sum()], +#' [rm_cnd_df()]. +#' +#' @examples +#' df <- data.frame(x = 1:3, y = letters[1:3]) +#' sdtm.oak:::get_cnd_df_cnd(df) +#' +#' cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +#' sdtm.oak:::get_cnd_df_cnd(cnd_df) +#' +#' @keywords internal get_cnd_df_cnd <- function(dat) { if (is_cnd_df(dat)) { attr(dat, "cnd") @@ -96,6 +140,26 @@ get_cnd_df_cnd <- function(dat) { } } +#' Get the summary of the conditioning vector from a conditioned data frame +#' +#' [get_cnd_df_cnd_sum()] extracts the tally of the conditioning vector from a +#' conditioned data frame. +#' +#' @param dat A conditioned data frame (`cnd_df`). +#' @return A vector of three elements providing the sum of `TRUE`, `FALSE`, and +#' `NA` values in the conditioning vector (`cnd`), or `NULL` if `dat` is not +#' a conditioned data frame (`cnd_df`). +#' +#' @seealso [new_cnd_df()], [is_cnd_df()], [get_cnd_df_cnd()], [rm_cnd_df()]. +#' +#' @examples +#' df <- data.frame(x = 1:3, y = letters[1:3]) +#' sdtm.oak:::get_cnd_df_cnd_sum(df) +#' +#' cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +#' sdtm.oak:::get_cnd_df_cnd_sum(cnd_df) +#' +#' @keywords internal get_cnd_df_cnd_sum <- function(dat) { if (is_cnd_df(dat)) { attr(dat, "cnd_sum") @@ -110,9 +174,19 @@ get_cnd_df_cnd_sum <- function(dat) { #' applicable. #' #' @param dat A data frame. -#' @return The input `dat` without the `cnd_df` class. +#' @return The input `dat` without the `cnd_df` class and associated attributes. #' -#' @export +#' @seealso [new_cnd_df()], [is_cnd_df()], [get_cnd_df_cnd()], +#' [get_cnd_df_cnd_sum()]. +#' +#' @examples +#' df <- data.frame(x = 1:3, y = letters[1:3]) +#' cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +#' +#' sdtm.oak:::is_cnd_df(cnd_df) +#' sdtm.oak:::is_cnd_df(sdtm.oak:::rm_cnd_df(cnd_df)) +#' +#' @keywords internal rm_cnd_df <- function(dat) { if (is_cnd_df(dat)) { class(dat) <- class(dat)[class(dat) != "cnd_df"] @@ -124,10 +198,23 @@ rm_cnd_df <- function(dat) { #' Conditioned tibble header print method #' +#' Conditioned tibble header print method. This S3 method adds an extra line +#' in the header of a tibble that indicates the tibble is a conditioned tibble +#' (`# Cond. tbl:`) followed by the tally of the conditioning vector: number +#' of TRUE, FALSE and NA values: e.g., `1/1/1`. +#' #' @param x A conditioned tibble of class `cnd_df`. #' @param ... Additional arguments passed to the default print method. #' #' @importFrom pillar tbl_sum +#' +#' @seealso [ctl_new_rowid_pillar.cnd_df()]. +#' +#' @examples +#' df <- data.frame(x = 1:3, y = letters[1:3]) +#' cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +#' print(cnd_df) +#' #' @export tbl_sum.cnd_df <- function(x, ...) { default_header <- NextMethod() @@ -145,6 +232,9 @@ lgl_to_chr <- function(x) { #' #' @inheritParams pillar::ctl_new_rowid_pillar #' @importFrom pillar ctl_new_rowid_pillar +#' +#' @seealso [tbl_sum.cnd_df()]. +#' #' @export ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { @@ -205,7 +295,7 @@ ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { #' @examples #' # Create a sample data frame #' df <- data.frame( -#' x = c(1, 2, 3, 4, 5), +#' x = c(1, 2, NA_integer_, 4, 5), #' y = c(TRUE, FALSE, TRUE, FALSE, TRUE), #' z = c("a", "b", "a", "b", "a") #' ) @@ -214,6 +304,7 @@ ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { #' sdtm.oak:::eval_conditions(df, x > 2) #' #' # Combined conditions on multiple columns +#' sdtm.oak:::eval_conditions(df, x > 2 & y) #' sdtm.oak:::eval_conditions(df, x > 2, y) #' #' # Using conditions with NA handling @@ -240,13 +331,13 @@ ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { eval_conditions <- function(dat, ..., .na = NA, - .env = rlang::env()) { + .env = rlang::caller_env()) { conditions <- rlang::enexprs(...) # List (or data frame). if (is.list(.env)) { - .env <- rlang::as_environment(.env, parent = rlang::env()) + .env <- rlang::as_environment(.env, parent = rlang::caller_env()) } lgl_vctrs <- @@ -259,21 +350,21 @@ eval_conditions <- function(dat, cnd } -#' Condition a data set based on specified conditions +#' Add filtering tags to a data set #' +#' @description #' This function tags records in a data set, indicating which rows match the #' specified conditions, resulting in a conditioned data frame. #' -#' @param dat A tibble. -#' @param ... Conditions to filter the tibble. -#' @return A tibble with an additional class `cnd_df` and a logical vector -#' attribute indicating matching rows. +#' @param dat A data frame. +#' @param ... Conditions to filter the data frame. #' @param .na Return value to be used when the conditions evaluate to `NA`. -#' @param .dat2 An optional environment to look for variables involved in logical -#' expression passed in `...`. A data frame or a list can also be passed that -#' will be coerced to an environment internally. +#' @param .dat2 An optional environment to look for variables involved in +#' logical expression passed in `...`. A data frame or a list can also be +#' passed that will be coerced to an environment internally. #' -#' @returns A conditioned data frame. +#' @returns A conditioned data frame, meaning a tibble with an additional class +#' `cnd_df` and a logical vector attribute indicating matching rows. #' #' @export condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { @@ -298,6 +389,10 @@ condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { #' conditioned data frame is `TRUE`. #' #' @param .data A conditioned data frame. +#' @param .by Not used when `.data` is a conditioned data frame. +#' @param .before Not used, use `.after` instead. +#' @param .after Control where new columns should appear, i.e. after which +#' columns. #' #' @inheritParams dplyr::mutate #' @importFrom dplyr mutate @@ -309,6 +404,14 @@ mutate.cnd_df <- function(.data, .before = NULL, .after = NULL) { + if (!rlang::is_null(.by)) { + rlang::abort("`.by` is not supported on conditioned data frames.") + } + + if (!rlang::is_null(.before)) { + rlang::abort("`.before` is not supported on conditioned data frames, use `.after` instead.") + } + cnd <- get_cnd_df_cnd(.data) dat <- rm_cnd_df(.data) # avoids recursive S3 method dispatch. @@ -318,5 +421,5 @@ mutate.cnd_df <- function(.data, lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else({{cnd}}, !!.x, NA))) lst <- rlang::set_names(lst, derived_vars) - dplyr::mutate(dat, !!!lst, .by = .by, .keep = .keep, .after = .after) + dplyr::mutate(dat, !!!lst, .by = NULL, .keep = .keep, .after = .after) } diff --git a/R/pipe.R b/R/pipe.R new file mode 100644 index 00000000..496c07bf --- /dev/null +++ b/R/pipe.R @@ -0,0 +1,71 @@ +#' Explicit Dot Pipe +#' +#' @description +#' `r lifecycle::badge("experimental")` +#' +#' This operator pipes an object forward into a function or call expression +#' using an explicit placement of the dot (`.`) placeholder. Unlike magrittr's +#' [%>%][magrittr::%>%] operator, `%.>%` does not automatically place the +#' left-hand side (`lhs`) as the first argument in the right-hand side (`rhs`) +#' call. This operator provides a simpler alternative to the use of braces with +#' magrittr, while achieving similar behavior. +#' +#' @param lhs A value to be piped forward. +#' @param rhs A function call that utilizes the dot (`.`) placeholder to specify +#' where `lhs` should be placed. +#' +#' @details +#' The `%.>%` operator is used to pipe the `lhs` value into the `rhs` function +#' call. Within the `rhs` expression, the placeholder `.` represents the +#' position where `lhs` will be inserted. This provides more control over where +#' the `lhs` value appears in the `rhs` function call, compared to the magrittr +#' pipe operator which always places `lhs` as the first argument of `rhs`. +#' +#' Unlike magrittr's pipe, which may require the use of braces to fully control +#' the placement of `lhs` in nested function calls, `%.>%` simplifies this by +#' directly allowing multiple usages of the dot placeholder without requiring +#' braces. For example, the following expression using magrittr's pipe and +#' braces: +#' +#' ```r +#' library(magrittr) +#' +#' 1:10 %>% {c(min(.), max(.))} +#' ``` +#' +#' can be written as: +#' +#' ```r +#' 1:10 %.>% c(min(.), max(.)) +#' ``` +#' +#' without needing additional braces. +#' +#' ## Downside +#' +#' The disadvantage of `%.>%` is that you always need to use +#' the dot placeholder, even when piping to the first argument of the +#' right-hand side (`rhs`). +#' +#' @examples +#' +#' iris %.>% subset(., 1:nrow(.) %% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) %% 2 == 0) +#' 1:10 %.>% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) +#' +#' @rdname dot_pipe +#' @export +`%.>%` <- function(lhs, rhs) { + + rhs_expr <- rlang::enexpr(rhs) + if (!contains_dot(rhs_expr)) { + rlang::abort("The right-hand side (rhs) of `%.>%` must contain at least one dot (.) placeholder.") + } + + rlang::eval_tidy(rhs_expr, list(. = lhs), env = rlang::caller_env()) +} + +# Recursively find if an expression contains a dot. +contains_dot <- function(expr) { + rlang::is_symbol(expr) && identical(expr, rlang::sym(".")) || + rlang::is_call(expr) && purrr::some(as.list(expr), contains_dot) +} diff --git a/R/sdtm.oak-package.R b/R/sdtm.oak-package.R index 0ba23dc1..bf0c896a 100644 --- a/R/sdtm.oak-package.R +++ b/R/sdtm.oak-package.R @@ -2,8 +2,8 @@ "_PACKAGE" ## usethis namespace: start -#' @importFrom tibble tibble #' @importFrom rlang .data #' @importFrom stats na.omit +#' @importFrom tibble tibble ## usethis namespace: end NULL diff --git a/inst/WORDLIST b/inst/WORDLIST index 78f8f566..bead1eac 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -26,3 +26,5 @@ AESTDY CMSTDY DM ungrouped +magrittr +magrittr's diff --git a/man/condition_add.Rd b/man/condition_add.Rd index 900052ed..bb6397e4 100644 --- a/man/condition_add.Rd +++ b/man/condition_add.Rd @@ -2,26 +2,24 @@ % Please edit documentation in R/cnd_df.R \name{condition_add} \alias{condition_add} -\title{Condition a data set based on specified conditions} +\title{Add filtering tags to a data set} \usage{ condition_add(dat, ..., .na = NA, .dat2 = rlang::env()) } \arguments{ -\item{dat}{A tibble.} +\item{dat}{A data frame.} -\item{...}{Conditions to filter the tibble.} +\item{...}{Conditions to filter the data frame.} \item{.na}{Return value to be used when the conditions evaluate to \code{NA}.} -\item{.dat2}{An optional environment to look for variables involved in logical -expression passed in \code{...}. A data frame or a list can also be passed that -will be coerced to an environment internally.} +\item{.dat2}{An optional environment to look for variables involved in +logical expression passed in \code{...}. A data frame or a list can also be +passed that will be coerced to an environment internally.} } \value{ -A tibble with an additional class \code{cnd_df} and a logical vector -attribute indicating matching rows. - -A conditioned data frame. +A conditioned data frame, meaning a tibble with an additional class +\code{cnd_df} and a logical vector attribute indicating matching rows. } \description{ This function tags records in a data set, indicating which rows match the diff --git a/man/ctl_new_rowid_pillar.cnd_df.Rd b/man/ctl_new_rowid_pillar.cnd_df.Rd index dc70aa27..eb469be6 100644 --- a/man/ctl_new_rowid_pillar.cnd_df.Rd +++ b/man/ctl_new_rowid_pillar.cnd_df.Rd @@ -18,3 +18,6 @@ \description{ Conditioned tibble pillar print method } +\seealso{ +\code{\link[=tbl_sum.cnd_df]{tbl_sum.cnd_df()}}. +} diff --git a/man/dot_pipe.Rd b/man/dot_pipe.Rd new file mode 100644 index 00000000..c4c52fe7 --- /dev/null +++ b/man/dot_pipe.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/pipe.R +\name{\%.>\%} +\alias{\%.>\%} +\title{Explicit Dot Pipe} +\usage{ +lhs \%.>\% rhs +} +\arguments{ +\item{lhs}{A value to be piped forward.} + +\item{rhs}{A function call that utilizes the dot (\code{.}) placeholder to specify +where \code{lhs} should be placed.} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This operator pipes an object forward into a function or call expression +using an explicit placement of the dot (\code{.}) placeholder. Unlike magrittr's +\link[magrittr:pipe]{\%>\%} operator, \verb{\%.>\%} does not automatically place the +left-hand side (\code{lhs}) as the first argument in the right-hand side (\code{rhs}) +call. This operator provides a simpler alternative to the use of braces with +magrittr, while achieving similar behavior. +} +\details{ +The \verb{\%.>\%} operator is used to pipe the \code{lhs} value into the \code{rhs} function +call. Within the \code{rhs} expression, the placeholder \code{.} represents the +position where \code{lhs} will be inserted. This provides more control over where +the \code{lhs} value appears in the \code{rhs} function call, compared to the magrittr +pipe operator which always places \code{lhs} as the first argument of \code{rhs}. + +Unlike magrittr's pipe, which may require the use of braces to fully control +the placement of \code{lhs} in nested function calls, \verb{\%.>\%} simplifies this by +directly allowing multiple usages of the dot placeholder without requiring +braces. For example, the following expression using magrittr's pipe and +braces: + +\if{html}{\out{
}}\preformatted{library(magrittr) + +1:10 \%>\% \{c(min(.), max(.))\} +}\if{html}{\out{
}} + +can be written as: + +\if{html}{\out{
}}\preformatted{1:10 \%.>\% c(min(.), max(.)) +}\if{html}{\out{
}} + +without needing additional braces. +\subsection{Downside}{ + +The disadvantage of \verb{\%.>\%} is that you always need to use +the dot placeholder, even when piping to the first argument of the +right-hand side (\code{rhs}). +} +} +\examples{ + +iris \%.>\% subset(., 1:nrow(.) \%\% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) \%\% 2 == 0) +1:10 \%.>\% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) + +} diff --git a/man/eval_conditions.Rd b/man/eval_conditions.Rd index ce5286d4..cafa6f5d 100644 --- a/man/eval_conditions.Rd +++ b/man/eval_conditions.Rd @@ -4,7 +4,7 @@ \alias{eval_conditions} \title{Evaluate conditions} \usage{ -eval_conditions(dat, ..., .na = NA, .env = rlang::env()) +eval_conditions(dat, ..., .na = NA, .env = rlang::caller_env()) } \arguments{ \item{dat}{A data frame} @@ -39,7 +39,7 @@ function's environment, followed by its parent environments. \examples{ # Create a sample data frame df <- data.frame( - x = c(1, 2, 3, 4, 5), + x = c(1, 2, NA_integer_, 4, 5), y = c(TRUE, FALSE, TRUE, FALSE, TRUE), z = c("a", "b", "a", "b", "a") ) @@ -48,6 +48,7 @@ df <- data.frame( sdtm.oak:::eval_conditions(df, x > 2) # Combined conditions on multiple columns +sdtm.oak:::eval_conditions(df, x > 2 & y) sdtm.oak:::eval_conditions(df, x > 2, y) # Using conditions with NA handling diff --git a/man/figures/lifecycle-archived.svg b/man/figures/lifecycle-archived.svg new file mode 100644 index 00000000..745ab0c7 --- /dev/null +++ b/man/figures/lifecycle-archived.svg @@ -0,0 +1,21 @@ + + lifecycle: archived + + + + + + + + + + + + + + + lifecycle + + archived + + diff --git a/man/figures/lifecycle-defunct.svg b/man/figures/lifecycle-defunct.svg new file mode 100644 index 00000000..d5c9559e --- /dev/null +++ b/man/figures/lifecycle-defunct.svg @@ -0,0 +1,21 @@ + + lifecycle: defunct + + + + + + + + + + + + + + + lifecycle + + defunct + + diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100644 index 00000000..b61c57c3 --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100644 index 00000000..5d88fc2c --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1,21 @@ + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/man/figures/lifecycle-maturing.svg b/man/figures/lifecycle-maturing.svg new file mode 100644 index 00000000..897370ec --- /dev/null +++ b/man/figures/lifecycle-maturing.svg @@ -0,0 +1,21 @@ + + lifecycle: maturing + + + + + + + + + + + + + + + lifecycle + + maturing + + diff --git a/man/figures/lifecycle-questioning.svg b/man/figures/lifecycle-questioning.svg new file mode 100644 index 00000000..7c1721d0 --- /dev/null +++ b/man/figures/lifecycle-questioning.svg @@ -0,0 +1,21 @@ + + lifecycle: questioning + + + + + + + + + + + + + + + lifecycle + + questioning + + diff --git a/man/figures/lifecycle-soft-deprecated.svg b/man/figures/lifecycle-soft-deprecated.svg new file mode 100644 index 00000000..9c166ff3 --- /dev/null +++ b/man/figures/lifecycle-soft-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: soft-deprecated + + + + + + + + + + + + + + + lifecycle + + soft-deprecated + + diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100644 index 00000000..9bf21e76 --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1,29 @@ + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100644 index 00000000..db8d757f --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1,21 @@ + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/man/get_cnd_df_cnd.Rd b/man/get_cnd_df_cnd.Rd new file mode 100644 index 00000000..ae3b3d7c --- /dev/null +++ b/man/get_cnd_df_cnd.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{get_cnd_df_cnd} +\alias{get_cnd_df_cnd} +\title{Get the conditioning vector from a conditioned data frame} +\usage{ +get_cnd_df_cnd(dat) +} +\arguments{ +\item{dat}{A conditioned data frame (\code{cnd_df}).} +} +\value{ +The conditioning vector (\code{cnd}) if \code{dat} is a conditioned data frame +(\code{cnd_df}), otherwise \code{NULL}, or \code{NULL} if \code{dat} is not a conditioned data +frame (\code{cnd_df}). +} +\description{ +\code{\link[=get_cnd_df_cnd]{get_cnd_df_cnd()}} extracts the conditioning vector from a conditioned data +frame, i.e. from an object of class \code{cnd_df}. +} +\examples{ +df <- data.frame(x = 1:3, y = letters[1:3]) +sdtm.oak:::get_cnd_df_cnd(df) + +cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +sdtm.oak:::get_cnd_df_cnd(cnd_df) + +} +\seealso{ +\code{\link[=new_cnd_df]{new_cnd_df()}}, \code{\link[=is_cnd_df]{is_cnd_df()}}, \code{\link[=get_cnd_df_cnd_sum]{get_cnd_df_cnd_sum()}}, +\code{\link[=rm_cnd_df]{rm_cnd_df()}}. +} +\keyword{internal} diff --git a/man/get_cnd_df_cnd_sum.Rd b/man/get_cnd_df_cnd_sum.Rd new file mode 100644 index 00000000..b7182b18 --- /dev/null +++ b/man/get_cnd_df_cnd_sum.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{get_cnd_df_cnd_sum} +\alias{get_cnd_df_cnd_sum} +\title{Get the summary of the conditioning vector from a conditioned data frame} +\usage{ +get_cnd_df_cnd_sum(dat) +} +\arguments{ +\item{dat}{A conditioned data frame (\code{cnd_df}).} +} +\value{ +A vector of three elements providing the sum of \code{TRUE}, \code{FALSE}, and +\code{NA} values in the conditioning vector (\code{cnd}), or \code{NULL} if \code{dat} is not +a conditioned data frame (\code{cnd_df}). +} +\description{ +\code{\link[=get_cnd_df_cnd_sum]{get_cnd_df_cnd_sum()}} extracts the tally of the conditioning vector from a +conditioned data frame. +} +\examples{ +df <- data.frame(x = 1:3, y = letters[1:3]) +sdtm.oak:::get_cnd_df_cnd_sum(df) + +cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +sdtm.oak:::get_cnd_df_cnd_sum(cnd_df) + +} +\seealso{ +\code{\link[=new_cnd_df]{new_cnd_df()}}, \code{\link[=is_cnd_df]{is_cnd_df()}}, \code{\link[=get_cnd_df_cnd]{get_cnd_df_cnd()}}, \code{\link[=rm_cnd_df]{rm_cnd_df()}}. +} +\keyword{internal} diff --git a/man/is_cnd_df.Rd b/man/is_cnd_df.Rd new file mode 100644 index 00000000..3cc10af8 --- /dev/null +++ b/man/is_cnd_df.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/cnd_df.R +\name{is_cnd_df} +\alias{is_cnd_df} +\title{Check if a data frame is a conditioned data frame} +\usage{ +is_cnd_df(dat) +} +\arguments{ +\item{dat}{A data frame.} +} +\value{ +\code{TRUE} if \code{dat} is a conditioned data frame (class \code{cnd_df}), +otherwise \code{FALSE}. +} +\description{ +\code{\link[=is_cnd_df]{is_cnd_df()}} checks whether a data frame is a conditioned data frame, i.e. +of class \code{cnd_df}. +} +\examples{ +df <- data.frame(x = 1:3, y = letters[1:3]) +sdtm.oak:::is_cnd_df(df) + +cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +sdtm.oak:::is_cnd_df(cnd_df) + +} +\seealso{ +\code{\link[=new_cnd_df]{new_cnd_df()}}, \code{\link[=get_cnd_df_cnd]{get_cnd_df_cnd()}}, \code{\link[=get_cnd_df_cnd_sum]{get_cnd_df_cnd_sum()}}, +\code{\link[=rm_cnd_df]{rm_cnd_df()}}. +} +\keyword{internal} diff --git a/man/mutate.cnd_df.Rd b/man/mutate.cnd_df.Rd index d55b2134..de6ec25a 100644 --- a/man/mutate.cnd_df.Rd +++ b/man/mutate.cnd_df.Rd @@ -28,11 +28,7 @@ if ungrouped). \item A data frame or tibble, to create multiple columns in the output. }} -\item{.by}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} - -<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> Optionally, a selection of columns to -group by for just this operation, functioning as an alternative to \code{\link[dplyr:group_by]{group_by()}}. For -details and examples, see \link[dplyr:dplyr_by]{?dplyr_by}.} +\item{.by}{Not used when \code{.data} is a conditioned data frame.} \item{.keep}{Control which columns from \code{.data} are retained in the output. Grouping columns and columns created by \code{...} are always kept. @@ -48,9 +44,10 @@ the columns used to generate them. variables and columns created by \code{...} are kept. }} -\item{.before, .after}{<\code{\link[dplyr:dplyr_tidy_select]{tidy-select}}> Optionally, control where new columns -should appear (the default is to add to the right hand side). See -\code{\link[dplyr:relocate]{relocate()}} for more details.} +\item{.before}{Not used, use \code{.after} instead.} + +\item{.after}{Control where new columns should appear, i.e. after which +columns.} } \description{ \code{\link[=mutate.cnd_df]{mutate.cnd_df()}} is an S3 method to be dispatched by \link[dplyr:mutate]{mutate} diff --git a/man/new_cnd_df.Rd b/man/new_cnd_df.Rd index f40b140b..0de6282e 100644 --- a/man/new_cnd_df.Rd +++ b/man/new_cnd_df.Rd @@ -36,5 +36,9 @@ transformation by methods that support \emph{conditioned} data frames. df <- data.frame(x = 1:3, y = letters[1:3]) sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +} +\seealso{ +\code{\link[=is_cnd_df]{is_cnd_df()}}, \code{\link[=get_cnd_df_cnd]{get_cnd_df_cnd()}}, \code{\link[=get_cnd_df_cnd_sum]{get_cnd_df_cnd_sum()}}, +\code{\link[=rm_cnd_df]{rm_cnd_df()}}. } \keyword{internal} diff --git a/man/rm_cnd_df.Rd b/man/rm_cnd_df.Rd index 531c972d..bd740d2c 100644 --- a/man/rm_cnd_df.Rd +++ b/man/rm_cnd_df.Rd @@ -10,9 +10,22 @@ rm_cnd_df(dat) \item{dat}{A data frame.} } \value{ -The input \code{dat} without the \code{cnd_df} class. +The input \code{dat} without the \code{cnd_df} class and associated attributes. } \description{ This function removes the \code{cnd_df} class, along with its attributes, if applicable. } +\examples{ +df <- data.frame(x = 1:3, y = letters[1:3]) +cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) + +sdtm.oak:::is_cnd_df(cnd_df) +sdtm.oak:::is_cnd_df(sdtm.oak:::rm_cnd_df(cnd_df)) + +} +\seealso{ +\code{\link[=new_cnd_df]{new_cnd_df()}}, \code{\link[=is_cnd_df]{is_cnd_df()}}, \code{\link[=get_cnd_df_cnd]{get_cnd_df_cnd()}}, +\code{\link[=get_cnd_df_cnd_sum]{get_cnd_df_cnd_sum()}}. +} +\keyword{internal} diff --git a/man/tbl_sum.cnd_df.Rd b/man/tbl_sum.cnd_df.Rd index 760e5507..d2d6689d 100644 --- a/man/tbl_sum.cnd_df.Rd +++ b/man/tbl_sum.cnd_df.Rd @@ -12,5 +12,17 @@ \item{...}{Additional arguments passed to the default print method.} } \description{ -Conditioned tibble header print method +Conditioned tibble header print method. This S3 method adds an extra line +in the header of a tibble that indicates the tibble is a conditioned tibble +(\verb{# Cond. tbl:}) followed by the tally of the conditioning vector: number +of TRUE, FALSE and NA values: e.g., \code{1/1/1}. +} +\examples{ +df <- data.frame(x = 1:3, y = letters[1:3]) +cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) +print(cnd_df) + +} +\seealso{ +\code{\link[=ctl_new_rowid_pillar.cnd_df]{ctl_new_rowid_pillar.cnd_df()}}. } diff --git a/tests/testthat/test-cnd_df.R b/tests/testthat/test-cnd_df.R new file mode 100644 index 00000000..4b13e3a5 --- /dev/null +++ b/tests/testthat/test-cnd_df.R @@ -0,0 +1,82 @@ +test_that("new_cnd_df creates conditioned data frame correctly", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, NA, TRUE) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) + + expect_true(inherits(cnd_df, "cnd_df")) + expect_equal(attr(cnd_df, "cnd"), cnd) + expect_equal(attr(cnd_df, "cnd_sum"), c(n_true = 1, n_false = 1, n_na = 1)) +}) + +test_that("new_cnd_df gives warning if dat is already cnd_df", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, NA, TRUE) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) + + expect_warning(sdtm.oak:::new_cnd_df(dat = cnd_df, cnd = cnd, .warn = TRUE)) +}) + +test_that("new_cnd_df errors when cnd length doesn't match dat rows", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, TRUE) + + expect_error(sdtm.oak:::new_cnd_df(dat = df, cnd = cnd)) +}) + +test_that("is_cnd_df correctly identifies cnd_df class", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) + + expect_true(sdtm.oak:::is_cnd_df(cnd_df)) + expect_false(sdtm.oak:::is_cnd_df(df)) +}) + +test_that("get_cnd_df_cnd correctly extracts cnd attribute", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, NA, TRUE) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) + + expect_equal(sdtm.oak:::get_cnd_df_cnd(cnd_df), cnd) + expect_null(sdtm.oak:::get_cnd_df_cnd(df)) +}) + +test_that("get_cnd_df_cnd_sum correctly extracts cnd_sum attribute", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, NA, TRUE) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) + + expect_equal(sdtm.oak:::get_cnd_df_cnd_sum(cnd_df), c(n_true = 1, n_false = 1, n_na = 1)) + expect_null(sdtm.oak:::get_cnd_df_cnd_sum(df)) +}) + +test_that("rm_cnd_df correctly removes cnd_df class and attributes", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, NA, TRUE) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) + un_cnd_df <- sdtm.oak:::rm_cnd_df(cnd_df) + + expect_false(inherits(un_cnd_df, "cnd_df")) + expect_null(attr(un_cnd_df, "cnd")) + expect_null(attr(un_cnd_df, "cnd_sum")) +}) + +test_that("tbl_sum.cnd_df adds conditioning summary to tibble header", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, NA, TRUE) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) + + sum_output <- tbl_sum(cnd_df) + expect_equal(sum_output["Cond. tbl"], c("Cond. tbl" = "1/1/1")) +}) + +test_that("ctl_new_rowid_pillar.cnd_df customizes row IDs with condition", { + df <- tibble(x = 1:3, y = letters[1:3]) + cnd <- c(FALSE, NA, TRUE) + cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) + + rowid_pillar <- ctl_new_rowid_pillar(controller = cnd_df, x = cnd_df, width = 10) + + expect_true(inherits(rowid_pillar, "pillar")) + expect_equal(rowid_pillar$data[[1]]$row_ids, c("1 F", "2 -", "3 T")) +}) + diff --git a/tests/testthat/test-condition_add.R b/tests/testthat/test-condition_add.R new file mode 100644 index 00000000..51d763ee --- /dev/null +++ b/tests/testthat/test-condition_add.R @@ -0,0 +1,87 @@ +test_that("condition_add tags records correctly with single condition", { + df <- tibble::tibble(x = 1:3, y = letters[1:3]) + + cnd_df <- condition_add(dat = df, x > 1) + expect_true(is_cnd_df(cnd_df)) + expect_equal(get_cnd_df_cnd(cnd_df), c(FALSE, TRUE, TRUE)) + expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 2, n_false = 1, n_na = 0)) +}) + +test_that("condition_add tags records correctly with multiple conditions", { + df <- tibble::tibble(x = 1:5, y = c(1.1, 2.2, 3.3, 4.4, 5.5), z = factor(letters[1:5])) + + cnd_df <- condition_add(dat = df, x > 1 & y < 5) + cnd_df_multiple <- condition_add(dat = df, x > 1, y < 5) + expect_true(is_cnd_df(cnd_df)) + expect_equal(get_cnd_df_cnd(cnd_df), c(FALSE, TRUE, TRUE, TRUE, FALSE)) + expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 3, n_false = 2, n_na = 0)) + + expect_equal(get_cnd_df_cnd(cnd_df_multiple), c(FALSE, TRUE, TRUE, TRUE, FALSE)) + expect_equal(get_cnd_df_cnd_sum(cnd_df_multiple), c(n_true = 3, n_false = 2, n_na = 0)) + +}) + +test_that("condition_add handles different data types correctly", { + df <- tibble::tibble(x = 1:5, y = c(1.1, 2.2, 3.3, 4.4, 5.5), z = letters[1:5], w = factor(letters[1:5])) + + cnd_df <- condition_add(dat = df, x > 2 & y < 5 & z %in% c("c", "d", "e") & w %in% c("c", "d", "e")) + expect_true(is_cnd_df(cnd_df)) + expect_equal(get_cnd_df_cnd(cnd_df), c(FALSE, FALSE, TRUE, TRUE, FALSE)) + expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 2, n_false = 3, n_na = 0)) +}) + +test_that("condition_add does not care about conditions' arguments being named", { + df <- tibble::tibble(x = 1:5, y = c(1.1, 2.2, 3.3, 4.4, 5.5)) + + cnd_df_named <- condition_add(dat = df, cond1 = x > 2, cond2 = y < 5) + cnd_df_unnamed <- condition_add(dat = df, x > 2, y < 5) + + expect_equal(cnd_df_named, cnd_df_unnamed) +}) + +test_that("condition_add handles empty data frames", { + df <- tibble::tibble(x = integer(0), y = character(0)) + + cnd_df <- condition_add(dat = df, x > 1) + expect_true(is_cnd_df(cnd_df)) + expect_equal(nrow(cnd_df), 0) + expect_equal(get_cnd_df_cnd(cnd_df), logical(0)) + expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 0, n_false = 0, n_na = 0)) +}) + +test_that("condition_add gives warning if dat is already a conditioned data frame", { + df <- tibble::tibble(x = 1:3, y = letters[1:3]) + cnd_df <- new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) + + expect_warning(condition_add(dat = cnd_df, x > 1), "The previous condition will be replaced by the new one.") +}) + +test_that("`condition_add()`: `dat` variables take precedence over variables in `.dat2`", { + df <- tibble::tibble(x = 1:3, y = letters[1:3]) + .dat2_env <- rlang::env(x = 2) + .dat2_list <- list(x = 2) + .dat2_df <- tibble::tibble(x = 2) + + cnd_df_env <- condition_add(dat = df, x > 2, .dat2 = .dat2_env) + cnd_df_list <- condition_add(dat = df, x > 2, .dat2 = .dat2_list) + cnd_df_df <- condition_add(dat = df, x > 2, .dat2 = .dat2_df) + + expect_equal(get_cnd_df_cnd(cnd_df_env), c(FALSE, FALSE, TRUE)) + expect_equal(get_cnd_df_cnd(cnd_df_list), c(FALSE, FALSE, TRUE)) + expect_equal(get_cnd_df_cnd(cnd_df_df), c(FALSE, FALSE, TRUE)) +}) + +test_that("condition_add handles .dat2 with additional variables", { + df <- tibble::tibble(x = 1:3, y = letters[1:3]) + .dat2_env <- rlang::env(z = 3, w = 1) + .dat2_list <- list(z = 3, w = 1) + .dat2_df <- tibble::tibble(z = 3, w = 1) + + cnd_df_env <- condition_add(dat = df, x > w & x < z, .dat2 = .dat2_env) + cnd_df_list <- condition_add(dat = df, x > w & x < z, .dat2 = .dat2_list) + cnd_df_df <- condition_add(dat = df, x > w & x < z, .dat2 = .dat2_df) + + expect_equal(get_cnd_df_cnd(cnd_df_env), c(FALSE, TRUE, FALSE)) + expect_equal(get_cnd_df_cnd(cnd_df_list), c(FALSE, TRUE, FALSE)) + expect_equal(get_cnd_df_cnd(cnd_df_df), c(FALSE, TRUE, FALSE)) +}) diff --git a/tests/testthat/test-eval_conditions.R b/tests/testthat/test-eval_conditions.R new file mode 100644 index 00000000..f2f50d35 --- /dev/null +++ b/tests/testthat/test-eval_conditions.R @@ -0,0 +1,39 @@ +test_that("`eval_conditions()` evaluates conditions correctly", { + df <- tibble::tibble( + x = c(1, 2, NA_integer_, 4, 5), + y = c(TRUE, FALSE, TRUE, FALSE, TRUE), + z = c("a", "b", "a", "b", "a") + ) + + # Tag records for which `x` is greater than 2. + expect_equal(sdtm.oak:::eval_conditions(df, x > 2), + c(FALSE, FALSE, NA, TRUE, TRUE)) + + # Tag records for which `x` is greater than 2 and `y` is TRUE. + expect_equal(sdtm.oak:::eval_conditions(df, x > 2, y), + c(FALSE, FALSE, NA, FALSE, TRUE)) + + # Tag records for which `x` is greater than 2 and convert resulting NAs into FALSE. + expect_equal(sdtm.oak:::eval_conditions(df, x > 2, .na = FALSE), + c(FALSE, FALSE, FALSE, TRUE, TRUE)) + + # Conditions may involve variables defined in the caller environment. + w <- 1 + expect_equal(sdtm.oak:::eval_conditions(df, x > w), + c(FALSE, TRUE, NA, TRUE, TRUE)) + + # Conditions may look into variables defined in other scopes (e.g., in + # environments). + env <- rlang::env(w = 1) + expect_equal(sdtm.oak:::eval_conditions(df, x > w, .env = env), + c(FALSE, TRUE, NA, TRUE, TRUE)) + + # Other scopes are not restricted to environments but lists and tibbles also + # work as namespaces for look-up. + expect_equal(sdtm.oak:::eval_conditions(df, x > w, .env = list(w = 3)), + c(FALSE, FALSE, NA, TRUE, TRUE)) + expect_equal( + sdtm.oak:::eval_conditions(df, x > w, .env = tibble::tibble(w = 4)), + c(FALSE, FALSE, NA, FALSE, TRUE) + ) +}) diff --git a/tests/testthat/test-mutate_cnd_df.R b/tests/testthat/test-mutate_cnd_df.R new file mode 100644 index 00000000..8e3c1c06 --- /dev/null +++ b/tests/testthat/test-mutate_cnd_df.R @@ -0,0 +1,103 @@ +test_that("mutate.cnd_df correctly mutates conditioned data frame", { + df <- tibble::tibble(x = 1:3, y = letters[1:3]) + cnd_df <- new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) + + mutated_df <- dplyr::mutate(cnd_df, z = x + 1) + expect_true("z" %in% colnames(mutated_df)) + expect_equal(mutated_df$z, c(NA, NA, 4)) +}) + +test_that("mutate.cnd_df handles multiple mutations", { + df <- tibble::tibble(x = 1:3, y = 1:3) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) + + mutated_df <- dplyr::mutate(cnd_df, z = x + y, w = x * y) + expect_true(all(c("z", "w") %in% colnames(mutated_df))) + expect_equal(mutated_df$z, c(2, NA, 6)) + expect_equal(mutated_df$w, c(1, NA, 9)) +}) + +test_that("mutate.cnd_df retains original data for non-conditioned rows", { + df <- tibble::tibble(x = 1:4, y = 2:5) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE, NA)) + + mutated_df <- dplyr::mutate(cnd_df, z = x + y) + expect_equal(mutated_df$z, c(3, NA, 7, NA)) + expect_equal(mutated_df$x, df$x) + expect_equal(mutated_df$y, df$y) +}) + +test_that("mutate.cnd_df works with different data types", { + df <- tibble::tibble(x = 1:3, y = c(1.1, 2.2, 3.3), z = c("a", "b", "c")) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) + + mutated_df <- dplyr::mutate(cnd_df, w = x * y, v = paste0(z, x)) + expect_true(all(c("w", "v") %in% colnames(mutated_df))) + expect_equal(mutated_df$w, c(1.1, NA, 9.9)) + expect_equal(mutated_df$v, c("a1", NA, "c3")) +}) + +test_that("mutate.cnd_df handles empty data frames", { + df <- tibble::tibble(x = integer(0), y = integer(0)) + cnd_df <- new_cnd_df(dat = df, cnd = logical(0)) + + mutated_df <- dplyr::mutate(cnd_df, z = x + y) + expect_equal(nrow(mutated_df), 0) + expect_true("z" %in% colnames(mutated_df)) + expect_equal(mutated_df$z, numeric(0)) +}) + +test_that("mutate.cnd_df handles .keep parameter correctly", { + df <- tibble::tibble(x = 1:3, y = 1:3) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) + + mutated_df_all <- dplyr::mutate(cnd_df, z = x + y, .keep = "all") + expect_true(all(c("x", "y", "z") %in% colnames(mutated_df_all))) + + mutated_df_used <- dplyr::mutate(cnd_df, z = 2 * x, .keep = "used") + expect_true(all(c("x", "z") %in% colnames(mutated_df_used))) + + mutated_df_unused <- dplyr::mutate(cnd_df, z = 2 * x, .keep = "unused") + expect_true(all(c("y", "z") %in% colnames(mutated_df_unused))) + + mutated_df_none <- dplyr::mutate(cnd_df, z = x + y, .keep = "none") + expect_true("z" == colnames(mutated_df_none)) + expect_false(any(c("x", "y") %in% colnames(mutated_df_none))) +}) + +test_that("mutate.cnd_df handles .after parameter correctly", { + df <- tibble::tibble(x = 1:3, y = 1:3) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) + + mutated_df_after <- dplyr::mutate(cnd_df, z = x + y, .after = "x") + expect_equal(colnames(mutated_df_after), c("x", "z", "y")) +}) + +test_that("mutate.cnd_df works with named arguments", { + df <- tibble::tibble(x = 1:3, y = 1:3) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) + + mutated_df_named <- dplyr::mutate(cnd_df, new_col = x + y) + expect_true("new_col" %in% colnames(mutated_df_named)) + expect_equal(mutated_df_named$new_col, c(2, NA, 6)) +}) + +test_that("mutate.cnd_df errors when .by is used", { + df <- tibble::tibble(x = 1:3, y = 1:3) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) + + expect_error( + dplyr::mutate(cnd_df, z = x + y, .by = "y"), + regex = "`\\.by` is not supported on conditioned data frames." + ) +}) + +test_that("mutate.cnd_df errors when .before is used", { + df <- tibble::tibble(x = 1:3, y = 1:3) + cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) + + expect_error( + dplyr::mutate(cnd_df, z = x + y, .before = "x"), + regex = "`\\.before` is not supported on conditioned data frames, use `\\.after` instead." + ) +}) diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R new file mode 100644 index 00000000..c939d6bc --- /dev/null +++ b/tests/testthat/test-pipe.R @@ -0,0 +1,73 @@ +`%>%` <- magrittr::`%>%` + +test_that("Basic operations work correctly", { + expect_equal(5 %.>% (2 + .), 5 %>% {2 + .}) + expect_equal("hello" %.>% toupper(.), "hello" %>% {toupper(.)}) +}) + +test_that("Nested operations work correctly", { + expect_equal(5 %.>% (2 + . + 3), 5 %>% {2 + . + 3}) + expect_equal("hello" %.>% paste(., "world"), "hello" %>% {paste(., "world")}) +}) + +test_that("Piping with braces", { + mtcars2 <- mtcars %.>% {.$cyl <- .$cyl * 2; .} + expect_equal(mtcars2$cyl, mtcars$cyl * 2) +}) + +test_that("Dot used multiple times in rhs", { + expect_equal(5 %.>% (. * 2 + .), 5 %>% { . * 2 + . }) + expect_equal("hello" %.>% paste(., toupper(.)), "hello" %>% {paste(., toupper(.))}) +}) + +test_that("Dot used in nested functions", { + expect_equal(mtcars %.>% subset(., 1:nrow(.) %% 2 == 0), mtcars %>% {subset(., 1:nrow(.) %% 2 == 0)}) + expect_equal(1:10 %.>% c(min(.), max(.)), 1:10 %>% {c(min(.), max(.))}) +}) + +test_that("Error when dot is not used in rhs", { + expect_error(5 %.>% (2 + 2)) + expect_error("hello" %.>% toupper) +}) + +test_that("Complex expressions work correctly", { + expect_equal(5 %.>% (2 + . + 3 + . * 2), 5 %>% {2 + . + 3 + . * 2}) + expect_equal(mtcars %.>% subset(., gear == 4 & mpg > mean(mpg)), mtcars %>% {subset(., gear == 4 & mpg > mean(mpg))}) + expect_equal(mtcars %.>% subset(., cyl == 6) %.>% nrow(.), mtcars %>% {subset(., cyl == 6)} %>% nrow()) +}) + +test_that("Functions returning functions", { + expect_equal(1:5 %.>% (sapply(., function(x) x * 2)), 1:5 %>% {sapply(., function(x) x * 2)}) + expect_equal(mtcars %.>% (apply(., 2, function(x) mean(x))), mtcars %>% {apply(., 2, function(x) mean(x))}) +}) + +test_that("Dot used in custom functions", { + custom_function <- function(x) { x + 1 } + expect_equal(5 %.>% custom_function(.), 5 %>% {custom_function(.)}) + expect_equal(mtcars %.>% head(.), mtcars %>% {head(.)}) +}) + +test_that("Anonymous functions with \\(x)", { + expect_equal(1:5 %.>% (purrr::map(., \(x) x * 2)), 1:5 %>% {purrr::map(., \(x) x * 2)}) +}) + +test_that("Anonymous functions with function(x)", { + expect_equal(1:5 %.>% (purrr::map(., function(x) x * 2)), 1:5 %>% {purrr::map(., function(x) x * 2)}) +}) + +test_that("Piping with environment-dependent functions", { + env <- environment() + "x" %.>% assign(x = ., 100, envir = env) + expect_equal(x, 100) +}) + +test_that("`.` is restored", { + 1 %.>% identity(.) + expect_error(., "not found") + + . <- "foo" + 1 %.>% identity(.) + expect_identical(., "foo") +}) + +# TODO: Support for lazy-evaluation diff --git a/vignettes/articles/cnd_df.Rmd b/vignettes/articles/cnd_df.Rmd new file mode 100644 index 00000000..527de492 --- /dev/null +++ b/vignettes/articles/cnd_df.Rmd @@ -0,0 +1,109 @@ +--- +title: "Conditioned Data Frames" +--- + +```{r setup, include=FALSE} +knitr::opts_chunk$set(echo = TRUE) +library(sdtm.oak) +library(tibble) +``` + +## Introduction + +Conditioned data frames, or `cnd_df`, are a powerful tool in the `{sdtm.oak}` +package designed to facilitate conditional transformations on data frames. This +article explains how to create and use conditioned data frames, particularly in +the context of SDTM domain derivations. + +## Creating Conditioned Data Frames + +A conditioned data frame is a regular data frame extended with a logical vector +`cnd` that marks rows for subsequent conditional transformations. The +`condition_add()` function is used to create these conditioned data frames. + +### Simple Example + +Consider a simple data frame `df`: + +```{r} +(df <- tibble(x = 1:3, y = letters[1:3])) +``` + +We can create a conditioned data frame where only rows where `x > 1` are marked: + +```{r} +(cnd_df <- condition_add(dat = df, x > 1)) +``` + +Here, only the second and third rows are marked as `TRUE`. + +## Usage in SDTM Domain Derivations + +The real power of conditioned data frames manifests when they are used with +functions such as `assign_no_ct`, `assign_ct`, `hardcode_no_ct`, and +`hardcode_ct`. These functions perform derivations only for the records that +match the pattern of `TRUE` values in conditioned data frames. + +### Example with Concomitant Medications (CM) Domain + +Consider a simplified dataset of concomitant medications, where we want to +derive a new variable CMGRPID (Concomitant Medication Group ID) based on the +condition that the medication treatment (CMTRT) is `"BENADRYL"`. + +Here is a simplified raw Concomitant Medications data set (`cm_raw`): + +```{r} +cm_raw <- tibble::tibble( + oak_id = 1:14, + raw_source = "ConMed", + patient_number = c(375, 375, 376, 377, 377, 377, 377, 378, 378, 378, 378, 379, 379, 379), + MDNUM = c(1, 2, 1, 1, 2, 3, 5, 4, 1, 2, 3, 1, 2, 3), + MDRAW = c( + "BABY ASPIRIN", "CORTISPORIN", "ASPIRIN", + "DIPHENHYDRAMINE HCL", "PARCETEMOL", "VOMIKIND", + "ZENFLOX OZ", "AMITRYPTYLINE", "BENADRYL", + "DIPHENHYDRAMINE HYDROCHLORIDE", "TETRACYCLINE", + "BENADRYL", "SOMINEX", "ZQUILL" + ) +) +cm_raw +``` + +To derive the `CMTRT` variable we use the `assign_no_ct()` function to map the +`MDRAW` variable to the `CMTRT` variable: + +```{r} +tgt_dat <- assign_no_ct( + tgt_var = "CMTRT", + raw_dat = cm_raw, + raw_var = "MDRAW" +) +tgt_dat +``` + +Then we create a conditioned data frame from the target data set (`tgt_dat`), +meaning we create a conditioned data frame where only rows with `CMTRT` equal to +`"BENADRYL"` are marked: + +```{r} +(cnd_tgt_dat <- condition_add(tgt_dat, CMTRT == "BENADRYL")) +``` + +Finally, we derive the `CMGRPID` variable conditionally. Using `assign_no_ct()`, +we derive `CMGRPID` which indicates the group ID for the medication, +based on the conditioned target data set: + +```{r} +derived_tgt_dat <- assign_no_ct( + tgt_dat = cnd_tgt_dat, + tgt_var = "CMGRPID", + raw_dat = cm_raw, + raw_var = "MDNUM" +) +derived_tgt_dat +``` + +Conditioned data frames in the `{sdtm.oak}` package provide a flexible way to +perform conditional transformations on data sets. By marking specific rows for +transformation, users can efficiently derive SDTM variables, ensuring that only +relevant records are processed. From 09a3921012910b4fbe79f496f0ca14a8e46baac8 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Mon, 17 Jun 2024 23:08:23 +0100 Subject: [PATCH 06/12] Styling fixes --- R/assign.R | 4 -- R/assign_datetime.R | 7 +- R/cnd_df.R | 17 ++--- R/hardcode.R | 3 - R/join.R | 2 - R/pipe.R | 5 +- R/sdtm_join.R | 2 - tests/testthat/test-assign.R | 29 ++++----- tests/testthat/test-cnd_df.R | 1 - tests/testthat/test-condition_add.R | 1 - tests/testthat/test-eval_conditions.R | 36 ++++++---- tests/testthat/test-hardcode.R | 31 ++++----- tests/testthat/test-pipe.R | 94 +++++++++++++++++++++------ 13 files changed, 139 insertions(+), 93 deletions(-) diff --git a/R/assign.R b/R/assign.R index d381f79b..57f3b0ed 100644 --- a/R/assign.R +++ b/R/assign.R @@ -42,7 +42,6 @@ sdtm_assign <- function(tgt_dat = NULL, ct_spec = NULL, ct_clst = NULL, id_vars = oak_id_vars()) { - admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) @@ -66,7 +65,6 @@ sdtm_assign <- function(tgt_dat = NULL, mutate("{tgt_var}" := tgt_val) |> # nolint object_name_linter() dplyr::select(-dplyr::any_of(setdiff(raw_var, tgt_var))) |> dplyr::relocate(dplyr::all_of(tgt_var), .after = dplyr::last_col()) - } #' Derive an SDTM variable @@ -185,7 +183,6 @@ assign_no_ct <- function(tgt_dat = NULL, raw_dat, raw_var, id_vars = oak_id_vars()) { - admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) @@ -214,7 +211,6 @@ assign_ct <- function(tgt_dat = NULL, ct_spec, ct_clst, id_vars = oak_id_vars()) { - admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) diff --git a/R/assign_datetime.R b/R/assign_datetime.R index 5af4f9e2..2e635f2a 100644 --- a/R/assign_datetime.R +++ b/R/assign_datetime.R @@ -159,7 +159,6 @@ assign_datetime <- raw_unk = c("UN", "UNK"), id_vars = oak_id_vars(), .warn = TRUE) { - admiraldev::assert_character_vector(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_vector(id_vars) @@ -178,9 +177,9 @@ assign_datetime <- tgt_val <- create_iso8601(!!!join_dat[raw_var], - .format = raw_fmt, - .na = raw_unk, - .warn = .warn + .format = raw_fmt, + .na = raw_unk, + .warn = .warn ) join_dat |> diff --git a/R/cnd_df.R b/R/cnd_df.R index 9c863258..11e5a076 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -54,7 +54,6 @@ #' #' @keywords internal new_cnd_df <- function(dat, cnd, .warn = TRUE) { - admiraldev::assert_data_frame(dat) assert_logical_vector(cnd) @@ -237,7 +236,6 @@ lgl_to_chr <- function(x) { #' #' @export ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { - out <- NextMethod() n_row <- nrow(x) idx <- seq_len(n_row) @@ -256,8 +254,8 @@ ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { type = out$type, data = pillar::pillar_component( pillar::new_pillar_shaft(list(row_ids = row_ids), - width = width, - class = "pillar_rif_shaft" + width = width, + class = "pillar_rif_shaft" ) ) ), @@ -332,7 +330,6 @@ eval_conditions <- function(dat, ..., .na = NA, .env = rlang::caller_env()) { - conditions <- rlang::enexprs(...) # List (or data frame). @@ -368,11 +365,12 @@ eval_conditions <- function(dat, #' #' @export condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { - if (is_cnd_df(dat)) { rlang::warn( - c("`dat` is already a conditioned data frame (`cnd_df`).", - "The previous condition will be replaced by the new one.") + c( + "`dat` is already a conditioned data frame (`cnd_df`).", + "The previous condition will be replaced by the new one." + ) ) } .env <- .dat2 @@ -403,7 +401,6 @@ mutate.cnd_df <- function(.data, .keep = c("all", "used", "unused", "none"), .before = NULL, .after = NULL) { - if (!rlang::is_null(.by)) { rlang::abort("`.by` is not supported on conditioned data frames.") } @@ -418,7 +415,7 @@ mutate.cnd_df <- function(.data, derivations <- rlang::enquos(...) derived_vars <- names(derivations) - lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else({{cnd}}, !!.x, NA))) + lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else({{ cnd }}, !!.x, NA))) lst <- rlang::set_names(lst, derived_vars) dplyr::mutate(dat, !!!lst, .by = NULL, .keep = .keep, .after = .after) diff --git a/R/hardcode.R b/R/hardcode.R index 3562192f..51d263e8 100644 --- a/R/hardcode.R +++ b/R/hardcode.R @@ -44,7 +44,6 @@ sdtm_hardcode <- function(tgt_dat = NULL, ct_spec = NULL, ct_clst = NULL, id_vars = oak_id_vars()) { - admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) admiraldev::assert_character_scalar(tgt_val) @@ -177,7 +176,6 @@ hardcode_no_ct <- function(tgt_dat = NULL, raw_var, tgt_var, id_vars = oak_id_vars()) { - admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) assertthat::assert_that(assertthat::is.scalar(tgt_val), @@ -211,7 +209,6 @@ hardcode_ct <- ct_spec, ct_clst, id_vars = oak_id_vars()) { - admiraldev::assert_character_scalar(raw_var) admiraldev::assert_character_scalar(tgt_var) assertthat::assert_that(assertthat::is.scalar(tgt_val), diff --git a/R/join.R b/R/join.R index 1e0e64b9..d85949b9 100644 --- a/R/join.R +++ b/R/join.R @@ -34,6 +34,4 @@ sdtm_join <- function(raw_dat, "__raw_dat_cond__", "__tgt_dat_cond__" ))) |> new_cnd_df(cnd = cnd, .warn = FALSE) - } - diff --git a/R/pipe.R b/R/pipe.R index 496c07bf..ae8a99cc 100644 --- a/R/pipe.R +++ b/R/pipe.R @@ -49,13 +49,12 @@ #' #' @examples #' -#' iris %.>% subset(., 1:nrow(.) %% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) %% 2 == 0) -#' 1:10 %.>% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) +#' iris %.>% subset(., 1:nrow(.) %% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) %% 2 == 0) +#' 1:10 %.>% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) #' #' @rdname dot_pipe #' @export `%.>%` <- function(lhs, rhs) { - rhs_expr <- rlang::enexpr(rhs) if (!contains_dot(rhs_expr)) { rlang::abort("The right-hand side (rhs) of `%.>%` must contain at least one dot (.) placeholder.") diff --git a/R/sdtm_join.R b/R/sdtm_join.R index fc973ead..ad2b5a1c 100644 --- a/R/sdtm_join.R +++ b/R/sdtm_join.R @@ -34,6 +34,4 @@ sdtm_join <- function(raw_dat, "__raw_dat_cond__", "__tgt_dat_cond__" ))) |> new_cnd_df(cnd = cnd, .warn = FALSE) - } - diff --git a/tests/testthat/test-assign.R b/tests/testthat/test-assign.R index b26d7568..a97ea9a2 100644 --- a/tests/testthat/test-assign.R +++ b/tests/testthat/test-assign.R @@ -1,5 +1,4 @@ test_that("assign_ct works as expected with a conditioned `tgt_dat`", { - vs_raw_dat <- tibble::tibble( oak_id = 1:5, raw_source = c("VS1", "VS2", "VS3", "VS4", "VS5"), @@ -11,17 +10,21 @@ test_that("assign_ct works as expected with a conditioned `tgt_dat`", { oak_id = as.integer(rep(1:5, each = 4)), raw_source = rep(c("VS1", "VS2", "VS3", "VS4", "VS5"), each = 4), patient_number = as.integer(rep(c(101L, 102L, 103L, 104L, 105L), each = 4)), - VSTESTCD = c("TEMP", "BPSYS", "BPDIAS", "HR", - "TEMP", "BPSYS", "BPDIAS", "HR", - "TEMP", "BPSYS", "BPDIAS", "HR", - "TEMP", "BPSYS", "BPDIAS", "HR", - "TEMP", "BPSYS", "BPDIAS", "HR") + VSTESTCD = c( + "TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR", + "TEMP", "BPSYS", "BPDIAS", "HR" + ) ) # vital signs' locations - vs_loc_raw <- c("Mouth", "Arm", "Arm", "Arm", "Armpit", "Arm", "Arm", "Arm", - "Rectum", "Arm", "Arm", "Arm", "auris", "Arm", "Arm", "Arm", "brow", "Arm", - "Arm", "Arm") + vs_loc_raw <- c( + "Mouth", "Arm", "Arm", "Arm", "Armpit", "Arm", "Arm", "Arm", + "Rectum", "Arm", "Arm", "Arm", "auris", "Arm", "Arm", "Arm", "brow", "Arm", + "Arm", "Arm" + ) vs_loc_tgt <- c( "ORAL", @@ -66,7 +69,6 @@ test_that("assign_ct works as expected with a conditioned `tgt_dat`", { test_that("assign_ct works as expected with both `raw_dat` and `tgt_dat` as conditioned data frames", { - ct_spec <- tibble::tibble( codelist_code = "C78734", term_code = c("C150895", "C12434", "C13275", "C89803", "C12801"), @@ -103,7 +105,7 @@ test_that("assign_ct works as expected with both `raw_dat` and `tgt_dat` as cond tgt_dat = condition_add( fa_tgt_dat, FATESTCD == "STATUS" & - FAOBJ == "Severe Acute Resp Syndrome Coronavirus 2" + FAOBJ == "Severe Acute Resp Syndrome Coronavirus 2" ), tgt_var = "FASPEC", raw_dat = condition_add(fa_raw_dat, is.na(SPECTYP)), @@ -120,12 +122,11 @@ test_that("assign_ct works as expected with both `raw_dat` and `tgt_dat` as cond }) test_that("assign_ct works as expected with conditions across both data sets", { - cm_raw_dat <- tibble::tibble( oak_id = 1:5, raw_source = paste0("MD", 1:5), patient_number = 101:105, - CMMODIFY = c("ASPIRIN EC", "IBUPROFEN LYSINE" , "PARACETAMOL", "DICLOFENAC", "NAPROXEN") + CMMODIFY = c("ASPIRIN EC", "IBUPROFEN LYSINE", "PARACETAMOL", "DICLOFENAC", "NAPROXEN") ) cm_tgt_dat <- tibble::tibble( @@ -163,6 +164,4 @@ test_that("assign_ct works as expected with conditions across both data sets", { expect_equal(result1, expected_result) expect_equal(result2, expected_result) - }) - diff --git a/tests/testthat/test-cnd_df.R b/tests/testthat/test-cnd_df.R index 4b13e3a5..a2a818c2 100644 --- a/tests/testthat/test-cnd_df.R +++ b/tests/testthat/test-cnd_df.R @@ -79,4 +79,3 @@ test_that("ctl_new_rowid_pillar.cnd_df customizes row IDs with condition", { expect_true(inherits(rowid_pillar, "pillar")) expect_equal(rowid_pillar$data[[1]]$row_ids, c("1 F", "2 -", "3 T")) }) - diff --git a/tests/testthat/test-condition_add.R b/tests/testthat/test-condition_add.R index 51d763ee..4e5f03f0 100644 --- a/tests/testthat/test-condition_add.R +++ b/tests/testthat/test-condition_add.R @@ -18,7 +18,6 @@ test_that("condition_add tags records correctly with multiple conditions", { expect_equal(get_cnd_df_cnd(cnd_df_multiple), c(FALSE, TRUE, TRUE, TRUE, FALSE)) expect_equal(get_cnd_df_cnd_sum(cnd_df_multiple), c(n_true = 3, n_false = 2, n_na = 0)) - }) test_that("condition_add handles different data types correctly", { diff --git a/tests/testthat/test-eval_conditions.R b/tests/testthat/test-eval_conditions.R index f2f50d35..f63a023f 100644 --- a/tests/testthat/test-eval_conditions.R +++ b/tests/testthat/test-eval_conditions.R @@ -6,32 +6,44 @@ test_that("`eval_conditions()` evaluates conditions correctly", { ) # Tag records for which `x` is greater than 2. - expect_equal(sdtm.oak:::eval_conditions(df, x > 2), - c(FALSE, FALSE, NA, TRUE, TRUE)) + expect_equal( + sdtm.oak:::eval_conditions(df, x > 2), + c(FALSE, FALSE, NA, TRUE, TRUE) + ) # Tag records for which `x` is greater than 2 and `y` is TRUE. - expect_equal(sdtm.oak:::eval_conditions(df, x > 2, y), - c(FALSE, FALSE, NA, FALSE, TRUE)) + expect_equal( + sdtm.oak:::eval_conditions(df, x > 2, y), + c(FALSE, FALSE, NA, FALSE, TRUE) + ) # Tag records for which `x` is greater than 2 and convert resulting NAs into FALSE. - expect_equal(sdtm.oak:::eval_conditions(df, x > 2, .na = FALSE), - c(FALSE, FALSE, FALSE, TRUE, TRUE)) + expect_equal( + sdtm.oak:::eval_conditions(df, x > 2, .na = FALSE), + c(FALSE, FALSE, FALSE, TRUE, TRUE) + ) # Conditions may involve variables defined in the caller environment. w <- 1 - expect_equal(sdtm.oak:::eval_conditions(df, x > w), - c(FALSE, TRUE, NA, TRUE, TRUE)) + expect_equal( + sdtm.oak:::eval_conditions(df, x > w), + c(FALSE, TRUE, NA, TRUE, TRUE) + ) # Conditions may look into variables defined in other scopes (e.g., in # environments). env <- rlang::env(w = 1) - expect_equal(sdtm.oak:::eval_conditions(df, x > w, .env = env), - c(FALSE, TRUE, NA, TRUE, TRUE)) + expect_equal( + sdtm.oak:::eval_conditions(df, x > w, .env = env), + c(FALSE, TRUE, NA, TRUE, TRUE) + ) # Other scopes are not restricted to environments but lists and tibbles also # work as namespaces for look-up. - expect_equal(sdtm.oak:::eval_conditions(df, x > w, .env = list(w = 3)), - c(FALSE, FALSE, NA, TRUE, TRUE)) + expect_equal( + sdtm.oak:::eval_conditions(df, x > w, .env = list(w = 3)), + c(FALSE, FALSE, NA, TRUE, TRUE) + ) expect_equal( sdtm.oak:::eval_conditions(df, x > w, .env = tibble::tibble(w = 4)), c(FALSE, FALSE, NA, FALSE, TRUE) diff --git a/tests/testthat/test-hardcode.R b/tests/testthat/test-hardcode.R index e95bb00f..059e5ab8 100644 --- a/tests/testthat/test-hardcode.R +++ b/tests/testthat/test-hardcode.R @@ -1,11 +1,11 @@ # `aesos`: example raw data set. aesos <- tibble::tribble( - ~oak_id, ~raw_source, ~patient_number, ~AESO, ~AESOSP, ~AESEV, ~AESER, ~AETERM, - 1L, "RS1", 101L, 0L, "Pain", "Mild", "No", "Headache", - 2L, "RS1", 102L, 0L, NA, "Severe", "Yes", "Dizziness", - 3L, "RS2", 103L, 1L, NA, "Moderate", "No", NA, - 4L, "RS2", 104L, 1L, NA, "Mild", "No", "Eye issues", - 5L, "RS3", 105L, 1L, "Nausea", "Severe", "Yes", "Food Poisoning" + ~oak_id, ~raw_source, ~patient_number, ~AESO, ~AESOSP, ~AESEV, ~AESER, ~AETERM, + 1L, "RS1", 101L, 0L, "Pain", "Mild", "No", "Headache", + 2L, "RS1", 102L, 0L, NA, "Severe", "Yes", "Dizziness", + 3L, "RS2", 103L, 1L, NA, "Moderate", "No", NA, + 4L, "RS2", 104L, 1L, NA, "Mild", "No", "Eye issues", + 5L, "RS3", 105L, 1L, "Nausea", "Severe", "Yes", "Food Poisoning" ) # `oe_inter`: example target data set. @@ -31,13 +31,13 @@ test_that("hardcode_no_ct works as expected", { expected_result <- tibble::tribble( ~oak_id, ~raw_source, ~patient_number, ~OEORRES, # NA because `aesos_cnd` is conditioned to be FALSE on this record. - 1L, "RS1", 101L, NA_character_, + 1L, "RS1", 101L, NA_character_, # NA because `aesos_cnd` is conditioned to be FALSE on this record. - 3L, "RS2", 103L, NA_character_, + 3L, "RS2", 103L, NA_character_, # NA because `aesos_cnd` is conditioned to be FALSE on this record. - 4L, "RS2", 104L, NA_character_, + 4L, "RS2", 104L, NA_character_, # Successful derivation - 5L, "RS3", 105L, "Y" + 5L, "RS3", 105L, "Y" ) expect_equal(result, expected_result) @@ -68,17 +68,14 @@ test_that("hardcode_ct works as expected", { expected_result <- tibble::tribble( ~oak_id, ~raw_source, ~patient_number, ~OETESTCD, # `NA` because `aesos_cnd` is conditioned to be FALSE for this record. - 1L, "RS1", 101L, NA_character_, + 1L, "RS1", 101L, NA_character_, # `NA` because AETERM == NA for this record in `aesos_cnd`. - 3L, "RS2", 103L, NA_character_, + 3L, "RS2", 103L, NA_character_, # Successful derivation: IOISYMPO -> HYPERMIA. - 4L, "RS2", 104L, "HYPERMIA", + 4L, "RS2", 104L, "HYPERMIA", # `NA` because `aesos_cnd` is conditioned to be FALSE for this record. - 5L, "RS3", 105L, NA_character_ + 5L, "RS3", 105L, NA_character_ ) expect_equal(result, expected_result) }) - - - diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R index c939d6bc..14166007 100644 --- a/tests/testthat/test-pipe.R +++ b/tests/testthat/test-pipe.R @@ -1,28 +1,55 @@ `%>%` <- magrittr::`%>%` test_that("Basic operations work correctly", { - expect_equal(5 %.>% (2 + .), 5 %>% {2 + .}) - expect_equal("hello" %.>% toupper(.), "hello" %>% {toupper(.)}) + expect_equal(5 %.>% (2 + .), 5 %>% + { + 2 + . + }) + expect_equal("hello" %.>% toupper(.), "hello" %>% + { + toupper(.) + }) }) test_that("Nested operations work correctly", { - expect_equal(5 %.>% (2 + . + 3), 5 %>% {2 + . + 3}) - expect_equal("hello" %.>% paste(., "world"), "hello" %>% {paste(., "world")}) + expect_equal(5 %.>% (2 + . + 3), 5 %>% + { + 2 + . + 3 + }) + expect_equal("hello" %.>% paste(., "world"), "hello" %>% + { + paste(., "world") + }) }) test_that("Piping with braces", { - mtcars2 <- mtcars %.>% {.$cyl <- .$cyl * 2; .} + mtcars2 <- mtcars %.>% { + .$cyl <- .$cyl * 2 + . + } expect_equal(mtcars2$cyl, mtcars$cyl * 2) }) test_that("Dot used multiple times in rhs", { - expect_equal(5 %.>% (. * 2 + .), 5 %>% { . * 2 + . }) - expect_equal("hello" %.>% paste(., toupper(.)), "hello" %>% {paste(., toupper(.))}) + expect_equal(5 %.>% (. * 2 + .), 5 %>% + { + . * 2 + . + }) + expect_equal("hello" %.>% paste(., toupper(.)), "hello" %>% + { + paste(., toupper(.)) + }) }) test_that("Dot used in nested functions", { - expect_equal(mtcars %.>% subset(., 1:nrow(.) %% 2 == 0), mtcars %>% {subset(., 1:nrow(.) %% 2 == 0)}) - expect_equal(1:10 %.>% c(min(.), max(.)), 1:10 %>% {c(min(.), max(.))}) + expect_equal(mtcars %.>% subset(., 1:nrow(.) %% 2 == 0), mtcars %>% + { + subset(., 1:nrow(.) %% 2 == 0) + }) + expect_equal(1:10 %.>% c(min(.), max(.)), 1:10 %>% + { + c(min(.), max(.)) + }) }) test_that("Error when dot is not used in rhs", { @@ -31,28 +58,57 @@ test_that("Error when dot is not used in rhs", { }) test_that("Complex expressions work correctly", { - expect_equal(5 %.>% (2 + . + 3 + . * 2), 5 %>% {2 + . + 3 + . * 2}) - expect_equal(mtcars %.>% subset(., gear == 4 & mpg > mean(mpg)), mtcars %>% {subset(., gear == 4 & mpg > mean(mpg))}) - expect_equal(mtcars %.>% subset(., cyl == 6) %.>% nrow(.), mtcars %>% {subset(., cyl == 6)} %>% nrow()) + expect_equal(5 %.>% (2 + . + 3 + . * 2), 5 %>% + { + 2 + . + 3 + . * 2 + }) + expect_equal(mtcars %.>% subset(., gear == 4 & mpg > mean(mpg)), mtcars %>% + { + subset(., gear == 4 & mpg > mean(mpg)) + }) + expect_equal(mtcars %.>% subset(., cyl == 6) %.>% nrow(.), mtcars %>% + { + subset(., cyl == 6) + } %>% nrow()) }) test_that("Functions returning functions", { - expect_equal(1:5 %.>% (sapply(., function(x) x * 2)), 1:5 %>% {sapply(., function(x) x * 2)}) - expect_equal(mtcars %.>% (apply(., 2, function(x) mean(x))), mtcars %>% {apply(., 2, function(x) mean(x))}) + expect_equal(1:5 %.>% (sapply(., function(x) x * 2)), 1:5 %>% + { + sapply(., function(x) x * 2) + }) + expect_equal(mtcars %.>% (apply(., 2, function(x) mean(x))), mtcars %>% + { + apply(., 2, function(x) mean(x)) + }) }) test_that("Dot used in custom functions", { - custom_function <- function(x) { x + 1 } - expect_equal(5 %.>% custom_function(.), 5 %>% {custom_function(.)}) - expect_equal(mtcars %.>% head(.), mtcars %>% {head(.)}) + custom_function <- function(x) { + x + 1 + } + expect_equal(5 %.>% custom_function(.), 5 %>% + { + custom_function(.) + }) + expect_equal(mtcars %.>% head(.), mtcars %>% + { + head(.) + }) }) test_that("Anonymous functions with \\(x)", { - expect_equal(1:5 %.>% (purrr::map(., \(x) x * 2)), 1:5 %>% {purrr::map(., \(x) x * 2)}) + expect_equal(1:5 %.>% (purrr::map(., \(x) x * 2)), 1:5 %>% + { + purrr::map(., \(x) x * 2) + }) }) test_that("Anonymous functions with function(x)", { - expect_equal(1:5 %.>% (purrr::map(., function(x) x * 2)), 1:5 %>% {purrr::map(., function(x) x * 2)}) + expect_equal(1:5 %.>% (purrr::map(., function(x) x * 2)), 1:5 %>% + { + purrr::map(., function(x) x * 2) + }) }) test_that("Piping with environment-dependent functions", { From a7bb91aa7827a3cc064b7645fa7859ff84751d52 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Tue, 18 Jun 2024 01:12:33 +0100 Subject: [PATCH 07/12] Update linting and styling --- R/cnd_df.R | 21 +++++-- man/dot_pipe.Rd | 4 +- man/mutate.cnd_df.Rd | 10 +++ tests/testthat/test-assign.R | 36 +++++------ tests/testthat/test-assign_datetime.R | 2 +- tests/testthat/test-cnd_df.R | 36 +++++------ tests/testthat/test-condition_add.R | 90 +++++++++++++-------------- tests/testthat/test-eval_conditions.R | 30 ++++----- tests/testthat/test-hardcode.R | 6 +- tests/testthat/test-mutate_cnd_df.R | 54 ++++++++-------- tests/testthat/test-pipe.R | 75 +++++++++++----------- vignettes/articles/cnd_df.Rmd | 10 +-- 12 files changed, 197 insertions(+), 177 deletions(-) diff --git a/R/cnd_df.R b/R/cnd_df.R index 11e5a076..ebd1dc3f 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -219,12 +219,12 @@ tbl_sum.cnd_df <- function(x, ...) { default_header <- NextMethod() tally <- get_cnd_df_cnd_sum(x) - h2 <- sprintf("%d/%d/%d", tally[1], tally[2], tally[3]) + h2 <- sprintf("%d/%d/%d", tally[1L], tally[2L], tally[3L]) c(default_header, "Cond. tbl" = h2) } lgl_to_chr <- function(x) { - ifelse(is.na(x), "-", ifelse(x, "T", "F")) + dplyr::case_match(x, TRUE ~ "T", FALSE ~ "F", NA ~ "-") } #' Conditioned tibble pillar print method @@ -242,8 +242,8 @@ ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { i <- sprintf("%d", idx) i_width <- nchar(as.character(i)) i_max_width <- max(i_width) - max_width <- i_max_width + 2 - ws <- strrep(" ", max_width - i_width - 1) + max_width <- i_max_width + 2L + ws <- strrep(" ", max_width - i_width - 1L) abb_lgl <- lgl_to_chr(attr(controller, "cnd")[idx]) row_ids <- paste0(i, ws, abb_lgl) @@ -392,6 +392,15 @@ condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { #' @param .after Control where new columns should appear, i.e. after which #' columns. #' +#' @examples +#' df <- tibble::tibble(x = 1L:3L, y = letters[x]) +#' cnd_df <- condition_add(df, x > 1L, y %in% c("a", "b")) +#' +#' # Because `cnd_df` is a conditioned data frame, dplyr::mutate() generic +#' # dispatches this S3 method and mutates only the second row, as that is the +#' # only record that fulfills simultaneously `x > 1L` and `y %in% c("a", "b")`. +#' dplyr::mutate(cnd_df, z = "match") +#' #' @inheritParams dplyr::mutate #' @importFrom dplyr mutate #' @export @@ -409,13 +418,13 @@ mutate.cnd_df <- function(.data, rlang::abort("`.before` is not supported on conditioned data frames, use `.after` instead.") } - cnd <- get_cnd_df_cnd(.data) + cnd <- get_cnd_df_cnd(.data) # nolint object_name_linter() dat <- rm_cnd_df(.data) # avoids recursive S3 method dispatch. derivations <- rlang::enquos(...) derived_vars <- names(derivations) - lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else({{ cnd }}, !!.x, NA))) + lst <- purrr::map(derivations, ~ rlang::expr(dplyr::if_else(!!cnd, !!.x, NA))) lst <- rlang::set_names(lst, derived_vars) dplyr::mutate(dat, !!!lst, .by = NULL, .keep = .keep, .after = .after) diff --git a/man/dot_pipe.Rd b/man/dot_pipe.Rd index c4c52fe7..8c933c82 100644 --- a/man/dot_pipe.Rd +++ b/man/dot_pipe.Rd @@ -55,7 +55,7 @@ right-hand side (\code{rhs}). } \examples{ -iris \%.>\% subset(., 1:nrow(.) \%\% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) \%\% 2 == 0) -1:10 \%.>\% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) +iris \%.>\% subset(., 1:nrow(.) \%\% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) \%\% 2 == 0) +1:10 \%.>\% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) } diff --git a/man/mutate.cnd_df.Rd b/man/mutate.cnd_df.Rd index de6ec25a..29b1d4fc 100644 --- a/man/mutate.cnd_df.Rd +++ b/man/mutate.cnd_df.Rd @@ -55,3 +55,13 @@ generic on conditioned data frames. This function implements a conditional mutate by only changing rows for which the condition stored in the conditioned data frame is \code{TRUE}. } +\examples{ +df <- tibble::tibble(x = 1L:3L, y = letters[x]) +cnd_df <- condition_add(df, x > 1L, y \%in\% c("a", "b")) + +# Because `cnd_df` is a conditioned data frame, dplyr::mutate() generic +# dispatches this S3 method and mutates only the second row, as that is the +# only record that fulfills simultaneously `x > 1L` and `y \%in\% c("a", "b")`. +dplyr::mutate(cnd_df, z = "match") + +} diff --git a/tests/testthat/test-assign.R b/tests/testthat/test-assign.R index a97ea9a2..0ac42317 100644 --- a/tests/testthat/test-assign.R +++ b/tests/testthat/test-assign.R @@ -1,15 +1,15 @@ test_that("assign_ct works as expected with a conditioned `tgt_dat`", { vs_raw_dat <- tibble::tibble( - oak_id = 1:5, + oak_id = 1L:5L, raw_source = c("VS1", "VS2", "VS3", "VS4", "VS5"), patient_number = c(101L, 102L, 103L, 104L, 105L), TEMPLOC = c("Oral", "Axillary", "Rectal", "Tympanic", "Temporal") ) vs_tgt_dat <- tibble::tibble( - oak_id = as.integer(rep(1:5, each = 4)), - raw_source = rep(c("VS1", "VS2", "VS3", "VS4", "VS5"), each = 4), - patient_number = as.integer(rep(c(101L, 102L, 103L, 104L, 105L), each = 4)), + oak_id = as.integer(rep(1L:5L, each = 4L)), + raw_source = rep(c("VS1", "VS2", "VS3", "VS4", "VS5"), each = 4L), + patient_number = as.integer(rep(c(101L, 102L, 103L, 104L, 105L), each = 4L)), VSTESTCD = c( "TEMP", "BPSYS", "BPDIAS", "HR", "TEMP", "BPSYS", "BPDIAS", "HR", @@ -64,7 +64,7 @@ test_that("assign_ct works as expected with a conditioned `tgt_dat`", { VSLOC = vs_loc_tgt ) - expect_equal(result, expected_result) + expect_identical(result, expected_result) }) @@ -79,17 +79,17 @@ test_that("assign_ct works as expected with both `raw_dat` and `tgt_dat` as cond ) fa_raw_dat <- tibble::tibble( - oak_id = as.integer(1:5), + oak_id = as.integer(1L:5L), raw_source = c("FA1", "FA2", "FA3", "FA4", "FA5"), - patient_number = 101:105, + patient_number = 101L:105L, SPCNM = c("Nasopharyngeal Swab", "Blood", "Saliva", "Urine", "Tissue"), SPECTYP = c(NA, NA, "Swab", NA, NA) ) fa_tgt_dat <- tibble::tibble( - oak_id = 1:5, + oak_id = 1L:5L, raw_source = c("FA1", "FA2", "FA3", "FA4", "FA5"), - patient_number = 101:105, + patient_number = 101L:105L, FATESTCD = c("STATUS", "OTHER", "STATUS", "STATUS", "OTHER"), FAOBJ = c( "Severe Acute Resp Syndrome Coronavirus 2", @@ -118,21 +118,21 @@ test_that("assign_ct works as expected with both `raw_dat` and `tgt_dat` as cond fa_tgt_dat |> tibble::add_column(FASPEC = c("SWABBED MATERIAL", NA, NA, "URINE", NA)) - expect_equal(result, expected_result) + expect_identical(result, expected_result) }) test_that("assign_ct works as expected with conditions across both data sets", { cm_raw_dat <- tibble::tibble( - oak_id = 1:5, - raw_source = paste0("MD", 1:5), - patient_number = 101:105, + oak_id = 1L:5L, + raw_source = paste0("MD", 1L:5L), + patient_number = 101L:105L, CMMODIFY = c("ASPIRIN EC", "IBUPROFEN LYSINE", "PARACETAMOL", "DICLOFENAC", "NAPROXEN") ) cm_tgt_dat <- tibble::tibble( - oak_id = 1:5, - raw_source = paste0("MD", 1:5), - patient_number = 101:105, + oak_id = 1L:5L, + raw_source = paste0("MD", 1L:5L), + patient_number = 101L:105L, CMTRT = c("ASPIRIN", "IBUPROFEN", "PARACETAMOL", "DICLOFENAC", "NAPROXEN") ) @@ -162,6 +162,6 @@ test_that("assign_ct works as expected with conditions across both data sets", { cm_tgt_dat |> tibble::add_column(CMMODIFY = c("ASPIRIN EC", "IBUPROFEN LYSINE", NA, NA, NA)) - expect_equal(result1, expected_result) - expect_equal(result2, expected_result) + expect_identical(result1, expected_result) + expect_identical(result2, expected_result) }) diff --git a/tests/testthat/test-assign_datetime.R b/tests/testthat/test-assign_datetime.R index 36879636..3e9a73bf 100644 --- a/tests/testthat/test-assign_datetime.R +++ b/tests/testthat/test-assign_datetime.R @@ -75,5 +75,5 @@ test_that("assign_datetime: date and time conversion", { dplyr::select(dplyr::all_of(c("oak_id", "raw_source", "patient_number"))) |> dplyr::bind_cols(tibble::tibble(CMSTDTC = cmstdtc)) - expect_equal(object = cm1, expected = expected) + expect_identical(object = cm1, expected = expected) }) diff --git a/tests/testthat/test-cnd_df.R b/tests/testthat/test-cnd_df.R index a2a818c2..1574c4e7 100644 --- a/tests/testthat/test-cnd_df.R +++ b/tests/testthat/test-cnd_df.R @@ -1,15 +1,15 @@ test_that("new_cnd_df creates conditioned data frame correctly", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, NA, TRUE) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) - expect_true(inherits(cnd_df, "cnd_df")) - expect_equal(attr(cnd_df, "cnd"), cnd) - expect_equal(attr(cnd_df, "cnd_sum"), c(n_true = 1, n_false = 1, n_na = 1)) + expect_s3_class(cnd_df, "cnd_df") + expect_identical(attr(cnd_df, "cnd"), cnd) + expect_identical(attr(cnd_df, "cnd_sum"), c(n_true = 1L, n_false = 1L, n_na = 1L)) }) test_that("new_cnd_df gives warning if dat is already cnd_df", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, NA, TRUE) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) @@ -17,14 +17,14 @@ test_that("new_cnd_df gives warning if dat is already cnd_df", { }) test_that("new_cnd_df errors when cnd length doesn't match dat rows", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, TRUE) expect_error(sdtm.oak:::new_cnd_df(dat = df, cnd = cnd)) }) test_that("is_cnd_df correctly identifies cnd_df class", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) expect_true(sdtm.oak:::is_cnd_df(cnd_df)) @@ -32,25 +32,25 @@ test_that("is_cnd_df correctly identifies cnd_df class", { }) test_that("get_cnd_df_cnd correctly extracts cnd attribute", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, NA, TRUE) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) - expect_equal(sdtm.oak:::get_cnd_df_cnd(cnd_df), cnd) + expect_identical(sdtm.oak:::get_cnd_df_cnd(cnd_df), cnd) expect_null(sdtm.oak:::get_cnd_df_cnd(df)) }) test_that("get_cnd_df_cnd_sum correctly extracts cnd_sum attribute", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, NA, TRUE) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) - expect_equal(sdtm.oak:::get_cnd_df_cnd_sum(cnd_df), c(n_true = 1, n_false = 1, n_na = 1)) + expect_identical(sdtm.oak:::get_cnd_df_cnd_sum(cnd_df), c(n_true = 1L, n_false = 1L, n_na = 1L)) expect_null(sdtm.oak:::get_cnd_df_cnd_sum(df)) }) test_that("rm_cnd_df correctly removes cnd_df class and attributes", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, NA, TRUE) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) un_cnd_df <- sdtm.oak:::rm_cnd_df(cnd_df) @@ -61,21 +61,21 @@ test_that("rm_cnd_df correctly removes cnd_df class and attributes", { }) test_that("tbl_sum.cnd_df adds conditioning summary to tibble header", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, NA, TRUE) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) sum_output <- tbl_sum(cnd_df) - expect_equal(sum_output["Cond. tbl"], c("Cond. tbl" = "1/1/1")) + expect_identical(sum_output["Cond. tbl"], c("Cond. tbl" = "1/1/1")) }) test_that("ctl_new_rowid_pillar.cnd_df customizes row IDs with condition", { - df <- tibble(x = 1:3, y = letters[1:3]) + df <- tibble(x = 1L:3L, y = letters[1L:3L]) cnd <- c(FALSE, NA, TRUE) cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = cnd) - rowid_pillar <- ctl_new_rowid_pillar(controller = cnd_df, x = cnd_df, width = 10) + rowid_pillar <- ctl_new_rowid_pillar(controller = cnd_df, x = cnd_df, width = 10L) - expect_true(inherits(rowid_pillar, "pillar")) - expect_equal(rowid_pillar$data[[1]]$row_ids, c("1 F", "2 -", "3 T")) + expect_s3_class(rowid_pillar, "pillar") + expect_identical(rowid_pillar$data[[1L]]$row_ids, c("1 F", "2 -", "3 T")) }) diff --git a/tests/testthat/test-condition_add.R b/tests/testthat/test-condition_add.R index 4e5f03f0..387d745a 100644 --- a/tests/testthat/test-condition_add.R +++ b/tests/testthat/test-condition_add.R @@ -1,86 +1,86 @@ test_that("condition_add tags records correctly with single condition", { - df <- tibble::tibble(x = 1:3, y = letters[1:3]) + df <- tibble::tibble(x = 1L:3L, y = letters[1L:3L]) - cnd_df <- condition_add(dat = df, x > 1) + cnd_df <- condition_add(dat = df, x > 1L) expect_true(is_cnd_df(cnd_df)) - expect_equal(get_cnd_df_cnd(cnd_df), c(FALSE, TRUE, TRUE)) - expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 2, n_false = 1, n_na = 0)) + expect_identical(get_cnd_df_cnd(cnd_df), c(FALSE, TRUE, TRUE)) + expect_identical(get_cnd_df_cnd_sum(cnd_df), c(n_true = 2L, n_false = 1L, n_na = 0L)) }) test_that("condition_add tags records correctly with multiple conditions", { - df <- tibble::tibble(x = 1:5, y = c(1.1, 2.2, 3.3, 4.4, 5.5), z = factor(letters[1:5])) + df <- tibble::tibble(x = 1L:5L, y = c(1.1, 2.2, 3.3, 4.4, 5.5), z = factor(letters[1L:5L])) - cnd_df <- condition_add(dat = df, x > 1 & y < 5) - cnd_df_multiple <- condition_add(dat = df, x > 1, y < 5) + cnd_df <- condition_add(dat = df, x > 1L & y < 5.0) + cnd_df_multiple <- condition_add(dat = df, x > 1L, y < 5.0) expect_true(is_cnd_df(cnd_df)) - expect_equal(get_cnd_df_cnd(cnd_df), c(FALSE, TRUE, TRUE, TRUE, FALSE)) - expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 3, n_false = 2, n_na = 0)) + expect_identical(get_cnd_df_cnd(cnd_df), c(FALSE, TRUE, TRUE, TRUE, FALSE)) + expect_identical(get_cnd_df_cnd_sum(cnd_df), c(n_true = 3L, n_false = 2L, n_na = 0L)) - expect_equal(get_cnd_df_cnd(cnd_df_multiple), c(FALSE, TRUE, TRUE, TRUE, FALSE)) - expect_equal(get_cnd_df_cnd_sum(cnd_df_multiple), c(n_true = 3, n_false = 2, n_na = 0)) + expect_identical(get_cnd_df_cnd(cnd_df_multiple), c(FALSE, TRUE, TRUE, TRUE, FALSE)) + expect_identical(get_cnd_df_cnd_sum(cnd_df_multiple), c(n_true = 3L, n_false = 2L, n_na = 0L)) }) test_that("condition_add handles different data types correctly", { - df <- tibble::tibble(x = 1:5, y = c(1.1, 2.2, 3.3, 4.4, 5.5), z = letters[1:5], w = factor(letters[1:5])) + df <- tibble::tibble(x = 1L:5L, y = c(1.1, 2.2, 3.3, 4.4, 5.5), z = letters[1L:5L], w = factor(letters[1L:5L])) - cnd_df <- condition_add(dat = df, x > 2 & y < 5 & z %in% c("c", "d", "e") & w %in% c("c", "d", "e")) + cnd_df <- condition_add(dat = df, x > 2L & y < 5.0 & z %in% c("c", "d", "e") & w %in% c("c", "d", "e")) expect_true(is_cnd_df(cnd_df)) - expect_equal(get_cnd_df_cnd(cnd_df), c(FALSE, FALSE, TRUE, TRUE, FALSE)) - expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 2, n_false = 3, n_na = 0)) + expect_identical(get_cnd_df_cnd(cnd_df), c(FALSE, FALSE, TRUE, TRUE, FALSE)) + expect_identical(get_cnd_df_cnd_sum(cnd_df), c(n_true = 2L, n_false = 3L, n_na = 0L)) }) test_that("condition_add does not care about conditions' arguments being named", { - df <- tibble::tibble(x = 1:5, y = c(1.1, 2.2, 3.3, 4.4, 5.5)) + df <- tibble::tibble(x = 1L:5L, y = c(1.1, 2.2, 3.3, 4.4, 5.5)) - cnd_df_named <- condition_add(dat = df, cond1 = x > 2, cond2 = y < 5) - cnd_df_unnamed <- condition_add(dat = df, x > 2, y < 5) + cnd_df_named <- condition_add(dat = df, cond1 = x > 2L, cond2 = y < 5.0) + cnd_df_unnamed <- condition_add(dat = df, x > 2L, y < 5.0) - expect_equal(cnd_df_named, cnd_df_unnamed) + expect_identical(cnd_df_named, cnd_df_unnamed) }) test_that("condition_add handles empty data frames", { - df <- tibble::tibble(x = integer(0), y = character(0)) + df <- tibble::tibble(x = integer(0L), y = character(0L)) - cnd_df <- condition_add(dat = df, x > 1) + cnd_df <- condition_add(dat = df, x > 1L) expect_true(is_cnd_df(cnd_df)) - expect_equal(nrow(cnd_df), 0) - expect_equal(get_cnd_df_cnd(cnd_df), logical(0)) - expect_equal(get_cnd_df_cnd_sum(cnd_df), c(n_true = 0, n_false = 0, n_na = 0)) + expect_identical(nrow(cnd_df), 0L) + expect_identical(get_cnd_df_cnd(cnd_df), logical(0L)) + expect_identical(get_cnd_df_cnd_sum(cnd_df), c(n_true = 0L, n_false = 0L, n_na = 0L)) }) test_that("condition_add gives warning if dat is already a conditioned data frame", { - df <- tibble::tibble(x = 1:3, y = letters[1:3]) + df <- tibble::tibble(x = 1L:3L, y = letters[1L:3L]) cnd_df <- new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) - expect_warning(condition_add(dat = cnd_df, x > 1), "The previous condition will be replaced by the new one.") + expect_warning(condition_add(dat = cnd_df, x > 1L), "The previous condition will be replaced by the new one.") }) test_that("`condition_add()`: `dat` variables take precedence over variables in `.dat2`", { - df <- tibble::tibble(x = 1:3, y = letters[1:3]) - .dat2_env <- rlang::env(x = 2) - .dat2_list <- list(x = 2) - .dat2_df <- tibble::tibble(x = 2) - - cnd_df_env <- condition_add(dat = df, x > 2, .dat2 = .dat2_env) - cnd_df_list <- condition_add(dat = df, x > 2, .dat2 = .dat2_list) - cnd_df_df <- condition_add(dat = df, x > 2, .dat2 = .dat2_df) - - expect_equal(get_cnd_df_cnd(cnd_df_env), c(FALSE, FALSE, TRUE)) - expect_equal(get_cnd_df_cnd(cnd_df_list), c(FALSE, FALSE, TRUE)) - expect_equal(get_cnd_df_cnd(cnd_df_df), c(FALSE, FALSE, TRUE)) + df <- tibble::tibble(x = 1L:3L, y = letters[1L:3L]) + .dat2_env <- rlang::env(x = 2L) + .dat2_list <- list(x = 2L) + .dat2_df <- tibble::tibble(x = 2L) + + cnd_df_env <- condition_add(dat = df, x > 2L, .dat2 = .dat2_env) + cnd_df_list <- condition_add(dat = df, x > 2L, .dat2 = .dat2_list) + cnd_df_df <- condition_add(dat = df, x > 2L, .dat2 = .dat2_df) + + expect_identical(get_cnd_df_cnd(cnd_df_env), c(FALSE, FALSE, TRUE)) + expect_identical(get_cnd_df_cnd(cnd_df_list), c(FALSE, FALSE, TRUE)) + expect_identical(get_cnd_df_cnd(cnd_df_df), c(FALSE, FALSE, TRUE)) }) test_that("condition_add handles .dat2 with additional variables", { - df <- tibble::tibble(x = 1:3, y = letters[1:3]) - .dat2_env <- rlang::env(z = 3, w = 1) - .dat2_list <- list(z = 3, w = 1) - .dat2_df <- tibble::tibble(z = 3, w = 1) + df <- tibble::tibble(x = 1L:3L, y = letters[1L:3L]) + .dat2_env <- rlang::env(z = 3L, w = 1L) + .dat2_list <- list(z = 3L, w = 1L) + .dat2_df <- tibble::tibble(z = 3L, w = 1L) cnd_df_env <- condition_add(dat = df, x > w & x < z, .dat2 = .dat2_env) cnd_df_list <- condition_add(dat = df, x > w & x < z, .dat2 = .dat2_list) cnd_df_df <- condition_add(dat = df, x > w & x < z, .dat2 = .dat2_df) - expect_equal(get_cnd_df_cnd(cnd_df_env), c(FALSE, TRUE, FALSE)) - expect_equal(get_cnd_df_cnd(cnd_df_list), c(FALSE, TRUE, FALSE)) - expect_equal(get_cnd_df_cnd(cnd_df_df), c(FALSE, TRUE, FALSE)) + expect_identical(get_cnd_df_cnd(cnd_df_env), c(FALSE, TRUE, FALSE)) + expect_identical(get_cnd_df_cnd(cnd_df_list), c(FALSE, TRUE, FALSE)) + expect_identical(get_cnd_df_cnd(cnd_df_df), c(FALSE, TRUE, FALSE)) }) diff --git a/tests/testthat/test-eval_conditions.R b/tests/testthat/test-eval_conditions.R index f63a023f..8cf0e4b2 100644 --- a/tests/testthat/test-eval_conditions.R +++ b/tests/testthat/test-eval_conditions.R @@ -1,51 +1,51 @@ test_that("`eval_conditions()` evaluates conditions correctly", { df <- tibble::tibble( - x = c(1, 2, NA_integer_, 4, 5), + x = c(1L, 2L, NA_integer_, 4L, 5L), y = c(TRUE, FALSE, TRUE, FALSE, TRUE), z = c("a", "b", "a", "b", "a") ) # Tag records for which `x` is greater than 2. - expect_equal( - sdtm.oak:::eval_conditions(df, x > 2), + expect_identical( + sdtm.oak:::eval_conditions(df, x > 2L), c(FALSE, FALSE, NA, TRUE, TRUE) ) # Tag records for which `x` is greater than 2 and `y` is TRUE. - expect_equal( - sdtm.oak:::eval_conditions(df, x > 2, y), + expect_identical( + sdtm.oak:::eval_conditions(df, x > 2L, y), c(FALSE, FALSE, NA, FALSE, TRUE) ) # Tag records for which `x` is greater than 2 and convert resulting NAs into FALSE. - expect_equal( - sdtm.oak:::eval_conditions(df, x > 2, .na = FALSE), + expect_identical( + sdtm.oak:::eval_conditions(df, x > 2L, .na = FALSE), c(FALSE, FALSE, FALSE, TRUE, TRUE) ) # Conditions may involve variables defined in the caller environment. - w <- 1 - expect_equal( + w <- 1L + expect_identical( sdtm.oak:::eval_conditions(df, x > w), c(FALSE, TRUE, NA, TRUE, TRUE) ) # Conditions may look into variables defined in other scopes (e.g., in # environments). - env <- rlang::env(w = 1) - expect_equal( + env <- rlang::env(w = 1L) + expect_identical( sdtm.oak:::eval_conditions(df, x > w, .env = env), c(FALSE, TRUE, NA, TRUE, TRUE) ) # Other scopes are not restricted to environments but lists and tibbles also # work as namespaces for look-up. - expect_equal( - sdtm.oak:::eval_conditions(df, x > w, .env = list(w = 3)), + expect_identical( + sdtm.oak:::eval_conditions(df, x > w, .env = list(w = 3L)), c(FALSE, FALSE, NA, TRUE, TRUE) ) - expect_equal( - sdtm.oak:::eval_conditions(df, x > w, .env = tibble::tibble(w = 4)), + expect_identical( + sdtm.oak:::eval_conditions(df, x > w, .env = tibble::tibble(w = 4L)), c(FALSE, FALSE, NA, FALSE, TRUE) ) }) diff --git a/tests/testthat/test-hardcode.R b/tests/testthat/test-hardcode.R index 059e5ab8..eb56cc7a 100644 --- a/tests/testthat/test-hardcode.R +++ b/tests/testthat/test-hardcode.R @@ -14,7 +14,7 @@ oe_inter <- tibble::tribble( 1L, "RS1", 101L, 3L, "RS2", 103L, 4L, "RS2", 104L, - 5L, "RS3", 105L, + 5L, "RS3", 105L ) test_that("hardcode_no_ct works as expected", { @@ -40,7 +40,7 @@ test_that("hardcode_no_ct works as expected", { 5L, "RS3", 105L, "Y" ) - expect_equal(result, expected_result) + expect_identical(result, expected_result) }) test_that("hardcode_ct works as expected", { @@ -77,5 +77,5 @@ test_that("hardcode_ct works as expected", { 5L, "RS3", 105L, NA_character_ ) - expect_equal(result, expected_result) + expect_identical(result, expected_result) }) diff --git a/tests/testthat/test-mutate_cnd_df.R b/tests/testthat/test-mutate_cnd_df.R index 8e3c1c06..fc4488bd 100644 --- a/tests/testthat/test-mutate_cnd_df.R +++ b/tests/testthat/test-mutate_cnd_df.R @@ -1,89 +1,89 @@ test_that("mutate.cnd_df correctly mutates conditioned data frame", { - df <- tibble::tibble(x = 1:3, y = letters[1:3]) + df <- tibble::tibble(x = 1L:3L, y = letters[1L:3L]) cnd_df <- new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) - mutated_df <- dplyr::mutate(cnd_df, z = x + 1) + mutated_df <- dplyr::mutate(cnd_df, z = x + 1L) expect_true("z" %in% colnames(mutated_df)) - expect_equal(mutated_df$z, c(NA, NA, 4)) + expect_identical(mutated_df$z, c(NA, NA, 4L)) }) test_that("mutate.cnd_df handles multiple mutations", { - df <- tibble::tibble(x = 1:3, y = 1:3) + df <- tibble::tibble(x = 1L:3L, y = 1L:3L) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) mutated_df <- dplyr::mutate(cnd_df, z = x + y, w = x * y) expect_true(all(c("z", "w") %in% colnames(mutated_df))) - expect_equal(mutated_df$z, c(2, NA, 6)) - expect_equal(mutated_df$w, c(1, NA, 9)) + expect_identical(mutated_df$z, c(2L, NA, 6L)) + expect_identical(mutated_df$w, c(1L, NA, 9L)) }) test_that("mutate.cnd_df retains original data for non-conditioned rows", { - df <- tibble::tibble(x = 1:4, y = 2:5) + df <- tibble::tibble(x = 1L:4L, y = 2L:5L) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE, NA)) mutated_df <- dplyr::mutate(cnd_df, z = x + y) - expect_equal(mutated_df$z, c(3, NA, 7, NA)) - expect_equal(mutated_df$x, df$x) - expect_equal(mutated_df$y, df$y) + expect_identical(mutated_df$z, c(3L, NA, 7L, NA)) + expect_identical(mutated_df$x, df$x) + expect_identical(mutated_df$y, df$y) }) test_that("mutate.cnd_df works with different data types", { - df <- tibble::tibble(x = 1:3, y = c(1.1, 2.2, 3.3), z = c("a", "b", "c")) + df <- tibble::tibble(x = 1L:3L, y = c(1.1, 2.2, 3.3), z = c("a", "b", "c")) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) mutated_df <- dplyr::mutate(cnd_df, w = x * y, v = paste0(z, x)) expect_true(all(c("w", "v") %in% colnames(mutated_df))) - expect_equal(mutated_df$w, c(1.1, NA, 9.9)) - expect_equal(mutated_df$v, c("a1", NA, "c3")) + expect_equal(mutated_df$w, c(1.1, NA, 9.9), tolerance = 0.0001) + expect_identical(mutated_df$v, c("a1", NA, "c3")) }) test_that("mutate.cnd_df handles empty data frames", { - df <- tibble::tibble(x = integer(0), y = integer(0)) - cnd_df <- new_cnd_df(dat = df, cnd = logical(0)) + df <- tibble::tibble(x = integer(0L), y = integer(0L)) + cnd_df <- new_cnd_df(dat = df, cnd = logical(0L)) mutated_df <- dplyr::mutate(cnd_df, z = x + y) - expect_equal(nrow(mutated_df), 0) + expect_identical(nrow(mutated_df), 0L) expect_true("z" %in% colnames(mutated_df)) - expect_equal(mutated_df$z, numeric(0)) + expect_identical(mutated_df$z, integer(0L)) }) test_that("mutate.cnd_df handles .keep parameter correctly", { - df <- tibble::tibble(x = 1:3, y = 1:3) + df <- tibble::tibble(x = 1L:3L, y = 1L:3L) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) mutated_df_all <- dplyr::mutate(cnd_df, z = x + y, .keep = "all") expect_true(all(c("x", "y", "z") %in% colnames(mutated_df_all))) - mutated_df_used <- dplyr::mutate(cnd_df, z = 2 * x, .keep = "used") + mutated_df_used <- dplyr::mutate(cnd_df, z = 2L * x, .keep = "used") expect_true(all(c("x", "z") %in% colnames(mutated_df_used))) - mutated_df_unused <- dplyr::mutate(cnd_df, z = 2 * x, .keep = "unused") + mutated_df_unused <- dplyr::mutate(cnd_df, z = 2L * x, .keep = "unused") expect_true(all(c("y", "z") %in% colnames(mutated_df_unused))) mutated_df_none <- dplyr::mutate(cnd_df, z = x + y, .keep = "none") - expect_true("z" == colnames(mutated_df_none)) + expect_identical(colnames(mutated_df_none), "z") expect_false(any(c("x", "y") %in% colnames(mutated_df_none))) }) test_that("mutate.cnd_df handles .after parameter correctly", { - df <- tibble::tibble(x = 1:3, y = 1:3) + df <- tibble::tibble(x = 1L:3L, y = 1L:3L) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) mutated_df_after <- dplyr::mutate(cnd_df, z = x + y, .after = "x") - expect_equal(colnames(mutated_df_after), c("x", "z", "y")) + expect_identical(colnames(mutated_df_after), c("x", "z", "y")) }) test_that("mutate.cnd_df works with named arguments", { - df <- tibble::tibble(x = 1:3, y = 1:3) + df <- tibble::tibble(x = 1L:3L, y = 1L:3L) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) mutated_df_named <- dplyr::mutate(cnd_df, new_col = x + y) expect_true("new_col" %in% colnames(mutated_df_named)) - expect_equal(mutated_df_named$new_col, c(2, NA, 6)) + expect_identical(mutated_df_named$new_col, c(2L, NA, 6L)) }) test_that("mutate.cnd_df errors when .by is used", { - df <- tibble::tibble(x = 1:3, y = 1:3) + df <- tibble::tibble(x = 1L:3L, y = 1L:3L) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) expect_error( @@ -93,7 +93,7 @@ test_that("mutate.cnd_df errors when .by is used", { }) test_that("mutate.cnd_df errors when .before is used", { - df <- tibble::tibble(x = 1:3, y = 1:3) + df <- tibble::tibble(x = 1L:3L, y = 1L:3L) cnd_df <- new_cnd_df(dat = df, cnd = c(TRUE, FALSE, TRUE)) expect_error( diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R index 14166007..70beaa8b 100644 --- a/tests/testthat/test-pipe.R +++ b/tests/testthat/test-pipe.R @@ -1,22 +1,22 @@ `%>%` <- magrittr::`%>%` test_that("Basic operations work correctly", { - expect_equal(5 %.>% (2 + .), 5 %>% + expect_identical(5L %.>% (2L + .), 5L %>% { - 2 + . + 2L + . }) - expect_equal("hello" %.>% toupper(.), "hello" %>% + expect_identical("hello" %.>% toupper(.), "hello" %>% { toupper(.) }) }) test_that("Nested operations work correctly", { - expect_equal(5 %.>% (2 + . + 3), 5 %>% + expect_identical(5L %.>% (2L + . + 3L), 5L %>% { - 2 + . + 3 + 2L + . + 3L }) - expect_equal("hello" %.>% paste(., "world"), "hello" %>% + expect_identical("hello" %.>% paste(., "world"), "hello" %>% { paste(., "world") }) @@ -24,105 +24,106 @@ test_that("Nested operations work correctly", { test_that("Piping with braces", { mtcars2 <- mtcars %.>% { - .$cyl <- .$cyl * 2 + .$cyl <- .$cyl * 2L . } - expect_equal(mtcars2$cyl, mtcars$cyl * 2) + expect_identical(mtcars2$cyl, mtcars$cyl * 2L) }) test_that("Dot used multiple times in rhs", { - expect_equal(5 %.>% (. * 2 + .), 5 %>% + expect_identical(5L %.>% (. * 2L + .), 5L %>% { - . * 2 + . + . * 2L + . }) - expect_equal("hello" %.>% paste(., toupper(.)), "hello" %>% + expect_identical("hello" %.>% paste(., toupper(.)), "hello" %>% { paste(., toupper(.)) }) }) test_that("Dot used in nested functions", { - expect_equal(mtcars %.>% subset(., 1:nrow(.) %% 2 == 0), mtcars %>% + expect_identical(mtcars %.>% subset(., seq_len(nrow(.)) %% 2L == 0L), mtcars %>% { - subset(., 1:nrow(.) %% 2 == 0) + subset(., seq_len(nrow(.)) %% 2L == 0L) }) - expect_equal(1:10 %.>% c(min(.), max(.)), 1:10 %>% + expect_identical(1L:10L %.>% c(min(.), max(.)), 1L:10L %>% { c(min(.), max(.)) }) }) test_that("Error when dot is not used in rhs", { - expect_error(5 %.>% (2 + 2)) + expect_error(5L %.>% (2L + 2L)) expect_error("hello" %.>% toupper) }) test_that("Complex expressions work correctly", { - expect_equal(5 %.>% (2 + . + 3 + . * 2), 5 %>% + expect_identical(5L %.>% (2L + . + 3L + . * 2L), 5L %>% { - 2 + . + 3 + . * 2 + 2L + . + 3L + . * 2L }) - expect_equal(mtcars %.>% subset(., gear == 4 & mpg > mean(mpg)), mtcars %>% + expect_identical(mtcars %.>% subset(., gear == 4L & mpg > mean(mpg)), mtcars %>% { - subset(., gear == 4 & mpg > mean(mpg)) + subset(., gear == 4L & mpg > mean(mpg)) }) - expect_equal(mtcars %.>% subset(., cyl == 6) %.>% nrow(.), mtcars %>% + expect_identical(mtcars %.>% subset(., cyl == 6L) %.>% nrow(.), mtcars %>% { - subset(., cyl == 6) - } %>% nrow()) + subset(., cyl == 6L) + } %>% + nrow()) }) test_that("Functions returning functions", { - expect_equal(1:5 %.>% (sapply(., function(x) x * 2)), 1:5 %>% + expect_identical(1L:5L %.>% (sapply(., function(x) x * 2L)), 1L:5L %>% { - sapply(., function(x) x * 2) + sapply(., function(x) x * 2L) }) - expect_equal(mtcars %.>% (apply(., 2, function(x) mean(x))), mtcars %>% + expect_identical(mtcars %.>% (apply(., 2L, function(x) mean(x))), mtcars %>% { - apply(., 2, function(x) mean(x)) + apply(., 2L, function(x) mean(x)) }) }) test_that("Dot used in custom functions", { custom_function <- function(x) { - x + 1 + x + 1L } - expect_equal(5 %.>% custom_function(.), 5 %>% + expect_identical(5L %.>% custom_function(.), 5L %>% { custom_function(.) }) - expect_equal(mtcars %.>% head(.), mtcars %>% + expect_identical(mtcars %.>% head(.), mtcars %>% { head(.) }) }) test_that("Anonymous functions with \\(x)", { - expect_equal(1:5 %.>% (purrr::map(., \(x) x * 2)), 1:5 %>% + expect_identical(1L:5L %.>% (purrr::map(., \(x) x * 2L)), 1L:5L %>% { - purrr::map(., \(x) x * 2) + purrr::map(., \(x) x * 2L) }) }) test_that("Anonymous functions with function(x)", { - expect_equal(1:5 %.>% (purrr::map(., function(x) x * 2)), 1:5 %>% + expect_identical(1L:5L %.>% (purrr::map(., function(x) x * 2L)), 1L:5L %>% { - purrr::map(., function(x) x * 2) + purrr::map(., function(x) x * 2L) }) }) test_that("Piping with environment-dependent functions", { env <- environment() - "x" %.>% assign(x = ., 100, envir = env) - expect_equal(x, 100) + "x" %.>% assign(x = ., 100L, envir = env) + expect_identical(x, 100L) }) test_that("`.` is restored", { - 1 %.>% identity(.) + 1L %.>% identity(.) expect_error(., "not found") . <- "foo" - 1 %.>% identity(.) + 1L %.>% identity(.) expect_identical(., "foo") }) diff --git a/vignettes/articles/cnd_df.Rmd b/vignettes/articles/cnd_df.Rmd index 527de492..5f8ebdd5 100644 --- a/vignettes/articles/cnd_df.Rmd +++ b/vignettes/articles/cnd_df.Rmd @@ -26,13 +26,13 @@ A conditioned data frame is a regular data frame extended with a logical vector Consider a simple data frame `df`: ```{r} -(df <- tibble(x = 1:3, y = letters[1:3])) +(df <- tibble(x = 1L:3L, y = letters[1L:3L])) ``` We can create a conditioned data frame where only rows where `x > 1` are marked: ```{r} -(cnd_df <- condition_add(dat = df, x > 1)) +(cnd_df <- condition_add(dat = df, x > 1L)) ``` Here, only the second and third rows are marked as `TRUE`. @@ -54,10 +54,10 @@ Here is a simplified raw Concomitant Medications data set (`cm_raw`): ```{r} cm_raw <- tibble::tibble( - oak_id = 1:14, + oak_id = seq_len(14L), raw_source = "ConMed", - patient_number = c(375, 375, 376, 377, 377, 377, 377, 378, 378, 378, 378, 379, 379, 379), - MDNUM = c(1, 2, 1, 1, 2, 3, 5, 4, 1, 2, 3, 1, 2, 3), + patient_number = c(375L, 375L, 376L, 377L, 377L, 377L, 377L, 378L, 378L, 378L, 378L, 379L, 379L, 379L), + MDNUM = c(1L, 2L, 1L, 1L, 2L, 3L, 5L, 4L, 1L, 2L, 3L, 1L, 2L, 3L), MDRAW = c( "BABY ASPIRIN", "CORTISPORIN", "ASPIRIN", "DIPHENHYDRAMINE HCL", "PARCETEMOL", "VOMIKIND", From 173f02072924f2ec5eae9c81341a1c32fb85bd06 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Tue, 18 Jun 2024 01:50:16 +0100 Subject: [PATCH 08/12] Tidying up - No need for S3 methods to be exported - `condition_add()` now links to the appropriate article about conditioned data frames - Documentation tweaks - Version bump, NEWS update and pkgdown reference list update --- DESCRIPTION | 2 +- NAMESPACE | 3 --- NEWS.md | 8 ++++++++ R/cnd_df.R | 18 ++++++++++-------- _pkgdown.yml | 9 ++++++++- man/condition_add.Rd | 6 ++++-- man/ctl_new_rowid_pillar.cnd_df.Rd | 1 + man/mutate.cnd_df.Rd | 1 + man/tbl_sum.cnd_df.Rd | 7 ++++--- 9 files changed, 37 insertions(+), 18 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f226c172..ad2306b1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: sdtm.oak Type: Package Title: SDTM Data Transformation Engine -Version: 0.0.0.9003 +Version: 0.0.0.9004 Authors@R: c( person("Rammprasad", "Ganapathy", role = c("aut", "cre"), email = "ganapathy.rammprasad@gene.com"), diff --git a/NAMESPACE b/NAMESPACE index 52a3a2ae..a7890de0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,6 @@ # Generated by roxygen2: do not edit by hand -S3method(ctl_new_rowid_pillar,cnd_df) -S3method(mutate,cnd_df) S3method(print,iso8601) -S3method(tbl_sum,cnd_df) export("%.>%") export(assign_ct) export(assign_datetime) diff --git a/NEWS.md b/NEWS.md index 8db329a1..843a5f92 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +# sdtm.oak 0.0.0.9004 (development version) + +## New Features + +* New function for creating conditioned data frames: `condition_add()`. +* New pipe operator: `%.>%` for explicit dot placeholder placement. +* `oak_id_vars()` is now an exported function. + # sdtm.oak 0.0.0.9003 (development version) ## New Features diff --git a/R/cnd_df.R b/R/cnd_df.R index ebd1dc3f..70975042 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -210,11 +210,11 @@ rm_cnd_df <- function(dat) { #' @seealso [ctl_new_rowid_pillar.cnd_df()]. #' #' @examples -#' df <- data.frame(x = 1:3, y = letters[1:3]) -#' cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) -#' print(cnd_df) +#' df <- data.frame(x = c(1L, NA_integer_, 3L)) +#' (cnd_df <- condition_add(dat = df, x >= 2L)) +#' pillar::tbl_sum(cnd_df) #' -#' @export +#' @keywords internal tbl_sum.cnd_df <- function(x, ...) { default_header <- NextMethod() @@ -234,7 +234,7 @@ lgl_to_chr <- function(x) { #' #' @seealso [tbl_sum.cnd_df()]. #' -#' @export +#' @keywords internal ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { out <- NextMethod() n_row <- nrow(x) @@ -350,8 +350,10 @@ eval_conditions <- function(dat, #' Add filtering tags to a data set #' #' @description -#' This function tags records in a data set, indicating which rows match the -#' specified conditions, resulting in a conditioned data frame. +#' `condition_add()` tags records in a data set, indicating which rows match the +#' specified conditions, resulting in a conditioned data frame. Learn how to +#' integrate conditioned data frames in your SDTM domain derivation in +#' `vignette("cnd_df")`. #' #' @param dat A data frame. #' @param ... Conditions to filter the data frame. @@ -403,7 +405,7 @@ condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { #' #' @inheritParams dplyr::mutate #' @importFrom dplyr mutate -#' @export +#' @keywords internal mutate.cnd_df <- function(.data, ..., .by = NULL, diff --git a/_pkgdown.yml b/_pkgdown.yml index 13e86fbf..a234a916 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -9,12 +9,14 @@ navbar: reference: - title: SDTM derivation - desc: Set of functions to perform SDTM derivations + desc: Toolkit for SDTM derivations contents: - assign - harcode + - condition_add - derive_study_day - assign_datetime + - oak_id_vars - title: Controlled terminology contents: @@ -30,6 +32,11 @@ reference: - dtc_formats - problems +- title: Explicit dot pipe operator + desc: A simple alternative to `%>% {...}` + contents: + - "%.>%" + - title: Package global state contents: - clear_cache diff --git a/man/condition_add.Rd b/man/condition_add.Rd index bb6397e4..dafbcf2b 100644 --- a/man/condition_add.Rd +++ b/man/condition_add.Rd @@ -22,6 +22,8 @@ A conditioned data frame, meaning a tibble with an additional class \code{cnd_df} and a logical vector attribute indicating matching rows. } \description{ -This function tags records in a data set, indicating which rows match the -specified conditions, resulting in a conditioned data frame. +\code{condition_add()} tags records in a data set, indicating which rows match the +specified conditions, resulting in a conditioned data frame. Learn how to +integrate conditioned data frames in your SDTM domain derivation in +\code{vignette("cnd_df")}. } diff --git a/man/ctl_new_rowid_pillar.cnd_df.Rd b/man/ctl_new_rowid_pillar.cnd_df.Rd index eb469be6..2f574ec5 100644 --- a/man/ctl_new_rowid_pillar.cnd_df.Rd +++ b/man/ctl_new_rowid_pillar.cnd_df.Rd @@ -21,3 +21,4 @@ Conditioned tibble pillar print method \seealso{ \code{\link[=tbl_sum.cnd_df]{tbl_sum.cnd_df()}}. } +\keyword{internal} diff --git a/man/mutate.cnd_df.Rd b/man/mutate.cnd_df.Rd index 29b1d4fc..a11b38fd 100644 --- a/man/mutate.cnd_df.Rd +++ b/man/mutate.cnd_df.Rd @@ -65,3 +65,4 @@ cnd_df <- condition_add(df, x > 1L, y \%in\% c("a", "b")) dplyr::mutate(cnd_df, z = "match") } +\keyword{internal} diff --git a/man/tbl_sum.cnd_df.Rd b/man/tbl_sum.cnd_df.Rd index d2d6689d..d5424fca 100644 --- a/man/tbl_sum.cnd_df.Rd +++ b/man/tbl_sum.cnd_df.Rd @@ -18,11 +18,12 @@ in the header of a tibble that indicates the tibble is a conditioned tibble of TRUE, FALSE and NA values: e.g., \code{1/1/1}. } \examples{ -df <- data.frame(x = 1:3, y = letters[1:3]) -cnd_df <- sdtm.oak:::new_cnd_df(dat = df, cnd = c(FALSE, NA, TRUE)) -print(cnd_df) +df <- data.frame(x = c(1L, NA_integer_, 3L)) +(cnd_df <- condition_add(dat = df, x >= 2L)) +pillar::tbl_sum(cnd_df) } \seealso{ \code{\link[=ctl_new_rowid_pillar.cnd_df]{ctl_new_rowid_pillar.cnd_df()}}. } +\keyword{internal} From c8c581acd9730287a8a2419d1d0dec1cef01a804 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Tue, 18 Jun 2024 02:11:32 +0100 Subject: [PATCH 09/12] Last tweaks - Add example for `condition_add()` - Re-export S3 methods for `cnd_df` - Update pkgdown reference list --- NAMESPACE | 2 ++ R/cnd_df.R | 16 ++++++++++++++-- _pkgdown.yml | 8 +++++++- man/condition_add.Rd | 7 +++++++ man/ctl_new_rowid_pillar.cnd_df.Rd | 1 - man/tbl_sum.cnd_df.Rd | 1 - 6 files changed, 30 insertions(+), 5 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a7890de0..e4165596 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,8 @@ # Generated by roxygen2: do not edit by hand +S3method(ctl_new_rowid_pillar,cnd_df) S3method(print,iso8601) +S3method(tbl_sum,cnd_df) export("%.>%") export(assign_ct) export(assign_datetime) diff --git a/R/cnd_df.R b/R/cnd_df.R index 70975042..0d102a26 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -214,7 +214,7 @@ rm_cnd_df <- function(dat) { #' (cnd_df <- condition_add(dat = df, x >= 2L)) #' pillar::tbl_sum(cnd_df) #' -#' @keywords internal +#' @export tbl_sum.cnd_df <- function(x, ...) { default_header <- NextMethod() @@ -234,7 +234,7 @@ lgl_to_chr <- function(x) { #' #' @seealso [tbl_sum.cnd_df()]. #' -#' @keywords internal +#' @export ctl_new_rowid_pillar.cnd_df <- function(controller, x, width, ...) { out <- NextMethod() n_row <- nrow(x) @@ -365,8 +365,20 @@ eval_conditions <- function(dat, #' @returns A conditioned data frame, meaning a tibble with an additional class #' `cnd_df` and a logical vector attribute indicating matching rows. #' +#' @examples +#' (df <- tibble::tibble(x = 1L:3L, y = letters[x])) +#' +#' # Mark rows for which `x` greater than `1` +#' (cnd_df <- condition_add(dat = df, x > 1L)) +#' #' @export condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { + + admiraldev::assert_data_frame(dat) + # TODO: assertion for `...` (perhaps with admiraldev::assert_filter_cond()?) + # TODO: assertion for `.na` + # TODO: assertion for `.dat2` + if (is_cnd_df(dat)) { rlang::warn( c( diff --git a/_pkgdown.yml b/_pkgdown.yml index a234a916..eabcf0ab 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -13,11 +13,17 @@ reference: contents: - assign - harcode - - condition_add - derive_study_day - assign_datetime - oak_id_vars +- title: Conditioned data frames + desc: Functions for conditioned data frames (`cnd_df`) + contents: + - condition_add + - ctl_new_rowid_pillar.cnd_df + - tbl_sum.cnd_df + - title: Controlled terminology contents: - read_ct_spec diff --git a/man/condition_add.Rd b/man/condition_add.Rd index dafbcf2b..5640ab71 100644 --- a/man/condition_add.Rd +++ b/man/condition_add.Rd @@ -27,3 +27,10 @@ specified conditions, resulting in a conditioned data frame. Learn how to integrate conditioned data frames in your SDTM domain derivation in \code{vignette("cnd_df")}. } +\examples{ +(df <- tibble::tibble(x = 1L:3L, y = letters[x])) + +# Mark rows for which `x` greater than `1` +(cnd_df <- condition_add(dat = df, x > 1L)) + +} diff --git a/man/ctl_new_rowid_pillar.cnd_df.Rd b/man/ctl_new_rowid_pillar.cnd_df.Rd index 2f574ec5..eb469be6 100644 --- a/man/ctl_new_rowid_pillar.cnd_df.Rd +++ b/man/ctl_new_rowid_pillar.cnd_df.Rd @@ -21,4 +21,3 @@ Conditioned tibble pillar print method \seealso{ \code{\link[=tbl_sum.cnd_df]{tbl_sum.cnd_df()}}. } -\keyword{internal} diff --git a/man/tbl_sum.cnd_df.Rd b/man/tbl_sum.cnd_df.Rd index d5424fca..ad009f66 100644 --- a/man/tbl_sum.cnd_df.Rd +++ b/man/tbl_sum.cnd_df.Rd @@ -26,4 +26,3 @@ pillar::tbl_sum(cnd_df) \seealso{ \code{\link[=ctl_new_rowid_pillar.cnd_df]{ctl_new_rowid_pillar.cnd_df()}}. } -\keyword{internal} From 4350a381e44239d8d585aa99a360d62507468b06 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Tue, 18 Jun 2024 02:32:54 +0100 Subject: [PATCH 10/12] Remove blank line --- R/cnd_df.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/cnd_df.R b/R/cnd_df.R index 0d102a26..9d3dedb9 100644 --- a/R/cnd_df.R +++ b/R/cnd_df.R @@ -373,7 +373,6 @@ eval_conditions <- function(dat, #' #' @export condition_add <- function(dat, ..., .na = NA, .dat2 = rlang::env()) { - admiraldev::assert_data_frame(dat) # TODO: assertion for `...` (perhaps with admiraldev::assert_filter_cond()?) # TODO: assertion for `.na` From 8148500d942cd617232d6e7d127d3e8ec8432c30 Mon Sep 17 00:00:00 2001 From: Ramiro Magno Date: Tue, 18 Jun 2024 02:36:20 +0100 Subject: [PATCH 11/12] Tweaks to `%.>%` docs --- R/pipe.R | 9 ++++++--- man/dot_pipe.Rd | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/R/pipe.R b/R/pipe.R index ae8a99cc..ee5a561c 100644 --- a/R/pipe.R +++ b/R/pipe.R @@ -30,7 +30,7 @@ #' ```r #' library(magrittr) #' -#' 1:10 %>% {c(min(.), max(.))} +#' 1:10 %>% { c(min(.), max(.)) } #' ``` #' #' can be written as: @@ -49,8 +49,11 @@ #' #' @examples #' -#' iris %.>% subset(., 1:nrow(.) %% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) %% 2 == 0) -#' 1:10 %.>% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) +#' # Equivalent to `subset(head(iris), 1:nrow(head(iris)) %% 2 == 0)` +#' head(iris) %.>% subset(., 1:nrow(.) %% 2 == 0) +#' +#' # Equivalent to `c(min(1:10), max(1:10))` +#' 1:10 %.>% c(min(.), max(.)) #' #' @rdname dot_pipe #' @export diff --git a/man/dot_pipe.Rd b/man/dot_pipe.Rd index 8c933c82..716b9fee 100644 --- a/man/dot_pipe.Rd +++ b/man/dot_pipe.Rd @@ -37,7 +37,7 @@ braces: \if{html}{\out{
}}\preformatted{library(magrittr) -1:10 \%>\% \{c(min(.), max(.))\} +1:10 \%>\% \{ c(min(.), max(.)) \} }\if{html}{\out{
}} can be written as: @@ -55,7 +55,10 @@ right-hand side (\code{rhs}). } \examples{ -iris \%.>\% subset(., 1:nrow(.) \%\% 2 == 0) # Equivalent to subset(iris, 1:nrow(iris) \%\% 2 == 0) -1:10 \%.>\% c(min(.), max(.)) # Equivalent to c(min(1:10), max(1:10)) +# Equivalent to `subset(head(iris), 1:nrow(head(iris)) \%\% 2 == 0)` +head(iris) \%.>\% subset(., 1:nrow(.) \%\% 2 == 0) + +# Equivalent to `c(min(1:10), max(1:10))` +1:10 \%.>\% c(min(.), max(.)) } From d7352a5641923fd364047d25cd42524558fcbdcb Mon Sep 17 00:00:00 2001 From: ramiromagno Date: Tue, 18 Jun 2024 01:45:12 +0000 Subject: [PATCH 12/12] Automatic renv profile update. --- renv.lock | 1690 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1690 insertions(+) create mode 100644 renv.lock diff --git a/renv.lock b/renv.lock new file mode 100644 index 00000000..30fb9575 --- /dev/null +++ b/renv.lock @@ -0,0 +1,1690 @@ +{ + "R": { + "Version": "4.3.3", + "Repositories": [ + { + "Name": "CRAN", + "URL": "https://packagemanager.posit.co/cran/latest" + }, + { + "Name": "RSPM", + "URL": "https://packagemanager.posit.co/cran/2023-04-20" + } + ] + }, + "Packages": { + "R.cache": { + "Package": "R.cache", + "Version": "0.16.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "R.utils", + "digest", + "utils" + ], + "Hash": "fe539ca3f8efb7410c3ae2cf5fe6c0f8" + }, + "R.methodsS3": { + "Package": "R.methodsS3", + "Version": "1.8.2", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "utils" + ], + "Hash": "278c286fd6e9e75d0c2e8f731ea445c8" + }, + "R.oo": { + "Package": "R.oo", + "Version": "1.26.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.methodsS3", + "methods", + "utils" + ], + "Hash": "4fed809e53ddb5407b3da3d0f572e591" + }, + "R.utils": { + "Package": "R.utils", + "Version": "2.12.3", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "R.methodsS3", + "R.oo", + "methods", + "tools", + "utils" + ], + "Hash": "3dc2829b790254bfba21e60965787651" + }, + "R6": { + "Package": "R6", + "Version": "2.5.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "470851b6d5d0ac559e9d01bb352b4021" + }, + "Rcpp": { + "Package": "Rcpp", + "Version": "1.0.10", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "methods", + "utils" + ], + "Hash": "e749cae40fa9ef469b6050959517453c" + }, + "askpass": { + "Package": "askpass", + "Version": "1.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "sys" + ], + "Hash": "e8a22846fff485f0be3770c2da758713" + }, + "assertthat": { + "Package": "assertthat", + "Version": "0.2.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "tools" + ], + "Hash": "50c838a310445e954bc13f26f26a6ecf" + }, + "backports": { + "Package": "backports", + "Version": "1.4.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "c39fbec8a30d23e721980b8afb31984c" + }, + "base64enc": { + "Package": "base64enc", + "Version": "0.1-3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "543776ae6848fde2f48ff3816d0628bc" + }, + "bit": { + "Package": "bit", + "Version": "4.0.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "d242abec29412ce988848d0294b208fd" + }, + "bit64": { + "Package": "bit64", + "Version": "4.0.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "bit", + "methods", + "stats", + "utils" + ], + "Hash": "9fe98599ca456d6552421db0d6772d8f" + }, + "brew": { + "Package": "brew", + "Version": "1.0-8", + "Source": "Repository", + "Repository": "repos", + "Hash": "d69a786e85775b126bddbee185ae6084" + }, + "brio": { + "Package": "brio", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "repos", + "Hash": "976cf154dfb043c012d87cddd8bca363" + }, + "bslib": { + "Package": "bslib", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "base64enc", + "cachem", + "grDevices", + "htmltools", + "jquerylib", + "jsonlite", + "memoise", + "mime", + "rlang", + "sass" + ], + "Hash": "a7fbf03946ad741129dc81098722fca1" + }, + "cachem": { + "Package": "cachem", + "Version": "1.0.7", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "fastmap", + "rlang" + ], + "Hash": "cda74447c42f529de601fe4d4050daef" + }, + "callr": { + "Package": "callr", + "Version": "3.7.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "processx", + "utils" + ], + "Hash": "9b2191ede20fa29828139b9900922e51" + }, + "checkmate": { + "Package": "checkmate", + "Version": "2.1.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "backports", + "utils" + ], + "Hash": "147e4db6909d8814bb30f671b49d7e06" + }, + "cli": { + "Package": "cli", + "Version": "3.6.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "utils" + ], + "Hash": "89e6d8219950eac806ae0c489052048a" + }, + "clipr": { + "Package": "clipr", + "Version": "0.8.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "utils" + ], + "Hash": "3f038e5ac7f41d4ac41ce658c85e3042" + }, + "commonmark": { + "Package": "commonmark", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "repos", + "Hash": "d691c61bff84bd63c383874d2d0c3307" + }, + "cpp11": { + "Package": "cpp11", + "Version": "0.4.3", + "Source": "Repository", + "Repository": "repos", + "Hash": "ed588261931ee3be2c700d22e94a29ab" + }, + "crayon": { + "Package": "crayon", + "Version": "1.5.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "grDevices", + "methods", + "utils" + ], + "Hash": "e8a1e41acf02548751f45c718d55aa6a" + }, + "credentials": { + "Package": "credentials", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "askpass", + "curl", + "jsonlite", + "openssl", + "sys" + ], + "Hash": "93762d0a34d78e6a025efdbfb5c6bb41" + }, + "curl": { + "Package": "curl", + "Version": "5.0.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "e4f97056611e8e6b8b852d13b7400cf1" + }, + "desc": { + "Package": "desc", + "Version": "1.4.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "cli", + "rprojroot", + "utils" + ], + "Hash": "6b9602c7ebbe87101a9c8edb6e8b6d21" + }, + "devtools": { + "Package": "devtools", + "Version": "2.4.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "desc", + "ellipsis", + "fs", + "lifecycle", + "memoise", + "miniUI", + "pkgbuild", + "pkgdown", + "pkgload", + "profvis", + "rcmdcheck", + "remotes", + "rlang", + "roxygen2", + "rversions", + "sessioninfo", + "stats", + "testthat", + "tools", + "urlchecker", + "usethis", + "utils", + "withr" + ], + "Hash": "ea5bc8b4a6a01e4f12d98b58329930bb" + }, + "diffobj": { + "Package": "diffobj", + "Version": "0.3.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "crayon", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "bcaa8b95f8d7d01a5dedfd959ce88ab8" + }, + "digest": { + "Package": "digest", + "Version": "0.6.31", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "utils" + ], + "Hash": "8b708f296afd9ae69f450f9640be8990" + }, + "downlit": { + "Package": "downlit", + "Version": "0.4.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "brio", + "desc", + "digest", + "evaluate", + "fansi", + "memoise", + "rlang", + "vctrs", + "withr", + "yaml" + ], + "Hash": "79bf3f66590752ffbba20f8d2da94c7c" + }, + "dplyr": { + "Package": "dplyr", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "cli", + "generics", + "glue", + "lifecycle", + "magrittr", + "methods", + "pillar", + "rlang", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "eb5742d256a0d9306d85ea68756d8187" + }, + "ellipsis": { + "Package": "ellipsis", + "Version": "0.3.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "rlang" + ], + "Hash": "bb0eec2fe32e88d9e2836c2f73ea2077" + }, + "evaluate": { + "Package": "evaluate", + "Version": "0.20", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4b68aa51edd89a0e044a66e75ae3cc6c" + }, + "fansi": { + "Package": "fansi", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "grDevices", + "utils" + ], + "Hash": "1d9e7ad3c8312a192dea7d3db0274fde" + }, + "fastmap": { + "Package": "fastmap", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "repos", + "Hash": "f7736a18de97dea803bde0a2daaafb27" + }, + "fontawesome": { + "Package": "fontawesome", + "Version": "0.5.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "htmltools", + "rlang" + ], + "Hash": "1e22b8cabbad1eae951a75e9f8b52378" + }, + "fs": { + "Package": "fs", + "Version": "1.6.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "methods" + ], + "Hash": "f4dcd23b67e33d851d2079f703e8b985" + }, + "generics": { + "Package": "generics", + "Version": "0.1.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "methods" + ], + "Hash": "15e9634c0fcd294799e9b2e929ed1b86" + }, + "gert": { + "Package": "gert", + "Version": "1.9.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "askpass", + "credentials", + "openssl", + "rstudioapi", + "sys", + "zip" + ], + "Hash": "9122b3958e749badb5c939f498038b57" + }, + "gh": { + "Package": "gh", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "gitcreds", + "httr2", + "ini", + "jsonlite", + "rlang" + ], + "Hash": "03533b1c875028233598f848fda44c4c" + }, + "git2r": { + "Package": "git2r", + "Version": "0.32.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "graphics", + "utils" + ], + "Hash": "1882d7a76fd8c14b2322865f74c9a348" + }, + "gitcreds": { + "Package": "gitcreds", + "Version": "0.1.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "ab08ac61f3e1be454ae21911eb8bc2fe" + }, + "glue": { + "Package": "glue", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "methods" + ], + "Hash": "4f2596dfb05dac67b9dc558e5c6fba2e" + }, + "highr": { + "Package": "highr", + "Version": "0.10", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "xfun" + ], + "Hash": "06230136b2d2b9ba5805e1963fa6e890" + }, + "hms": { + "Package": "hms", + "Version": "1.1.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "lifecycle", + "methods", + "pkgconfig", + "rlang", + "vctrs" + ], + "Hash": "b59377caa7ed00fa41808342002138f9" + }, + "htmltools": { + "Package": "htmltools", + "Version": "0.5.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "base64enc", + "digest", + "ellipsis", + "fastmap", + "grDevices", + "rlang", + "utils" + ], + "Hash": "ba0240784ad50a62165058a27459304a" + }, + "htmlwidgets": { + "Package": "htmlwidgets", + "Version": "1.6.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "grDevices", + "htmltools", + "jsonlite", + "knitr", + "rmarkdown", + "yaml" + ], + "Hash": "a865aa85bcb2697f47505bfd70422471" + }, + "httpuv": { + "Package": "httpuv", + "Version": "1.6.9", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "Rcpp", + "later", + "promises", + "utils" + ], + "Hash": "1046aa31a57eae8b357267a56a0b6d8b" + }, + "httr": { + "Package": "httr", + "Version": "1.4.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "curl", + "jsonlite", + "mime", + "openssl" + ], + "Hash": "f6844033201269bec3ca0097bc6c97b3" + }, + "httr2": { + "Package": "httr2", + "Version": "0.2.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "cli", + "curl", + "glue", + "magrittr", + "openssl", + "rappdirs", + "rlang", + "withr" + ], + "Hash": "5c09fe33064978ede54de42309c8b532" + }, + "hunspell": { + "Package": "hunspell", + "Version": "3.0.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "Rcpp", + "digest" + ], + "Hash": "656219b6f3f605499d7cdbe208656639" + }, + "ini": { + "Package": "ini", + "Version": "0.3.1", + "Source": "Repository", + "Repository": "repos", + "Hash": "6154ec2223172bce8162d4153cda21f7" + }, + "jquerylib": { + "Package": "jquerylib", + "Version": "0.1.4", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "htmltools" + ], + "Hash": "5aab57a3bd297eee1c1d862735972182" + }, + "jsonlite": { + "Package": "jsonlite", + "Version": "1.8.4", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "methods" + ], + "Hash": "a4269a09a9b865579b2635c77e572374" + }, + "knitr": { + "Package": "knitr", + "Version": "1.42", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "evaluate", + "highr", + "methods", + "tools", + "xfun", + "yaml" + ], + "Hash": "8329a9bcc82943c8069104d4be3ee22d" + }, + "later": { + "Package": "later", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "Rcpp", + "rlang" + ], + "Hash": "7e7b457d7766bc47f2a5f21cc2984f8e" + }, + "lifecycle": { + "Package": "lifecycle", + "Version": "1.0.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "glue", + "rlang" + ], + "Hash": "001cecbeac1cff9301bdc3775ee46a86" + }, + "lubridate": { + "Package": "lubridate", + "Version": "1.9.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "generics", + "methods", + "timechange" + ], + "Hash": "e25f18436e3efd42c7c590a1c4c15390" + }, + "magrittr": { + "Package": "magrittr", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "7ce2733a9826b3aeb1775d56fd305472" + }, + "memoise": { + "Package": "memoise", + "Version": "2.0.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "cachem", + "rlang" + ], + "Hash": "e2817ccf4a065c5d9d7f2cfbe7c1d78c" + }, + "mime": { + "Package": "mime", + "Version": "0.12", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "tools" + ], + "Hash": "18e9c28c1d3ca1560ce30658b22ce104" + }, + "miniUI": { + "Package": "miniUI", + "Version": "0.1.1.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "htmltools", + "shiny", + "utils" + ], + "Hash": "fec5f52652d60615fdb3957b3d74324a" + }, + "openssl": { + "Package": "openssl", + "Version": "2.0.6", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "askpass" + ], + "Hash": "0f7cd2962e3044bb940cca4f4b5cecbe" + }, + "pillar": { + "Package": "pillar", + "Version": "1.9.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "cli", + "fansi", + "glue", + "lifecycle", + "rlang", + "utf8", + "utils", + "vctrs" + ], + "Hash": "15da5a8412f317beeee6175fbc76f4bb" + }, + "pkgbuild": { + "Package": "pkgbuild", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "callr", + "cli", + "crayon", + "desc", + "prettyunits", + "processx", + "rprojroot", + "withr" + ], + "Hash": "d6c3008d79653a0f267703288230105e" + }, + "pkgconfig": { + "Package": "pkgconfig", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "utils" + ], + "Hash": "01f28d4278f15c76cddbea05899c5d6f" + }, + "pkgdown": { + "Package": "pkgdown", + "Version": "2.0.7", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "bslib", + "callr", + "cli", + "desc", + "digest", + "downlit", + "fs", + "httr", + "jsonlite", + "magrittr", + "memoise", + "purrr", + "ragg", + "rlang", + "rmarkdown", + "tibble", + "whisker", + "withr", + "xml2", + "yaml" + ], + "Hash": "16fa15449c930bf3a7761d3c68f8abf9" + }, + "pkgload": { + "Package": "pkgload", + "Version": "1.3.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "crayon", + "desc", + "fs", + "glue", + "methods", + "rlang", + "rprojroot", + "utils", + "withr" + ], + "Hash": "6b0c222c5071efe0f3baf3dae9aa40e2" + }, + "praise": { + "Package": "praise", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "repos", + "Hash": "a555924add98c99d2f411e37e7d25e9f" + }, + "prettyunits": { + "Package": "prettyunits", + "Version": "1.1.1", + "Source": "Repository", + "Repository": "repos", + "Hash": "95ef9167b75dde9d2ccc3c7528393e7e" + }, + "processx": { + "Package": "processx", + "Version": "3.8.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "ps", + "utils" + ], + "Hash": "d75b4059d781336efba24021915902b4" + }, + "profvis": { + "Package": "profvis", + "Version": "0.3.7", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "htmlwidgets", + "stringr" + ], + "Hash": "e9d21e79848e02e524bea6f5bd53e7e4" + }, + "progress": { + "Package": "progress", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R6", + "crayon", + "hms", + "prettyunits" + ], + "Hash": "14dc9f7a3c91ebb14ec5bb9208a07061" + }, + "promises": { + "Package": "promises", + "Version": "1.2.0.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R6", + "Rcpp", + "later", + "magrittr", + "rlang", + "stats" + ], + "Hash": "4ab2c43adb4d4699cf3690acd378d75d" + }, + "ps": { + "Package": "ps", + "Version": "1.7.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "utils" + ], + "Hash": "709d852d33178db54b17c722e5b1e594" + }, + "purrr": { + "Package": "purrr", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "lifecycle", + "magrittr", + "rlang", + "vctrs" + ], + "Hash": "d71c815267c640f17ddbf7f16144b4bb" + }, + "ragg": { + "Package": "ragg", + "Version": "1.2.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "systemfonts", + "textshaping" + ], + "Hash": "690bc058ea2b1b8a407d3cfe3dce3ef9" + }, + "rappdirs": { + "Package": "rappdirs", + "Version": "0.3.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "5e3c5dc0b071b21fa128676560dbe94d" + }, + "rcmdcheck": { + "Package": "rcmdcheck", + "Version": "1.4.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R6", + "callr", + "cli", + "curl", + "desc", + "digest", + "pkgbuild", + "prettyunits", + "rprojroot", + "sessioninfo", + "utils", + "withr", + "xopen" + ], + "Hash": "8f25ebe2ec38b1f2aef3b0d2ef76f6c4" + }, + "readr": { + "Package": "readr", + "Version": "2.1.4", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "cli", + "clipr", + "cpp11", + "crayon", + "hms", + "lifecycle", + "methods", + "rlang", + "tibble", + "tzdb", + "utils", + "vroom" + ], + "Hash": "b5047343b3825f37ad9d3b5d89aa1078" + }, + "rematch2": { + "Package": "rematch2", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "tibble" + ], + "Hash": "76c9e04c712a05848ae7a23d2f170a40" + }, + "remotes": { + "Package": "remotes", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "R", + "methods", + "stats", + "tools", + "utils" + ], + "Hash": "3ee025083e66f18db6cf27b56e23e141" + }, + "renv": { + "Package": "renv", + "Version": "1.0.7", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "utils" + ], + "Hash": "397b7b2a265bc5a7a06852524dabae20" + }, + "rlang": { + "Package": "rlang", + "Version": "1.1.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "utils" + ], + "Hash": "dc079ccd156cde8647360f473c1fa718" + }, + "rmarkdown": { + "Package": "rmarkdown", + "Version": "2.21", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "bslib", + "evaluate", + "fontawesome", + "htmltools", + "jquerylib", + "jsonlite", + "knitr", + "methods", + "stringr", + "tinytex", + "tools", + "utils", + "xfun", + "yaml" + ], + "Hash": "493df4ae51e2e984952ea4d5c75786a3" + }, + "roxygen2": { + "Package": "roxygen2", + "Version": "7.3.1", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R6", + "brew", + "cli", + "commonmark", + "cpp11", + "desc", + "knitr", + "methods", + "pkgload", + "purrr", + "rlang", + "stringi", + "stringr", + "utils", + "withr", + "xml2" + ], + "Hash": "c25fe7b2d8cba73d1b63c947bf7afdb9" + }, + "rprojroot": { + "Package": "rprojroot", + "Version": "2.0.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "1de7ab598047a87bba48434ba35d497d" + }, + "rstudioapi": { + "Package": "rstudioapi", + "Version": "0.14", + "Source": "Repository", + "Repository": "repos", + "Hash": "690bd2acc42a9166ce34845884459320" + }, + "rversions": { + "Package": "rversions", + "Version": "2.1.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "curl", + "utils", + "xml2" + ], + "Hash": "a9881dfed103e83f9de151dc17002cd1" + }, + "sass": { + "Package": "sass", + "Version": "0.4.5", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R6", + "fs", + "htmltools", + "rappdirs", + "rlang" + ], + "Hash": "2bb4371a4c80115518261866eab6ab11" + }, + "sessioninfo": { + "Package": "sessioninfo", + "Version": "1.2.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "tools", + "utils" + ], + "Hash": "3f9796a8d0a0e8c6eb49a4b029359d1f" + }, + "shiny": { + "Package": "shiny", + "Version": "1.7.4", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "bslib", + "cachem", + "commonmark", + "crayon", + "ellipsis", + "fastmap", + "fontawesome", + "glue", + "grDevices", + "htmltools", + "httpuv", + "jsonlite", + "later", + "lifecycle", + "methods", + "mime", + "promises", + "rlang", + "sourcetools", + "tools", + "utils", + "withr", + "xtable" + ], + "Hash": "c2eae3d8c670fa9dfa35a12066f4a1d5" + }, + "sourcetools": { + "Package": "sourcetools", + "Version": "0.1.7-1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "5f5a7629f956619d519205ec475fe647" + }, + "spelling": { + "Package": "spelling", + "Version": "2.2.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "commonmark", + "hunspell", + "knitr", + "xml2" + ], + "Hash": "8ed9f010f7caeb8586523088b7f23dcd" + }, + "staged.dependencies": { + "Package": "staged.dependencies", + "Version": "0.3.1.9001", + "Source": "GitHub", + "RemoteType": "github", + "RemoteHost": "api.github.com", + "RemoteUsername": "openpharma", + "RemoteRepo": "staged.dependencies", + "RemoteRef": "main", + "RemoteSha": "fb124997306b35d44a0225bb4b400bf7258c4c75", + "Requirements": [ + "checkmate", + "desc", + "devtools", + "digest", + "dplyr", + "fs", + "git2r", + "glue", + "httr", + "jsonlite", + "methods", + "rcmdcheck", + "remotes", + "rlang", + "stats", + "tidyr", + "utils", + "withr", + "yaml" + ], + "Hash": "145e45afff215d85f808dda07557fcad" + }, + "stringi": { + "Package": "stringi", + "Version": "1.7.12", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "stats", + "tools", + "utils" + ], + "Hash": "ca8bd84263c77310739d2cf64d84d7c9" + }, + "stringr": { + "Package": "stringr", + "Version": "1.5.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "magrittr", + "rlang", + "stringi", + "vctrs" + ], + "Hash": "671a4d384ae9d32fc47a14e98bfa3dc8" + }, + "styler": { + "Package": "styler", + "Version": "1.10.2", + "Source": "Repository", + "Repository": "RSPM", + "Requirements": [ + "R", + "R.cache", + "cli", + "magrittr", + "purrr", + "rlang", + "rprojroot", + "tools", + "vctrs", + "withr" + ], + "Hash": "d61238fd44fc63c8adf4565efe8eb682" + }, + "sys": { + "Package": "sys", + "Version": "3.4.1", + "Source": "Repository", + "Repository": "repos", + "Hash": "34c16f1ef796057bfa06d3f4ff818a5d" + }, + "systemfonts": { + "Package": "systemfonts", + "Version": "1.0.4", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "90b28393209827327de889f49935140a" + }, + "testthat": { + "Package": "testthat", + "Version": "3.1.7", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "R6", + "brio", + "callr", + "cli", + "desc", + "digest", + "ellipsis", + "evaluate", + "jsonlite", + "lifecycle", + "magrittr", + "methods", + "pkgload", + "praise", + "processx", + "ps", + "rlang", + "utils", + "waldo", + "withr" + ], + "Hash": "7eb5fd202a61d2fb78af5869b6c08998" + }, + "textshaping": { + "Package": "textshaping", + "Version": "0.3.6", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cpp11", + "systemfonts" + ], + "Hash": "1ab6223d3670fac7143202cb6a2d43d5" + }, + "tibble": { + "Package": "tibble", + "Version": "3.2.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "fansi", + "lifecycle", + "magrittr", + "methods", + "pillar", + "pkgconfig", + "rlang", + "utils", + "vctrs" + ], + "Hash": "a84e2cc86d07289b3b6f5069df7a004c" + }, + "tidyr": { + "Package": "tidyr", + "Version": "1.3.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "cpp11", + "dplyr", + "glue", + "lifecycle", + "magrittr", + "purrr", + "rlang", + "stringr", + "tibble", + "tidyselect", + "utils", + "vctrs" + ], + "Hash": "e47debdc7ce599b070c8e78e8ac0cfcf" + }, + "tidyselect": { + "Package": "tidyselect", + "Version": "1.2.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang", + "vctrs", + "withr" + ], + "Hash": "79540e5fcd9e0435af547d885f184fd5" + }, + "timechange": { + "Package": "timechange", + "Version": "0.2.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "8548b44f79a35ba1791308b61e6012d7" + }, + "tinytex": { + "Package": "tinytex", + "Version": "0.45", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "xfun" + ], + "Hash": "e4e357f28c2edff493936b6cb30c3d65" + }, + "tzdb": { + "Package": "tzdb", + "Version": "0.3.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cpp11" + ], + "Hash": "b2e1cbce7c903eaf23ec05c58e59fb5e" + }, + "urlchecker": { + "Package": "urlchecker", + "Version": "1.0.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "curl", + "tools", + "xml2" + ], + "Hash": "409328b8e1253c8d729a7836fe7f7a16" + }, + "usethis": { + "Package": "usethis", + "Version": "2.1.6", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "clipr", + "crayon", + "curl", + "desc", + "fs", + "gert", + "gh", + "glue", + "jsonlite", + "lifecycle", + "purrr", + "rappdirs", + "rlang", + "rprojroot", + "rstudioapi", + "stats", + "utils", + "whisker", + "withr", + "yaml" + ], + "Hash": "a67a22c201832b12c036cc059f1d137d" + }, + "utf8": { + "Package": "utf8", + "Version": "1.2.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R" + ], + "Hash": "1fe17157424bb09c48a8b3b550c753bc" + }, + "vctrs": { + "Package": "vctrs", + "Version": "0.6.2", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "cli", + "glue", + "lifecycle", + "rlang" + ], + "Hash": "a745bda7aff4734c17294bb41d4e4607" + }, + "vroom": { + "Package": "vroom", + "Version": "1.6.1", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "bit64", + "cli", + "cpp11", + "crayon", + "glue", + "hms", + "lifecycle", + "methods", + "progress", + "rlang", + "stats", + "tibble", + "tidyselect", + "tzdb", + "vctrs", + "withr" + ], + "Hash": "7015a74373b83ffaef64023f4a0f5033" + }, + "waldo": { + "Package": "waldo", + "Version": "0.4.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "cli", + "diffobj", + "fansi", + "glue", + "methods", + "rematch2", + "rlang", + "tibble" + ], + "Hash": "035fba89d0c86e2113120f93301b98ad" + }, + "whisker": { + "Package": "whisker", + "Version": "0.4.1", + "Source": "Repository", + "Repository": "repos", + "Hash": "c6abfa47a46d281a7d5159d0a8891e88" + }, + "withr": { + "Package": "withr", + "Version": "2.5.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "grDevices", + "graphics", + "stats" + ], + "Hash": "c0e49a9760983e81e55cdd9be92e7182" + }, + "xfun": { + "Package": "xfun", + "Version": "0.38", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "stats", + "tools" + ], + "Hash": "1ed71215d45e85562d3b1b29a068ccec" + }, + "xml2": { + "Package": "xml2", + "Version": "1.3.3", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "methods" + ], + "Hash": "40682ed6a969ea5abfd351eb67833adc" + }, + "xopen": { + "Package": "xopen", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "processx" + ], + "Hash": "6c85f015dee9cc7710ddd20f86881f58" + }, + "xtable": { + "Package": "xtable", + "Version": "1.8-4", + "Source": "Repository", + "Repository": "repos", + "Requirements": [ + "R", + "stats", + "utils" + ], + "Hash": "b8acdf8af494d9ec19ccb2481a9b11c2" + }, + "yaml": { + "Package": "yaml", + "Version": "2.3.7", + "Source": "Repository", + "Repository": "repos", + "Hash": "0d0056cc5383fbc240ccd0cb584bf436" + }, + "zip": { + "Package": "zip", + "Version": "2.3.0", + "Source": "Repository", + "Repository": "repos", + "Hash": "d98c94dacb7e0efcf83b0a133a705504" + } + } +}