Extend create_table()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: clinsight
 Title: ClinSight
-Version: 0.1.0.9004
+Version: 0.1.0.9005
 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_events)
 S3method(create_table,conc_procedures)
 S3method(create_table,continuous)
 S3method(create_table,default)

NEWS.md

@@ -4,6 +4,7 @@
 - Generalized `merge_meta_with_data()` to allow user-defined processing functions.
 - 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`.
+- Added form type as a class to be used in `create_table()` to display tables.
 
 # clinsight 0.1.0
 

R/fct_appdata.R

@@ -256,7 +256,13 @@ 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, item_name, item_group)
+  forms <- c("common_forms", "study_forms", "general")
+  form_types <- Map(
+    \(x, y) cbind(form_type = y, item_group = unique(x$item_group)), 
+    metadata[forms], 
+    forms) |> 
+    do.call(what = rbind.data.frame)
 
   data <- split(data, ~item_group)
   ## Apply changes specific for continuous data:
@@ -267,9 +273,10 @@ get_appdata <-  function(
       "item_group consists of multipe elements which is not allowed: ", 
       item_group_x
     )
+    class(x) <- c(with(form_types, form_type[item_group == item_group_x]), 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 +319,7 @@ get_appdata <-  function(
         )
       ) |> 
       dplyr::ungroup() 
-    class(df) <- c("continuous", class(df))
+    class(df) <- unique(c("continuous", class(x)))
     df
   }) 
   appdata

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_events <- 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

@@ -35,6 +35,7 @@ reference:
   - create_table.default
   - create_table.adverse_events
   - create_table.bm_cytology
+  - create_table.common_events
   - create_table.conc_procedures
   - create_table.continuous
   - create_table.general