#' 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.

#'

#' @return When used within a model formula, produces univariate models for each variable provided.

#'

#' @details

#' If provided alongside with pairwise specification, the model

#' `y ~ ARM + univariate(SEX, AGE, RACE)` lead to the study and comparison of the models

#' + `y ~ ARM`

#' + `y ~ ARM + SEX`

#' + `y ~ ARM + AGE`

#' + `y ~ ARM + RACE`

#'

#' @export

univariate <- function(x) {

}

# Get the right-hand-term of a formula

rht <- function(x) {

}

#' Hazard ratio estimation in interactions

#'

#' This function estimates the hazard ratios between arms when an interaction variable is given with

#' specific values.

#'

#' @param variable,given (`character(2)`)\cr names of the two variables in the interaction. We seek the estimation of

#'   the levels of `variable` given the levels of `given`.

#' @param lvl_var,lvl_given (`character`)\cr corresponding levels given by [levels()].

#' @param mmat (named `numeric`) a vector filled with `0`s used as a template to obtain the design matrix.

#' @param coef (`numeric`)\cr vector of estimated coefficients.

#' @param vcov (`matrix`)\cr variance-covariance matrix of underlying model.

#' @param conf_level (`proportion`)\cr confidence level of estimate intervals.

#'

#' @details Given the cox regression investigating the effect of Arm (A, B, C; reference A)

#'   and Sex (F, M; reference Female). The model is abbreviated: y ~ Arm + Sex + Arm x Sex.

#'   The cox regression estimates the coefficients along with a variance-covariance matrix for:

#'

#'   - b1 (arm b), b2 (arm c)

#'   - b3 (sex m)

#'   - b4 (arm b: sex m), b5 (arm c: sex m)

#'

#'   Given that I want an estimation of the Hazard Ratio for arm C/sex M, the estimation

#'   will be given in reference to arm A/Sex M by exp(b2 + b3 + b5)/ exp(b3) = exp(b2 + b5),

#'   therefore the interaction coefficient is given by b2 + b5 while the standard error is obtained

#'   as $1.96 * sqrt(Var b2 + Var b5 + 2 * covariance (b2,b5))$ for a confidence level of 0.95.

#'

#' @return A list of matrices (one per level of variable) with rows corresponding to the combinations of

#'   `variable` and `given`, with columns:

#'   * `coef_hat`: Estimation of the coefficient.

#'   * `coef_se`: Standard error of the estimation.

#'   * `hr`: Hazard ratio.

#'   * `lcl, ucl`: Lower/upper confidence limit of the hazard ratio.

#'

#' @seealso [s_cox_multivariate()].

#'

#' @examples

#' library(dplyr)

#' library(survival)

#'

#' ADSL <- tern_ex_adsl %>%

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

#'

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

#' adtte$ARMCD <- droplevels(adtte$ARMCD)

#' adtte$SEX <- droplevels(adtte$SEX)

#'

#' mod <- coxph(

#'   formula = Surv(time = AVAL, event = 1 - CNSR) ~ (SEX + ARMCD)^2,

#'   data = adtte

#' )

#'

#' mmat <- stats::model.matrix(mod)[1, ]

#' mmat[!mmat == 0] <- 0

#'

#' @keywords internal

estimate_coef <- function(variable, given,

                          lvl_var, lvl_given,

                          coef,

                          mmat,

                          vcov,

                          conf_level = 0.95) {

    }

  )

    }

  )

  })

  })

  )

}

#' `tryCatch` around `car::Anova`

#'

#' Captures warnings when executing [car::Anova].

#'

#' @inheritParams car::Anova

#'

#' @return A list with item `aov` for the result of the model and `error_text` for the captured warnings.

#'

#' @examples

#' # `car::Anova` on cox regression model including strata and expected

#' # a likelihood ratio test triggers a warning as only Wald method is

#' # accepted.

#'

#' library(survival)

#'

#' mod <- coxph(

#'   formula = Surv(time = futime, event = fustat) ~ factor(rx) + strata(ecog.ps),

