#' Helper function to create a new SMQ variable in ADAE by stacking SMQ and/or CQ records.

#'

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

#'

#' Helper function to create a new SMQ variable in ADAE that consists of all adverse events belonging to

#' selected Standardized/Customized queries. The new dataset will only contain records of the adverse events

#' belonging to any of the selected baskets. Remember that `na_str` must match the needed pre-processing

#' done with [df_explicit_na()] to have the desired output.

#'

#' @inheritParams argument_convention

#' @param baskets (`character`)\cr variable names of the selected Standardized/Customized queries.

#' @param smq_varlabel (`string`)\cr a label for the new variable created.

#' @param keys (`character`)\cr names of the key variables to be returned along with the new variable created.

#' @param aag_summary (`data.frame`)\cr containing the SMQ baskets and the levels of interest for the final SMQ

#'   variable. This is useful when there are some levels of interest that are not observed in the `df` dataset.

#'   The two columns of this dataset should be named `basket` and `basket_name`.

#'

#' @return A `data.frame` with variables in `keys` taken from `df` and new variable SMQ containing

#'   records belonging to the baskets selected via the `baskets` argument.

#'

#' @examples

#' adae <- tern_ex_adae[1:20, ] %>% df_explicit_na()

#' h_stack_by_baskets(df = adae)

#'

#' aag <- data.frame(

#'   NAMVAR = c("CQ01NAM", "CQ02NAM", "SMQ01NAM", "SMQ02NAM"),

#'   REFNAME = c(

#'     "D.2.1.5.3/A.1.1.1.1 aesi", "X.9.9.9.9/Y.8.8.8.8 aesi",

#'     "C.1.1.1.3/B.2.2.3.1 aesi", "C.1.1.1.3/B.3.3.3.3 aesi"

#'   ),

#'   SCOPE = c("", "", "BROAD", "BROAD"),

#'   stringsAsFactors = FALSE

#' )

#'

#' basket_name <- character(nrow(aag))

#' cq_pos <- grep("^(CQ).+NAM$", aag$NAMVAR)

#' smq_pos <- grep("^(SMQ).+NAM$", aag$NAMVAR)

#' basket_name[cq_pos] <- aag$REFNAME[cq_pos]

#' basket_name[smq_pos] <- paste0(

#'   aag$REFNAME[smq_pos], "(", aag$SCOPE[smq_pos], ")"

#' )

#'

#' aag_summary <- data.frame(

#'   basket = aag$NAMVAR,

#'   basket_name = basket_name,

#'   stringsAsFactors = TRUE

#' )

#'

#' result <- h_stack_by_baskets(df = adae, aag_summary = aag_summary)

#' all(levels(aag_summary$basket_name) %in% levels(result$SMQ))

#'

#' h_stack_by_baskets(

#'   df = adae,

#'   aag_summary = NULL,

#'   keys = c("STUDYID", "USUBJID", "AEDECOD", "ARM"),

#'   baskets = "SMQ01NAM"

#' )

#'

#' @export

h_stack_by_baskets <- function(df,

                               baskets = grep("^(SMQ|CQ).+NAM$", names(df), value = TRUE),

                               smq_varlabel = "Standardized MedDRA Query",

                               keys = c("STUDYID", "USUBJID", "ASTDTM", "AEDECOD", "AESEQ"),

                               aag_summary = NULL,

                               na_str = "<Missing>") {

  # SC corresponding to NAM

    )

    # Warning in case there is no match between `aag_summary$basket` and `baskets` argument.

    # Honestly, I think those should completely match. Target baskets should be the same.

    }

  }

  # convert `na_str` records from baskets to NA for the later loop and from wide to long steps

  } else {

    # Concatenate SMQxxxNAM with corresponding SMQxxxSC

    }

    # have to convert df_cnct from tibble to data frame

    # as it throws a warning otherwise about rownames.

    # tibble do not support rownames and reshape creates rownames

    )

  }

    # A warning in case there is no match between df and aag_summary records

    }

        )

      )

    )

  } else {

    )

  }

}

#' Control function for Cox regression

#'

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

#'

#' Sets a list of parameters for Cox regression fit. Used internally.

#'

#' @inheritParams argument_convention

#' @param pval_method (`string`)\cr the method used for estimation of p.values; `wald` (default) or `likelihood`.

