Skip to content

Commit

Permalink
Fix pipeline failures
Browse files Browse the repository at this point in the history
  • Loading branch information
rammprasad committed Jun 18, 2024
1 parent 2b1a9c0 commit 1332197
Show file tree
Hide file tree
Showing 4 changed files with 15 additions and 23 deletions.
17 changes: 9 additions & 8 deletions R/derive_blfl.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 "<unspecified>" for processing
if (!"VISIT" %in% names(ds_mod)) {
ds_mod[["VISIT"]] <- "<unspecified>" # nolint object_name_linter()
ds_mod[["VISIT"]] <- "<unspecified>"
}

# If --TPT not in data frame then assign it as "<unspecified>" for processing
Expand Down Expand Up @@ -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."))
Expand All @@ -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",
Expand All @@ -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
Expand Down
2 changes: 2 additions & 0 deletions R/globals.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
utils::globalVariables(c("USUBJID", "VISIT", "dom_dt", "dom_tm", "ref_dt",
"ref_tm"))
2 changes: 2 additions & 0 deletions man/derive_blfl.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

17 changes: 2 additions & 15 deletions tests/testthat/test-derive_blfl.R
Original file line number Diff line number Diff line change
@@ -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",
Expand All @@ -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,
Expand All @@ -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)
Expand All @@ -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,
Expand All @@ -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 |>
Expand All @@ -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,
Expand All @@ -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 |>
Expand Down

0 comments on commit 1332197

Please sign in to comment.