R/wlr.R

In simtrial: Clinical Trial Simulation

#  Copyright (c) 2024 Merck & Co., Inc., Rahway, NJ, USA and its affiliates.
#  All rights reserved.
#
#  This file is part of the simtrial program.
#
#  simtrial 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/>.

#' Weighted logrank test
#'
#' @param data Dataset that has been cut, generated by [sim_pw_surv()].
#' @param weight Weighting functions, such as [fh()], [mb()], and
#'   [early_zero()].
#' @param return_variance A logical flag that, if `TRUE`, adds columns
#'   estimated variance for weighted sum of observed minus expected;
#'   see details; Default: `FALSE`.
#'
#' @return A list containing the test method (`method`),
#' parameters of this test method (`parameter`),
#' point estimation of the treatment effect (`estimation`),
#' standardized error of the treatment effect (`se`),
#' Z-score (`z`), p-values (`p_value`).
#'
#' @importFrom data.table setDF setDT
#'
#' @export
#'
#' @details
#' - \eqn{z} - Standardized normal Fleming-Harrington weighted logrank test.
#' - \eqn{i} - Stratum index.
#' - \eqn{d_i} - Number of distinct times at which events occurred in
#'   stratum \eqn{i}.
#' - \eqn{t_{ij}} - Ordered times at which events in stratum
#'   \eqn{i}, \eqn{j = 1, 2, \ldots, d_i} were observed;
#'   for each observation, \eqn{t_{ij}} represents the time post study entry.
#' - \eqn{O_{ij.}} - Total number of events in stratum \eqn{i} that occurred
#'   at time \eqn{t_{ij}}.
#' - \eqn{O_{ije}} - Total number of events in stratum \eqn{i} in the
#'   experimental treatment group that occurred at time \eqn{t_{ij}}.
#' - \eqn{N_{ij.}} - Total number of study subjects in stratum \eqn{i}
#'   who were followed for at least duration.
#' - \eqn{E_{ije}} - Expected observations in experimental treatment group
#'   given random selection of \eqn{O_{ij.}} from those in
#'   stratum \eqn{i} at risk at time \eqn{t_{ij}}.
#' - \eqn{V_{ije}} - Hypergeometric variance for \eqn{E_{ije}} as
#'   produced in `Var` from [counting_process()].
#' - \eqn{N_{ije}} - Total number of study subjects in
#'   stratum \eqn{i} in the experimental treatment group
#'   who were followed for at least duration \eqn{t_{ij}}.
#' - \eqn{E_{ije}} - Expected observations in experimental group in
#'   stratum \eqn{i} at time \eqn{t_{ij}} conditioning on the overall number
#'   of events and at risk populations at that time and sampling at risk
#'   observations without replacement:
#'   \deqn{E_{ije} = O_{ij.} N_{ije}/N_{ij.}}
#' - \eqn{S_{ij}} - Kaplan-Meier estimate of survival in combined
#'   treatment groups immediately prior to time \eqn{t_{ij}}.
#' - \eqn{\rho, \gamma} - Real parameters for Fleming-Harrington test.
#' - \eqn{X_i} - Numerator for signed logrank test in stratum \eqn{i}
#'   \deqn{X_i = \sum_{j=1}^{d_{i}} S_{ij}^\rho(1-S_{ij}^\gamma)(O_{ije}-E_{ije})}
#' - \eqn{V_{ij}} - Variance used in denominator for Fleming-Harrington
#'   weighted logrank tests
#'   \deqn{V_i = \sum_{j=1}^{d_{i}} (S_{ij}^\rho(1-S_{ij}^\gamma))^2V_{ij})}
#'   The stratified Fleming-Harrington weighted logrank test is then computed as:
#'   \deqn{z = \sum_i X_i/\sqrt{\sum_i V_i}.}
#'
#' @examples
#' x <- sim_pw_surv(n = 200) |> cut_data_by_event(100)
#'
#' # Example 1: WLR test with FH wights
#' x |> wlr(weight = fh(rho = 0, gamma = 1))
#' x |> wlr(weight = fh(rho = 0, gamma = 1), return_variance = TRUE)
#'
#' # Example 2: WLR test with MB wights
#' x |> wlr(weight = mb(delay = 4, w_max = 2))
#'
#' # Example 3: WLR test with early zero wights
#' x |> wlr(weight = early_zero(early_period = 4))
wlr <- function(data, weight, return_variance = FALSE) {
  x <- data |> counting_process(arm = "experimental")

  ans <- list()
  ans$method <- "WLR"

  if (inherits(weight, "fh")) {
    x <- x |> fh_weight(rho = weight$rho, gamma = weight$gamma)

    ans$parameter <- paste0("FH(rho=", weight$rho, ", gamma=", weight$gamma, ")")
    ans$estimation <- sum(x$weight * x$o_minus_e)
    ans$se <- sqrt(sum(x$weight^2 * x$var_o_minus_e))
    ans$z <- ans$estimation / ans$se
  } else if (inherits(weight, "mb")) {
    x <- x |> mb_weight(delay = weight$delay, w_max = weight$w_max)

    ans$parameter <- paste0("MB(delay = ", weight$delay, ", max_weight = ", weight$w_max, ")")
    ans$estimate <- sum(x$o_minus_e * x$mb_weight)
    ans$se <- sqrt(sum(x$var_o_minus_e * x$mb_weight^2))
    ans$z <- ans$estimate / ans$se
  } else if (inherits(weight, "early_period")) {
    x <- x |> early_zero_weight(early_period = weight$early_period, fail_rate = weight$fail_rate)

    ans$parameter <- paste0("Xu 2017 with first ", weight$early_period, " months of 0 weights")
    ans$estimate <- sum(x$o_minus_e * x$weight)
    ans$se <- sqrt(sum(x$var_o_minus_e * x$weight^2))
    ans$z <- ans$estimate / ans$se
  }
  return(ans)
}