#' @param interaction (`flag`)\cr if `TRUE`, the model includes the interaction between the studied

#'   treatment and candidate covariate. Note that for univariate models without treatment arm, and

#'   multivariate models, no interaction can be used so that this needs to be `FALSE`.

#' @param ties (`string`)\cr among `exact` (equivalent to `DISCRETE` in SAS), `efron` and `breslow`,

#'   see [survival::coxph()]. Note: there is no equivalent of SAS `EXACT` method in R.

#'

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

#'

#' @seealso [fit_coxreg_univar()] and [fit_coxreg_multivar()].

#'

#' @examples

#' control_coxreg()

#'

#' @export

control_coxreg <- function(pval_method = c("wald", "likelihood"),

                           ties = c("exact", "efron", "breslow"),

                           conf_level = 0.95,

                           interaction = FALSE) {

  )

}

#' Custom tidy methods for Cox regression

#'

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

#'

#' @inheritParams argument_convention

#' @param x (`list`)\cr result of the Cox regression model fitted by [fit_coxreg_univar()] (for univariate models)

#'   or [fit_coxreg_multivar()] (for multivariate models).

#'

#' @return [broom::tidy()] returns:

#' * For `summary.coxph` objects,  a `data.frame` with columns: `Pr(>|z|)`, `exp(coef)`, `exp(-coef)`, `lower .95`,

#'   `upper .95`, `level`, and `n`.

#' * For `coxreg.univar` objects, a `data.frame` with columns: `effect`, `term`, `term_label`, `level`, `n`, `hr`,

#'   `lcl`, `ucl`, `pval`, and `ci`.

#' * For `coxreg.multivar` objects, a `data.frame` with columns: `term`, `pval`, `term_label`, `hr`, `lcl`, `ucl`,

#'   `level`, and `ci`.

#'

#' @seealso [cox_regression]

#'

#' @name tidy_coxreg

NULL

#' @describeIn tidy_coxreg Custom tidy method for [survival::coxph()] summary results.

#'

#' Tidy the [survival::coxph()] results into a `data.frame` to extract model results.

#'

#' @method tidy summary.coxph

#'

#' @examples

#' library(survival)

#' library(broom)

#'

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

#'

#' dta_bladder <- with(

#'   data = bladder[bladder$enum < 5, ],

#'   data.frame(

#'     time = stop,

#'     status = event,

#'     armcd = as.factor(rx),

#'     covar1 = as.factor(enum),

#'     covar2 = factor(

#'       sample(as.factor(enum)),

#'       levels = 1:4, labels = c("F", "F", "M", "M")

#'     )

#'   )

#' )

#' labels <- c("armcd" = "ARM", "covar1" = "A Covariate Label", "covar2" = "Sex (F/M)")

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

#' dta_bladder$age <- sample(20:60, size = nrow(dta_bladder), replace = TRUE)

#'

#' formula <- "survival::Surv(time, status) ~ armcd + covar1"

#' msum <- summary(coxph(stats::as.formula(formula), data = dta_bladder))

#' tidy(msum)

#'

#' @export

tidy.summary.coxph <- function(x, # nolint

                               ...) {

}

#' @describeIn tidy_coxreg Custom tidy method for a univariate Cox regression.

#'

#' Tidy up the result of a Cox regression model fitted by [fit_coxreg_univar()].

#'

#' @method tidy coxreg.univar

#'

#' @examples

#' ## Cox regression: arm + 1 covariate.

#' mod1 <- fit_coxreg_univar(

#'   variables = list(

#'     time = "time", event = "status", arm = "armcd",

#'     covariates = "covar1"

#'   ),

#'   data = dta_bladder,

#'   control = control_coxreg(conf_level = 0.91)

#' )

#'

#' ## Cox regression: arm + 1 covariate + interaction, 2 candidate covariates.

#' mod2 <- fit_coxreg_univar(

#'   variables = list(

#'     time = "time", event = "status", arm = "armcd",

#'     covariates = c("covar1", "covar2")

#'   ),

#'   data = dta_bladder,

#'   control = control_coxreg(conf_level = 0.91, interaction = TRUE)

#' )

#'

#' tidy(mod1)

#' tidy(mod2)

#'

#' @export