#'   data = ovarian

#' )

#'

#' @keywords internal

try_car_anova <- function(mod,

                          test.statistic) { # nolint

          ),

        )

      },

        # If a warning is detected it is handled as "w".

        # A warning is sometimes expected, then, we want to restart

        # the execution while ignoring the warning.

      }

    ),

    }

  )

}

#' Fit a Cox regression model and ANOVA

#'

#' The functions derives the effect p-values using [car::Anova()] from [survival::coxph()] results.

#'

#' @inheritParams t_coxreg

#'

#' @return A list with items `mod` (results of [survival::coxph()]), `msum` (result of `summary`) and

#'   `aov` (result of [car::Anova()]).

#'

#' @noRd

fit_n_aov <- function(formula,

                      data = data,

                      conf_level = conf_level,

                      pval_method = c("wald", "likelihood"),

                      ...) {

    # We expect some warnings due to coxph which fails strict programming.

  })

    )

  )

}

# argument_checks

check_formula <- function(formula) {

  }

}

check_covariate_formulas <- function(covariates) {

  }

}

name_covariate_names <- function(covariates) {

}

check_increments <- function(increments, covariates) {

            )

          )

        }

      }

    )

  }

}

#' Multivariate Cox model - summarized results

#'

#' Analyses based on multivariate Cox model are usually not performed for the Controlled Substance Reporting or

#' regulatory documents but serve exploratory purposes only (e.g., for publication). In practice, the model usually

#' includes only the main effects (without interaction terms). It produces the hazard ratio estimates for each of the

#' covariates included in the model.

#' The analysis follows the same principles (e.g., stratified vs. unstratified analysis and tie handling) as the

#' usual Cox model analysis. Since there is usually no pre-specified hypothesis testing for such analysis,

#' the p.values need to be interpreted with caution. (**Statistical Analysis of Clinical Trials Data with R**,

#' `NEST's bookdown`)

#'

#' @param formula (`formula`)\cr a formula corresponding to the investigated [survival::Surv()] survival model

#'   including covariates.

#' @param data (`data.frame`)\cr a data frame which includes the variable in formula and covariates.

#' @param conf_level (`proportion`)\cr the confidence level for the hazard ratio interval estimations. Default is 0.95.

#' @param pval_method (`string`)\cr the method used for the estimation of p-values, should be one of

#'   `"wald"` (default) or `"likelihood"`.

#' @param ... optional parameters passed to [survival::coxph()]. Can include `ties`, a character string specifying the

#'   method for tie handling, one of `exact` (default), `efron`, `breslow`.

#'

#' @return A `list` with elements `mod`, `msum`, `aov`, and `coef_inter`.

#'

#' @details The output is limited to single effect terms. Work in ongoing for estimation of interaction terms

#'   but is out of scope as defined by the  Global Data Standards Repository

#'   (**`GDS_Standard_TLG_Specs_Tables_2.doc`**).

#'

#' @seealso [estimate_coef()].

#'

#' @examples

#' library(dplyr)

#'

#' adtte <- tern_ex_adtte

#' adtte_f <- subset(adtte, PARAMCD == "OS") # _f: filtered

#' adtte_f <- filter(

#'   adtte_f,

#'   PARAMCD == "OS" &

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

#'     RACE %in% c("ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE")

#' )

#' adtte_f$SEX <- droplevels(adtte_f$SEX)

#' adtte_f$RACE <- droplevels(adtte_f$RACE)

#'

#' @keywords internal

s_cox_multivariate <- function(formula, data,

                               conf_level = 0.95,

                               pval_method = c("wald", "likelihood"),

                               ...) {

      }

    }

  )

  # Results directly exported from environment(fit_n_aov) to environment(s_function_draft)

    ...

  )

      )

    }

      }

    )

  }

}

#' Stack multiple grobs

#'

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

#'

#' Stack grobs as a new grob with 1 column and multiple rows layout.

#'

#' @param ... grobs.

#' @param grobs (`list` of `grob`)\cr a list of grobs.

