2 develop the prepare_disposition for the disposition table

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: metalite.sl
 Title: Subject-level Analysis Using 'metalite'
-Version: 0.1.0
-Authors@R: c(
+Version: 0.1.1
+Authors@R:c(
     person("Benjamin", "Wang", email = "[email protected]", role = c("aut", "cre")),
     person("Yujie", "Zhao", role = "aut"),
     person("Hiroaki", "Fukuda", role = "aut"),

NAMESPACE

@@ -5,5 +5,6 @@ export(defmt_pct)
 export(format_base_char)
 export(meta_sl_example)
 export(prepare_base_char)
+export(prepare_disposition)
 export(react_base_char)
 export(rtf_base_char)

R/prepare_disposition.R

@@ -0,0 +1,113 @@
+# 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/>.
+
+#' Prepare data for disposition table
+#'
+#' @param meta A metadata object created by metalite.
+#' @param population A character value of population term name.
+#'   The term name is used as key to link information.
+#' @param observation A character value of observation term name.
+#'   The term name is used as key to link information.
+#' @param analysis A character value of analysis term name.
+#'   The term name is used as key to link information.
+#' @param parameter A character value of parameter term name.
+#'   The term name is used as key to link information.
+#'
+#' @return A list of analysis raw datasets.
+#'
+#' @export
+#'
+#' @examples
+#' meta <- meta_sl_example()
+#'
+#' meta |>
+#'   prepare_base_char()
+prepare_disposition <- function(meta,
+                                population = "apat",
+                                observation = "apat",
+                                analysis = "disp",
+                                parameter = "disposition;medical-disposition") {
+
+  parameters <- unlist(strsplit(parameter, ";"))
+
+  # obtain variables
+  pop_var <- metalite::collect_adam_mapping(meta, population)$var
+  obs_var <- metalite::collect_adam_mapping(meta, observation)$var
+  par_var <- metalite::collect_adam_mapping(meta, parameter)$var
+
+  pop_group <- metalite::collect_adam_mapping(meta, population)$group
+  obs_group <- metalite::collect_adam_mapping(meta, observation)$group
+
+  pop_id <- metalite::collect_adam_mapping(meta, population)$id
+  obs_id <- metalite::collect_adam_mapping(meta, observation)$id
+
+  # obtain data
+  pop <- metalite::collect_population_record(meta, population, var = pop_var)
+
+  # obtain group names
+  group <- unique(pop[[pop_group]])
+
+  # count the number of subjects in each arms
+  n_pop <- metalite::n_subject(id = pop[[pop_id]], group = pop[[pop_group]])
+  names(n_pop) <- do.call(
+    c,
+    lapply(
+      factor(names(n_pop), levels = levels(pop[[pop_group]])) |> as.numeric(),
+      function(x) {
+        paste0("n_", x)
+      }
+    )
+  )
+  n_pop$n_9999 <- sum(n_pop[1, ])
+  n_pop$name <- "Participants in population"
+  n_pop <- n_pop[, c(length(group) + 2, 1:(length(group) + 1))]
+  n_pop$var_label <- "-----"
+
+  # get the baseline characteristics variables in adsl
+  disp_var <- do.call(c, lapply(parameters, function(x) {
+    metalite::collect_adam_mapping(meta, x)$var
+  }))
+
+  # get the baseline characteristics counts
+  disp_n <- lapply(parameters, function(x) {
+    collect_baseline(meta, population, x)[[2]]
+  })
+
+  # get the baseline characteristics propositions
+  disp_prop <- lapply(parameters, function(x) {
+    collect_baseline(meta, population, x)[[3]]
+  })
+
+  # Get the variable date type
+  var_type <- lapply(parameters, function(x) {
+    collect_baseline(meta, population, x)[[4]]
+  })
+
+  ans <- metalite::outdata(
+    meta, population, observation, parameter,
+    n = n_pop,
+    order = NULL, group = pop_group, reference_group = NULL,
+    char_n = disp_n,
+    char_var = disp_var,
+    char_prop = disp_prop,
+    var_type = var_type,
+    group_label = unique(pop[[pop_group]])
+  )
+
+  return(ans)
+}

vignettes/disposition.Rmd

@@ -0,0 +1,142 @@
+---
+title: "Disposition Table"
+output:
+  rmarkdown::html_document:
+    toc: true
+    toc_float: true
+    toc_depth: 2
+    number_sections: true
+    highlight: "textmate"
+    css: "custom.css"
+# bibliography: "example.bib"
+vignette: >
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteIndexEntry{What the Vignette Does (Title Case)}
+---
+
+```{r}
+library(metalite)
+library(metalite.sl)
+```
+
+# Build a metadata
+```{r}
+adsl <- r2rtf::r2rtf_adsl
+adsl$TRTA <- adsl$TRT01A
+adsl$TRTA <- factor(adsl$TRTA,
+  levels = c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose"),
+  labels = c("Placebo", "Low Dose", "High Dose")
+)
+
+# Create a variable EOSSTT indicating the end of end of study status
+adsl$EOSSTT <- sample(x = c("Participants Ongoing", "Discontinued"),
+                      size = length(adsl$USUBJID), 
+                      prob = c(0.8, 0.2), replace = TRUE)
+# Create a variable EOTSTT1 indicating the end of treatment status part 1
+adsl$EOTSTT1 <- sample(x = c("Completed", "Discontinued"),
+                      size = length(adsl$USUBJID), 
+                      prob = c(0.85, 0.15), replace = TRUE)
+meta <- meta_adam(
+  population = adsl,
+  observation = adsl
+  ) |>
+  define_plan(plan = plan(
+    analysis = "base_char", population = "apat",
+    observation = "apat", parameter = "age;gender;race")
+  ) |>
+  define_plan(plan = plan(
+    analysis = "disp", population = "apat",
+    observation = "apat", parameter = "disposition;medical-disposition")
+  ) |>
+  define_population(
+    name = "apat",
+    group = "TRTA",
+    subset = quote(SAFFL == "Y"),
+    var = c("USUBJID", "TRTA", "SAFFL", "AGEGR1", "SEX", "RACE", "EOSSTT", "EOTSTT1")
+  ) |>
+  define_observation(
+    name = "apat",
+    group = "TRTA",
+    subset = quote(SAFFL == "Y"),
+    var = c("USUBJID", "TRTA", "SAFFL", "AGEGR1", "SEX", "RACE")
+  ) |>
+  define_parameter(
+    name = "age",
+    var = "AGE",
+    label = "Age (years)",
+    vargroup = "AGEGR1"
+  ) |>
+  define_parameter(
+    name = "gender",
+    var = "SEX",
+    label = "Gender"
+  ) |>
+  define_parameter(
+    name = "race",
+    var = "RACE",
+    label = "Race"
+  ) |>
+  define_parameter(
+    name = "disposition",
+    var = "EOSSTT",
+    label = "Trial Disposition"
+  ) |>
+  define_parameter(
+    name = "medical-disposition",
+    var = "EOTSTT1",
+    label = "Participant Study Medication Disposition"
+  ) |>
+  define_analysis(
+    name = "base_char",
+    title = "Participant Baseline Characteristics by Treatment Group",
+    label = "baseline characteristic table"
+  ) |>
+  define_analysis(
+    name = "disp",
+    title = "Disposition of Participant",
+    label = "disposition table"
+  ) |>
+  meta_build()
+```
+
+# Prepare the numbers
+```{r}
+outdata <- meta |>
+  prepare_disposition(
+    population = "apat",
+    observation = "apat",
+    analysis = "disp",
+    parameter = "disposition;medical-disposition"
+  )
+
+outdata
+#
+outdata$n
+outdata$char_n
+outdata$char_var
+outdata$char_prop
+```
+
+# Formate the numbers
+```{r, eval=FALSE}
+outdata <- outdata |> format_disposition(display_col = c("n", "prop", "total"), digits_prop = 2)
+
+outdata$tbl
+```
+
+```{r, eval=FALSE}
+outdata <- outdata |> format_disposition(display_col = c("n", "prop"), digits_prop = 3)
+
+outdata$tbl
+```
+
+# Output as rtf
+```{r, eval=FALSE}
+outdata |> rtf_base_char(
+  source = "Source: [CDISCpilot: adam-adsl]",
+  path_outdata = file.path(tempdir(), "base0char111.rtf"),
+  path_outtable = tempfile(fileext = ".Rdata")
+)
+```
+
+# References