#' Formatting functions

#'

#' See below for the list of formatting functions created in `tern` to work with `rtables`.

#'

#' Other available formats can be listed via [`formatters::list_valid_format_labels()`]. Additional

#' custom formats can be created via the [`formatters::sprintf_format()`] function.

#'

#' @family formatting functions

#' @name formatting_functions

NULL

#' Format fraction and percentage

#'

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

#'

#' Formats a fraction together with ratio in percent.

#'

#' @param x (named `integer`)\cr vector with elements `num` and `denom`.

#' @param ... not used. Required for `rtables` interface.

#'

#' @return A string in the format `num / denom (ratio %)`. If `num` is 0, the format is `num / denom`.

#'

#' @examples

#' format_fraction(x = c(num = 2L, denom = 3L))

#' format_fraction(x = c(num = 0L, denom = 3L))

#'

#' @family formatting functions

#' @export

format_fraction <- function(x, ...) {

  } else {

    )

  }

}

#' Format fraction and percentage with fixed single decimal place

#'

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

#'

#' Formats a fraction together with ratio in percent with fixed single decimal place.

#' Includes trailing zero in case of whole number percentages to always keep one decimal place.

#'

#' @inheritParams format_fraction

#'

#' @return A string in the format `num / denom (ratio %)`. If `num` is 0, the format is `num / denom`.

#'

#' @examples

#' format_fraction_fixed_dp(x = c(num = 1L, denom = 2L))

#' format_fraction_fixed_dp(x = c(num = 1L, denom = 4L))

#' format_fraction_fixed_dp(x = c(num = 0L, denom = 3L))

#'

#' @family formatting functions

#' @export

format_fraction_fixed_dp <- function(x, ...) {

  } else {

    )

  }

}

#' Format count and fraction

#'

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

#'

#' Formats a count together with fraction with special consideration when count is `0`.

#'

#' @param x (`numeric(2)`)\cr vector of length 2 with count and fraction, respectively.

#' @param ... not used. Required for `rtables` interface.

#'

#' @return A string in the format `count (fraction %)`. If `count` is 0, the format is `0`.

#'

#' @examples

#' format_count_fraction(x = c(2, 0.6667))

#' format_count_fraction(x = c(0, 0))

#'

#' @family formatting functions

#' @export

format_count_fraction <- function(x, ...) {

  }

  } else {

  }

}

#' Format count and percentage with fixed single decimal place

#'

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

#'

#' Formats a count together with fraction with special consideration when count is `0`.

#'

#' @inheritParams format_count_fraction

#'

#' @return A string in the format `count (fraction %)`. If `count` is 0, the format is `0`.

#'

#' @examples

#' format_count_fraction_fixed_dp(x = c(2, 0.6667))

#' format_count_fraction_fixed_dp(x = c(2, 0.5))

#' format_count_fraction_fixed_dp(x = c(0, 0))

#'

#' @family formatting functions

#' @export

format_count_fraction_fixed_dp <- function(x, ...) {

  }

  } else {

  }

}

#' Format count and fraction with special case for count < 10

#'

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

#'

#' Formats a count together with fraction with special consideration when count is less than 10.

#'

#' @inheritParams format_count_fraction

#'

#' @return A string in the format `count (fraction %)`. If `count` is less than 10, only `count` is printed.

#'

#' @examples

#' format_count_fraction_lt10(x = c(275, 0.9673))

#' format_count_fraction_lt10(x = c(2, 0.6667))

#' format_count_fraction_lt10(x = c(9, 1))

#'

#' @family formatting functions

#' @export

format_count_fraction_lt10 <- function(x, ...) {

  }

  } else {

  }

}

#' Format XX as a formatting function

#'

#' Translate a string where x and dots are interpreted as number place

#' holders, and others as formatting elements.

#'

#' @param str (`string`)\cr template.

#'

#' @return An `rtables` formatting function.

#'

#' @examples

#' test <- list(c(1.658, 0.5761), c(1e1, 785.6))

#'

#' z <- format_xx("xx (xx.x)")

#' sapply(test, z)

#'

#' z <- format_xx("xx.x - xx.x")

#' sapply(test, z)

#'

#' z <- format_xx("xx.x, incl. xx.x% NE")

#' sapply(test, z)

#'

#' @family formatting functions

#' @export

format_xx <- function(str) {

  # Find position in the string.

  # Roundings depends on the number of x behind [.].

      }

    }

  )

  }

}

#' Format numeric values by significant figures

#'

#' Format numeric values to print with a specified number of significant figures.

#'

#' @param sigfig (`integer(1)`)\cr number of significant figures to display.

#' @param format (`string`)\cr the format label (string) to apply when printing the value. Decimal

#'   places in string are ignored in favor of formatting by significant figures. Formats options are:

#'   `"xx"`, `"xx / xx"`, `"(xx, xx)"`, `"xx - xx"`, and `"xx (xx)"`.