#' @param padding (`grid::unit`)\cr unit of length 1, space between each grob.

#' @param vp (`viewport` or `NULL`)\cr a [viewport()] object (or `NULL`).

#' @param name (`string`)\cr a character identifier for the grob.

#' @param gp (`gpar`)\cr a [gpar()] object.

#'

#' @return A `grob`.

#'

#' @examples

#' library(grid)

#'

#' g1 <- circleGrob(gp = gpar(col = "blue"))

#' g2 <- circleGrob(gp = gpar(col = "red"))

#' g3 <- textGrob("TEST TEXT")

#' grid.newpage()

#' grid.draw(stack_grobs(g1, g2, g3))

#'

#' showViewport()

#'

#' grid.newpage()

#' pushViewport(viewport(layout = grid.layout(1, 2)))

#' vp1 <- viewport(layout.pos.row = 1, layout.pos.col = 2)

#' grid.draw(stack_grobs(g1, g2, g3, vp = vp1, name = "test"))

#'

#' showViewport()

#' grid.ls(grobs = TRUE, viewports = TRUE, print = FALSE)

#'

#' @export

stack_grobs <- function(...,

                        grobs = list(...),

                        padding = grid::unit(2, "line"),

                        vp = NULL,

                        gp = NULL,

                        name = NULL) {

  )

  )

  }

      } else {

      }

    }

  )

  )

    )

  )

  )

}

#' Arrange multiple grobs

#'

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

#'

#' Arrange grobs as a new grob with `n * m (rows * cols)` layout.

#'

#' @inheritParams stack_grobs

#' @param ncol (`integer(1)`)\cr number of columns in layout.

#' @param nrow (`integer(1)`)\cr number of rows in layout.

#' @param padding_ht (`grid::unit`)\cr unit of length 1, vertical space between each grob.

#' @param padding_wt (`grid::unit`)\cr unit of length 1, horizontal space between each grob.

#'

#' @return A `grob`.

#'

#' @examples

#' library(grid)

#'

#' \donttest{

#' num <- lapply(1:9, textGrob)

#' grid::grid.newpage()

#' grid.draw(arrange_grobs(grobs = num, ncol = 2))

#'

#' showViewport()

#'

#' g1 <- circleGrob(gp = gpar(col = "blue"))

#' g2 <- circleGrob(gp = gpar(col = "red"))

#' g3 <- textGrob("TEST TEXT")

#' grid::grid.newpage()

#' grid.draw(arrange_grobs(g1, g2, g3, nrow = 2))

#'

#' showViewport()

#'

#' grid::grid.newpage()

#' grid.draw(arrange_grobs(g1, g2, g3, ncol = 3))

#'

#' grid::grid.newpage()

#' grid::pushViewport(grid::viewport(layout = grid::grid.layout(1, 2)))

#' vp1 <- grid::viewport(layout.pos.row = 1, layout.pos.col = 2)

#' grid.draw(arrange_grobs(g1, g2, g3, ncol = 2, vp = vp1))

#'

#' showViewport()

#' }

#' @export

arrange_grobs <- function(...,

                          grobs = list(...),

                          ncol = NULL, nrow = NULL,

                          padding_ht = grid::unit(2, "line"),

                          padding_wt = grid::unit(2, "line"),

                          vp = NULL,

                          gp = NULL,

                          name = NULL) {

  )

  )

  }

  }

  }

  }

      } else {

      }

    }

  )

      } else {

      }

    }

  )

  )

          ))

        )

      }

    }

  }

  )

  )

}

#' Draw `grob`

#'

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

#'

#' Draw grob on device page.

#'

#' @param grob (`grob`)\cr grid object.

#' @param newpage (`flag`)\cr draw on a new page.

#' @param vp (`viewport` or `NULL`)\cr a [viewport()] object (or `NULL`).

#'

#' @return A `grob`.

#'

#' @examples

#' library(dplyr)

#' library(grid)

#'

#' \donttest{

#' rect <- rectGrob(width = grid::unit(0.5, "npc"), height = grid::unit(0.5, "npc"))

