get_cut_date_by_event.R

#  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/>.

#' Get date at which an event count is reached
#'
#' @param x A time-to-event dataset, for example, generated by [sim_pw_surv()].
#' @param event Event count at which dataset is to be cut off for analysis.
#'
#' @return A numeric value with the `cte` from the input dataset
#'   at which the targeted event count is reached, or if the final event count
#'   is never reached, the final `cte` at which an event occurs.
#'
#' @importFrom data.table ":=" as.data.table frankv last
#'
#' @export
#'
#' @examplesIf requireNamespace("dplyr", quietly = TRUE)
#' library(dplyr)
#'
#' # Use default enrollment and calendar cut date
#' # for 50 events in the "Positive" stratum
#' x <- sim_pw_surv(
#'   n = 200,
#'   stratum = data.frame(
#'     stratum = c("Positive", "Negative"),
#'     p = c(.5, .5)
#'   ),
#'   fail_rate = data.frame(
#'     stratum = rep(c("Positive", "Negative"), 2),
#'     period = rep(1, 4),
#'     treatment = c(rep("control", 2), rep("experimental", 2)),
#'     duration = rep(1, 4),
#'     rate = log(2) / c(6, 9, 9, 12)
#'   ),
#'   dropout_rate = data.frame(
#'     stratum = rep(c("Positive", "Negative"), 2),
#'     period = rep(1, 4),
#'     treatment = c(rep("control", 2), rep("experimental", 2)),
#'     duration = rep(1, 4),
#'     rate = rep(.001, 4)
#'   )
#' )
#'
#' d <- get_cut_date_by_event(x |> filter(stratum == "Positive"), event = 50)
#'
#' y <- cut_data_by_date(x, cut_date = d)
#' table(y$stratum, y$event)
get_cut_date_by_event <- function(x, event) {
  y <- as.data.table(x)
  y <- y[fail == 1, ]
  y <- y[, .(cte)]
  y <- y[order(cte), ]
  y[, eventCount := frankv(y, "cte", ties.method = "first")]
  y <- y[eventCount <= event, ]

  return(last(y$cte))
}