tidy.coxreg.univar <- function(x, # nolint

                               ...) {

        )

      }

    )

        )

      }

    )

  } else {

        )

      }

    )

  }

    # Remove interaction p-values due to change in specifications.

  }

}

#' @describeIn tidy_coxreg Custom tidy method for a multivariate Cox regression.

#'

#' Tidy up the result of a Cox regression model fitted by [fit_coxreg_multivar()].

#'

#' @method tidy coxreg.multivar

#'

#' @examples

#' multivar_model <- fit_coxreg_multivar(

#'   variables = list(

#'     time = "time", event = "status", arm = "armcd",

#'     covariates = c("covar1", "covar2")

#'   ),

#'   data = dta_bladder

#' )

#' broom::tidy(multivar_model)

#'

#' @export

tidy.coxreg.multivar <- function(x, # nolint

                                 ...) {

  # Convert the model summaries to data.

      )

    }

  )

}

#' Fitting functions for Cox proportional hazards regression

#'

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

#'

#' Fitting functions for univariate and multivariate Cox regression models.

#'

#' @param variables (named `list`)\cr the names of the variables found in `data`, passed as a named list and

#'   corresponding to the `time`, `event`, `arm`, `strata`, and `covariates` terms. If `arm` is missing from

#'   `variables`, then only Cox model(s) including the `covariates` will be fitted and the corresponding effect

#'   estimates will be tabulated later.

#' @param data (`data.frame`)\cr the dataset containing the variables to fit the models.

#' @param at (`list` of `numeric`)\cr when the candidate covariate is a `numeric`, use `at` to specify

#'   the value of the covariate at which the effect should be estimated.

#' @param control (`list`)\cr a list of parameters as returned by the helper function [control_coxreg()].

#'

#' @seealso [h_cox_regression] for relevant helper functions, [cox_regression].

#'

#' @examples

#' library(survival)

#'

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

#'

#' # Testing dataset [survival::bladder].

#' dta_bladder <- with(

#'   data = bladder[bladder$enum < 5, ],

#'   data.frame(

#'     time = stop,

#'     status = event,

#'     armcd = as.factor(rx),

#'     covar1 = as.factor(enum),

#'     covar2 = factor(

#'       sample(as.factor(enum)),

#'       levels = 1:4, labels = c("F", "F", "M", "M")

#'     )

#'   )

#' )

#' labels <- c("armcd" = "ARM", "covar1" = "A Covariate Label", "covar2" = "Sex (F/M)")

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

#' dta_bladder$age <- sample(20:60, size = nrow(dta_bladder), replace = TRUE)

#'

#' plot(

#'   survfit(Surv(time, status) ~ armcd + covar1, data = dta_bladder),

#'   lty = 2:4,

#'   xlab = "Months",

#'   col = c("blue1", "blue2", "blue3", "blue4", "red1", "red2", "red3", "red4")

#' )

#'

#' @name fit_coxreg

NULL

#' @describeIn fit_coxreg Fit a series of univariate Cox regression models given the inputs.

#'

#' @return

#' * `fit_coxreg_univar()` returns a `coxreg.univar` class object which is a named `list`

#'   with 5 elements:

#'   * `mod`: Cox regression models fitted by [survival::coxph()].

#'   * `data`: The original data frame input.

#'   * `control`: The original control input.

#'   * `vars`: The variables used in the model.

#'   * `at`: Value of the covariate at which the effect should be estimated.

#'

#' @note When using `fit_coxreg_univar` there should be two study arms.

#'

#' @examples

#' # fit_coxreg_univar

#'

#' ## Cox regression: arm + 1 covariate.

#' mod1 <- fit_coxreg_univar(

#'   variables = list(

#'     time = "time", event = "status", arm = "armcd",

#'     covariates = "covar1"

#'   ),

#'   data = dta_bladder,

#'   control = control_coxreg(conf_level = 0.91)

#' )

#'

#' ## Cox regression: arm + 1 covariate + interaction, 2 candidate covariates.

#' mod2 <- fit_coxreg_univar(

#'   variables = list(

#'     time = "time", event = "status", arm = "armcd",

#'     covariates = c("covar1", "covar2")

#'   ),

#'   data = dta_bladder,

#'   control = control_coxreg(conf_level = 0.91, interaction = TRUE)

#' )

#'