#' rect %>% draw_grob(vp = grid::viewport(angle = 45))

#'

#' num <- lapply(1:10, textGrob)

#' num %>%

#'   arrange_grobs(grobs = .) %>%

#'   draw_grob()

#' showViewport()

#' }

#'

#' @export

draw_grob <- function(grob, newpage = TRUE, vp = NULL) {

  )

  }

  }

}

tern_grob <- function(x) {

}

#' @keywords internal

print.ternGrob <- function(x, ...) {

}

#' Convert `rtable` objects to `ggplot` objects

#'

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

#'

#' Given a [rtables::rtable()] object, performs basic conversion to a [ggplot2::ggplot()] object built using

#' functions from the `ggplot2` package. Any table titles and/or footnotes are ignored.

#'

#' @param tbl (`VTableTree`)\cr `rtables` table object.

#' @param fontsize (`numeric(1)`)\cr font size.

#' @param colwidths (`numeric` or `NULL`)\cr a vector of column widths. Each element's position in

#'   `colwidths` corresponds to the column of `tbl` in the same position. If `NULL`, column widths

#'   are calculated according to maximum number of characters per column.

#' @param lbl_col_padding (`numeric`)\cr additional padding to use when calculating spacing between

#'   the first (label) column and the second column of `tbl`. If `colwidths` is specified,

#'   the width of the first column becomes `colwidths[1] + lbl_col_padding`. Defaults to 0.

#'

#' @return A `ggplot` object.

#'

#' @examples

#' dta <- data.frame(

#'   ARM     = rep(LETTERS[1:3], rep(6, 3)),

#'   AVISIT  = rep(paste0("V", 1:3), 6),

#'   AVAL    = c(9:1, rep(NA, 9))

#' )

#'

#' lyt <- basic_table() %>%

#'   split_cols_by(var = "ARM") %>%

#'   split_rows_by(var = "AVISIT") %>%

#'   analyze_vars(vars = "AVAL")

#'

#' tbl <- build_table(lyt, df = dta)

#'

#' rtable2gg(tbl)

#'

#' rtable2gg(tbl, fontsize = 15, colwidths = c(2, 1, 1, 1))

#'

#' @export

rtable2gg <- function(tbl, fontsize = 12, colwidths = NULL, lbl_col_padding = 0) {

  # Apply indentation in first column

  })

  # Get column widths

  }

  }

    )

  # If header content spans multiple columns, center over these columns

          )

        }

        )

          ) +

          )

      }

    }

  }

  # Add table columns

    )

  }

}

#' Convert `data.frame` object to `ggplot` object

#'

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

#'

#' Given a `data.frame` object, performs basic conversion to a [ggplot2::ggplot()] object built using

#' functions from the `ggplot2` package.

#'

#' @param df (`data.frame`)\cr a data frame.

#' @param colwidths (`numeric` or `NULL`)\cr a vector of column widths. Each element's position in

#'   `colwidths` corresponds to the column of `df` in the same position. If `NULL`, column widths

#'   are calculated according to maximum number of characters per column.

#' @param font_size (`numeric(1)`)\cr font size.

#' @param col_labels (`flag`)\cr whether the column names (labels) of `df` should be used as the first row

#'   of the output table.

#' @param col_lab_fontface (`string`)\cr font face to apply to the first row (of column labels

#'   if `col_labels = TRUE`). Defaults to `"bold"`.

#' @param hline (`flag`)\cr whether a horizontal line should be printed below the first row of the table.

#' @param bg_fill (`string`)\cr table background fill color.

#'

#' @return A `ggplot` object.

#'

#' @examples

#' \dontrun{

#' df2gg(head(iris, 5))

#'

#' df2gg(head(iris, 5), font_size = 15, colwidths = c(1, 1, 1, 1, 1))

#' }

#' @keywords internal

df2gg <- function(df,

                  colwidths = NULL,

                  font_size = 10,

                  col_labels = TRUE,

                  col_lab_fontface = "bold",

                  hline = TRUE,

                  bg_fill = NULL) {

  # convert to text

  }

  # Get column widths

  }

      )

  }

    )

        } else {

        }

      )

  }

}

