From 13321977cde93789f2ed7b309b4cad579933024d Mon Sep 17 00:00:00 2001 From: Rammprasad Ganapathy Date: Tue, 18 Jun 2024 22:58:05 +0000 Subject: [PATCH] Fix pipeline failures --- R/derive_blfl.R | 17 +++++++++-------- R/globals.R | 2 ++ man/derive_blfl.Rd | 2 ++ tests/testthat/test-derive_blfl.R | 17 ++--------------- 4 files changed, 15 insertions(+), 23 deletions(-) create mode 100644 R/globals.R diff --git a/R/derive_blfl.R b/R/derive_blfl.R index 94d2ca6d..c801a6d5 100644 --- a/R/derive_blfl.R +++ b/R/derive_blfl.R @@ -142,6 +142,7 @@ dtc_timepart <- function(dtc, partial_as_na = TRUE, ignore_seconds = TRUE) { #' - Join the baseline flag onto the input dataset based on oak id vars #' #' @param sdtm_in Input SDTM domain. +#' @param dm_domain DM domain with the reference varaible `ref_var` #' @param tgt_var Name of variable to be derived (`--BLFL` or #' `--LOBXFL` where `--` is domain). #' @param ref_var vector of a date/time from the @@ -413,15 +414,15 @@ derive_blfl <- function(sdtm_in, # Split --DTC and ref_var into date and time parts # (partial or missing dates and times set to NA) - ds_mod$dom_dt <- dtc_datepart(ds_mod[[domain_prefixed_names["dtc"]]]) # nolint object_name_linter() - ds_mod$dom_tm <- dtc_timepart(ds_mod[[domain_prefixed_names["dtc"]]]) # nolint object_name_linter() - ds_mod$ref_dt <- dtc_datepart(ds_mod[[ref_var]]) # nolint object_name_linter() - ds_mod$ref_tm <- dtc_timepart(ds_mod[[ref_var]]) # nolint object_name_linter() + ds_mod$dom_dt <- dtc_datepart(ds_mod[[domain_prefixed_names["dtc"]]]) + ds_mod$dom_tm <- dtc_timepart(ds_mod[[domain_prefixed_names["dtc"]]]) + ds_mod$ref_dt <- dtc_datepart(ds_mod[[ref_var]]) + ds_mod$ref_tm <- dtc_timepart(ds_mod[[ref_var]]) # If VISIT not in data frame then assign it as "" for processing if (!"VISIT" %in% names(ds_mod)) { - ds_mod[["VISIT"]] <- "" # nolint object_name_linter() + ds_mod[["VISIT"]] <- "" } # If --TPT not in data frame then assign it as "" for processing @@ -465,7 +466,7 @@ derive_blfl <- function(sdtm_in, ds_base <- rbind(ds_subset_lt, ds_subset_eq_1, ds_subset_eq_2) # Sort the rows in ascending order with respect to columns from con_col - ds_base <- dplyr::arrange_at(ds_base, c("USUBJID", con_col)) # nolint object_name_linter() + ds_base <- dplyr::arrange_at(ds_base, c("USUBJID", con_col)) if (nrow(ds_base) == 0L) { message(paste0("There are no baseline records.")) @@ -480,7 +481,7 @@ derive_blfl <- function(sdtm_in, dplyr::slice_max(!!rlang::sym(domain_prefixed_names["dtc"]), na_rm = TRUE) |> dplyr::ungroup() |> dplyr::select( - dplyr::all_of(c(sdtm.oak:::oak_id_vars(), domain_prefixed_names[["testcd"]])), + dplyr::all_of(c(sdtm.oak::oak_id_vars(), domain_prefixed_names[["testcd"]])), dplyr::any_of( c(domain_prefixed_names[c( "cat", @@ -501,7 +502,7 @@ derive_blfl <- function(sdtm_in, # Join baseline flag onto input dataset ds_out <- dplyr::left_join(sdtm_in, ds_blfl, by = c( domain_prefixed_names[["testcd"]], - sdtm.oak:::oak_id_vars() + sdtm.oak::oak_id_vars() )) # Assert that merged data frame has same number of rows as input data frame diff --git a/R/globals.R b/R/globals.R new file mode 100644 index 00000000..30e021b3 --- /dev/null +++ b/R/globals.R @@ -0,0 +1,2 @@ +utils::globalVariables(c("USUBJID", "VISIT", "dom_dt", "dom_tm", "ref_dt", + "ref_tm")) diff --git a/man/derive_blfl.Rd b/man/derive_blfl.Rd index 50af8410..b58dc5c7 100644 --- a/man/derive_blfl.Rd +++ b/man/derive_blfl.Rd @@ -16,6 +16,8 @@ derive_blfl( \arguments{ \item{sdtm_in}{Input SDTM domain.} +\item{dm_domain}{DM domain with the reference varaible \code{ref_var}} + \item{tgt_var}{Name of variable to be derived (\code{--BLFL} or \code{--LOBXFL} where \verb{--} is domain).} diff --git a/tests/testthat/test-derive_blfl.R b/tests/testthat/test-derive_blfl.R index 468424b7..f58da69d 100644 --- a/tests/testthat/test-derive_blfl.R +++ b/tests/testthat/test-derive_blfl.R @@ -1,4 +1,3 @@ -dta <- function(env = parent.frame()) { dm <- tibble::tribble( ~USUBJID, ~RFSTDTC, ~RFXSTDTC, "test_study-375", "2020-09-28T10:10", "2020-09-28T10:10", @@ -24,18 +23,10 @@ dta <- function(env = parent.frame()) { "VS", 3L, "VTLS1", 378L, "test_study-378", "2020-01-21T11:00", "PULSE", "105", NA, "SCREENING" ) - withr::defer( - { - rm(d, envir = env) - }, - envir = env - ) + d <- list(sdtm_in = sdtm_in, dm = dm) - list(sdtm_in = sdtm_in, dm = dm) -} test_that("derive_blfl example works", { - d <- dta() observed_output <- derive_blfl( sdtm_in = d$sdtm_in, @@ -50,7 +41,6 @@ test_that("derive_blfl example works", { }) test_that("derive_blfl sdmt_in validations work", { - d <- dta() sdmt_in_no_domain <- d$sdtm_in |> dplyr::select(-DOMAIN) @@ -64,7 +54,7 @@ test_that("derive_blfl sdmt_in validations work", { sdmt_in_no_id_vars <- d$sdtm_in |> - dplyr::select(-sdtm.oak:::oak_id_vars()) + dplyr::select(-sdtm.oak::oak_id_vars()) expect_snapshot_error(derive_blfl( sdtm_in = sdmt_in_no_id_vars, @@ -91,7 +81,6 @@ test_that("derive_blfl sdmt_in validations work", { }) test_that("derive_blfl dm_domain validations work", { - d <- dta() dm_no_vars <- d$dm |> @@ -106,7 +95,6 @@ test_that("derive_blfl dm_domain validations work", { }) test_that("derive_blfl tgt_var and ref_var validations work", { - d <- dta() expect_snapshot_error(derive_blfl( sdtm_in = d$sdtm_in, @@ -131,7 +119,6 @@ test_that("derive_blfl tgt_var and ref_var validations work", { }) test_that("derive_blfl DOMAIN validation works", { - d <- dta() sdtm_in_bad_domain <- d$sdtm_in |>