#' ## Cox regression: arm + 1 covariate, stratified analysis.

#' mod3 <- fit_coxreg_univar(

#'   variables = list(

#'     time = "time", event = "status", arm = "armcd", strata = "covar2",

#'     covariates = c("covar1")

#'   ),

#'   data = dta_bladder,

#'   control = control_coxreg(conf_level = 0.91)

#' )

#'

#' ## Cox regression: no arm, only covariates.

#' mod4 <- fit_coxreg_univar(

#'   variables = list(

#'     time = "time", event = "status",

#'     covariates = c("covar1", "covar2")

#'   ),

#'   data = dta_bladder

#' )

#'

#' @export

fit_coxreg_univar <- function(variables,

                              data,

                              at = list(),

                              control = control_coxreg()) {

  }

  }

    }

  }

    }

  )

    ),

  )

}

#' @describeIn fit_coxreg Fit a multivariate Cox regression model.

#'

#' @return

#' * `fit_coxreg_multivar()` returns a `coxreg.multivar` class object which is a named list

#'   with 4 elements:

#'   * `mod`: Cox regression model fitted by [survival::coxph()].

#'   * `data`: The original data frame input.

#'   * `control`: The original control input.

#'   * `vars`: The variables used in the model.

#'

#' @examples

#' # fit_coxreg_multivar

#'

#' ## Cox regression: multivariate Cox regression.

#' multivar_model <- fit_coxreg_multivar(

#'   variables = list(

#'     time = "time", event = "status", arm = "armcd",

#'     covariates = c("covar1", "covar2")

#'   ),

#'   data = dta_bladder

#' )

#'

#' # Example without treatment arm.

#' multivar_covs_model <- fit_coxreg_multivar(

#'   variables = list(

#'     time = "time", event = "status",

#'     covariates = c("covar1", "covar2")

#'   ),

#'   data = dta_bladder

#' )

#'

#' @export

fit_coxreg_multivar <- function(variables,

                                data,

                                control = control_coxreg()) {

  }

  }

  )

    ),

  )

}

#' Muffled `car::Anova`

#'

#' Applied on survival models, [car::Anova()] signal that the `strata` terms is dropped from the model formula when

#' present, this function deliberately muffles this message.

#'

#' @param mod (`coxph`)\cr Cox regression model fitted by [survival::coxph()].

#' @param test_statistic (`string`)\cr the method used for estimation of p.values; `wald` (default) or `likelihood`.

#'

#' @return The output of [car::Anova()], with convergence message muffled.

#'

#' @keywords internal

muffled_car_anova <- function(mod, test_statistic) {

        )

      },

        ))

      }

    )

  )

}

#' Multivariate logistic regression table

#'

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

#'

#' Layout-creating function which summarizes a logistic variable regression for binary outcome with

#' categorical/continuous covariates in model statement. For each covariate category (if categorical)

#' or specified values (if continuous), present degrees of freedom, regression parameter estimate and

#' standard error (SE) relative to reference group or category. Report odds ratios for each covariate

#' category or specified values and corresponding Wald confidence intervals as default but allow user

#' to specify other confidence levels. Report p-value for Wald chi-square test of the null hypothesis

#' that covariate has no effect on response in model containing all specified covariates.

#' Allow option to include one two-way interaction and present similar output for

#' each interaction degree of freedom.

#'

#' @inheritParams argument_convention

#' @param drop_and_remove_str (`string`)\cr string to be dropped and removed.

#'

#' @return A layout object suitable for passing to further layouting functions, or to [rtables::build_table()].

#'   Adding this function to an `rtable` layout will add a logistic regression variable summary to the table layout.

#'

#' @note For the formula, the variable names need to be standard `data.frame` column names without

#'   special characters.

#'

#' @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"

#'   )

#' )

#'

#' df <- tidy(mod1, conf_level = 0.99)

#' df2 <- tidy(mod2, conf_level = 0.99)

#'

#' # flagging empty strings with "_"

#' df <- df_explicit_na(df, na_level = "_")

#' df2 <- df_explicit_na(df2, na_level = "_")

#'

#' result1 <- basic_table() %>%

#'   summarize_logistic(

#'     conf_level = 0.95,

#'     drop_and_remove_str = "_"

#'   ) %>%

#'   build_table(df = df)

