#' Control functions for Kaplan-Meier plot annotation tables

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Auxiliary functions for controlling arguments for formatting the annotation tables that can be added to plots

#' generated via [g_km()].

#'

#' @param x (`proportion`)\cr x-coordinate for center of annotation table.

#' @param y (`proportion`)\cr y-coordinate for center of annotation table.

#' @param w (`proportion`)\cr relative width of the annotation table.

#' @param h (`proportion`)\cr relative height of the annotation table.

#' @param fill (`flag` or `character`)\cr whether the annotation table should have a background fill color.

#'   Can also be a color code to use as the background fill color. If `TRUE`, color code defaults to `"#00000020"`.

#'

#' @return A list of components with the same names as the arguments.

#'

#' @seealso [g_km()]

#'

#' @name control_annot

NULL

#' @describeIn control_annot Control function for formatting the median survival time annotation table. This annotation

#'   table can be added in [g_km()] by setting `annot_surv_med=TRUE`, and can be configured using the

#'   `control_surv_med_annot()` function by setting it as the `control_annot_surv_med` argument.

#'

#' @examples

#' control_surv_med_annot()

#'

#' @export

control_surv_med_annot <- function(x = 0.8, y = 0.85, w = 0.32, h = 0.16, fill = TRUE) {

}

#' @describeIn control_annot Control function for formatting the Cox-PH annotation table. This annotation table can be

#'   added in [g_km()] by setting `annot_coxph=TRUE`, and can be configured using the `control_coxph_annot()` function

#'   by setting it as the `control_annot_coxph` argument.

#'

#' @param ref_lbls (`flag`)\cr whether the reference group should be explicitly printed in labels for the

#'   annotation table. If `FALSE` (default), only comparison groups will be printed in the table labels.

#'

#' @examples

#' control_coxph_annot()

#'

#' @export

control_coxph_annot <- function(x = 0.29, y = 0.51, w = 0.4, h = 0.125, fill = TRUE, ref_lbls = FALSE) {

}

#' Helper function to calculate x-tick positions

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Calculate the positions of ticks on the x-axis. However, if `xticks` already

#' exists it is kept as is. It is based on the same function `ggplot2` relies on,

#' and is required in the graphic and the patient-at-risk annotation table.

#'

#' @inheritParams g_km

#' @inheritParams h_ggkm

#'

#' @return A vector of positions to use for x-axis ticks on a `ggplot` object.

#'

#' @examples

#' library(dplyr)

#' library(survival)

#'

#' data <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .) %>%

#'   h_data_plot()

#'

#' h_xticks(data)

#' h_xticks(data, xticks = seq(0, 3000, 500))

#' h_xticks(data, xticks = 500)

#' h_xticks(data, xticks = 500, max_time = 6000)

#' h_xticks(data, xticks = c(0, 500), max_time = 300)

#' h_xticks(data, xticks = 500, max_time = 300)

#'

#' @export

h_xticks <- function(data, xticks = NULL, max_time = NULL) {

    } else {

    }

    } else {

    }

  } else {

      )

    )

  }

}

#' Helper function for survival estimations

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Transform a survival fit to a table with groups in rows characterized by N, median and confidence interval.

#'

#' @inheritParams h_data_plot

#'

#' @return A summary table with statistics `N`, `Median`, and `XX% CI` (`XX` taken from `fit_km`).

#'

#' @examples

#' library(dplyr)

#' library(survival)

#'

#' adtte <- tern_ex_adtte %>% filter(PARAMCD == "OS")

#' fit <- survfit(

#'   formula = Surv(AVAL, 1 - CNSR) ~ ARMCD,

#'   data = adtte

#' )

#' h_tbl_median_surv(fit_km = fit)

#'

#' @export

h_tbl_median_surv <- function(fit_km, armval = "All") {

  } else {

  }

  )

  )

}

#' Helper function for generating a pairwise Cox-PH table

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Create a `data.frame` of pairwise stratified or unstratified Cox-PH analysis results.

#'

#' @inheritParams g_km

#' @param annot_coxph_ref_lbls (`flag`)\cr whether the reference group should be explicitly printed in labels for the

#'   `annot_coxph` table. If `FALSE` (default), only comparison groups will be printed in `annot_coxph` table labels.

#'

#' @return A `data.frame` containing statistics `HR`, `XX% CI` (`XX` taken from `control_coxph_pw`),