#' Split function to configure risk difference column

#'

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

#'

#' Wrapper function for [rtables::add_combo_levels()] which configures settings for the risk difference

#' column to be added to an `rtables` object. To add a risk difference column to a table, this function

#' should be used as `split_fun` in calls to [rtables::split_cols_by()], followed by setting argument

#' `riskdiff` to `TRUE` in all following analyze function calls.

#'

#' @param arm_x (`string`)\cr name of reference arm to use in risk difference calculations.

#' @param arm_y (`character`)\cr names of one or more arms to compare to reference arm in risk difference

#'   calculations. A new column will be added for each value of `arm_y`.

#' @param col_label (`character`)\cr labels to use when rendering the risk difference column within the table.

#'   If more than one comparison arm is specified in `arm_y`, default labels will specify which two arms are

#'   being compared (reference arm vs. comparison arm).

#' @param pct (`flag`)\cr whether output should be returned as percentages. Defaults to `TRUE`.

#'

#' @return A closure suitable for use as a split function (`split_fun`) within [rtables::split_cols_by()]

#'   when creating a table layout.

#'

#' @seealso [stat_propdiff_ci()] for details on risk difference calculation.

#'

#' @examples

#' adae <- tern_ex_adae

#' adae$AESEV <- factor(adae$AESEV)

#'

#' lyt <- basic_table() %>%

#'   split_cols_by("ARMCD", split_fun = add_riskdiff(arm_x = "ARM A", arm_y = c("ARM B", "ARM C"))) %>%

#'   count_occurrences_by_grade(

#'     var = "AESEV",

#'     riskdiff = TRUE

#'   )

#'

#' tbl <- build_table(lyt, df = adae)

#' tbl

#'

#' @export

add_riskdiff <- function(arm_x,

                         arm_y,

                         col_label = paste0(

                           "Risk Difference (%) (95% CI)", if (length(arm_y) > 1) paste0("\n", arm_x, " vs. ", arm_y)

                         ),

                         pct = TRUE) {

      )

    )

  }

}

#' Analysis function to calculate risk difference column values

#'

#' In the risk difference column, this function uses the statistics function associated with `afun` to

#' calculates risk difference values from arm X (reference group) and arm Y. These arms are specified

#' when configuring the risk difference column which is done using the [add_riskdiff()] split function in

#' the previous call to [rtables::split_cols_by()]. For all other columns, applies `afun` as usual. This

#' function utilizes the [stat_propdiff_ci()] function to perform risk difference calculations.

#'

#' @inheritParams argument_convention

#' @param afun (named `list`)\cr a named list containing one name-value pair where the name corresponds to

#'   the name of the statistics function that should be used in calculations and the value is the corresponding

#'   analysis function.

#'

#' @return A list of formatted [rtables::CellValue()].

#'

#' @seealso

#' * [stat_propdiff_ci()] for details on risk difference calculation.

#' * Split function [add_riskdiff()] which, when used as `split_fun` within [rtables::split_cols_by()] with

#'   `riskdiff` argument set to `TRUE` in subsequent analyze functions calls, adds a risk difference column

#'   to a table layout.

#'

#' @keywords internal

afun_riskdiff <- function(df,

                          labelstr = "",

                          afun,

                          ...,

                          .stats = NULL,

                          .stat_names = NULL,

                          .formats = NULL,

                          .labels = NULL,

                          .indent_mods = NULL) {

    )

  }

  )

    # Apply basic afun (no risk difference) in all other columns

  } else {

    } else {

    }

    # Apply statistics function to arm X and arm Y data

    # Get statistic name and row names

    } else {

    }

    # Calculate risk difference for each row, repeated if multiple statistics in table

  }

}

#' Control function for risk difference column

#'

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

#'

#' Sets a list of parameters to use when generating a risk (proportion) difference column. Used as input to the

#' `riskdiff` parameter of [tabulate_rsp_subgroups()] and [tabulate_survival_subgroups()].