#' result1

#'

#' result2 <- basic_table() %>%

#'   summarize_logistic(

#'     conf_level = 0.95,

#'     drop_and_remove_str = "_"

#'   ) %>%

#'   build_table(df = df2)

#' result2

#'

#' @export

#' @order 1

summarize_logistic <- function(lyt,

                               conf_level,

                               drop_and_remove_str = "",

                               .indent_mods = NULL) {

  # checks

}

#' Fit for logistic regression

#'

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

#'

#' Fit a (conditional) logistic regression model.

#'

#' @inheritParams argument_convention

#' @param data (`data.frame`)\cr the data frame on which the model was fit.

#' @param response_definition (`string`)\cr the definition of what an event is in terms of `response`.

#'   This will be used when fitting the (conditional) logistic regression model on the left hand

#'   side of the formula.

#'

#' @return A fitted logistic regression model.

#'

#' @section Model Specification:

#'

#' The `variables` list needs to include the following elements:

#'   * `arm`: Treatment arm variable name.

#'   * `response`: The response arm variable name. Usually this is a 0/1 variable.

#'   * `covariates`: This is either `NULL` (no covariates) or a character vector of covariate variable names.

#'   * `interaction`: This is either `NULL` (no interaction) or a string of a single covariate variable name already

#'     included in `covariates`. Then the interaction with the treatment arm is included in the model.

#'

#' @examples

#' library(dplyr)

#'

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

#'   )

#' )

#'

#' @export

fit_logistic <- function(data,

                         variables = list(

                           response = "Response",

                           arm = "ARMCD",

                           covariates = NULL,

                           interaction = NULL,

                           strata = NULL

                         ),

                         response_definition = "response") {

  )

  }

  }

    } else {

    }

  }

    )

  } else {

    )

  }

}

#' Custom tidy method for binomial GLM results

#'

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

#'

#' Helper method (for [broom::tidy()]) to prepare a data frame from a `glm` object

#' with `binomial` family.

#'

#' @inheritParams argument_convention

#' @param at (`numeric` or `NULL`)\cr optional values for the interaction variable. Otherwise the median is used.

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

#'

#' @return A `data.frame` containing the tidied model.

#'

#' @method tidy glm

#'

#' @seealso [h_logistic_regression] for relevant helper functions.

#'

#' @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"

#'   )

#' )

#'

#' df <- tidy(mod1, conf_level = 0.99)

#' df2 <- tidy(mod2, conf_level = 0.99)

#'

#' @export

tidy.glm <- function(x, # nolint

                     conf_level = 0.95,

                     at = NULL,

                     ...) {

    )

  } else {

    )

  }

  }

}

#' Logistic regression multivariate column layout function

#'

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

#'

#' Layout-creating function which creates a multivariate column layout summarizing logistic

#' regression results. This function is a wrapper for [rtables::split_cols_by_multivar()].

#'

#' @inheritParams argument_convention

#'

#' @return A layout object suitable for passing to further layouting functions. Adding this

#'   function to an `rtable` layout will split the table into columns corresponding to

#'   statistics `df`, `estimate`, `std_error`, `odds_ratio`, `ci`, and `pvalue`.

#'

#' @export

logistic_regression_cols <- function(lyt,

                                     conf_level = 0.95) {

  )

  )

}

#' Logistic regression summary table

#'

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

#'

#' Constructor for content functions to be used in [`summarize_logistic()`] to summarize

#' logistic regression results. This function is a wrapper for [rtables::summarize_row_groups()].

#'

#' @inheritParams argument_convention

#' @param flag_var (`string`)\cr variable name identifying which row should be used in this

#'   content function.

#'

#' @return A content function.

#'

#' @export

logistic_summary_by_flag <- function(flag_var, na_str = default_na_str(), .indent_mods = NULL) {

    )

    )

  }

}

# Utility functions to cooperate with {rtables} package

#' Convert table into matrix of strings

#'

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

#'

#' Helper function to use mostly within tests. `with_spaces`parameter allows

#' to test not only for content but also indentation and table structure.

#' `print_txt_to_copy` instead facilitate the testing development by returning a well

#' formatted text that needs only to be copied and pasted in the expected output.

#'

#' @inheritParams formatters::toString

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

#' @param with_spaces (`flag`)\cr whether the tested table should keep the indentation and other relevant spaces.