#'   and `p-value (log-rank)`.

#'

#' @examples

#' library(dplyr)

#'

#' adtte <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   mutate(is_event = CNSR == 0)

#'

#' h_tbl_coxph_pairwise(

#'   df = adtte,

#'   variables = list(tte = "AVAL", is_event = "is_event", arm = "ARM"),

#'   control_coxph_pw = control_coxph(conf_level = 0.9)

#' )

#'

#' @export

h_tbl_coxph_pairwise <- function(df,

                                 variables,

                                 ref_group_coxph = NULL,

                                 control_coxph_pw = control_coxph(),

                                 annot_coxph_ref_lbls = FALSE) {

    )

  }

    )

      ),

    )

}

#' Helper function to tidy survival fit data

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Convert the survival fit data into a data frame designed for plotting

#' within `g_km`.

#'

#' This starts from the [broom::tidy()] result, and then:

#'   * Post-processes the `strata` column into a factor.

#'   * Extends each stratum by an additional first row with time 0 and probability 1 so that

#'     downstream plot lines start at those coordinates.

#'   * Adds a `censor` column.

#'   * Filters the rows before `max_time`.

#'

#' @inheritParams g_km

#' @param fit_km (`survfit`)\cr result of [survival::survfit()].

#' @param armval (`string`)\cr used as strata name when treatment arm variable only has one level. Default is `"All"`.

#'

#' @return A `tibble` with columns `time`, `n.risk`, `n.event`, `n.censor`, `estimate`, `std.error`, `conf.high`,

#'   `conf.low`, `strata`, and `censor`.

#'

#' @examples

#' library(dplyr)

#' library(survival)

#'

#' # Test with multiple arms

#' tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .) %>%

#'   h_data_plot()

#'

#' # Test with single arm

#' tern_ex_adtte %>%

#'   filter(PARAMCD == "OS", ARMCD == "ARM B") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .) %>%

#'   h_data_plot(armval = "ARM B")

#'

#' @export

h_data_plot <- function(fit_km,

                        armval = "All",

                        max_time = NULL) {

    )

  } else {

  }

      )

    }

  )

  }

}

## Deprecated Functions ----

#' Helper function to create a KM plot

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Draw the Kaplan-Meier plot using `ggplot2`.

#'

#' @inheritParams g_km

#' @param data (`data.frame`)\cr survival data as pre-processed by `h_data_plot`.

#'

#' @return A `ggplot` object.

#'

#' @examples

#' \donttest{

#' library(dplyr)

#' library(survival)

#'

#' fit_km <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .)

#' data_plot <- h_data_plot(fit_km = fit_km)

#' xticks <- h_xticks(data = data_plot)

#' gg <- h_ggkm(

#'   data = data_plot,

#'   censor_show = TRUE,

#'   xticks = xticks,

#'   xlab = "Days",

#'   yval = "Survival",

#'   ylab = "Survival Probability",

#'   title = "Survival"

#' )

#' gg

#' }

#'

#' @export

h_ggkm <- function(data,

                   xticks = NULL,

                   yval = "Survival",

                   censor_show,

                   xlab,

                   ylab,

                   ylim = NULL,

                   title,

                   footnotes = NULL,

                   max_time = NULL,

                   lwd = 1,

                   lty = NULL,

                   pch = 3,

                   size = 2,

                   col = NULL,

                   ci_ribbon = FALSE,

                   ggtheme = nestcolor::theme_nest()) {

  )

    } else {

    }

  }

  # change estimates of survival to estimates of failure (1 - survival)

  }

      )

    ) +

  }

  }

  }

  }

      ),

    ) +

      )

  }

    } else {

    }

  }

  }

  )

}

#' `ggplot` decomposition

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' The elements composing the `ggplot` are extracted and organized in a `list`.

#'

#' @param gg (`ggplot`)\cr a graphic to decompose.

#'

#' @return A named `list` with elements:

#'   * `panel`: The panel.

#'   * `yaxis`: The y-axis.

#'   * `xaxis`: The x-axis.

#'   * `xlab`: The x-axis label.

#'   * `ylab`: The y-axis label.

#'   * `guide`: The legend.

#'

#' @examples

#' \donttest{

#' library(dplyr)

#' library(survival)

#' library(grid)

#'

#' fit_km <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .)

