From 3d4715ade973a8b9513f7ef69928aba2be0a6193 Mon Sep 17 00:00:00 2001 From: Arjun Rubalingam <115066417+arjoon-r@users.noreply.github.com> Date: Wed, 31 Jul 2024 15:10:37 +0530 Subject: [PATCH 1/4] #246 removed metatools from imports but moved suggests --- DESCRIPTION | 4 +- NAMESPACE | 1 - R/admiralvaccine.R | 1 - inst/templates/ad_adface.R | 12 +- inst/templates/ad_adis.R | 2 +- man/derive_vars_merged_vaccine.Rd | 25 +--- .../test-derive_vars_merged_vaccine.R | 123 +----------------- vignettes/adface.Rmd | 9 +- vignettes/adis.Rmd | 2 +- 9 files changed, 20 insertions(+), 159 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d2057e65..1a45738d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -58,7 +58,6 @@ Imports: lifecycle (>= 0.1.0), lubridate (>= 1.7.4), magrittr (>= 1.5), - metatools, purrr (>= 0.3.3), rlang (>= 0.4.4), stringr (>= 1.4.0), @@ -81,7 +80,8 @@ Suggests: styler, testthat, tibble, - usethis + usethis, + metatools VignetteBuilder: knitr Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 4db4d77c..6a3fbe90 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -87,7 +87,6 @@ importFrom(lubridate,years) importFrom(lubridate,ymd) importFrom(lubridate,ymd_hms) importFrom(magrittr,"%>%") -importFrom(metatools,combine_supp) importFrom(purrr,compose) importFrom(purrr,every) importFrom(purrr,flatten) diff --git a/R/admiralvaccine.R b/R/admiralvaccine.R index 8fcf9918..46099173 100644 --- a/R/admiralvaccine.R +++ b/R/admiralvaccine.R @@ -32,5 +32,4 @@ #' @importFrom admiraldev assert_logical_scalar assert_character_vector assert_vars #' assert_data_frame assert_character_scalar assert_numeric_vector assert_filter_cond #' assert_symbol assert_expr_list expect_dfs_equal -#' @importFrom metatools combine_supp "_PACKAGE" diff --git a/inst/templates/ad_adface.R b/inst/templates/ad_adface.R index 63e23699..f546f35d 100644 --- a/inst/templates/ad_adface.R +++ b/inst/templates/ad_adface.R @@ -58,13 +58,17 @@ face <- face %>% adsl_vars <- exprs(RFSTDTC, RFENDTC) +# Combine the parental datasets with their respective supp datasets (only if exist) +# User can use `combine_supp()` from {metatools} to combine the parental with supp dataset. + +face <- metatools::combine_supp(face, suppface) +ex <- metatools::combine_supp(ex, suppex) + # Step 2 - Merging supplementary datasets and FACE with EX adface <- derive_vars_merged_vaccine( dataset = face, dataset_ex = ex, - dataset_supp = suppface, - dataset_suppex = suppex, by_vars_sys = exprs(USUBJID, FATPTREF = EXLNKGRP), by_vars_adms = exprs(USUBJID, FATPTREF = EXLNKGRP, FALOC = EXLOC, FALAT = EXLAT), ex_vars = exprs(EXTRT, EXDOSE, EXSEQ, EXSTDTC, EXENDTC, VISIT, VISITNUM) @@ -261,13 +265,11 @@ keep_vars <- c( "APEREDT", "APERETM", "APEREDTM", "APERDY", "FAORRES" ) -adface <- adface %>% select( +admiralvaccine_adface <- adface %>% select( any_of(keep_vars), starts_with("TRT0"), starts_with("VAX"), starts_with("EVE"), starts_with("ANL") ) -admiralvaccine_adface <- adface - # Save output ---- dir <- tools::R_user_dir("admiralvaccine_templates_data", which = "cache") diff --git a/inst/templates/ad_adis.R b/inst/templates/ad_adis.R index 8d5b32d3..c4efe455 100644 --- a/inst/templates/ad_adis.R +++ b/inst/templates/ad_adis.R @@ -31,7 +31,7 @@ adsl <- convert_blanks_to_na(admiralvaccine_adsl) # STEP 1 - combine IS with SUPPIS. # Please, upload MOCK data -is_suppis <- combine_supp(is, suppis) +is_suppis <- metatools::combine_supp(is, suppis) # STEP 2 - Visits and timing variables derivation. diff --git a/man/derive_vars_merged_vaccine.Rd b/man/derive_vars_merged_vaccine.Rd index 16135696..9053af81 100644 --- a/man/derive_vars_merged_vaccine.Rd +++ b/man/derive_vars_merged_vaccine.Rd @@ -9,18 +9,16 @@ derive_vars_merged_vaccine( dataset_ex, by_vars_sys, by_vars_adms, - dataset_supp = NULL, - dataset_suppex = NULL, ex_vars ) } \arguments{ -\item{dataset}{Input dataset +\item{dataset}{Input dataset which should have been combined with the supplementary(if exists). The variables specified by the \code{by_vars} argument inside the \code{derive_vars_merged}are expected.} -\item{dataset_ex}{EX dataset to merge with the input dataset. +\item{dataset_ex}{\code{ex} dataset(combined with \code{suppex}) to merge with the input dataset. The variables specified by the \code{ex_vars} argument are expected.} @@ -28,18 +26,6 @@ The variables specified by the \code{ex_vars} argument are expected.} \item{by_vars_adms}{Grouping variables for administration site events.} -\item{dataset_supp}{Supplementary input dataset - -By default \code{dataset_supp} will be \code{NULL}, user has to provide -supplementary dataset to merge it back with original input dataset -if they have supplementary dataset in their case.} - -\item{dataset_suppex}{Supplementary EX dataset - -By default \code{dataset_suppex} will be \code{NULL}, user has to provide -supplementary dataset to merge it back with original \code{EX} dataset -if they have supplementary dataset in their case.} - \item{ex_vars}{Variables to be added to the output dataset from EX dataset} } \value{ @@ -61,8 +47,7 @@ is expected to handle if any pre-processing is required. Only the variables passed to the \code{ex_vars} will be added in the output dataset If the input dataset has multiple vaccination for a subject at same visit -then this function will not merge ex dataset and will return only the input -dataset merged with its supplementary dataset. +then this function will not merge ex dataset and will return the \code{dataset}. } \examples{ @@ -74,8 +59,6 @@ library(pharmaversesdtm) derive_vars_merged_vaccine( dataset = face_vaccine, dataset_ex = ex_vaccine, - dataset_supp = NULL, - dataset_suppex = NULL, by_vars_sys = exprs(USUBJID, FATPTREF = EXLNKGRP), by_vars_adms = exprs(USUBJID, FATPTREF = EXLNKGRP, FALOC = EXLOC, FALAT = EXLAT), ex_vars = exprs(EXTRT, EXDOSE, EXDOSU, EXSTDTC, EXENDTC) @@ -86,8 +69,6 @@ derive_vars_merged_vaccine( derive_vars_merged_vaccine( dataset = face_vaccine, dataset_ex = ex_vaccine, - dataset_supp = suppface_vaccine, - dataset_suppex = suppex_vaccine, by_vars_sys = exprs(USUBJID, FATPTREF = EXLNKGRP), by_vars_adms = exprs(USUBJID, FATPTREF = EXLNKGRP, FALOC = EXLOC, FALAT = EXLAT), ex_vars = exprs(EXTRT, EXDOSE, EXDOSU, EXSTDTC, EXENDTC) diff --git a/tests/testthat/test-derive_vars_merged_vaccine.R b/tests/testthat/test-derive_vars_merged_vaccine.R index d591d974..dde20dda 100644 --- a/tests/testthat/test-derive_vars_merged_vaccine.R +++ b/tests/testthat/test-derive_vars_merged_vaccine.R @@ -1,5 +1,3 @@ -## Test 1: Merging EXTRT variable from EX to FACE - test_that("derive_vars_merged_vaccine Test 1: Merging EXTRT variable from EX to FACE", { face <- tibble::tribble( ~USUBJID, ~FACAT, ~FASCAT, ~FATESTCD, ~FAOBJ, ~FATEST, ~FALOC, ~FALAT, ~FATPTREF, @@ -43,8 +41,6 @@ test_that("derive_vars_merged_vaccine Test 1: Merging EXTRT variable from EX to actual <- derive_vars_merged_vaccine( dataset = face, dataset_ex = ex, - dataset_supp = NULL, - dataset_suppex = NULL, by_vars_sys = exprs(USUBJID, FATPTREF = EXTPTREF), by_vars_adms = exprs(USUBJID, FATPTREF = EXTPTREF, FALOC = EXLOC, FALAT = EXLAT), ex_vars = exprs(EXTRT, EXDOSE) @@ -55,123 +51,8 @@ test_that("derive_vars_merged_vaccine Test 1: Merging EXTRT variable from EX to )) }) -## Test 2: Check if supp datasets merged properly if they exist - -test_that("derive_vars_merged_vaccine Test 2: Check if supp datasets merged - properly if they exist", { - face <- tibble::tribble( - ~STUDYID, ~DOMAIN, ~USUBJID, ~FACAT, ~FASCAT, ~FATESTCD, ~FAOBJ, ~FATEST, ~FALOC, ~FALAT, - ~FATPTREF, ~FASEQ, - "ABC", "FACE", "ABC101", "REACTO", "ADMINISTRATION SITE", "SEV", "Redness", "Severity", "ARM", - "RIGHT", "VAC 1", 1, - "ABC", "FACE", "ABC101", "REACTO", "ADMINISTRATION SITE", "DIAMETER", "Redness", "Diameter", - "ARM", "LEFT", "VAC 1", 2, - "ABC", "FACE", "ABC101", "REACTO", "ADMINISTRATION SITE", "DIAM", "Redness", "Diameter", - NA, NA, "VAC 2", 3, - "ABC", "FACE", "ABC101", "REACTO", "SYSTEMIC", "OCCUR", "Fatigue", "Occurrence", - "LEG", "LEFT", "VAC 3", 5, - "ABC", "FACE", "ABC101", "REACTO", "ADMINISTRATION SITE", "OCCUR", "Erythema", - "Occurrence", "LEG", "LEFT", "VAC 3", 6, - "ABC", "FACE", "ABC101", "REACTO", "ADMINISTRATION SITE", "SEV", "Swelling", - "Severity", NA, NA, "VAC 4", 7, - "ABC", "FACE", "ABC101", "REACTO", "ADMINISTRATION SITE", "OCCUR", "Swelling", - "Occurrence", NA, NA, "VAC 4", 8, - "ABC", "FACE", "ABC102", "REACTO", "ADMINISTRATION SITE", "OCCUR", "Swelling", - "Occurrence", NA, NA, "VAC 1", 1 - ) - - ex <- tibble::tribble( - ~STUDYID, ~DOMAIN, ~USUBJID, ~EXSTDTC, ~VISITNUM, ~EXTRT, ~EXTPTREF, ~VISIT, ~EXLOC, ~EXLAT, - ~EXDOSE, ~EXSEQ, - "ABC", "EX", "ABC101", "2015-01-10", 1, "DRUG A", "VAC 1", "VISIT 1", "ARM", "RIGHT", 20, 1, - "ABC", "EX", "ABC101", "2015-01-11", 2, "DRUG A", "VAC 2", "VISIT 2", NA, NA, 30, 2, - "ABC", "EX", "ABC101", "2015-01-12", 3, "DRUG B", "VAC 3", "VISIT 3", "LEG", "LEFT", 25, 3, - "ABC", "EX", "ABC101", "2015-01-13", 4, "DRUG C", "VAC 4", "VISIT 4", NA, NA, 30, 4, - "ABC", "EX", "ABC102", "2015-01-13", 1, "DRUG B", "VAC 1", "VISIT 5", NA, NA, 10, 1 - ) - - suppface <- tibble::tribble( - ~STUDYID, ~USUBJID, ~RDOMAIN, ~IDVAR, ~IDVARVAL, ~QNAM, ~QVAL, ~QLABEL, ~QORIG, - "ABC", "ABC101", "FACE", "FASEQ", 1, "CLTYP", "DAIRY", "Collection Type", - "Predecessor", - "ABC", "ABC101", "FACE", "FASEQ", 2, "CLTYP", "CRF", "Collection Type", - "Predecessor" - ) - - suppex <- tibble::tribble( - ~STUDYID, ~USUBJID, ~RDOMAIN, ~IDVAR, ~IDVARVAL, ~QNAM, ~QVAL, ~QLABEL, ~QORIG, - "ABC", "ABC101", "EX", "EXSEQ", 1, "EXTDV", "N", "Temporary Delay of Vaccination", - "ASSIGNED", - "ABC", "ABC101", "EX", "EXSEQ", 2, "EXTDV", "Y", "Temporary Delay of Vaccination", - "ASSIGNED" - ) - - temp <- suppface %>% - pivot_wider( - id_cols = c(USUBJID, IDVAR, IDVARVAL), - names_from = QNAM, - values_from = QVAL - ) %>% - mutate(FASEQ = IDVARVAL) %>% - select(-c(IDVAR, IDVARVAL)) - facef <- left_join(face, temp, by = c("USUBJID", "FASEQ"), keep = FALSE) - face1 <- facef %>% - mutate(LOC = FALOC, LAT = FALAT, TPTREF = FATPTREF) - - tempex <- suppex %>% - pivot_wider( - id_cols = c(USUBJID, IDVAR, IDVARVAL), - names_from = QNAM, - values_from = QVAL - ) %>% - mutate(EXSEQ = IDVARVAL) %>% - select(-c(IDVAR, IDVARVAL)) - exf <- left_join(ex, tempex, by = c("USUBJID", "EXSEQ"), keep = FALSE) - - ex1 <- exf %>% - mutate(LOC = EXLOC, LAT = EXLAT, TPTREF = EXTPTREF) %>% - select(-c( - "VISITNUM", "VISIT", "EXLOC", "EXLAT", "EXSTDTC", - "EXTPTREF", "STUDYID", "DOMAIN", "EXSEQ" - )) - - admin <- face1 %>% - filter(FASCAT == "ADMINISTRATION SITE") - expected1 <- left_join(admin, - ex1, - by = c("USUBJID", "LOC", "LAT", "TPTREF"), keep = FALSE - ) %>% - select(-c("LOC", "LAT", "TPTREF")) - - sys <- face1 %>% filter(FASCAT == "SYSTEMIC") - expected2 <- left_join(sys, - ex1, - by = c("USUBJID", "TPTREF"), keep = FALSE - ) %>% - select(-c("TPTREF", "LOC.x", "LOC.y", "LAT.x", "LAT.y")) - - expected <- bind_rows(expected1, expected2) - - - actual <- derive_vars_merged_vaccine( - dataset = face, - dataset_ex = ex, - dataset_supp = suppface, - dataset_suppex = suppex, - by_vars_sys = exprs(USUBJID, FATPTREF = EXTPTREF), - by_vars_adms = exprs(USUBJID, FATPTREF = EXTPTREF, FALOC = EXLOC, FALAT = EXLAT), - ex_vars = exprs(EXTRT, EXDOSE, EXTDV) - ) - expect_dfs_equal(actual, expected, keys = c( - "USUBJID", "FAOBJ", "FATESTCD", "FATPTREF", - "FALOC", "FALAT" - )) -}) - - -## Test 3: Check if warning is raised when there are multiple vaccination in same visit -test_that("derive_vars_merged_vaccine Test 3: Check if warning is raised when +test_that("derive_vars_merged_vaccine Test 2: Check if warning is raised when there are multiple vaccination in same ", { face <- tibble::tribble( ~STUDYID, ~DOMAIN, ~USUBJID, ~FACAT, ~FASCAT, ~FATESTCD, ~FAOBJ, ~FATEST, ~FALOC, ~FALAT, @@ -207,8 +88,6 @@ test_that("derive_vars_merged_vaccine Test 3: Check if warning is raised when derive_vars_merged_vaccine( dataset = face, dataset_ex = ex, - dataset_supp = NULL, - dataset_suppex = NULL, by_vars_sys = exprs(USUBJID, FATPTREF = EXTPTREF), by_vars_adms = exprs(USUBJID, FATPTREF = EXTPTREF, FALOC = EXLOC, FALAT = EXLAT), ex_vars = exprs(EXTRT, EXDOSE) diff --git a/vignettes/adface.Rmd b/vignettes/adface.Rmd index fbdd4642..49f009ef 100644 --- a/vignettes/adface.Rmd +++ b/vignettes/adface.Rmd @@ -84,12 +84,15 @@ adsl <- convert_blanks_to_na(admiralvaccine_adsl) ## Pre-processing of Input Dataset {#input} This step involves company-specific pre-processing of required input dataset for -further analysis. In this step, we will filter records that has only reactogenicity events. +further analysis. In this step, we will filter records that has only reactogenicity events and +combine the `face` and `ex` with their supplementary datasets `suppface` and `suppex` respectively. ```{r eval=TRUE} face <- face %>% filter(FACAT == "REACTOGENICITY" & grepl("ADMIN|SYS", FASCAT)) %>% - mutate(FAOBJ = str_to_upper(FAOBJ)) + mutate(FAOBJ = str_to_upper(FAOBJ)) %>% + metatools::combine_supp(suppface) +ex <- metatools::combine_supp(ex, suppex) ``` ```{r, echo=FALSE} @@ -109,8 +112,6 @@ The function `derive_vars_merged_vaccine()` is used to merge `face` with `ex` do adface <- derive_vars_merged_vaccine( dataset = face, dataset_ex = ex, - dataset_supp = suppface, - dataset_suppex = suppex, by_vars_sys = exprs(USUBJID, FATPTREF = EXLNKGRP), by_vars_adms = exprs(USUBJID, FATPTREF = EXLNKGRP, FALOC = EXLOC, FALAT = EXLAT), ex_vars = exprs(EXTRT, EXDOSE, EXSEQ, EXSTDTC, EXENDTC, VISIT, VISITNUM) diff --git a/vignettes/adis.Rmd b/vignettes/adis.Rmd index c568b655..882c3153 100644 --- a/vignettes/adis.Rmd +++ b/vignettes/adis.Rmd @@ -102,7 +102,7 @@ adsl <- convert_blanks_to_na(admiralvaccine_adsl) ## Combine IS with SUPPIS {#combine_supp} Combine `IS` with its supplemental domain `SUPPIS`. ```{r eval=TRUE} -is_suppis <- combine_supp(is, suppis) +is_suppis <- metatools::combine_supp(is, suppis) ``` From f429c662efc12a622eb44d98707a4f6faf6cf810 Mon Sep 17 00:00:00 2001 From: Arjun Rubalingam <115066417+arjoon-r@users.noreply.github.com> Date: Wed, 31 Jul 2024 15:11:05 +0530 Subject: [PATCH 2/4] #246 removed supp dataset args --- R/derive_vars_merged_vaccine.R | 47 +++++----------------------------- 1 file changed, 7 insertions(+), 40 deletions(-) diff --git a/R/derive_vars_merged_vaccine.R b/R/derive_vars_merged_vaccine.R index cf666435..2d43f239 100644 --- a/R/derive_vars_merged_vaccine.R +++ b/R/derive_vars_merged_vaccine.R @@ -4,27 +4,15 @@ #' The variables to be added to the output dataset will be based on input variables #' passed on `ex_vars` argument. #' -#' @param dataset Input dataset +#' @param dataset Input dataset which should have been combined with the supplementary(if exists). #' #' The variables specified by the `by_vars` argument inside the #' `derive_vars_merged`are expected. #' -#' @param dataset_ex EX dataset to merge with the input dataset. +#' @param dataset_ex `ex` dataset(combined with `suppex`) to merge with the input dataset. #' #' The variables specified by the `ex_vars` argument are expected. #' -#' @param dataset_supp Supplementary input dataset -#' -#' By default `dataset_supp` will be `NULL`, user has to provide -#' supplementary dataset to merge it back with original input dataset -#' if they have supplementary dataset in their case. -#' -#' @param dataset_suppex Supplementary EX dataset -#' -#' By default `dataset_suppex` will be `NULL`, user has to provide -#' supplementary dataset to merge it back with original `EX` dataset -#' if they have supplementary dataset in their case. -#' #' @param by_vars_sys Grouping variables for systemic events. #' #' @param by_vars_adms Grouping variables for administration site events. @@ -45,8 +33,7 @@ #' Only the variables passed to the `ex_vars` will be added in the output dataset #' #' If the input dataset has multiple vaccination for a subject at same visit -#' then this function will not merge ex dataset and will return only the input -#' dataset merged with its supplementary dataset. +#' then this function will not merge ex dataset and will return the `dataset`. #' #' @author Vikram S #' @@ -66,8 +53,6 @@ #' derive_vars_merged_vaccine( #' dataset = face_vaccine, #' dataset_ex = ex_vaccine, -#' dataset_supp = NULL, -#' dataset_suppex = NULL, #' by_vars_sys = exprs(USUBJID, FATPTREF = EXLNKGRP), #' by_vars_adms = exprs(USUBJID, FATPTREF = EXLNKGRP, FALOC = EXLOC, FALAT = EXLAT), #' ex_vars = exprs(EXTRT, EXDOSE, EXDOSU, EXSTDTC, EXENDTC) @@ -78,38 +63,21 @@ #' derive_vars_merged_vaccine( #' dataset = face_vaccine, #' dataset_ex = ex_vaccine, -#' dataset_supp = suppface_vaccine, -#' dataset_suppex = suppex_vaccine, #' by_vars_sys = exprs(USUBJID, FATPTREF = EXLNKGRP), #' by_vars_adms = exprs(USUBJID, FATPTREF = EXLNKGRP, FALOC = EXLOC, FALAT = EXLAT), #' ex_vars = exprs(EXTRT, EXDOSE, EXDOSU, EXSTDTC, EXENDTC) -#' ) %>% -#' filter(CLTYP == "DAIRY") %>% -#' select(USUBJID, FATPTREF, CLTYP, EXTRT, EXDOSE, EXDOSU, EXSTDTC, EXENDTC) +#' ) +#' derive_vars_merged_vaccine <- function(dataset, dataset_ex, by_vars_sys, by_vars_adms, - dataset_supp = NULL, - dataset_suppex = NULL, ex_vars) { assert_data_frame(dataset) assert_vars(by_vars_sys) assert_vars(by_vars_adms) assert_vars(ex_vars) - assert_data_frame(dataset_supp, optional = TRUE) assert_data_frame(dataset_ex) - assert_data_frame(dataset_suppex, optional = TRUE) - - # combine face and suppface dataset - if (!is.null(dataset_supp)) { - dataset <- combine_supp(dataset, dataset_supp) - } - - # combine face and suppex dataset - if (!is.null(dataset_suppex)) { - dataset_ex <- combine_supp(dataset_ex, dataset_suppex) - } if ("VISIT" %in% names(dataset_ex)) { ex_distinct <- dataset_ex %>% distinct(USUBJID, VISIT, .keep_all = TRUE) @@ -119,8 +87,7 @@ derive_vars_merged_vaccine <- function(dataset, if (nrow(dataset_ex) != nrow(ex_distinct)) { warning("Subjects have multiple vaccinations at same visit") - - dataset <- dataset + return(dataset) } else { # Filter records for ADMINISTRATION SITE events and merge it with EX dataset dataset_adminstration <- dataset %>% @@ -145,6 +112,6 @@ derive_vars_merged_vaccine <- function(dataset, ) # bind face1 and face2 datasets - bind_rows(face1, face2) + return(bind_rows(face1, face2)) } } From 2e8c2bc66ae15c624a441e32fe4d45c4590102d3 Mon Sep 17 00:00:00 2001 From: Arjun Rubalingam <115066417+arjoon-r@users.noreply.github.com> Date: Wed, 31 Jul 2024 16:08:28 +0530 Subject: [PATCH 3/4] #246 --- NEWS.md | 4 ++++ man/derive_vars_merged_vaccine.Rd | 5 ++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1bc01627..67ca2151 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,8 @@ # admiralvaccine (development version) +# admiralvaccine 0.3.0 + +## Updates to Templates and Function +- Removed `dataset_supp` and `dataset_suppex` arguments from `derive_vars_merged_vaccine()` as we are not combining the parental with supplementary inside the function, but can be combined in the ADCE, ADFACE and ADIS template using `combine_supp()` from {metatools} as the {metatools} has been removed from dependency. # admiralvaccine 0.2.0 diff --git a/man/derive_vars_merged_vaccine.Rd b/man/derive_vars_merged_vaccine.Rd index 9053af81..b1c9eb97 100644 --- a/man/derive_vars_merged_vaccine.Rd +++ b/man/derive_vars_merged_vaccine.Rd @@ -72,9 +72,8 @@ derive_vars_merged_vaccine( by_vars_sys = exprs(USUBJID, FATPTREF = EXLNKGRP), by_vars_adms = exprs(USUBJID, FATPTREF = EXLNKGRP, FALOC = EXLOC, FALAT = EXLAT), ex_vars = exprs(EXTRT, EXDOSE, EXDOSU, EXSTDTC, EXENDTC) -) \%>\% - filter(CLTYP == "DAIRY") \%>\% - select(USUBJID, FATPTREF, CLTYP, EXTRT, EXDOSE, EXDOSU, EXSTDTC, EXENDTC) +) + } \seealso{ Other der_var: From 915a430edfc36f39cf1c4eb60b05f272e949d51f Mon Sep 17 00:00:00 2001 From: ahasoplakus Date: Wed, 31 Jul 2024 11:09:03 +0000 Subject: [PATCH 4/4] update news.md --- NEWS.md | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 67ca2151..d25a87e2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,12 @@ -# admiralvaccine (development version) # admiralvaccine 0.3.0 -## Updates to Templates and Function -- Removed `dataset_supp` and `dataset_suppex` arguments from `derive_vars_merged_vaccine()` as we are not combining the parental with supplementary inside the function, but can be combined in the ADCE, ADFACE and ADIS template using `combine_supp()` from {metatools} as the {metatools} has been removed from dependency. +## Breaking Changes + +- Removed `dataset_supp` and `dataset_suppex` arguments from `derive_vars_merged_vaccine()` as we are not combining the parental with supplementary inside the function, but can be optionally combined in the ADCE, ADFACE and ADIS templates using `combine_supp()` function from {metatools}. (#246) + +## Updates to Templates + +- Supplementary domains are now optionally combined with parental domain within the template. (#246) # admiralvaccine 0.2.0