Initial commit

.Rbuildignore

@@ -0,0 +1,6 @@
+^LICENSE\.md$
+^.*\.Rproj$
+^\.Rproj\.user$
+^.*\.groovy$
+^jenkins$
+^.merck\.yml$

.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

DESCRIPTION

@@ -0,0 +1,30 @@
+Package: metalite.sl
+Title: Subject-level Analysis Using 'metalite'
+Version: 0.1.0
+Authors@R:c(
+    person("Benjamin", "Wang", email = "[email protected]", role = c("aut", "cre")),
+    person("Yujie", "Zhao", role = "aut"),
+    person("Hiroaki", "Fukuda", role = "aut"),
+    person("Jeetener", "Chauhan", role = "ctb"),
+    person("Merck Sharp & Dohme Corp", role = "cph")
+    )
+Description: Provide subject-level analysis.
+Depends: R (>= 4.1.0)
+License: GPL (>= 3)
+Imports:
+    r2rtf,
+    metalite,
+    metalite.ae,
+    reactable,
+    glue,
+    stringr
+Suggests:
+    dplyr,
+    testthat (>= 3.0.0),
+    tidyr,
+    knitr
+Encoding: UTF-8
+VignetteBuilder: knitr
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3
+Config/testthat/edition: 3

LICENSE_THIRD_PARTY.md

