Merge pull request #28 from Merck/develop-exp-duration-function

Develop format and rtf functions for exposure duration anaylsis

NAMESPACE

@@ -5,16 +5,22 @@ export(defmt_pct)
 export(format_base_char)
 export(format_base_char_subgroup)
 export(format_disposition)
+export(format_exp_duration)
+export(format_sl_summary)
 export(format_trt_compliance)
 export(meta_sl)
 export(meta_sl_example)
+export(meta_sl_exposure_example)
 export(prepare_base_char)
 export(prepare_base_char_subgroup)
 export(prepare_disposition)
+export(prepare_exp_duration)
 export(prepare_sl_summary)
 export(prepare_trt_compliance)
 export(react_base_char)
 export(rtf_base_char)
 export(rtf_base_char_subgroup)
 export(rtf_disposition)
+export(rtf_exp_duration)
+export(rtf_sl_summary)
 export(rtf_trt_compliance)

R/format_base_char.R → R/format_sl_summary.R

@@ -34,9 +34,9 @@
 #' meta <- meta_sl_example()
 #'
 #' meta |>
-#'   prepare_base_char(parameter = "age;gender") |>
-#'   format_base_char()
-format_base_char <- function(
+#'   prepare_sl_summary(population = "apat", analysis = "base_char", parameter = "age;gender") |>
+#'   format_sl_summary()
+format_sl_summary <- function(
     outdata,
     display_col = c("n", "prop", "total"),
     digits_prop = 1,
@@ -120,9 +120,25 @@ format_base_char <- function(
   return(outdata)
 }
 
+#' Format Baseline Characteristics Analysis
+#'
+#' @inheritParams format_sl_summary
+#'
+#' @return A list of analysis raw datasets.
+#'
+#' @export
+#'
+#' @examples
+#' meta <- meta_sl_example()
+#'
+#' meta |>
+#'   prepare_base_char(population = "apat", parameter = "age;gender") |>
+#'   format_base_char()
+format_base_char <- format_sl_summary
+
 #' Format Treatment Compliance Analysis
 #'
-#' @inheritParams format_base_char
+#' @inheritParams format_sl_summary
 #'
 #' @return A list of analysis raw datasets.
 #'
@@ -134,12 +150,28 @@ format_base_char <- function(
 #' meta |>
 #'   prepare_trt_compliance(parameter = "comp8;comp16") |>
 #'   format_trt_compliance()
-format_trt_compliance <- format_base_char
+format_trt_compliance <- format_sl_summary
+
+#' Format Treatment Compliance Analysis
+#'
+#' @inheritParams format_sl_summary
+#'
+#' @return A list of analysis raw datasets.
+#'
+#' @export
+#'
+#' @examples
+#' meta <- meta_sl_example()
+#'
+#' meta |>
+#'   prepare_trt_compliance(population = "apat", parameter = "comp8;comp16") |>
+#'   format_trt_compliance()
+format_trt_compliance <- format_sl_summary
 
 
 #' Format Disposition Analysis
 #'
-#' @inheritParams format_base_char
+#' @inheritParams format_sl_summary
 #'
 #' @return A list of analysis raw datasets.
 #'
@@ -149,8 +181,22 @@ format_trt_compliance <- format_base_char
 #' meta <- meta_sl_example()
 #'
 #' meta |>
-#'   prepare_disposition(parameter = "disposition;medical-disposition") |>
+#'   prepare_disposition(population = "apat", parameter = "disposition;medical-disposition") |>
 #'   format_disposition()
-format_disposition <- format_base_char
-
+format_disposition <- format_sl_summary
 
+#' Format Exposure Duration Analysis
+#'
+#' @inheritParams format_sl_summary
+#'
+#' @return A list of analysis raw datasets.
+#'
+#' @export
+#'
+#' @examples
+#' meta <- meta_sl_exposure_example()
+#'
+#' meta |>
+#'   prepare_exp_duration(population = "apat", parameter = "expdur") |>
+#'   format_exp_duration()
+format_exp_duration <- format_sl_summary

R/meta_sl_example.R

@@ -178,6 +178,9 @@ meta_sl_exposure_example <- function() {
   adexsum$EXDURGR[adexsum$AVAL>=12*7] <- ">=12 weeks"
   adexsum$EXDURGR[adexsum$AVAL>=24*7] <- ">=24 weeks"
 
+  adexsum$EXDURGR <- factor(adexsum$EXDURGR,
+                            levels = c("not treated", ">=1 day", ">=7 days", ">=28 days", ">=12 weeks", ">=24 weeks"))
+
   plan <- metalite::plan(
     analysis = "exp_dur", population = "apat",
     observation = "apat", parameter = "expdur"

R/prepare_base_char.R

@@ -16,7 +16,7 @@
 # You should have received a copy of the GNU General Public License
 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-#' Prepare data for treatment compliance table
+#' Prepare data for baseline characteristic table
 #'
 #' @param meta A metadata object created by metalite.
 #' @param population A character value of population term name.

R/prepare_sl_summary.R

@@ -110,7 +110,8 @@ prepare_sl_summary <- function(
     char_var = char_var,
     char_prop = char_prop,
     var_type = var_type,
-    group_label = unique(pop[[pop_group]])
+    group_label = unique(pop[[pop_group]]),
+    analysis = analysis
   )
 
   return(ans)

R/rtf_exp_duration.R

@@ -0,0 +1,68 @@
+# Copyright (c) 2024 Merck & Co., Inc., Rahway, NJ, USA and its affiliates.
+# All rights reserved.
+#
+# This file is part of the metalite.sl program.
+#
+# metalite.sl is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+#' Exposure duration table
+#'
+#' @param outdata An `outdata` object created by [prepare_sl_summary()].
+#' @param source A character value of the data source.
+#' @inheritParams r2rtf::rtf_page
+#' @inheritParams r2rtf::rtf_body
+#' @param footnotes A character vector of table footnotes.
+#' @param title Term "analysis", "observation" and "population") for collecting title from metadata or a character vector of table titles.
+#' @param path_outdata A character string of the outdata path.
+#' @param path_outtable A character string of the outtable path.
+#'
+#' @return RTF file and source dataset for baseline characteristic table.
+#'
+#' @export
+#'
+#' @examples
+#' meta <- meta_sl_exposure_example()
+#'
+#' meta |>
+#'   prepare_exp_duration(population = "apat", parameter = "expdur") |>
+#'   format_exp_duration() |>
+#'   rtf_exp_duration(
+#'     source = "Source: [CDISCpilot: adam-adsl; adex]",
+#'     path_outdata = tempfile(fileext = ".Rdata"),
+#'     path_outtable = tempfile(fileext = ".rtf")
+#'   )
+rtf_exp_duration <- function(outdata,
+                             source = "Source: [CDISCpilot: adam-adsl; adex]",
+                             col_rel_width = NULL,
+                             text_font_size = 9,
+                             orientation = "portrait",
+                             footnotes = c("Each participant is counted once on each applicable duration category row.", 
+                                           "Duration of Exposure is the time from the first dose date to the last dose date."),
+                             title = NULL,
+                             path_outdata = NULL,
+                             path_outtable = NULL){
+  return(
+    rtf_sl_summary(
+      outdata,
+      source,
+      col_rel_width = col_rel_width,
+      text_font_size = text_font_size,
+      orientation = orientation,
+      footnotes = footnotes,
+      title = title,
+      path_outdata = path_outdata,
+      path_outtable = path_outtable
+    ) 
+  )
+}

R/rtf_base_char.R → R/rtf_sl_summary.R

@@ -35,17 +35,18 @@
 #' meta <- meta_sl_example()
 #'
 #' meta |>
-#'   prepare_base_char(
+#'   prepare_sl_summary(
 #'     population = "apat",
+#'     analysis = "base_char",
 #'     parameter = "age;gender"
 #'   ) |>
-#'   format_base_char() |>
-#'   rtf_base_char(
+#'   format_sl_summary() |>
+#'   rtf_sl_summary(
 #'     source = "Source: [CDISCpilot: adam-adsl]",
 #'     path_outdata = tempfile(fileext = ".Rdata"),
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
-rtf_base_char <- function(
+rtf_sl_summary <- function(
     outdata,
     source,
     col_rel_width = NULL,
@@ -72,7 +73,7 @@ rtf_base_char <- function(
     stop(
       "col_rel_width must have the same length (has ",
       length(col_rel_width),
-      ") as as `outdata$tbl` has number of columns (has ",
+      ") as `outdata$tbl` has number of columns (has ",
       n_col, ").",
       call. = FALSE
     )
@@ -84,7 +85,7 @@ rtf_base_char <- function(
       outdata$population,
       "",
       outdata$parameter,
-      analysis = "base_char"
+      analysis = outdata$analysis
     )
   }
 
@@ -195,9 +196,34 @@ rtf_base_char <- function(
   rtf_output(outdata, path_outdata, path_outtable)
 }
 
-#' Format Treatment Compliance Analysis
+#' Baseline characteristic table
+#'
+#' @inheritParams rtf_sl_summary
+#'
+#' @return A list of analysis raw datasets.
+#'
+#' @export
+#'
+#' @examples
+#' meta <- meta_sl_example()
+#'
+#' meta |>
+#'   prepare_base_char(
+#'     population = "apat",
+#'     analysis = "base_char",
+#'     parameter = "age;gender"
+#'   ) |>
+#'   format_base_char() |>
+#'   rtf_base_char(
+#'     source = "Source: [CDISCpilot: adam-adsl]",
+#'     path_outdata = tempfile(fileext = ".Rdata"),
+#'     path_outtable = tempfile(fileext = ".rtf")
+#'   )
+rtf_base_char <- rtf_sl_summary
+
+#' Treatment compliance table
 #'
-#' @inheritParams rtf_base_char
+#' @inheritParams rtf_sl_summary
 #'
 #' @return A list of analysis raw datasets.
 #'
@@ -207,19 +233,19 @@ rtf_base_char <- function(
 #' meta <- meta_sl_example()
 #'
 #' meta |>
-#'   prepare_trt_compliance(parameter = "comp8;comp16") |>
+#'   prepare_trt_compliance(population = "apat", parameter = "comp8;comp16") |>
 #'   format_trt_compliance() |>
 #'   rtf_trt_compliance(
 #'     source = "Source: [CDISCpilot: adam-adsl]",
 #'     path_outdata = tempfile(fileext = ".Rdata"),
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
-rtf_trt_compliance <- rtf_base_char
+rtf_trt_compliance <- rtf_sl_summary
 
 
-#' Format Disposition Analysis
+#' Disposition table
 #'
-#' @inheritParams rtf_base_char
+#' @inheritParams rtf_sl_summary
 #'
 #' @return A list of analysis raw datasets.
 #'
@@ -229,11 +255,11 @@ rtf_trt_compliance <- rtf_base_char
 #' meta <- meta_sl_example()
 #'
 #' meta |>
-#'   prepare_disposition(parameter = "disposition;medical-disposition") |>
+#'   prepare_disposition(population = "apat", parameter = "disposition;medical-disposition") |>
 #'   format_disposition() |>
 #'   rtf_disposition(
 #'     source = "Source: [CDISCpilot: adam-adsl]",
 #'     path_outdata = tempfile(fileext = ".Rdata"),
 #'     path_outtable = tempfile(fileext = ".rtf")
 #'   )
-rtf_disposition <- rtf_base_char
+rtf_disposition <- rtf_sl_summary