Nothing
# 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)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.