#' Tabulate survival duration by subgroup

#'

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

#'

#' The [tabulate_survival_subgroups()] function creates a layout element to tabulate survival duration by subgroup,

#' returning statistics including median survival time and hazard ratio for each population subgroup. The table is

#' created from `df`, a list of data frames returned by [extract_survival_subgroups()], with the statistics to include

#' specified via the `vars` parameter.

#'

#' A forest plot can be created from the resulting table using the [g_forest()] function.

#'

#' @inheritParams argument_convention

#' @inheritParams survival_coxph_pairwise

#' @param df (`list`)\cr list of data frames containing all analysis variables. List should be

#'   created using [extract_survival_subgroups()].

#' @param vars (`character`)\cr the names of statistics to be reported among:

#'   * `n_tot_events`: Total number of events per group.

#'   * `n_events`: Number of events per group.

#'   * `n_tot`: Total number of observations per group.

#'   * `n`: Number of observations per group.

#'   * `median`: Median survival time.

#'   * `hr`: Hazard ratio.

#'   * `ci`: Confidence interval of hazard ratio.

#'   * `pval`: p-value of the effect.

#'   Note, one of the statistics `n_tot` and `n_tot_events`, as well as both `hr` and `ci`

#'   are required.

#' @param time_unit (`string`)\cr label with unit of median survival time. Default `NULL` skips displaying unit.

#'

#' @details These functions create a layout starting from a data frame which contains

#'   the required statistics. Tables typically used as part of forest plot.

#'

#' @seealso [extract_survival_subgroups()]

#'

#' @examples

#' library(dplyr)

#'

#' adtte <- tern_ex_adtte

#'

#' # Save variable labels before data processing steps.

#' adtte_labels <- formatters::var_labels(adtte)

#'

#' adtte_f <- adtte %>%

#'   filter(

#'     PARAMCD == "OS",

#'     ARM %in% c("B: Placebo", "A: Drug X"),

#'     SEX %in% c("M", "F")

#'   ) %>%

#'   mutate(

#'     # Reorder levels of ARM to display reference arm before treatment arm.

#'     ARM = droplevels(forcats::fct_relevel(ARM, "B: Placebo")),

#'     SEX = droplevels(SEX),

#'     AVALU = as.character(AVALU),

#'     is_event = CNSR == 0

#'   )

#' labels <- c(

#'   "ARM" = adtte_labels[["ARM"]],

#'   "SEX" = adtte_labels[["SEX"]],

#'   "AVALU" = adtte_labels[["AVALU"]],

#'   "is_event" = "Event Flag"

#' )

#' formatters::var_labels(adtte_f)[names(labels)] <- labels

#'

#' df <- extract_survival_subgroups(

#'   variables = list(

#'     tte = "AVAL",

#'     is_event = "is_event",

#'     arm = "ARM", subgroups = c("SEX", "BMRKR2")

#'   ),

#'   label_all = "Total Patients",

#'   data = adtte_f

#' )

#' df

#'

#' df_grouped <- extract_survival_subgroups(

#'   variables = list(

#'     tte = "AVAL",

#'     is_event = "is_event",

#'     arm = "ARM", subgroups = c("SEX", "BMRKR2")

#'   ),

#'   data = adtte_f,

#'   groups_lists = list(

#'     BMRKR2 = list(

#'       "low" = "LOW",

#'       "low/medium" = c("LOW", "MEDIUM"),

#'       "low/medium/high" = c("LOW", "MEDIUM", "HIGH")

#'     )

#'   )

#' )

#' df_grouped

#'

#' @name survival_duration_subgroups

#' @order 1

NULL

#' Prepare survival data for population subgroups in data frames

#'

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

#'

#' Prepares estimates of median survival times and treatment hazard ratios for population subgroups in

#' data frames. Simple wrapper for [h_survtime_subgroups_df()] and [h_coxph_subgroups_df()]. Result is a `list`

#' of two `data.frame`s: `survtime` and `hr`. `variables` corresponds to the names of variables found in `data`,

#' passed as a named `list` and requires elements `tte`, `is_event`, `arm` and optionally `subgroups` and `strata`.

#' `groups_lists` optionally specifies groupings for `subgroups` variables.

#'

#' @inheritParams argument_convention

#' @inheritParams survival_duration_subgroups

#' @inheritParams survival_coxph_pairwise

#'

#' @return A named `list` of two elements:

#'   * `survtime`: A `data.frame` containing columns `arm`, `n`, `n_events`, `median`, `subgroup`, `var`,

#'     `var_label`, and `row_type`.

#'   * `hr`: A `data.frame` containing columns `arm`, `n_tot`, `n_tot_events`, `hr`, `lcl`, `ucl`, `conf_level`,

#'     `pval`, `pval_label`, `subgroup`, `var`, `var_label`, and `row_type`.

#'

#' @seealso [survival_duration_subgroups]

#'

#' @export

extract_survival_subgroups <- function(variables,

                                       data,

                                       groups_lists = list(),

                                       control = control_coxph(),

                                       label_all = "All Patients") {

    )

  }

  )

  )

}