#' @param num_fmt (`string`)\cr numeric format modifiers to apply to the value. Defaults to `"fg"` for

#'   standard significant figures formatting - fixed (non-scientific notation) format (`"f"`)

#'   and `sigfig` equal to number of significant figures instead of decimal places (`"g"`). See the

#'   [formatC()] `format` argument for more options.

#'

#' @return An `rtables` formatting function.

#'

#' @examples

#' fmt_3sf <- format_sigfig(3)

#' fmt_3sf(1.658)

#' fmt_3sf(1e1)

#'

#' fmt_5sf <- format_sigfig(5)

#' fmt_5sf(0.57)

#' fmt_5sf(0.000025645)

#'

#' @family formatting functions

#' @export

format_sigfig <- function(sigfig, format = "xx", num_fmt = "fg") {

  }

}

#' Format fraction with lower threshold

#'

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

#'

#' Formats a fraction when the second element of the input `x` is the fraction. It applies

#' a lower threshold, below which it is just stated that the fraction is smaller than that.

#'

#' @param threshold (`proportion`)\cr lower threshold.

#'

#' @return An `rtables` formatting function that takes numeric input `x` where the second

#'   element is the fraction that is formatted. If the fraction is above or equal to the threshold,

#'   then it is displayed in percentage. If it is positive but below the threshold, it returns,

#'   e.g. "<1" if the threshold is `0.01`. If it is zero, then just "0" is returned.

#'

#' @examples

#' format_fun <- format_fraction_threshold(0.05)

#' format_fun(x = c(20, 0.1))

#' format_fun(x = c(2, 0.01))

#' format_fun(x = c(0, 0))

#'

#' @family formatting functions

#' @export

format_fraction_threshold <- function(threshold) {

      )

    )

  }

}

#' Format extreme values

#'

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

#'

#' `rtables` formatting functions that handle extreme values.

#'

#' @param digits (`integer(1)`)\cr number of decimal places to display.

#'

#' @details For each input, apply a format to the specified number of `digits`. If the value is

#'    below a threshold, it returns "<0.01" e.g. if the number of `digits` is 2. If the value is

#'    above a threshold, it returns ">999.99" e.g. if the number of `digits` is 2.

#'    If it is zero, then returns "0.00".

#'

#' @family formatting functions

#' @name extreme_format

NULL

#' @describeIn extreme_format Internal helper function to calculate the threshold and create formatted strings

#'  used in Formatting Functions. Returns a list with elements `threshold` and `format_string`.

#'

#' @return

#' * `h_get_format_threshold()` returns a `list` of 2 elements: `threshold`, with `low` and `high` thresholds,

#'   and `format_string`, with thresholds formatted as strings.

#'

#' @examples

#' h_get_format_threshold(2L)

#'

#' @export

h_get_format_threshold <- function(digits = 2L) {

  )

}

#' @describeIn extreme_format Internal helper function to apply a threshold format to a value.

#'   Creates a formatted string to be used in Formatting Functions.

#'

#' @param x (`numeric(1)`)\cr value to format.

#'

#' @return

#' * `h_format_threshold()` returns the given value, or if the value is not within the digit threshold the relation

#'   of the given value to the digit threshold, as a formatted string.

#'

#' @examples

#' h_format_threshold(0.001)

#' h_format_threshold(1000)

#'

#' @export

h_format_threshold <- function(x, digits = 2L) {

  }

  } else {

  }

}

#' Format a single extreme value

#'

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

#'

#' Create a formatting function for a single extreme value.

#'

#' @inheritParams extreme_format

#'

#' @return An `rtables` formatting function that uses threshold `digits` to return a formatted extreme value.

#'

#' @examples

#' format_fun <- format_extreme_values(2L)

#' format_fun(x = 0.127)

#' format_fun(x = Inf)

#' format_fun(x = 0)

#' format_fun(x = 0.009)

#'

#' @family formatting functions

#' @export

format_extreme_values <- function(digits = 2L) {

  }

}

#' Format extreme values part of a confidence interval

#'

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

#'

#' Formatting Function for extreme values part of a confidence interval. Values

#' are formatted as e.g. "(xx.xx, xx.xx)" if the number of `digits` is 2.

#'

#' @inheritParams extreme_format

#'

#' @return An `rtables` formatting function that uses threshold `digits` to return a formatted extreme

#'   values confidence interval.

#'

#' @examples

#' format_fun <- format_extreme_values_ci(2L)

#' format_fun(x = c(0.127, Inf))

#' format_fun(x = c(0, 0.009))

#'

#' @family formatting functions

#' @export

format_extreme_values_ci <- function(digits = 2L) {

  }

}

#' Format automatically using data significant digits

#'

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

#'

#' Formatting function for the majority of default methods used in [analyze_vars()].

#' For non-derived values, the significant digits of data is used (e.g. range), while derived

#' values have one more digits (measure of location and dispersion like mean, standard deviation).

