R/getCutDateForCount.R

Defines functions get_cut_date_by_event

Documented in get_cut_date_by_event

#  Copyright (c) 2022 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/>.

#' @importFrom dplyr ungroup select mutate filter arrange last
NULL
#' Get Date at Which an Event Count is Reached
#'
#' @param x a time-to-event dataset, e.g., generated by \code{sim_pw_surv}
#' @param count event count at which dataset is to be cut off for analysis
#'
#' @examples
#' library(dplyr)
#' library(tibble)
#'
#' # Use default enrollment and calendar cut date for 50 events in Positive stratum
#' x <- sim_pw_surv(
#'   n = 200,
#'   strata = tibble(Stratum = c("Positive", "Negative"),
#'                   p = c(.5, .5)),
#'   fail_rate = tibble(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)),
#'   dropoutRates = tibble(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"), count = 50)
#'
#' y <- cut_data_by_date(x, cut_date = d)
#' table(y$Stratum, y$event)
#'
#' @return The a numeric value with the \code{cte} from the input dataset at which the targeted event count
#' is reached, or if the final event count is never reached, the final \code{cte} at which an event occurs.
#'
#' @export

get_cut_date_by_event <- function(x, count){
  y <- x %>%
    ungroup() %>%
    select(cte, fail) %>%
    filter(fail == 1) %>%
    select(cte) %>%
    arrange(cte) %>%
    mutate(eventCount = row_number()) %>%
    subset(eventCount <= count)

  return(last(y$cte))
}
keaven/simtrial documentation built on April 17, 2023, 4:03 a.m.