#'

#' @inheritParams add_riskdiff

#' @param format (`string` or `function`)\cr the format label (string) or formatting function to apply to the risk

#'   difference statistic. See the `3d` string options in [formatters::list_valid_format_labels()] for possible format

#'   strings. Defaults to `"xx.x (xx.x - xx.x)"`.

#'

#' @return A `list` of items with names corresponding to the arguments.

#'

#' @seealso [add_riskdiff()], [tabulate_rsp_subgroups()], and [tabulate_survival_subgroups()].

#'

#' @examples

#' control_riskdiff()

#' control_riskdiff(arm_x = "ARM A", arm_y = "ARM B")

#'

#' @export

control_riskdiff <- function(arm_x = NULL,

                             arm_y = NULL,

                             format = "xx.x (xx.x - xx.x)",

                             col_label = "Risk Difference (%) (95% CI)",

                             pct = TRUE) {

}

#' Helper functions for multivariate logistic regression

#'

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

#'

#' Helper functions used in calculations for logistic regression.

#'

#' @inheritParams argument_convention

#' @param fit_glm (`glm`)\cr logistic regression model fitted by [stats::glm()] with "binomial" family.

#'   Limited functionality is also available for conditional logistic regression models fitted by

#'   [survival::clogit()], currently this is used only by [extract_rsp_biomarkers()].

#' @param x (`character`)\cr a variable or interaction term in `fit_glm` (depending on the helper function used).

#'

#' @examples

#' library(dplyr)

#' library(broom)

#'

#' adrs_f <- tern_ex_adrs %>%

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

#'   filter(RACE %in% c("ASIAN", "WHITE", "BLACK OR AFRICAN AMERICAN")) %>%

#'   mutate(

#'     Response = case_when(AVALC %in% c("PR", "CR") ~ 1, TRUE ~ 0),

#'     RACE = factor(RACE),

#'     SEX = factor(SEX)

#'   )

#' formatters::var_labels(adrs_f) <- c(formatters::var_labels(tern_ex_adrs), Response = "Response")

#' mod1 <- fit_logistic(

#'   data = adrs_f,

#'   variables = list(

#'     response = "Response",

#'     arm = "ARMCD",

#'     covariates = c("AGE", "RACE")

#'   )

#' )

#' mod2 <- fit_logistic(

#'   data = adrs_f,

#'   variables = list(

#'     response = "Response",

#'     arm = "ARMCD",

#'     covariates = c("AGE", "RACE"),

#'     interaction = "AGE"

#'   )

#' )

#'

#' @name h_logistic_regression

NULL

#' @describeIn h_logistic_regression Helper function to extract interaction variable names from a fitted

#'   model assuming only one interaction term.

#'

#' @return Vector of names of interaction variables.

#'

#' @export

h_get_interaction_vars <- function(fit_glm) {

}

#' @describeIn h_logistic_regression Helper function to get the right coefficient name from the

#'   interaction variable names and the given levels. The main value here is that the order

#'   of first and second variable is checked in the `interaction_vars` input.

#'

#' @param interaction_vars (`character(2)`)\cr interaction variable names.

#' @param first_var_with_level (`character(2)`)\cr the first variable name with the interaction level.

#' @param second_var_with_level (`character(2)`)\cr the second variable name with the interaction level.

#'

#' @return Name of coefficient.

#'

#' @export

h_interaction_coef_name <- function(interaction_vars,

                                    first_var_with_level,

                                    second_var_with_level) {

  }

}

#' @describeIn h_logistic_regression Helper function to calculate the odds ratio estimates

#'   for the case when both the odds ratio and the interaction variable are categorical.

#'

#' @param odds_ratio_var (`string`)\cr the odds ratio variable.

#' @param interaction_var (`string`)\cr the interaction variable.

#'

#' @return Odds ratio.

#'

#' @export

h_or_cat_interaction <- function(odds_ratio_var,

                                 interaction_var,

                                 fit_glm,

                                 conf_level = 0.95) {