#' data_plot <- h_data_plot(fit_km = fit_km)

#' xticks <- h_xticks(data = data_plot)

#' gg <- h_ggkm(

#'   data = data_plot,

#'   yval = "Survival",

#'   censor_show = TRUE,

#'   xticks = xticks, xlab = "Days", ylab = "Survival Probability",

#'   title = "tt",

#'   footnotes = "ff"

#' )

#'

#' g_el <- h_decompose_gg(gg)

#' grid::grid.newpage()

#' grid.rect(gp = grid::gpar(lty = 1, col = "red", fill = "gray85", lwd = 5))

#' grid::grid.draw(g_el$panel)

#'

#' grid::grid.newpage()

#' grid.rect(gp = grid::gpar(lty = 1, col = "royalblue", fill = "gray85", lwd = 5))

#' grid::grid.draw(with(g_el, cbind(ylab, yaxis)))

#' }

#'

#' @export

h_decompose_gg <- function(gg) {

  )

  )

}

#' Helper function to prepare a KM layout

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Prepares a (5 rows) x (2 cols) layout for the Kaplan-Meier curve.

#'

#' @inheritParams g_km

#' @inheritParams h_ggkm

#' @param g_el (`list` of `gtable`)\cr list as obtained by `h_decompose_gg()`.

#' @param annot_at_risk (`flag`)\cr compute and add the annotation table reporting the number of

#'   patient at risk matching the main grid of the Kaplan-Meier curve.

#'

#' @return A grid layout.

#'

#' @details The layout corresponds to a grid of two columns and five rows of unequal dimensions. Most of the

#'   dimension are fixed, only the curve is flexible and will accommodate with the remaining free space.

#'   * The left column gets the annotation of the `ggplot` (y-axis) and the names of the strata for the patient

#'     at risk tabulation. The main constraint is about the width of the columns which must allow the writing of

#'     the strata name.

#'   * The right column receive the `ggplot`, the legend, the x-axis and the patient at risk table.

#'

#' @examples

#' \donttest{

#' library(dplyr)

#' library(survival)

#' library(grid)

#'

#' fit_km <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .)

#' data_plot <- h_data_plot(fit_km = fit_km)

#' xticks <- h_xticks(data = data_plot)

#' gg <- h_ggkm(

#'   data = data_plot,

#'   censor_show = TRUE,

#'   xticks = xticks, xlab = "Days", ylab = "Survival Probability",

#'   title = "tt", footnotes = "ff", yval = "Survival"

#' )

#' g_el <- h_decompose_gg(gg)

#' lyt <- h_km_layout(data = data_plot, g_el = g_el, title = "t", footnotes = "f")

#' grid.show.layout(lyt)

#' }

#'

#' @export

h_km_layout <- function(data, g_el, title, footnotes, annot_at_risk = TRUE, annot_at_risk_title = TRUE) {

  )

        )

      )

    )

  )

  }

  )

  )

  }

    }

  } else {

  }

    )

  )

}

#' Helper function to create patient-at-risk grobs

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Two graphical objects are obtained, one corresponding to row labeling and the second to the table of

#' numbers of patients at risk. If `title = TRUE`, a third object corresponding to the table title is

#' also obtained.

#'

#' @inheritParams g_km

#' @inheritParams h_ggkm

#' @param annot_tbl (`data.frame`)\cr annotation as prepared by [survival::summary.survfit()] which

#'   includes the number of patients at risk at given time points.

#' @param xlim (`numeric(1)`)\cr the maximum value on the x-axis (used to ensure the at risk table aligns with the KM

#'   graph).

#' @param title (`flag`)\cr whether the "Patients at Risk" title should be added above the `annot_at_risk`

#'   table. Has no effect if `annot_at_risk` is `FALSE`. Defaults to `TRUE`.

#'

#' @return A named `list` of two `gTree` objects if `title = FALSE`: `at_risk` and `label`, or three

#'   `gTree` objects if `title = TRUE`: `at_risk`, `label`, and `title`.

#'

#' @examples

#' \donttest{

#' library(dplyr)

#' library(survival)

#' library(grid)

#'

#' fit_km <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .)

#'

#' data_plot <- h_data_plot(fit_km = fit_km)

#'

#' xticks <- h_xticks(data = data_plot)

#'

#' gg <- h_ggkm(

#'   data = data_plot,

#'   censor_show = TRUE,