#' @describeIn survival_duration_subgroups  Formatted analysis function which is used as

#'   `afun` in `tabulate_survival_subgroups()`.

#'

#' @return

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

#'

#' @keywords internal

a_survival_subgroups <- function(df,

                                 labelstr = "",

                                 ...,

                                 .stats = NULL,

                                 .stat_names = NULL,

                                 .formats = NULL,

                                 .labels = NULL,

                                 .indent_mods = NULL) {

  # Check for additional parameters to the statistics function

  # Uniquely name & label rows

    }

  }

  # if empty, return NA

  }

  # Main statistics taken from df

  # Fill in formatting defaults

    # default labels are pre-determined in extract_*() function

  )

  ) %>%

  # Auto format handling

  # Get and check statistical names

  )

}

#' @describeIn survival_duration_subgroups Table-creating function which creates a table

#'   summarizing survival by subgroup. This function is a wrapper for [rtables::analyze_colvars()]

#'   and [rtables::summarize_row_groups()].

#'

#' @param label_all `r lifecycle::badge("deprecated")`\cr please assign the `label_all` parameter within the

#'   [extract_survival_subgroups()] function when creating `df`.

#' @param riskdiff (`list`)\cr if a risk (proportion) difference column should be added, a list of settings to apply

#'   within the column. See [control_riskdiff()] for details. If `NULL`, no risk difference column will be added. If

#'   `riskdiff$arm_x` and `riskdiff$arm_y` are `NULL`, the first level of `df$survtime$arm` will be used as `arm_x`

#'   and the second level as `arm_y`.

#'

#' @return An `rtables` table summarizing survival by subgroup.

#'

#' @examples

#' ## Table with default columns.

#' basic_table() %>%

#'   tabulate_survival_subgroups(df, time_unit = adtte_f$AVALU[1])

#'

#' ## Table with a manually chosen set of columns: adding "pval".

#' basic_table() %>%

#'   tabulate_survival_subgroups(

#'     df = df,

#'     vars = c("n_tot_events", "n_events", "median", "hr", "ci", "pval"),

#'     time_unit = adtte_f$AVALU[1]

#'   )

#'

#' @export

#' @order 2

tabulate_survival_subgroups <- function(lyt,

                                        df,

                                        vars = c("n_tot_events", "n_events", "median", "hr", "ci"),

                                        groups_lists = list(),

                                        label_all = lifecycle::deprecated(),

                                        time_unit = NULL,

                                        riskdiff = NULL,

                                        na_str = default_na_str(),

                                        ...,

                                        .stat_names = NULL,

                                        .formats = NULL,

                                        .labels = NULL,

                                        .indent_mods = NULL) {

    )

  }

    )

  }

  # Process standard extra arguments

  # Create "ci" column from "lcl" and "ucl"

  # Extract additional parameters from df

  # Process additional arguments to the statistic function

    ...

  )

  # Adding additional info from layout to analysis function

  # Add risk difference column

      ) %>%

        )

      ) %>%

      )

  }

  # Add columns from table_survtime (optional)

    )

    # Add "All Patients" row

    )

    )

    # Add analysis rows

      )

      )

    }

  } else {

  }

  # Add columns from table_hr ("n_tot_events" or "n_tot", "hr" and "ci" required)

  )

  # Add "All Patients" row

  )

  ) %>%

  # Add analysis rows

    )

    )

  }

  # Join tables, add forest plot attributes

  } else {

  }

  )

}

#' Labels for column variables in survival duration by subgroup table

#'

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

#'

#' Internal function to check variables included in [tabulate_survival_subgroups()] and create column labels.

#'

#' @inheritParams tabulate_survival_subgroups

#' @inheritParams argument_convention

#' @param method (`string`)\cr p-value method for testing hazard ratio = 1.

#'

#' @return A `list` of variables and their labels to tabulate.

#'

#' @note At least one of `n_tot` and `n_tot_events` must be provided in `vars`.

#'

#' @export

d_survival_subgroups_colvars <- function(vars,

                                         conf_level,

                                         method,

                                         time_unit = NULL) {

  )

  } else {

  }

  )

  )

}

#' Cumulative counts of numeric variable by thresholds

#'

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

#'

#' The analyze function [count_cumulative()] creates a layout element to calculate cumulative counts of values in a

#' numeric variable that are less than, less or equal to, greater than, or greater or equal to user-specified

#' threshold values.

#'

#' This function analyzes numeric variable `vars` against the threshold values supplied to the `thresholds`

#' argument as a numeric vector. Whether counts should include the threshold values, and whether to count

#' values lower or higher than the threshold values can be set via the `include_eq` and `lower_tail`

#' parameters, respectively.

#'

#' @inheritParams h_count_cumulative

#' @inheritParams argument_convention

#' @param thresholds (`numeric`)\cr vector of cutoff values for the counts.

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

#'

#'   Options are: ``r shQuote(get_stats("count_cumulative"), type = "sh")``

