R/RcppExports.R

In PTE: Personalized Treatment Evaluator

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

eigen_Xt_times_X_cpp <- function(X_sexp) {
    .Call(`_PTE_eigen_Xt_times_X_cpp`, X_sexp)
}

eigen_compute_single_entry_on_diagonal_of_inverse_matrix_cpp <- function(M_sexp, j) {
    .Call(`_PTE_eigen_compute_single_entry_on_diagonal_of_inverse_matrix_cpp`, M_sexp, j)
}

eigen_Xt_times_diag_w_times_X_cpp <- function(X_sexp, w_sexp) {
    .Call(`_PTE_eigen_Xt_times_diag_w_times_X_cpp`, X_sexp, w_sexp)
}

likelihood_ratio_test_from_negloglik_cpp <- function(unrestricted_neg_loglik, null_neg_loglik, df = 1L) {
    .Call(`_PTE_likelihood_ratio_test_from_negloglik_cpp`, unrestricted_neg_loglik, null_neg_loglik, df)
}

score_test_from_score_information_cpp <- function(score_sexp, information_sexp, tested_idx) {
    .Call(`_PTE_score_test_from_score_information_cpp`, score_sexp, information_sexp, tested_idx)
}

gradient_test_from_restricted_score_cpp <- function(score_sexp, unrestricted_estimate, null_value, tested_idx) {
    .Call(`_PTE_gradient_test_from_restricted_score_cpp`, score_sexp, unrestricted_estimate, null_value, tested_idx)
}

mean_cpp <- function(x_sexp) {
    .Call(`_PTE_mean_cpp`, x_sexp)
}

var_cpp <- function(x_sexp) {
    .Call(`_PTE_var_cpp`, x_sexp)
}

fast_default_continuous_cv_run_cpp <- function(X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, censored_sexp, boot_idx_sexp, begin_cutoffs_sexp, end_cutoffs_sexp, y_higher_is_better) {
    .Call(`_PTE_fast_default_continuous_cv_run_cpp`, X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, censored_sexp, boot_idx_sexp, begin_cutoffs_sexp, end_cutoffs_sexp, y_higher_is_better)
}

default_continuous_q_scores_cpp <- function(y_sexp, given_tx_sexp, rec_tx_sexp, y_higher_is_better) {
    .Call(`_PTE_default_continuous_q_scores_cpp`, y_sexp, given_tx_sexp, rec_tx_sexp, y_higher_is_better)
}

default_incidence_q_scores_cpp <- function(y_sexp, given_tx_sexp, rec_tx_sexp, y_higher_is_better, incidence_metric) {
    .Call(`_PTE_default_incidence_q_scores_cpp`, y_sexp, given_tx_sexp, rec_tx_sexp, y_higher_is_better, incidence_metric)
}

fast_default_continuous_bootstrap_q_cpp <- function(X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, censored_sexp, B, begin_cutoffs_sexp, end_cutoffs_sexp, y_higher_is_better) {
    .Call(`_PTE_fast_default_continuous_bootstrap_q_cpp`, X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, censored_sexp, B, begin_cutoffs_sexp, end_cutoffs_sexp, y_higher_is_better)
}

get_logistic_regression_score_cpp <- function(X_sexp, y_sexp, beta_sexp) {
    .Call(`_PTE_get_logistic_regression_score_cpp`, X_sexp, y_sexp, beta_sexp)
}

get_logistic_regression_hessian_cpp <- function(X_sexp, beta_sexp) {
    .Call(`_PTE_get_logistic_regression_hessian_cpp`, X_sexp, beta_sexp)
}

get_logistic_regression_weighted_score_cpp <- function(X_sexp, y_sexp, weights_sexp, beta_sexp) {
    .Call(`_PTE_get_logistic_regression_weighted_score_cpp`, X_sexp, y_sexp, weights_sexp, beta_sexp)
}

get_logistic_regression_weighted_hessian_cpp <- function(X_sexp, weights_sexp, beta_sexp) {
    .Call(`_PTE_get_logistic_regression_weighted_hessian_cpp`, X_sexp, weights_sexp, beta_sexp)
}

fast_logistic_regression_cpp <- function(X_sexp, y_sexp, warm_start_beta = NULL, smart_cold_start = FALSE, maxit = 100L, tol = 1e-8, fixed_idx = NULL, fixed_values = NULL, optimization_alg = "irls", warm_start_weights = NULL, warm_start_fisher_info = NULL, estimate_only = FALSE) {
    .Call(`_PTE_fast_logistic_regression_cpp`, X_sexp, y_sexp, warm_start_beta, smart_cold_start, maxit, tol, fixed_idx, fixed_values, optimization_alg, warm_start_weights, warm_start_fisher_info, estimate_only)
}

