generated from pharmaverse/admiraltemplate
-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Changes made to the documentation for read-out
- Loading branch information
1 parent
8446bc5
commit 5489f42
Showing
8 changed files
with
390 additions
and
198 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,84 +1,144 @@ | ||
| #' @title Produce a Datacut Summary Rmarkdown | ||
| #' @title Datacut Summary File | ||
| #' | ||
| #' @description | ||
| #' @description Produces a .html file summarising the changes applied to data during a data cut. | ||
| #' The file will contain an overview for the change in number of records for each dataset, the types | ||
| #' of cut applied and the opportunity to inspect the removed records. | ||
| #' | ||
| #' @param dcut | ||
| #' @param patient_cut_data A list of quoted SDTMv domain names in which a patient cut has been | ||
| #' applied. To be left blank if a patient cut has not been performed on any domains. | ||
| #' @param dcut The output datacut dataset (DCUT), created via the `create_dcut()` function, containing | ||
| #' the variable DCUTDTC. | ||
| #' @param patient_cut_data A list of quoted SDTMv domain names in which a patient cut has been. | ||
| #' applied (via the `pt_cut()` function). To be left blank if a patient cut has not been performed on any domains. | ||
| #' @param date_cut_data A list of quoted SDTMv domain names in which a date cut has been applied. | ||
| #' To be left blank if a date cut has not been performed on any domains. | ||
| #' @param dm_cut | ||
| #' (via the `date_cut()` function). To be left blank if a date cut has not been performed on any domains. | ||
| #' @param dm_cut The output dataset, created via the `special_dm_cut()` function, containing | ||
| #' the variables DCUT_TEMP_REMOVE and DCUT_TEMP_DTHCHANGE. | ||
| #' @param no_cut_list List of of quoted SDTMv domain names in which no cut should be applied. To be | ||
| #' left blank if no domains are to remain exactly as source. | ||
| #' @param out_path A character vector of file save path for the summary file; | ||
| #' the default corresponds to the working directory, getwd(). | ||
| #' | ||
| #' @return Returns a .html R markdown summarising the changes made to data during a data cut. | ||
| #' @return Returns a .html file summarising the changes made to data during a datacut. | ||
| #' | ||
| #' @importFrom reactable reactable | ||
| #' | ||
| #' @export | ||
| #' | ||
| #' @keywords derive | ||
| #' | ||
| #' @examples | ||
| #' | ||
|
|
||
| # alt name summarize_cut() ?? | ||
| #' dcut <- tibble::tribble( | ||
| #' ~USUBJID, ~DCUTDTM, ~DCUTDTC, | ||
| #' "subject1", ymd_hms("2020-10-11T23:59:59"), "2020-10-11T23:59:59", | ||
| #' "subject2", ymd_hms("2020-10-11T23:59:59"), "2020-10-11T23:59:59", | ||
| #' "subject4", ymd_hms("2020-10-11T23:59:59"), "2020-10-11T23:59:59" | ||
| #' ) | ||
| #' | ||
| #' ae <- tibble::tribble( | ||
| #' ~USUBJID, ~AESEQ, ~AESTDTC, | ||
| #' "subject1", 1, "2020-01-02T00:00:00", | ||
| #' "subject1", 2, "2020-08-31T00:00:00", | ||
| #' "subject1", 3, "2020-10-10T00:00:00", | ||
| #' "subject2", 2, "2020-02-20T00:00:00", | ||
| #' "subject3", 1, "2020-03-02T00:00:00", | ||
| #' "subject4", 1, "2020-11-02T00:00:00", | ||
| #' "subject4", 2, "" | ||
| #' ) | ||
| #' | ||
| #' dm <- tibble::tribble( | ||
| #' ~USUBJID, ~DTHDTC, ~DTHFL, | ||
| #' "subject1", "2020-10-11", "Y", | ||
| #' "subject2", "2020-10-12", "Y", | ||
| #' ) | ||
| #' | ||
| #' dt_ae <- date_cut( | ||
| #' dataset_sdtm = ae, | ||
| #' sdtm_date_var = AESTDTC, | ||
| #' dataset_cut = dcut, | ||
| #' cut_var = DCUTDTM | ||
| #' ) | ||
| #' | ||
| #' pt_ae <- pt_cut( | ||
| #' dataset_sdtm = ae, | ||
| #' dataset_cut = dcut | ||
| #' ) | ||
| #' | ||
| #' dm_cut <- special_dm_cut( | ||
| #' dataset_dm = dm, | ||
| #' dataset_cut = dcut, | ||
| #' cut_var = DCUTDTM | ||
| #' ) | ||
| #' | ||
| #' read_out(dcut, patient_cut_data = list(ae = pt_ae), date_cut_data = list(ae = dt_ae), dm_cut) | ||
| #' | ||
| read_out <- function(dcut = NULL, | ||
| patient_cut_data = NULL, | ||
| date_cut_data = NULL, | ||
| dm_cut = NULL, | ||
| no_cut_list = NULL, | ||
| out_path = ".") { | ||
| #browser() | ||
| if (!is.null(dcut)) { | ||
| assert_data_frame(dcut, | ||
| required_vars = exprs(USUBJID, DCUTDTC) | ||
| required_vars = exprs(USUBJID, DCUTDTC) | ||
| ) | ||
| } | ||
| if (!is.null(patient_cut_data)){ | ||
| } | ||
| if (!is.null(patient_cut_data)) { | ||
| assert_that(is.list(patient_cut_data) & !is.data.frame(patient_cut_data), | ||
| msg = "patient_cut_data must be a list. \n | ||
| msg = "patient_cut_data must be a list. \n | ||
| Note: If you have not used or do not with to view patient cut on any SDTMv domains, then please leave | ||
| patient_cut_data empty, in which case a default value of NULL will be used.") | ||
| patient_cut_data empty, in which case a default value of NULL will be used." | ||
| ) | ||
|
|
||
| for(i in seq(length(patient_cut_data))){ | ||
| for (i in seq(length(patient_cut_data))) { | ||
| assert_data_frame(patient_cut_data[[i]], | ||
| required_vars = exprs(USUBJID, DCUT_TEMP_REMOVE)) | ||
| required_vars = exprs(USUBJID, DCUT_TEMP_REMOVE) | ||
| ) | ||
|
|
||
| assert_that(is_named(patient_cut_data[i]), | ||
| msg = "All elements patient_cut_data must be named with corresponding domain") | ||
| assert_that(admiraldev::is_named(patient_cut_data[i]), | ||
| msg = "All elements patient_cut_data must be named with corresponding domain" | ||
| ) | ||
| } | ||
| } | ||
| if (!is.null(date_cut_data)){ | ||
| if (!is.null(date_cut_data)) { | ||
| assert_that(is.list(date_cut_data) & !is.data.frame(date_cut_data), | ||
| msg = "date_cut_data must be a list. \n | ||
| msg = "date_cut_data must be a list. \n | ||
| Note: If you have not used or do not with to view date cut on any SDTMv domains, then please leave | ||
| date_cut_data empty, in which case a default value of NULL will be used.") | ||
| for(i in seq(length(date_cut_data))){ | ||
| date_cut_data empty, in which case a default value of NULL will be used." | ||
| ) | ||
| for (i in seq(length(date_cut_data))) { | ||
| assert_data_frame(date_cut_data[[i]], | ||
| required_vars = exprs(USUBJID, DCUT_TEMP_REMOVE)) | ||
| required_vars = exprs(USUBJID, DCUT_TEMP_REMOVE) | ||
| ) | ||
|
|
||
| assert_that(is_named(date_cut_data[i]), | ||
| msg = "All elements in date_cut_data must be named with corresponding domain") | ||
| assert_that(admiraldev::is_named(date_cut_data[i]), | ||
| msg = "All elements in date_cut_data must be named with corresponding domain" | ||
| ) | ||
| } | ||
| } | ||
| if (!is.null(dm_cut)){ | ||
| if (!is.null(dm_cut)) { | ||
| assert_data_frame(dm_cut, | ||
| required_vars = exprs(USUBJID, DCUT_TEMP_REMOVE, DCUT_TEMP_DTHCHANGE) | ||
| ) | ||
| required_vars = exprs(USUBJID, DCUT_TEMP_REMOVE, DCUT_TEMP_DTHCHANGE) | ||
| ) | ||
| } | ||
| if (!is.null(no_cut_list)){ | ||
| if (!is.null(no_cut_list)) { | ||
| assert_that(is.list(no_cut_list) & !is.data.frame(no_cut_list), | ||
| msg = "no_cut_list must be a list. \n | ||
| msg = "no_cut_list must be a list. \n | ||
| Note: If you have not used or do not with to view the SDTMv domains where no cut has been applied, then please leave | ||
| no_cut_list empty, in which case a default value of NULL will be used.") | ||
| for(i in seq(length(no_cut_list))){ | ||
| no_cut_list empty, in which case a default value of NULL will be used." | ||
| ) | ||
| for (i in seq(length(no_cut_list))) { | ||
| assert_data_frame(no_cut_list[[i]]) | ||
|
|
||
| assert_that(is_named(no_cut_list[i]), | ||
| msg = "All elements in no_cut_list must be named with corresponding domain") | ||
| } | ||
| msg = "All elements in no_cut_list must be named with corresponding domain" | ||
| ) | ||
| } | ||
| } | ||
| rmarkdown::render(paste0(system.file(package = "datacutr"), | ||
| path = "/read-out/read_out.Rmd"), | ||
| output_file = paste("datacut_", format(Sys.time(), "%d-%b-%Y_%H:%M:%S", ".html")), | ||
| output_dir = out_path) | ||
| rmarkdown::render( | ||
| paste0(system.file(package = "datacutr"), | ||
| path = "/read-out/read_out.Rmd" | ||
| ), | ||
| output_file = paste("datacut_", format(Sys.time(), "%d-%b-%Y_%H:%M:%S", ".html")), | ||
| output_dir = out_path | ||
| ) | ||
| } |
Oops, something went wrong.