#'

#' @seealso Relevant helper function [h_count_cumulative()], and descriptive function [d_count_cumulative()].

#'

#' @name count_cumulative

#' @order 1

NULL

#' Helper function for `s_count_cumulative()`

#'

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

#'

#' Helper function to calculate count and fraction of `x` values in the lower or upper tail given a threshold.

#'

#' @inheritParams argument_convention

#' @param threshold (`numeric(1)`)\cr a cutoff value as threshold to count values of `x`.

#' @param lower_tail (`flag`)\cr whether to count lower tail, default is `TRUE`.

#' @param include_eq (`flag`)\cr whether to include value equal to the `threshold` in

#'   count, default is `TRUE`.

#'

#' @return A named vector with items:

#'   * `count`: the count of values less than, less or equal to, greater than, or greater or equal to a threshold

#'     of user specification.

#'   * `fraction`: the fraction of the count.

#'

#' @seealso [count_cumulative]

#'

#' @examples

#' set.seed(1, kind = "Mersenne-Twister")

#' x <- c(sample(1:10, 10), NA)

#' .N_col <- length(x)

#'

#' h_count_cumulative(x, 5, denom = .N_col)

#' h_count_cumulative(x, 5, lower_tail = FALSE, include_eq = FALSE, na_rm = FALSE, denom = .N_col)

#' h_count_cumulative(x, 0, lower_tail = FALSE, denom = .N_col)

#' h_count_cumulative(x, 100, lower_tail = FALSE, denom = .N_col)

#'

#' @export

h_count_cumulative <- function(x,

                               threshold,

                               lower_tail = TRUE,

                               include_eq = TRUE,

                               na_rm = TRUE,

                               denom) {

  }

  )

}

#' Description of cumulative count

#'

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

#'

#' This is a helper function that describes the analysis in [s_count_cumulative()].

#'

#' @inheritParams h_count_cumulative

#'

#' @return Labels for [s_count_cumulative()].

#'

#' @export

d_count_cumulative <- function(threshold, lower_tail = TRUE, include_eq = TRUE) {

}

#' @describeIn count_cumulative Statistics function that produces a named list given a numeric vector of thresholds.

#'

#' @return

#' * `s_count_cumulative()` returns a named list of `count_fraction`s: a list with each `thresholds` value as a

#'   component, each component containing a vector for the count and fraction.

#'

#' @keywords internal

s_count_cumulative <- function(x,

                               thresholds,

                               lower_tail = TRUE,

                               include_eq = TRUE,

                               denom = c("N_col", "n", "N_row"),

                               .N_col, # nolint

                               .N_row, # nolint

                               na_rm = TRUE,

                               ...) {

    )

}

#' @describeIn count_cumulative Formatted analysis function which is used as `afun`

#'   in `count_cumulative()`.

#'

#' @return

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

#'

#' @keywords internal

a_count_cumulative <- function(x,

                               ...,

                               .stats = NULL,

                               .stat_names = NULL,

                               .formats = NULL,

                               .labels = NULL,

                               .indent_mods = NULL) {

  # Check if there are user-defined functions

  # Adding automatically extra parameters to the statistic function (see ?rtables::additional_fun_params)

  )

  # Main statistical functions application

    )

  )

  # Fill in with stats defaults if needed

  )

  # Fill in formats/indents/labels with custom input and defaults

  )

  # Unlist stats

  # Auto format handling

  )

  # Get and check statistical names from defaults

  )

}

#' @describeIn count_cumulative Layout-creating function which can take statistics function arguments

#'   and additional format arguments. This function is a wrapper for [rtables::analyze()].

#'

#' @return

#' * `count_cumulative()` returns a layout object suitable for passing to further layouting functions,

#'   or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted rows containing

#'   the statistics from `s_count_cumulative()` to the table layout.

#'

#' @examples

#' basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   add_colcounts() %>%

#'   count_cumulative(

#'     vars = "AGE",

#'     thresholds = c(40, 60)

#'   ) %>%

#'   build_table(tern_ex_adsl)

#'

#' @export

#' @order 2

count_cumulative <- function(lyt,

                             vars,

                             thresholds,

                             lower_tail = TRUE,

                             include_eq = TRUE,

                             var_labels = vars,

                             show_labels = "visible",

                             na_str = default_na_str(),

                             nested = TRUE,

                             table_names = vars,

                             ...,

                             na_rm = TRUE,

                             .stats = c("count_fraction"),

                             .stat_names = NULL,

                             .formats = NULL,

                             .labels = NULL,

                             .indent_mods = NULL) {

  # Depending on main functions

    ...

  )

  # Needed defaults

  # Adding all additional information from layout to analysis functions (see ?rtables::additional_fun_params)

  )

  # Main {rtables} structural call

  )

}

#' Univariate formula special term

#'

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

#'

#' The special term `univariate` indicate that the model should be fitted individually for

#' every variable included in univariate.

#'

#' @param x (`character`)\cr a vector of variable names separated by commas.