#' This function can be called internally with "auto" like, for example,

#' `.formats = c("mean" = "auto")`. See details to see how this works with the inner function.

#'

#' @param dt_var (`numeric`)\cr variable data the statistics were calculated from. Used only to

#'   find significant digits. In [analyze_vars] this comes from `.df_row` (see

#'   [rtables::additional_fun_params]), and it is the row data after the above row splits. No

#'   column split is considered.

#' @param x_stat (`string`)\cr string indicating the current statistical method used.

#'

#' @return A string that `rtables` prints in a table cell.

#'

#' @details

#' The internal function is needed to work with `rtables` default structure for

#' format functions, i.e. `function(x, ...)`, where is x are results from statistical evaluation.

#' It can be more than one element (e.g. for `.stats = "mean_sd"`).

#'

#' @examples

#' x_todo <- c(0.001, 0.2, 0.0011000, 3, 4)

#' res <- c(mean(x_todo[1:3]), sd(x_todo[1:3]))

#'

#' # x is the result coming into the formatting function -> res!!

#' format_auto(dt_var = x_todo, x_stat = "mean_sd")(x = res)

#' format_auto(x_todo, "range")(x = range(x_todo))

#' no_sc_x <- c(0.0000001, 1)

#' format_auto(no_sc_x, "range")(x = no_sc_x)

#'

#' @family formatting functions

#' @export

format_auto <- function(dt_var, x_stat) {

    # Defaults - they may be a param in the future

    )

    # Safenet for miss-modifications

    # Finds the max number of digits in data

    }

    # Render input

      )

    }

    # Squashing them together

  }

}

# Utility function that could be useful in general

str_extract <- function(string, pattern = "xx|xx\\.|xx\\.x+", invert = FALSE) {

}

# Helper function

count_decimalplaces <- function(dec) {

  } else {

  }

}

#' Apply automatic formatting

#'

#' Checks if any of the listed formats in `.formats` are `"auto"`, and replaces `"auto"` with

#' the correct implementation of `format_auto` for the given statistics, data, and variable.

#'

#' @inheritParams argument_convention

#' @param x_stats (named `list`)\cr a named list of statistics where each element corresponds

#'   to an element in `.formats`, with matching names.

#'

#' @keywords internal

apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) {

  }

}

#' Horizontal waterfall plot

#'

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

#'

#' This basic waterfall plot visualizes a quantity `height` ordered by value with some markup.

#'

#' @param height (`numeric`)\cr vector containing values to be plotted as the waterfall bars.

#' @param id (`character`)\cr vector containing identifiers to use as the x-axis label for the waterfall bars.

#' @param col (`character`)\cr color(s).

#' @param col_var (`factor`, `character`, or `NULL`)\cr categorical variable for bar coloring. `NULL` by default.

#' @param xlab (`string`)\cr x label. Default is `"ID"`.

#' @param ylab (`string`)\cr y label. Default is `"Value"`.

#' @param title (`string`)\cr text to be displayed as plot title.

#' @param col_legend_title (`string`)\cr text to be displayed as legend title.

#'

#' @return A `ggplot` waterfall plot.

#'

#' @examples

#' library(dplyr)

#'

#' g_waterfall(height = c(3, 5, -1), id = letters[1:3])

#'

#' g_waterfall(

#'   height = c(3, 5, -1),

#'   id = letters[1:3],

#'   col_var = letters[1:3]

#' )

#'

#' adsl_f <- tern_ex_adsl %>%

#'   select(USUBJID, STUDYID, ARM, ARMCD, SEX)

#'

#' adrs_f <- tern_ex_adrs %>%

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

#'   mutate(pchg = rnorm(n(), 10, 50))

#'

#' adrs_f <- head(adrs_f, 30)

#' adrs_f <- adrs_f[!duplicated(adrs_f$USUBJID), ]

#' head(adrs_f)

#'

#' g_waterfall(

#'   height = adrs_f$pchg,

#'   id = adrs_f$USUBJID,

#'   col_var = adrs_f$AVALC

#' )

#'

#' g_waterfall(

#'   height = adrs_f$pchg,

#'   id = paste("asdfdsfdsfsd", adrs_f$USUBJID),

#'   col_var = adrs_f$SEX

#' )

#'

#' g_waterfall(

#'   height = adrs_f$pchg,

#'   id = paste("asdfdsfdsfsd", adrs_f$USUBJID),

#'   xlab = "ID",

#'   ylab = "Percentage Change",

#'   title = "Waterfall plot"

#' )

#'

#' @export

g_waterfall <- function(height,

                        id,

                        col_var = NULL,

                        col = getOption("ggplot2.discrete.colour"),

                        xlab = NULL,

                        ylab = NULL,

                        col_legend_title = NULL,

                        title = NULL) {

  } else {

  }

  }

  )

    ) +

      )

  }

  }

  }

}

#' 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) {

  )

      )

    )

  }

    ),

      ),

    )

  )

    ),