Merge pull request #118 from openpharma/jt-107-extend_create_table

Extend `create_table()`

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", , "[email protected]", role = c("cre", "aut"),
            comment = c(ORCID = "0000-0002-6252-7639")),

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)

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
 

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

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 = ",",

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.

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: 

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

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
         <chr>     <chr>      <chr>    <date>            <int> <chr>         <int>
       1 9600      9600-001   SCR      2022-11-09            1 DM                1
@@ -39,18 +39,18 @@
       4 <NA>      <NA>       <NA>     NA                   NA <NA>             NA
       5 <NA>      <NA>       <NA>     NA                   NA <NA>             NA
       6 <NA>      <NA>       <NA>     NA                   NA <NA>             NA
-      # i 16 more variables: edit_date_time <dttm>, day <drtn>, vis_day <dbl>,
-      #   vis_num <dbl>, event_name <chr>, event_label <chr>, item_name <chr>,
-      #   item_type <chr>, item_group <chr>, item_unit <chr>, lower_lim <dbl>,
-      #   upper_lim <dbl>, item_value <chr>, significance <chr>,
+      # i 17 more variables: edit_date_time <dttm>, day <drtn>, vis_day <dbl>,
+      #   vis_num <dbl>, event_name <chr>, event_label <chr>, form_type <chr>,
+      #   item_name <chr>, item_type <chr>, item_group <chr>, item_unit <chr>,
+      #   lower_lim <dbl>, upper_lim <dbl>, item_value <chr>, significance <chr>,
       #   reason_notdone <chr>, region <chr>
 
 ---
 
     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
          <chr>     <chr>      <chr>    <date>            <int> <chr>         <int>
        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 <dttm>, day <drtn>, vis_day <dbl>,
-      #   vis_num <dbl>, event_name <chr>, event_label <chr>, item_name <chr>,
-      #   item_type <chr>, item_group <chr>, item_unit <chr>, lower_lim <dbl>,
-      #   upper_lim <dbl>, item_value <chr>, significance <chr>,
+      # i 17 more variables: edit_date_time <dttm>, day <drtn>, vis_day <dbl>,
+      #   vis_num <dbl>, event_name <chr>, event_label <chr>, form_type <chr>,
+      #   item_name <chr>, item_type <chr>, item_group <chr>, item_unit <chr>,
+      #   lower_lim <dbl>, upper_lim <dbl>, item_value <chr>, significance <chr>,
       #   reason_notdone <chr>, region <chr>
 
 # get_appdata works: produces the expected output

tests/testthat/_snaps/fct_tables.md

@@ -220,3 +220,40 @@
       # i 3 more variables: `BM smear assessment` <chr>, `Auer Rods` <chr>,
       #   `Ringed Sideroblasts` <chr>
 
+# 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`
+         <chr>            <int> <chr>       <chr>         <chr>           <chr>       
+       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  <NA>            <NA>        
+      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` <chr>, `MH Treatment` <chr>,
+      #   `MH Comment` <chr>
+

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)
+      })
+    }
+)