#'   xticks = xticks, xlab = "Days", ylab = "Survival Probability",

#'   title = "tt", footnotes = "ff", yval = "Survival"

#' )

#'

#' # The annotation table reports the patient at risk for a given strata and

#' # times (`xticks`).

#' annot_tbl <- summary(fit_km, times = xticks)

#' if (is.null(fit_km$strata)) {

#'   annot_tbl <- with(annot_tbl, data.frame(n.risk = n.risk, time = time, strata = "All"))

#' } else {

#'   strata_lst <- strsplit(sub("=", "equals", levels(annot_tbl$strata)), "equals")

#'   levels(annot_tbl$strata) <- matrix(unlist(strata_lst), ncol = 2, byrow = TRUE)[, 2]

#'   annot_tbl <- data.frame(

#'     n.risk = annot_tbl$n.risk,

#'     time = annot_tbl$time,

#'     strata = annot_tbl$strata

#'   )

#' }

#'

#' # The annotation table is transformed into a grob.

#' tbl <- h_grob_tbl_at_risk(data = data_plot, annot_tbl = annot_tbl, xlim = max(xticks))

#'

#' # For the representation, the layout is estimated for which the decomposition

#' # of the graphic element is necessary.

#' g_el <- h_decompose_gg(gg)

#' lyt <- h_km_layout(data = data_plot, g_el = g_el, title = "t", footnotes = "f")

#'

#' grid::grid.newpage()

#' pushViewport(viewport(layout = lyt, height = .95, width = .95))

#' grid.rect(gp = grid::gpar(lty = 1, col = "purple", fill = "gray85", lwd = 1))

#' pushViewport(viewport(layout.pos.row = 3:4, layout.pos.col = 2))

#' grid.rect(gp = grid::gpar(lty = 1, col = "orange", fill = "gray85", lwd = 1))

#' grid::grid.draw(tbl$at_risk)

#' popViewport()

#' pushViewport(viewport(layout.pos.row = 3:4, layout.pos.col = 1))

#' grid.rect(gp = grid::gpar(lty = 1, col = "green3", fill = "gray85", lwd = 1))

#' grid::grid.draw(tbl$label)

#' }

#'

#' @export

h_grob_tbl_at_risk <- function(data, annot_tbl, xlim, title = TRUE) {

  )

      )

    )

  }

    ),

      ),

    )

  )

    ),

    )

  )

            ),

          )

        )

      )

    ),

            ),

          )

        )

      )

    )

  )

            ),

          )

        )

      )

    )

  }

}

#' Helper function to create survival estimation grobs

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' The survival fit is transformed in a grob containing a table with groups in

#' rows characterized by N, median and 95% confidence interval.

#'

#' @inheritParams g_km

#' @inheritParams h_data_plot

#' @param ttheme (`list`)\cr see [gridExtra::ttheme_default()].

#' @param x (`proportion`)\cr a value between 0 and 1 specifying x-location.

#' @param y (`proportion`)\cr a value between 0 and 1 specifying y-location.

#' @param width (`grid::unit`)\cr width (as a unit) to use when printing the grob.

#'

#' @return A `grob` of a table containing statistics `N`, `Median`, and `XX% CI` (`XX` taken from `fit_km`).

#'

#' @examples

#' \donttest{

#' library(dplyr)

#' library(survival)

#' library(grid)

#'

#' grid::grid.newpage()

#' grid.rect(gp = grid::gpar(lty = 1, col = "pink", fill = "gray85", lwd = 1))

#' tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .) %>%

#'   h_grob_median_surv() %>%

#'   grid::grid.draw()

#' }

#'

#' @export

h_grob_median_surv <- function(fit_km,

                               armval = "All",

                               x = 0.9,

                               y = 0.9,

                               width = grid::unit(0.3, "npc"),

                               ttheme = gridExtra::ttheme_default()) {

  )

  ))

  })

  })

  }

  )

  )

    )

  )

}

#' Helper function to create grid object with y-axis annotation

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Build the y-axis annotation from a decomposed `ggplot`.

#'

#' @param ylab (`gtable`)\cr the y-lab as a graphical object derived from a `ggplot`.

#' @param yaxis (`gtable`)\cr the y-axis as a graphical object derived from a `ggplot`.

#'

#' @return A `gTree` object containing the y-axis annotation from a `ggplot`.

