# 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))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.