#' 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 (`character`)\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

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 (`NULL` or `numeric`)\cr optional values for the interaction variable. Otherwise the median is used.

#' @param x 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 Constructor Function

#'

#' @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, .indent_mods = NULL) {

    )

    )

  }

}

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

#'

#' @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 `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_level = "<Missing>") {

  # Use of df_explicit_na() in case the user has not previously used

  # 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_level` 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 dataframe

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

    )

  }

}

#' 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 A vector of variable name 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 Names of two variable in interaction. We seek the estimation of the levels of `variable`

#'   given the levels of `given`.

#' @param lvl_var,lvl_given corresponding levels has given by `levels`.

#' @param mmat A name numeric filled with 0 used as template to obtain the design matrix.

#' @param coef Numeric of estimated coefficients.

#' @param vcov Variance-covariance matrix of underlying model.

#' @param conf_level Single numeric for the 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 matrix (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 the Cox Regression Model and `Anova`

#'

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

#' This last package introduces more flexibility to get the effect p.values.

#'

#' @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 (`character`)\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"),