fast_logistic_regression_weighted_cpp <- function(X_sexp, y_sexp, weights_sexp, warm_start_beta = NULL, smart_cold_start = FALSE, maxit = 100L, tol = 1e-8, fixed_idx = NULL, fixed_values = NULL, optimization_alg = "irls", warm_start_weights = NULL, warm_start_fisher_info = NULL) {
    .Call(`_PTE_fast_logistic_regression_weighted_cpp`, X_sexp, y_sexp, weights_sexp, warm_start_beta, smart_cold_start, maxit, tol, fixed_idx, fixed_values, optimization_alg, warm_start_weights, warm_start_fisher_info)
}

fast_logistic_regression_with_var_cpp <- function(X_sexp, y_sexp, j = 2L, warm_start_beta = NULL, smart_cold_start = FALSE, fixed_idx = NULL, fixed_values = NULL, optimization_alg = "irls", warm_start_weights = NULL, warm_start_fisher_info = NULL) {
    .Call(`_PTE_fast_logistic_regression_with_var_cpp`, X_sexp, y_sexp, j, warm_start_beta, smart_cold_start, fixed_idx, fixed_values, optimization_alg, warm_start_weights, warm_start_fisher_info)
}

fast_default_incidence_cv_run_cpp <- function(X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, censored_sexp, boot_idx_sexp, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_beta = NULL, y_higher_is_better = TRUE) {
    .Call(`_PTE_fast_default_incidence_cv_run_cpp`, X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, censored_sexp, boot_idx_sexp, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_beta, y_higher_is_better)
}

fast_default_incidence_bootstrap_q_cpp <- function(X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, B, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_beta = NULL, y_higher_is_better = TRUE, incidence_metric = "odds_ratio") {
    .Call(`_PTE_fast_default_incidence_bootstrap_q_cpp`, X_obs_sexp, y_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, B, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_beta, y_higher_is_better, incidence_metric)
}

#' Kaplan-Meier median survival time for a single group
#'
#' A minimal, compiled replacement for \code{summary(survival::survfit(Surv(y, dead) ~ 1))$table['median']}
#' -- computes only the median (no confidence intervals, no full survival table), which is all
#' \code{create_PTE_results_object} ever needs. See \code{get_survival_stat_diff} for the
#' treatment-vs-control difference used directly by the package.
#'
#' @param y_sexp Numeric vector of survival/censoring times.
#' @param dead_sexp Integer vector of event indicators (1 = event/death, 0 = censored).
#' @return The KM median survival time, or \code{Inf} if the curve never drops below 0.5.
#' @keywords internal
#' @noRd
get_survival_stat_for_group_cpp <- function(y_sexp, dead_sexp) {
    .Call(`_PTE_get_survival_stat_for_group_cpp`, y_sexp, dead_sexp)
}

#' Difference in Kaplan-Meier median survival time between two groups
#'
#' A minimal, compiled replacement for the package's previous
#' \code{summary(survival::survfit(Surv(y, dead) ~ w))$table[, 'median']} pattern, which paid for
#' the full \code{survfit}/\code{summary.survfit} machinery (confidence intervals, the full
#' survival table, formula/factor bookkeeping) purely to extract two numbers. This computes just
#' the two group medians directly and returns their difference.
#'
#' @param y_sexp Numeric vector of survival/censoring times (both groups concatenated).
#' @param dead_sexp Integer vector of event indicators (1 = event/death, 0 = censored).
#' @param w_sexp Integer vector of group membership (1 = first/"treatment" group, 0 = second/"control" group).
#' @return \code{median(group w == 1) - median(group w == 0)}. \code{NA} if either group's median
#' is not reached (the KM curve never drops below 0.5) or either group is empty, matching the
#' \code{NA} that \code{summary.survfit} would have produced in the same situation.
#' @keywords internal
#' @noRd
get_survival_stat_diff_cpp <- function(y_sexp, dead_sexp, w_sexp) {
    .Call(`_PTE_get_survival_stat_diff_cpp`, y_sexp, dead_sexp, w_sexp)
}