#'

#' @examples

#' \donttest{

#' library(dplyr)

#' library(survival)

#' library(grid)

#'

#' fit_km <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   survfit(formula = Surv(AVAL, 1 - CNSR) ~ ARMCD, data = .)

#' data_plot <- h_data_plot(fit_km = fit_km)

#' xticks <- h_xticks(data = data_plot)

#' gg <- h_ggkm(

#'   data = data_plot,

#'   censor_show = TRUE,

#'   xticks = xticks, xlab = "Days", ylab = "Survival Probability",

#'   title = "title", footnotes = "footnotes", yval = "Survival"

#' )

#'

#' g_el <- h_decompose_gg(gg)

#'

#' grid::grid.newpage()

#' pvp <- grid::plotViewport(margins = c(5, 4, 2, 20))

#' pushViewport(pvp)

#' grid::grid.draw(h_grob_y_annot(ylab = g_el$ylab, yaxis = g_el$yaxis))

#' grid.rect(gp = grid::gpar(lty = 1, col = "gray35", fill = NA))

#' }

#'

#' @export

h_grob_y_annot <- function(ylab, yaxis) {

  )

      ),

    )

  )

}

#' Helper function to create Cox-PH grobs

#'

#' @description `r lifecycle::badge("deprecated")`

#'

#' Grob of `rtable` output from [h_tbl_coxph_pairwise()]

#'

#' @inheritParams h_grob_median_surv

#' @param ... arguments to pass to [h_tbl_coxph_pairwise()].

#' @param x (`proportion`)\cr a value between 0 and 1 specifying x-location.

#' @param y (`proportion`)\cr a value between 0 and 1 specifying y-location.

#' @param width (`grid::unit`)\cr width (as a unit) to use when printing the grob.

#'

#' @return A `grob` of a table containing statistics `HR`, `XX% CI` (`XX` taken from `control_coxph_pw`),

#'   and `p-value (log-rank)`.

#'

#' @examples

#' \donttest{

#' library(dplyr)

#' library(survival)

#' library(grid)

#'

#' grid::grid.newpage()

#' grid.rect(gp = grid::gpar(lty = 1, col = "pink", fill = "gray85", lwd = 1))

#' data <- tern_ex_adtte %>%

#'   filter(PARAMCD == "OS") %>%

#'   mutate(is_event = CNSR == 0)

#' tbl_grob <- h_grob_coxph(

#'   df = data,

#'   variables = list(tte = "AVAL", is_event = "is_event", arm = "ARMCD"),

#'   control_coxph_pw = control_coxph(conf_level = 0.9), x = 0.5, y = 0.5

#' )

#' grid::grid.draw(tbl_grob)

#' }

#'

#' @export

h_grob_coxph <- function(...,

                         x = 0,

                         y = 0,

                         width = grid::unit(0.4, "npc"),

                         ttheme = gridExtra::ttheme_default(

                           padding = grid::unit(c(1, .5), "lines"),

                           core = list(bg_params = list(fill = c("grey95", "grey90"), alpha = .5))

                         )) {

  )

  ))

  })

  })

  }

      )

        )

      )

    },

      ))

          )

        )

      )

    }

  )

}

#' Occurrence table pruning

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Family of constructor and condition functions to flexibly prune occurrence tables.

#' The condition functions always return whether the row result is higher than the threshold.

#' Since they are of class [CombinationFunction()] they can be logically combined with other condition

#' functions.

#'

#' @note Since most table specifications are worded positively, we name our constructor and condition

#'   functions positively, too. However, note that the result of [keep_rows()] says what

#'   should be pruned, to conform with the [rtables::prune_table()] interface.

#'

#' @examples

#' \donttest{

#' tab <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("RACE") %>%

#'   split_rows_by("STRATA1") %>%

#'   summarize_row_groups() %>%

#'   analyze_vars("COUNTRY", .stats = "count_fraction") %>%

#'   build_table(DM)

#' }

#'

#' @name prune_occurrences

NULL

#' @describeIn prune_occurrences Constructor for creating pruning functions based on

#'   a row condition function. This removes all analysis rows (`TableRow`) that should be

#'   pruned, i.e., don't fulfill the row condition. It removes the sub-tree if there are no

#'   children left.

#'

#' @param row_condition (`CombinationFunction`)\cr condition function which works on individual