#' @param print_txt_to_copy (`flag`)\cr utility to have a way to copy the input table directly

#'   into the expected variable instead of copying it too manually.

#'

#' @return A `matrix` of `string`s. If `print_txt_to_copy = TRUE` the well formatted printout of the

#'   table will be printed to console, ready to be copied as a expected value.

#'

#' @examples

#' tbl <- basic_table() %>%

#'   split_rows_by("SEX") %>%

#'   split_cols_by("ARM") %>%

#'   analyze("AGE") %>%

#'   build_table(tern_ex_adsl)

#'

#' to_string_matrix(tbl, widths = ceiling(propose_column_widths(tbl) / 2))

#'

#' @export

to_string_matrix <- function(x, widths = NULL, max_width = NULL,

                             hsep = formatters::default_hsep(),

                             with_spaces = TRUE, print_txt_to_copy = FALSE) {

  } else {

  }

  }

  # Producing the matrix to test

  } else {

  }

  # Printing to console formatted output that needs to be copied in "expected"

    }

  }

  # Return values

}

#' Blank for missing input

#'

#' Helper function to use in tabulating model results.

#'

#' @param x (`vector`)\cr input for a cell.

#'

#' @return An empty `character` vector if all entries in `x` are missing (`NA`), otherwise

#'   the unlisted version of `x`.

#'

#' @keywords internal

unlist_and_blank_na <- function(x) {

  } else {

  }

}

#' Constructor for content functions given a data frame with flag input

#'

#' This can be useful for tabulating model results.

#'

#' @param analysis_var (`string`)\cr variable name for the column containing values to be returned by the

#'   content function.

#' @param flag_var (`string`)\cr variable name for the logical column identifying which row should be returned.

#' @param format (`string`)\cr `rtables` format to use.

#'

#' @return A content function which gives `df$analysis_var` at the row identified by

#'   `.df_row$flag` in the given format.

#'

#' @keywords internal

cfun_by_flag <- function(analysis_var,

                         flag_var,

                         format = "xx",

                         .indent_mods = NULL) {

    )

  }

}

#' Content row function to add row total to labels

#'

#' This takes the label of the latest row split level and adds the row total from `df` in parentheses.

#' This function differs from [c_label_n_alt()] by taking row counts from `df` rather than

#' `alt_counts_df`, and is used by [add_rowcounts()] when `alt_counts` is set to `FALSE`.

#'

#' @inheritParams argument_convention

#'

#' @return A list with formatted [rtables::CellValue()] with the row count value and the correct label.

#'

#' @note It is important here to not use `df` but rather `.N_row` in the implementation, because

#'   the former is already split by columns and will refer to the first column of the data only.

#'

#' @seealso [c_label_n_alt()] which performs the same function but retrieves row counts from

#'   `alt_counts_df` instead of `df`.

#'

#' @keywords internal

c_label_n <- function(df,

                      labelstr,

                      .N_row) { # nolint

  )

}

#' Content row function to add `alt_counts_df` row total to labels

#'

#' This takes the label of the latest row split level and adds the row total from `alt_counts_df`

#' in parentheses. This function differs from [c_label_n()] by taking row counts from `alt_counts_df`

#' rather than `df`, and is used by [add_rowcounts()] when `alt_counts` is set to `TRUE`.

#'

#' @inheritParams argument_convention

#'

#' @return A list with formatted [rtables::CellValue()] with the row count value and the correct label.

#'

#' @seealso [c_label_n()] which performs the same function but retrieves row counts from `df` instead

#'   of `alt_counts_df`.

#'

#' @keywords internal

c_label_n_alt <- function(df,

                          labelstr,

                          .alt_df_row) {

  )

}

#' Layout-creating function to add row total counts

#'

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

#'

#' This works analogously to [rtables::add_colcounts()] but on the rows. This function

#'  is a wrapper for [rtables::summarize_row_groups()].

#'

#' @inheritParams argument_convention

#' @param alt_counts (`flag`)\cr whether row counts should be taken from `alt_counts_df` (`TRUE`)

#'   or from `df` (`FALSE`). Defaults to `FALSE`.

#'

#' @return A modified layout where the latest row split labels now have the row-wise

#'   total counts (i.e. without column-based subsetting) attached in parentheses.

