diff --git a/DESCRIPTION b/DESCRIPTION index dfd6df31..7e508c44 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: clinsight Title: ClinSight -Version: 0.1.0.9007 +Version: 0.1.0.9008 Authors@R: c( person("Leonard Daniël", "Samson", , "lsamson@gcp-service.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0002-6252-7639")), diff --git a/NAMESPACE b/NAMESPACE index 360244be..09118691 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ S3method(create_table,adverse_events) S3method(create_table,bm_cytology) +S3method(create_table,common_forms) S3method(create_table,conc_procedures) S3method(create_table,continuous) S3method(create_table,default) diff --git a/NEWS.md b/NEWS.md index 3014ff5e..f61c66bd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,7 @@ - Added a feature where, in applicable tables, a user can navigate to a form by double-clicking a table row. - Fixed warnings in `apply_edc_specific_changes` due to the use of a vector within `dplyr::select`. - Gave users ability to re-organized the column order in any table. +- Added form type as a class to be used in `create_table()` to display tables. ## Bug fixes diff --git a/R/fct_appdata.R b/R/fct_appdata.R index 940f8735..e92d2cdc 100644 --- a/R/fct_appdata.R +++ b/R/fct_appdata.R @@ -256,7 +256,7 @@ get_appdata <- function( meta = metadata ){ tableclasses <- gsub("create_table.", "", as.character(utils::methods("create_table"))) - var_levels <- dplyr::distinct(meta$items_expanded, item_name, item_group) + var_levels <- dplyr::distinct(meta$items_expanded, form_type, item_name, item_group) data <- split(data, ~item_group) ## Apply changes specific for continuous data: @@ -267,9 +267,18 @@ get_appdata <- function( "item_group consists of multipe elements which is not allowed: ", item_group_x ) + form_type_x <- unique(with(var_levels, form_type[item_group == item_group_x])) + if(length(form_type_x) != 1) stop( + "form_type consists of multipe elements which is not allowed: ", + form_type_x + ) + tableclass <- simplify_string(form_type_x) + if(tableclass %in% tableclasses){ + class(x) <- unique(c(tableclass, class(x))) + } tableclass <- simplify_string(item_group_x) if(tableclass %in% tableclasses){ - class(x) <- c(tableclass, class(x)) + class(x) <- unique(c(tableclass, class(x))) } if(!all(x$item_type == "continuous")) return(x) df <- x |> @@ -312,7 +321,7 @@ get_appdata <- function( ) ) |> dplyr::ungroup() - class(df) <- c("continuous", class(df)) + class(df) <- unique(c("continuous", class(x))) df }) appdata diff --git a/R/fct_data_helpers.R b/R/fct_data_helpers.R index 5f52baf0..30407059 100644 --- a/R/fct_data_helpers.R +++ b/R/fct_data_helpers.R @@ -50,7 +50,7 @@ get_metadata <- function( } meta$items_expanded <- meta[expand_tab_items] |> - dplyr::bind_rows() |> + dplyr::bind_rows(.id = "form_type") |> expand_columns( columns = expand_cols, separator = ",", diff --git a/R/fct_tables.R b/R/fct_tables.R index dc2efa86..6d9337a1 100644 --- a/R/fct_tables.R +++ b/R/fct_tables.R @@ -176,6 +176,23 @@ create_table.general <- function( } +#' Create Default 'Common Events' Table +#' +#' @export +#' @inherit create_table.default +create_table.common_forms <- function( + data, + name_column = "item_name", + value_column = "item_value", + keep_vars = c("subject_id", "form_repeat"), + expected_columns = NULL, + ... +){ + create_table.default(data, name_column, value_column, + keep_vars, expected_columns) +} + + #' Create Adverse Events table #' #' Function to create an adverse event dataset. diff --git a/data/metadata.rda b/data/metadata.rda index 63c728e4..11544a02 100644 Binary files a/data/metadata.rda and b/data/metadata.rda differ diff --git a/inst/_pkgdown.yml b/inst/_pkgdown.yml index c2003205..9e7bec08 100644 --- a/inst/_pkgdown.yml +++ b/inst/_pkgdown.yml @@ -33,13 +33,7 @@ reference: - contents: - create_table - create_table.default - - create_table.adverse_events - - create_table.bm_cytology - - create_table.conc_procedures - - create_table.continuous - - create_table.general - - create_table.medical_history - - create_table.medication + - starts_with("create_table") - title: Data frame functions desc: Create data for use in the application. - contents: diff --git a/inst/golem-config.yml b/inst/golem-config.yml index c2638c6c..e1d167ee 100644 --- a/inst/golem-config.yml +++ b/inst/golem-config.yml @@ -1,6 +1,6 @@ default: golem_name: clinsight - golem_version: 0.1.0.9006 + golem_version: 0.1.0.9008 app_prod: no user_identification: test_user study_data: !expr clinsight::clinsightful_data diff --git a/man/create_table.common_forms.Rd b/man/create_table.common_forms.Rd new file mode 100644 index 00000000..61cd6b65 --- /dev/null +++ b/man/create_table.common_forms.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/fct_tables.R +\name{create_table.common_forms} +\alias{create_table.common_forms} +\title{Create Default 'Common Events' Table} +\usage{ +\method{create_table}{common_forms}( + data, + name_column = "item_name", + value_column = "item_value", + keep_vars = c("subject_id", "form_repeat"), + expected_columns = NULL, + ... +) +} +\arguments{ +\item{data}{A data frame to convert, in long format.} + +\item{name_column}{Character string. Column that contains all the names for +the wide table format.} + +\item{value_column}{Character string. Column that contains all the values of +the table in wide format.} + +\item{keep_vars}{all common variables that identify a unique single data row.} + +\item{expected_columns}{A character vector with the names of the expected +variables. Needed to make sure that all expected columns are always +created, even if some variables are implicitly missing (which might occur +if there are not yet any values available for a specific variable). Also, +implicitly missing variables might give errors if part of the script relies +on the variables' presence.} + +\item{...}{Other options. Currently unused.} +} +\value{ +A data frame in wide format +} +\description{ +Create Default 'Common Events' Table +} diff --git a/tests/testthat/_snaps/fct_appdata.md b/tests/testthat/_snaps/fct_appdata.md index 10578b1d..ed3a1240 100644 --- a/tests/testthat/_snaps/fct_appdata.md +++ b/tests/testthat/_snaps/fct_appdata.md @@ -30,7 +30,7 @@ Code df[c(1, 1000, 2000, 3000, 4000, 5000), ] Output - # A tibble: 6 x 23 + # A tibble: 6 x 24 site_code subject_id event_id event_date event_repeat form_id form_repeat 1 9600 9600-001 SCR 2022-11-09 1 DM 1 @@ -39,10 +39,10 @@ 4 NA NA NA 5 NA NA NA 6 NA NA NA - # i 16 more variables: edit_date_time , day , vis_day , - # vis_num , event_name , event_label , item_name , - # item_type , item_group , item_unit , lower_lim , - # upper_lim , item_value , significance , + # i 17 more variables: edit_date_time , day , vis_day , + # vis_num , event_name , event_label , form_type , + # item_name , item_type , item_group , item_unit , + # lower_lim , upper_lim , item_value , significance , # reason_notdone , region --- @@ -50,7 +50,7 @@ Code df Output - # A tibble: 543 x 23 + # A tibble: 543 x 24 site_code subject_id event_id event_date event_repeat form_id form_repeat 1 9600 9600-001 SCR 2022-11-09 1 DM 1 @@ -64,10 +64,10 @@ 9 9600 9600-002 SCR 2022-01-01 1 VS 1 10 9600 9600-002 SCR 2022-01-01 1 VS 1 # i 533 more rows - # i 16 more variables: edit_date_time , day , vis_day , - # vis_num , event_name , event_label , item_name , - # item_type , item_group , item_unit , lower_lim , - # upper_lim , item_value , significance , + # i 17 more variables: edit_date_time , day , vis_day , + # vis_num , event_name , event_label , form_type , + # item_name , item_type , item_group , item_unit , + # lower_lim , upper_lim , item_value , significance , # reason_notdone , region # get_appdata works: produces the expected output diff --git a/tests/testthat/_snaps/fct_tables.md b/tests/testthat/_snaps/fct_tables.md index a8797699..6e1dc140 100644 --- a/tests/testthat/_snaps/fct_tables.md +++ b/tests/testthat/_snaps/fct_tables.md @@ -220,3 +220,40 @@ # i 3 more variables: `BM smear assessment` , `Auer Rods` , # `Ringed Sideroblasts` +# create_table.common_forms: creates expected medical history table + + Code + print(create_table(df, expected_columns = expected_cols), n = 25) + Output + # A tibble: 152 x 9 + subject_id form_repeat `MH Number` `MH Name` `MH Start Date` `MH Ongoing` + + 1 BEL_08_885 1 1 Epilepsy 2008-01-01 Yes + 2 BEL_09_464 1 1 Atrial fibri~ 1990-01-01 No + 3 BEL_09_464 2 2 Hypothyroidi~ 2017-11-01 No + 4 BEL_09_464 3 3 Arhtritis 2010-01-01 No + 5 BEL_09_464 4 4 Chronic hepa~ 2010-01-01 No + 6 BEL_09_464 5 5 Familial Med~ 1990-01-01 Yes + 7 BEL_09_464 6 6 Migraine 2007-01-01 Yes + 8 BEL_09_464 7 7 Atrial fibri~ 2013-01-01 Yes + 9 BEL_09_361 1 1 Hypertension 2021-02-NK Yes + 10 BEL_09_361 2 2 Diabetes mel~ 2023-06-NK Yes + 11 BEL_09_361 3 3 COPD 2003-NK-NK Yes + 12 BEL_09_361 4 4 COPD 2020-NK-NK Yes + 13 DEU_02_968 1 1 Hypertension + 14 NLD_06_755 1 1 Familial Med~ 2023-03-15 Yes + 15 NLD_06_755 2 2 Chronic hepa~ 2023-03-08 Yes + 16 NLD_06_755 3 3 Familial Med~ 2023-06-28 No + 17 NLD_06_755 4 4 Hypertension 2023-05-19 Yes + 18 NLD_06_755 5 5 Diabetes mel~ 2023-05-19 Yes + 19 NLD_06_755 6 6 Migraine 2023-05-19 Yes + 20 NLD_06_755 7 7 Malaria 2015-07-10 No + 21 NLD_06_755 8 8 Malaria 2022-09-12 Yes + 22 NLD_06_755 9 9 Osteoporosis 2015-NK-NK Yes + 23 NLD_06_755 10 10 Malaria 2023-03-08 Yes + 24 DEU_02_866 1 1 Epilepsy 2021-01-NK Yes + 25 DEU_02_866 2 2 COPD 2020-09-NK Yes + # i 127 more rows + # i 3 more variables: `MH End Date` , `MH Treatment` , + # `MH Comment` + diff --git a/tests/testthat/test-fct_tables.R b/tests/testthat/test-fct_tables.R index 7b9ec3fa..c4b94692 100644 --- a/tests/testthat/test-fct_tables.R +++ b/tests/testthat/test-fct_tables.R @@ -284,3 +284,33 @@ describe( }) } ) + +describe( + "create_table.common_forms", + { + appdata <- get_appdata(clinsightful_data) + vars <- get_meta_vars(appdata, metadata) + expected_cols <- names(vars$items$`Medical History`) + df <- appdata$`Medical History` + # Remove medical_history class + class(df) <- class(df)[-1] + expect_equal( + class(df), + c("common_forms", "tbl_df", "tbl", "data.frame") + ) + it("creates a table with S3 method for common forms", { + expect_true(is.data.frame(create_table(df))) + expect_equal(create_table(df), create_table.common_forms(df)) + }) + + it("creates expected medical history table", { + expect_snapshot(print(create_table(df, expected_columns = expected_cols), + n = 25)) + }) + it("does not error with a zero-row data frame input", { + expect_no_error(create_table(df[0,], expected_columns = expected_cols)) + output <- create_table(df[0,], expected_columns = expected_cols) + expect_equal(nrow(output), 0) + }) + } +)