#'   analysis rows and flags whether these should be kept in the pruned table.

#'

#' @return

#' * `keep_rows()` returns a pruning function that can be used with [rtables::prune_table()]

#'   to prune an `rtables` table.

#'

#' @examples

#' \donttest{

#' # `keep_rows`

#' is_non_empty <- !CombinationFunction(all_zero_or_na)

#' prune_table(tab, keep_rows(is_non_empty))

#' }

#'

#' @export

keep_rows <- function(row_condition) {

    }

  }

}

#' @describeIn prune_occurrences Constructor for creating pruning functions based on

#'   a condition for the (first) content row in leaf tables. This removes all leaf tables where

#'   the first content row does not fulfill the condition. It does not check individual rows.

#'   It then proceeds recursively by removing the sub tree if there are no children left.

#'

#' @param content_row_condition (`CombinationFunction`)\cr condition function which works on individual

#'   first content rows of leaf tables and flags whether these leaf tables should be kept in the pruned table.

#'

#' @return

#' * `keep_content_rows()` returns a pruning function that checks the condition on the first content

#'   row of leaf tables in the table.

#'

#' @examples

#' # `keep_content_rows`

#' \donttest{

#' more_than_twenty <- has_count_in_cols(atleast = 20L, col_names = names(tab))

#' prune_table(tab, keep_content_rows(more_than_twenty))

#' }

#'

#' @export

keep_content_rows <- function(content_row_condition) {

    }

    }

  }

}

#' @describeIn prune_occurrences Constructor for creating condition functions on total counts in the specified columns.

#'

#' @param atleast (`numeric(1)`)\cr threshold which should be met in order to keep the row.

#' @param ... arguments for row or column access, see [`rtables_access`]: either `col_names` (`character`) including

#'   the names of the columns which should be used, or alternatively `col_indices` (`integer`) giving the indices

#'   directly instead.

#'

#' @return

#' * `has_count_in_cols()` returns a condition function that sums the counts in the specified column.

#'

#' @examples

#' \donttest{

#' more_than_one <- has_count_in_cols(atleast = 1L, col_names = names(tab))

#' prune_table(tab, keep_rows(more_than_one))

#' }

#'

#' @export

has_count_in_cols <- function(atleast, ...) {

  })

}

#' @describeIn prune_occurrences Constructor for creating condition functions on any of the counts in

#'   the specified columns satisfying a threshold.

#'

#' @param atleast (`numeric(1)`)\cr threshold which should be met in order to keep the row.

#'

#' @return

#' * `has_count_in_any_col()` returns a condition function that compares the counts in the

#'   specified columns with the threshold.

#'

#' @examples

#' \donttest{

#' # `has_count_in_any_col`

#' any_more_than_one <- has_count_in_any_col(atleast = 1L, col_names = names(tab))

#' prune_table(tab, keep_rows(any_more_than_one))

#' }

#'

#' @export

has_count_in_any_col <- function(atleast, ...) {

  })

}

#' @describeIn prune_occurrences Constructor for creating condition functions on total fraction in

#'   the specified columns.

#'

#' @return

#' * `has_fraction_in_cols()` returns a condition function that sums the counts in the

#'   specified column, and computes the fraction by dividing by the total column counts.

#'

#' @examples

#' \donttest{

#' # `has_fraction_in_cols`

#' more_than_five_percent <- has_fraction_in_cols(atleast = 0.05, col_names = names(tab))

#' prune_table(tab, keep_rows(more_than_five_percent))

#' }

#'

#' @export

has_fraction_in_cols <- function(atleast, ...) {

  })

}

#' @describeIn prune_occurrences Constructor for creating condition functions on any fraction in

#'   the specified columns.

#'

#' @return

#' * `has_fraction_in_any_col()` returns a condition function that looks at the fractions

#'  in the specified columns and checks whether any of them fulfill the threshold.

#'

#' @examples

#' \donttest{

#' # `has_fraction_in_any_col`

#' any_atleast_five_percent <- has_fraction_in_any_col(atleast = 0.05, col_names = names(tab))

#' prune_table(tab, keep_rows(any_atleast_five_percent))

#' }

#'

#' @export

has_fraction_in_any_col <- function(atleast, ...) {

  })

}

#' @describeIn prune_occurrences Constructor for creating condition function that checks the difference

#'   between the fractions reported in each specified column.

#'

#' @return