#'

#' @note Row count values are contained in these row count rows but are not displayed

#'   so that they are not considered zero rows by default when pruning.

#'

#' @examples

#' basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   add_colcounts() %>%

#'   split_rows_by("RACE", split_fun = drop_split_levels) %>%

#'   add_rowcounts() %>%

#'   analyze("AGE", afun = list_wrap_x(summary), format = "xx.xx") %>%

#'   build_table(DM)

#'

#' @export

add_rowcounts <- function(lyt, alt_counts = FALSE) {

  )

}

#' Obtain column indices

#'

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

#'

#' Helper function to extract column indices from a `VTableTree` for a given

#' vector of column names.

#'

#' @param table_tree (`VTableTree`)\cr `rtables` table object to extract the indices from.

#' @param col_names (`character`)\cr vector of column names.

#'

#' @return A vector of column indices.

#'

#' @export

h_col_indices <- function(table_tree, col_names) {

}

#' Labels or names of list elements

#'

#' Helper function for working with nested statistic function results which typically

#' don't have labels but names that we can use.

#'

#' @param x (`list`)\cr a list.

#'

#' @return A `character` vector with the labels or names for the list elements.

#'

#' @examples

#' x <- data.frame(

#'   a = 1:10,

#'   b = rnorm(10)

#' )

#' labels_or_names(x)

#' var_labels(x) <- c(b = "Label for b", a = NA)

#' labels_or_names(x)

#'

#' @export

labels_or_names <- function(x) {

}

#' Convert to `rtable`

#'

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

#'

#' This is a new generic function to convert objects to `rtable` tables.

#'

#' @param x (`data.frame`)\cr the object which should be converted to an `rtable`.

#' @param ... additional arguments for methods.

#'

#' @return An `rtables` table object. Note that the concrete class will depend on the method used.

#'

#' @export

as.rtable <- function(x, ...) { # nolint

}

#' @describeIn as.rtable Method for converting a `data.frame` that contains numeric columns to `rtable`.

#'

#' @param format (`string` or `function`)\cr the format which should be used for the columns.

#'

#' @method as.rtable data.frame

#'

#' @examples

#' x <- data.frame(

#'   a = 1:10,

#'   b = rnorm(10)

#' )

#' as.rtable(x)

#'

#' @export

as.rtable.data.frame <- function(x, format = "xx.xx", ...) {

      ),

            )

          )

        },

      )

    )

  )

}

#' Split parameters

#'

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

#'

#' It divides the data in the vector `param` into the groups defined by `f` based on specified `values`. It is relevant

#' in `rtables` layers so as to distribute parameters `.stats` or' `.formats` into lists with items corresponding to

#' specific analysis function.

#'

#' @param param (`vector`)\cr the parameter to be split.

#' @param value (`vector`)\cr the value used to split.

#' @param f (`list`)\cr the reference to make the split.

#'

#' @return A named `list` with the same element names as `f`, each containing the elements specified in `.stats`.

#'

#' @examples

#' f <- list(

#'   surv = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci"),

#'   surv_diff = c("rate_diff", "rate_diff_ci", "ztest_pval")

#' )

#'

#' .stats <- c("pt_at_risk", "rate_diff")

#' h_split_param(.stats, .stats, f = f)

#'

#' # $surv

#' # [1] "pt_at_risk"

#' #

#' # $surv_diff

#' # [1] "rate_diff"

#'

#' .formats <- c("pt_at_risk" = "xx", "event_free_rate" = "xxx")

#' h_split_param(.formats, names(.formats), f = f)

#'

#' # $surv

#' # pt_at_risk event_free_rate

#' # "xx"           "xxx"

#' #

#' # $surv_diff

#' # NULL

#'

#' @export

h_split_param <- function(param,

                          value,

                          f) {

}

#' Get selected statistics names

#'

#' Helper function to be used for creating `afun`.

#'

#' @param .stats (`vector` or `NULL`)\cr input to the layout creating function. Note that `NULL` means

#'   in this context that all default statistics should be used.

#' @param all_stats (`character`)\cr all statistics which can be selected here potentially.

#'

#' @return A `character` vector with the selected statistics.

#'

#' @keywords internal

afun_selected_stats <- function(.stats, all_stats) {

  } else {

  }

}