default_survival_q_scores_cpp <- function(y_sexp, dead_sexp, given_tx_sexp, rec_tx_sexp, y_higher_is_better) {
    .Call(`_PTE_default_survival_q_scores_cpp`, y_sexp, dead_sexp, given_tx_sexp, rec_tx_sexp, y_higher_is_better)
}

#' @title Compute Weibull Regression Score
#' @description Calculates the score vector (gradient of the log-likelihood) for a Weibull AFT regression model.
#' @param X_sexp A numeric matrix of predictors.
#' @param y_sexp A numeric vector of survival times.
#' @param dead_sexp A numeric vector of event indicators.
#' @param params_sexp A numeric vector of parameters [beta, log_sigma].
#' @return A numeric vector representing the score.
#' @keywords internal
#' @noRd
get_weibull_regression_score_cpp <- function(X_sexp, y_sexp, dead_sexp, params_sexp) {
    .Call(`_PTE_get_weibull_regression_score_cpp`, X_sexp, y_sexp, dead_sexp, params_sexp)
}

#' @title Compute Weibull Regression Hessian
#' @description Calculates the Hessian matrix (second derivatives of the log-likelihood) for a Weibull AFT regression model.
#' @param X_sexp A numeric matrix of predictors.
#' @param y_sexp A numeric vector of survival times.
#' @param dead_sexp A numeric vector of event indicators.
#' @param params_sexp A numeric vector of parameters [beta, log_sigma].
#' @return A numeric matrix representing the Hessian.
#' @keywords internal
#' @noRd
get_weibull_regression_hessian_cpp <- function(X_sexp, y_sexp, dead_sexp, params_sexp) {
    .Call(`_PTE_get_weibull_regression_hessian_cpp`, X_sexp, y_sexp, dead_sexp, params_sexp)
}

compute_weibull_rand_bootstrap_parallel_cpp <- function(y0, dead, Xc, i_mat, w_mat, delta, noise_mat, num_cores) {
    .Call(`_PTE_compute_weibull_rand_bootstrap_parallel_cpp`, y0, dead, Xc, i_mat, w_mat, delta, noise_mat, num_cores)
}

#' @title Fast Weibull AFT Regression (C++)
#' @description Weibull Accelerated Failure Time model fitting.
#' @param X_sexp A numeric matrix of predictors.
#' @param y_sexp A numeric vector of survival times.
#' @param dead_sexp A numeric vector of event indicators (1=event, 0=censored).
#' @param warm_start_params Optional starting values for coefficients.
#' @param smart_cold_start Logical. If TRUE, use an initial OLS-based guess.
#' @param estimate_only Logical. If TRUE, do not compute variance-covariance.
#' @param maxit Maximum number of iterations.
#' @param tol Convergence tolerance.
#' @param fixed_idx Optional indices of fixed parameters.
#' @param fixed_values Optional values for fixed parameters.
#' @param optimization_alg Optimization algorithm.
#' @param warm_start_fisher_info Optional initial Fisher Information matrix.
#' @return A list containing coefficients, log_sigma, and convergence status.
#' @keywords internal
#' @noRd
fast_weibull_regression_cpp <- function(X_sexp, y_sexp, dead_sexp, warm_start_params = NULL, smart_cold_start = TRUE, estimate_only = FALSE, maxit = 100L, tol = 1e-8, fixed_idx = NULL, fixed_values = NULL, optimization_alg = "lbfgs", warm_start_fisher_info = NULL) {
    .Call(`_PTE_fast_weibull_regression_cpp`, X_sexp, y_sexp, dead_sexp, warm_start_params, smart_cold_start, estimate_only, maxit, tol, fixed_idx, fixed_values, optimization_alg, warm_start_fisher_info)
}

fast_default_weibull_cv_run_cpp <- function(X_obs_sexp, y_full_sexp, dead_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, boot_idx_sexp, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_params = NULL, y_higher_is_better = TRUE) {
    .Call(`_PTE_fast_default_weibull_cv_run_cpp`, X_obs_sexp, y_full_sexp, dead_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, boot_idx_sexp, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_params, y_higher_is_better)
}

fast_default_weibull_bootstrap_q_cpp <- function(X_obs_sexp, y_full_sexp, dead_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, B, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_params = NULL, y_higher_is_better = TRUE) {
    .Call(`_PTE_fast_default_weibull_bootstrap_q_cpp`, X_obs_sexp, y_full_sexp, dead_full_sexp, X_tx0_sexp, X_tx1_sexp, treatment_sexp, B, begin_cutoffs_sexp, end_cutoffs_sexp, warm_start_params, y_higher_is_better)
}