#' * `has_fractions_difference()` returns a condition function that extracts the fractions of each

#'   specified column, and computes the difference of the minimum and maximum.

#'

#' @examples

#' \donttest{

#' # `has_fractions_difference`

#' more_than_five_percent_diff <- has_fractions_difference(atleast = 0.05, col_names = names(tab))

#' prune_table(tab, keep_rows(more_than_five_percent_diff))

#' }

#'

#' @export

has_fractions_difference <- function(atleast, ...) {

  })

}

#' @describeIn prune_occurrences Constructor for creating condition function that checks the difference

#'   between the counts reported in each specified column.

#'

#' @return

#' * `has_counts_difference()` returns a condition function that extracts the counts of each

#'   specified column, and computes the difference of the minimum and maximum.

#'

#' @examples

#' \donttest{

#' more_than_one_diff <- has_counts_difference(atleast = 1L, col_names = names(tab))

#' prune_table(tab, keep_rows(more_than_one_diff))

#' }

#'

#' @export

has_counts_difference <- function(atleast, ...) {

  })

}

#' Survival time point analysis

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Summarize patients' survival rate and difference of survival rates between groups at a time point.

#'

#' @inheritParams argument_convention

#' @inheritParams s_surv_time

#' @param time_point (`numeric(1)`)\cr survival time point of interest.

#' @param control (`list`)\cr parameters for comparison details, specified by using the helper function

#'   [control_surv_timepoint()]. Some possible parameter options are:

#'   * `conf_level` (`proportion`)\cr confidence level of the interval for survival rate.

#'   * `conf_type` (`string`)\cr confidence interval type. Options are "plain" (default), "log", "log-log",

#'     see more in [survival::survfit()]. Note option "none" is no longer supported.

#'   * `time_point` (`numeric(1)`)\cr survival time point of interest.

#' @param method (`string`)\cr `surv` (survival estimations),

#'   `surv_diff` (difference in survival with the control), or `both`.

#' @param table_names_suffix (`string`)\cr optional suffix for the `table_names` used for the `rtables` to

#'   avoid warnings from duplicate table names.

#' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("surv_timepoint")`

#'   to see available statistics for this function.

#' @param .indent_mods (named `integer`)\cr indent modifiers for the labels. Each element of the vector

#'   should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation

#'   for that statistic's row label.

#'

#' @name survival_timepoint

#' @order 1

NULL

#' @describeIn survival_timepoint Statistics function which analyzes survival rate.

#'

#' @return

#' * `s_surv_timepoint()` returns the statistics:

#'   * `pt_at_risk`: Patients remaining at risk.

#'   * `event_free_rate`: Event-free rate (%).

#'   * `rate_se`: Standard error of event free rate.

#'   * `rate_ci`: Confidence interval for event free rate.

#'

#' @keywords internal

s_surv_timepoint <- function(df,

                             .var,

                             time_point,

                             is_event,

                             control = control_surv_timepoint()) {

  )

  } else {

  }

  )

}

#' @describeIn survival_timepoint Formatted analysis function which is used as `afun` in `surv_timepoint()`

#'   when `method = "surv"`.

#'

#' @return

#' * `a_surv_timepoint()` returns the corresponding list with formatted [rtables::CellValue()].

#'

#' @keywords internal

a_surv_timepoint <- make_afun(

  s_surv_timepoint,

  .indent_mods = c(

    pt_at_risk = 0L,

    event_free_rate = 0L,

    rate_se = 1L,

    rate_ci = 1L

  ),

  .formats = c(

    pt_at_risk = "xx",

    event_free_rate = "xx.xx",

    rate_se = "xx.xx",

    rate_ci = "(xx.xx, xx.xx)"

  )

)

#' @describeIn survival_timepoint Statistics function which analyzes difference between two survival rates.

#'

#' @return

#' * `s_surv_timepoint_diff()` returns the statistics:

#'   * `rate_diff`: Event-free rate difference between two groups.

#'   * `rate_diff_ci`: Confidence interval for the difference.

#'   * `ztest_pval`: p-value to test the difference is 0.

#'

#' @keywords internal

s_surv_timepoint_diff <- function(df,

                                  .var,

                                  .ref_group,

                                  .in_ref_col,

                                  time_point,

                                  control = control_surv_timepoint(),

                                  ...) {

      )

    )

  }

  })