#' Add variable labels to top left corner in table

#'

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

#'

#' Helper layout-creating function to append the variable labels of a given variables vector

#' from a given dataset in the top left corner. If a variable label is not found then the

#' variable name itself is used instead. Multiple variable labels are concatenated with slashes.

#'

#' @inheritParams argument_convention

#' @param vars (`character`)\cr variable names of which the labels are to be looked up in `df`.

#' @param indent (`integer(1)`)\cr non-negative number of nested indent space, default to 0L which means no indent.

#'   1L means two spaces indent, 2L means four spaces indent and so on.

#'

#' @return A modified layout with the new variable label(s) added to the top-left material.

#'

#' @note This is not an optimal implementation of course, since we are using here the data set

#'   itself during the layout creation. When we have a more mature `rtables` implementation then

#'   this will also be improved or not necessary anymore.

#'

#' @examples

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   add_colcounts() %>%

#'   split_rows_by("SEX") %>%

#'   append_varlabels(DM, "SEX") %>%

#'   analyze("AGE", afun = mean) %>%

#'   append_varlabels(DM, "AGE", indent = 1)

#' build_table(lyt, DM)

#'

#' lyt <- basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   split_rows_by("SEX") %>%

#'   analyze("AGE", afun = mean) %>%

#'   append_varlabels(DM, c("SEX", "AGE"))

#' build_table(lyt, DM)

#'

#' @export

append_varlabels <- function(lyt, df, vars, indent = 0L) {

  }

}

#' Default string replacement for `NA` values

#'

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

#'

#' The default string used to represent `NA` values. This value is used as the default

#' value for the `na_str` argument throughout the `tern` package, and printed in place

#' of `NA` values in output tables. If not specified for each `tern` function by the user

#' via the `na_str` argument, or in the R environment options via [set_default_na_str()],

#' then `NA` is used.

#'

#' @param na_str (`string`)\cr single string value to set in the R environment options as

#'   the default value to replace `NA`s. Use `getOption("tern_default_na_str")` to check the

#'   current value set in the R environment (defaults to `NULL` if not set).

#'

#' @name default_na_str

NULL

#' @describeIn default_na_str Accessor for default `NA` value replacement string.

#'

#' @return

#' * `default_na_str` returns the current value if an R environment option has been set

#'   for `"tern_default_na_str"`, or `NA_character_` otherwise.

#'

#' @examples

#' # Default settings

#' default_na_str()

#' getOption("tern_default_na_str")

#'

#' # Set custom value

#' set_default_na_str("<Missing>")

#'

#' # Settings after value has been set

#' default_na_str()

#' getOption("tern_default_na_str")

#'

#' @export

default_na_str <- function() {

}

#' @describeIn default_na_str Setter for default `NA` value replacement string. Sets the

#'   option `"tern_default_na_str"` within the R environment.

#'

#' @return

#' * `set_default_na_str` has no return value.

#'

#' @export

set_default_na_str <- function(na_str) {

}

#' Utilities to handle extra arguments in analysis functions

#'

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

#' Important additional parameters, useful to modify behavior of analysis and summary

#' functions are listed in [rtables::additional_fun_params]. With these utility functions

#' we can retrieve a curated list of these parameters from the environment, and pass them

#' to the analysis functions with dedicated `...`; notice that the final `s_*` function

#' will get them through argument matching.

#'

#' @param extra_afun_params (`list`)\cr list of additional parameters (`character`) to be

#'   retrieved from the environment. Curated list is present in [rtables::additional_fun_params].

#' @param add_alt_df (`logical`)\cr if `TRUE`, the function will also add `.alt_df` and `.alt_df_row`

#'   parameters.

#'

#' @name util_handling_additional_fun_params

NULL

#' @describeIn util_handling_additional_fun_params Retrieve additional parameters from the environment.

#'

#' @return

#' * `retrieve_extra_afun_params` returns a list of the values of the parameters in the environment.

#'

#' @keywords internal

retrieve_extra_afun_params <- function(extra_afun_params) {

  }

}

#' @describeIn util_handling_additional_fun_params Curated list of additional parameters for

#'   analysis functions. Please check [rtables::additional_fun_params] for precise descriptions.

#'

#' @return

#' * `get_additional_afun_params` returns a list of additional parameters.