@@ -0,0 +1,24 @@
+metalite.sl uses third-party R packages which may be distributed under different
+licenses. We have listed all of these third party packages and their licenses
+below. However, the most up-to-date information can be found via inspecting
+the Imports field in the DESCRIPTION file.
+
+You must agree to the terms of these licenses, in addition to the metalite.ae
+source code license, in order to use this software.
+
+--------------------------------------------------
+Third party R packages listed by License type
+[Format: Name - URL]
+--------------------------------------------------
+
+MIT / X11 License (or adaptations) (https://www.opensource.org/licenses/MIT)
+  * rlang - https://rlang.r-lib.org/LICENSE.html
+  * glue - https://glue.tidyverse.org/LICENSE.html
+  * dplyr - https://dplyr.tidyverse.org/LICENSE.html
+  * tidyr - https://tidyr.tidyverse.org/LICENSE.html
+  * reactable - https://cran.r-project.org/web/packages/reactable/LICENSE
+
+GPL-3
+  * metalite - https://merck.github.io/metalite/LICENSE.html
+  * metalite.ae - https://merck.github.io/metalite.ae/LICENSE.html
+  * r2rtf - https://github.com/Merck/r2rtf/blob/master/LICENSE

NAMESPACE

@@ -0,0 +1,9 @@
+# Generated by roxygen2: do not edit by hand
+
+export(collect_baseline)
+export(defmt_pct)
+export(format_base_char)
+export(meta_sl_example)
+export(prepare_base_char)
+export(react_base_char)
+export(rtf_base_char)

NEWS.md

@@ -0,0 +1,4 @@
+# metalite.sl 0.1.0
+
+- Initial version.
+- Added a `NEWS.md` file to track changes to the package.

R/collect.R

@@ -0,0 +1,206 @@
+# 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/>.
+
+#' Count number of subjects
+#'
+#' @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 parameter A character value of parameter term name.
+#'   The term name is used as key to link information.
+#' @param type A character value to control title name,
+#'   e.g., Subjects or Records.
+#' @param use_na A character value for whether to include `NA` values
+#' in the table. See the `useNA` argument in [base::table()] for more details.
+#' @param display_total A logical value to display total column.
+#' @return A list containing number of subjects
+#' @export
+#'
+#' @examples
+#' meta <- meta_sl_example()
+#' meta |>
+#'   collect_baseline(
+#'     population = "apat",
+#'     parameter = "age"
+#'   )
+collect_baseline <- function(meta,
+                             population,
+                             parameter,
+                             type = "Subjects",
+                             use_na = c("ifany", "no", "always"),
+                             display_total = TRUE) {
+  use_na <- match.arg(use_na)
+
+  title <- c(
+    all = glue::glue("Number of {type}"),
+    with_data = glue::glue("{type} with Data"),
+    missing = "Missing"
+  )
+
+  if (display_total) {
+    meta <- metalite::meta_add_total(meta)
+  }
+
+  # Obtain variables
+  par_var <- metalite::collect_adam_mapping(meta, parameter)$var
+  par_var_group <- metalite::collect_adam_mapping(meta, parameter)$vargroup
+
+  # Obtain Data
+  pop <- metalite::collect_population_record(meta, population, var = c(par_var))
+
+  # Obtain ID
+  pop_id <- metalite::collect_adam_mapping(meta, population)$id
+
+  # Obtain Group
+  pop_group <- metalite::collect_adam_mapping(meta, population)$group
+
+  # Define analysis dataset
+  uid <- pop[[pop_id]]
+  id <- seq(uid)
+  group <- pop[[pop_group]]
+  var <- pop[[par_var]]
+
+  class_var <- class(var)
+
+  # Check ID duplication
+  if (any(duplicated(uid[!group %in% "Total"]))) {
+    warning(pop_id, " is not a unique ID")
+  }
+
+  # Obtain variable label
+  label <- metalite::collect_adam_mapping(meta, parameter)$label
+  if (is.null(label)) {
+    label <- metalite::collect_adam_mapping(meta, parameter)$var
+  }
+
+  # standardize group variable
+  stopifnot(inherits(group, c("factor", "character")))
+  group <- factor(group, exclude = NULL)
+  levels(group)[is.na(levels(group))] <- "Missing"
+
+  # standardize continuous variables
+  stopifnot(inherits(var, c("numeric", "integer", "factor", "character", "logical")))
+
+  # summary of population
+  all <- rep(title["all"], length(var))
+  pop_all <- metalite::n_subject(id, group, par = all)
+
+  var_n <- factor(is.na(var), c(FALSE, TRUE), title[c("with_data", "missing")])
+
+  # Obtain Number of Subjects
+  pop_n <- metalite::n_subject(id, group, par = var_n)
+
+  # Transfer logical value
+  if ("logical" %in% class_var) {
+    class_var <- "character"
+    var <- factor(var, c(TRUE, FALSE), c("Yes", "No"))
+  }
+
+  if (any(c("numeric", "integer") %in% class_var)) {
+    # calculate summary statistics
+    pop_num <- tapply(var, group, function(x) {
+      value <- c(
+        Mean = mean(x, na.rm = TRUE),
+        SD = stats::sd(x, na.rm = TRUE),
+        SE = stats::sd(x, na.rm = TRUE) / sqrt(sum(!is.na(x))),
+        Median = stats::median(x, na.rm = TRUE),
+        Min = min(x, na.rm = TRUE),
+        Max = max(x, na.rm = TRUE)
+      )
+      value <- formatC(value, format = "f", digits = 1)
+
+      value <- c(value,
+        `Q1 to Q3` = paste0(
+          stats::quantile(x, probs = 0.25, na.rm = TRUE, names = FALSE), " to ",
+          stats::quantile(x, probs = 0.75, na.rm = TRUE, names = FALSE)
+        ),
+        Range = paste0(min(x, na.rm = TRUE), " to ", max(x, na.rm = TRUE))
+      )
+
+      value
+    })
+    pop_num <- t(do.call(rbind, pop_num))
+    pop_num <- data.frame(
+      name = row.names(pop_num),
+      pop_num
+    )
+    # combine results
+    names(pop_num) <- names(pop_n)
+    row.names(pop_num) <- NULL
+    # add percentage
+    pop_prop <- pop_num
+    for (i in 2:ncol(pop_prop)) {
+      pop_prop[, i] <- NA
+    }
+  }
+
+  # standardize categorical variables
+  if (any(c("factor", "character") %in% class_var)) {
+    var <- factor(var, exclude = NULL)
+
+    if (all(is.na(var))) {
+      levels(var) <- c(levels(var), title["missing"])
+    } else {
+      levels(var)[is.na(levels(var))] <- title["missing"]
+    }
+
+    # Obtain Number of Subjects
+    pop_num <- metalite::n_subject(id, group, par = var)
+
+    pop_prop <- pop_num
+    for (i in seq(names(pop_prop))) {
+      if ("integer" %in% class(pop_prop[[i]])) {
+        pct <- pop_prop[[i]] / pop_all[[i]] * 100
+        pop_prop[[i]] <- pct
+      }
+    }
+  }
+
+  # variable group
+  if (!is.null(par_var_group)) {
+    vargroup <- pop[[par_var_group]]
+    stopifnot(inherits(vargroup, c("factor", "character")))
+    vargroup <- factor(vargroup, exclude = NULL)
+
+    if (all(is.na(vargroup))) {
+      levels(vargroup) <- c(levels(vargroup), title["missing"])
+    } else {
+      levels(vargroup)[is.na(levels(vargroup))] <- title["missing"]
+    }
+
+    # Obtain Number of Subjects
+    pop_num_group <- metalite::n_subject(id, group, par = vargroup)
+
+    pop_prop_group <- pop_num_group
+    for (i in seq(names(pop_prop_group))) {
+      if ("integer" %in% class(pop_prop_group[[i]])) {
+        pct <- pop_prop_group[[i]] / pop_all[[i]] * 100
+        pop_prop_group[[i]] <- pct
+      }
+    }
+
+    pop_num <- rbind(pop_num_group, pop_num)
+    pop_prop <- rbind(pop_prop_group, pop_prop)
+  }
+
+  pop_n["var_label"] <- label
+  pop_num["var_label"] <- label
+  pop_prop["var_label"] <- label
+
+  list(n = pop_n, stat = pop_num, pop = pop_prop, var_type = class_var)
+}