R/RcppExports.R

Defines functions weightedAverageIFCumhazard_cpp rowMultiply_cpp colMultiply_cpp rowScale_cpp colScale_cpp rowCenter_cpp colCenter_cpp rowSumsCrossprod rowCumSum predictCIF_cpp IFlambda0_cpp IFbeta_cpp calcE_cpp getInfluenceFunctionBrierKMCensoringTerm getInfluenceFunctionAUCKMCensoringTerm getIC0AUC sampleMaxProcess_cpp pProcess_cpp quantileProcess_cpp colCumSum calculateDelongCovarianceFast calcAIFsurv_cpp calcSeMinimalCox_cpp calcSeCif2_cpp calcSeMinimalCSC_cpp baseHaz_cpp aucLoobFun

Documented in baseHaz_cpp colCenter_cpp colCumSum colMultiply_cpp colScale_cpp rowCenter_cpp rowCumSum rowMultiply_cpp rowScale_cpp rowSumsCrossprod

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

aucLoobFun <- function(IDCase, IDControl, riskMat, splitMat, weights) {
    .Call(`_riskRegression_aucLoobFun`, IDCase, IDControl, riskMat, splitMat, weights)
}

#' @title C++ Fast Baseline Hazard Estimation
#' @description C++ function to estimate the baseline hazard from a Cox Model
#'
#' @param starttimes a vector of times (begin at risk period). 
#' @param stoptimes a vector of times (end at risk period). 
#' @param status a vector indicating  censoring or event. 
#' @param eXb a numeric vector (exponential of the linear predictor).
#' @param strata a vector of integers (index of the strata for each observation).
#' @param predtimes a vector of times (time at which to evaluate the hazard). Must be sorted.
#' @param emaxtimes another vector of times, one per strata (last observation time in each strata).
#' @param nPatients number of observations.
#' @param nStrata number of strata 
#' @param cause the status value corresponding to event.
#' @param Efron whether Efron or Breslow estimator should be used in presence of ties.
#' 
#' @details WARNING stoptimes status eXb and strata must be sorted by strata, stoptimes, and status
#' @export
baseHaz_cpp <- function(starttimes, stoptimes, status, eXb, strata, predtimes, emaxtimes, nPatients, nStrata, cause, Efron) {
    .Call(`_riskRegression_baseHaz_cpp`, starttimes, stoptimes, status, eXb, strata, predtimes, emaxtimes, nPatients, nStrata, cause, Efron)
}

calcSeMinimalCSC_cpp <- function(seqTau, newSurvival, hazard0, cumhazard0, newX, neweXb, IFbeta, Ehazard0, cumEhazard0, hazard_iS0, cumhazard_iS0, delta_iS0, sample_eXb, sample_time, indexJumpSample_time, jump_time, isJump_time1, jump2jump, firstTime1theCause, lastSampleTime, newdata_index, factor, grid_strata, nTau, nNewObs, nSample, nStrata, nCause, p, theCause, diag, survtype, exportSE, exportIF, exportIFmean, debug) {
    .Call(`_riskRegression_calcSeMinimalCSC_cpp`, seqTau, newSurvival, hazard0, cumhazard0, newX, neweXb, IFbeta, Ehazard0, cumEhazard0, hazard_iS0, cumhazard_iS0, delta_iS0, sample_eXb, sample_time, indexJumpSample_time, jump_time, isJump_time1, jump2jump, firstTime1theCause, lastSampleTime, newdata_index, factor, grid_strata, nTau, nNewObs, nSample, nStrata, nCause, p, theCause, diag, survtype, exportSE, exportIF, exportIFmean, debug)
}

calcSeCif2_cpp <- function(ls_IFbeta, ls_X, ls_cumhazard, ls_hazard, survival, cif, ls_IFcumhazard, ls_IFhazard, eXb, nJumpTime, JumpMax, tau, tauIndex, nTau, nObs, theCause, nCause, hazardType, nVar, nNewObs, strata, exportSE, exportIF, exportIFsum, diag) {
    .Call(`_riskRegression_calcSeCif2_cpp`, ls_IFbeta, ls_X, ls_cumhazard, ls_hazard, survival, cif, ls_IFcumhazard, ls_IFhazard, eXb, nJumpTime, JumpMax, tau, tauIndex, nTau, nObs, theCause, nCause, hazardType, nVar, nNewObs, strata, exportSE, exportIF, exportIFsum, diag)
}

calcSeMinimalCox_cpp <- function(seqTau, newSurvival, hazard0, cumhazard0, newX, neweXb, IFbeta, Ehazard0, cumEhazard0, hazard_iS0, cumhazard_iS0, delta_iS0, sample_eXb, sample_time, indexJumpSample_time, jump_time, indexJumpTau, lastSampleTime, newdata_index, factor, nTau, nNewObs, nSample, nStrata, p, diag, exportSE, exportIF, exportIFmean, exportHazard, exportCumhazard, exportSurvival, debug) {
    .Call(`_riskRegression_calcSeMinimalCox_cpp`, seqTau, newSurvival, hazard0, cumhazard0, newX, neweXb, IFbeta, Ehazard0, cumEhazard0, hazard_iS0, cumhazard_iS0, delta_iS0, sample_eXb, sample_time, indexJumpSample_time, jump_time, indexJumpTau, lastSampleTime, newdata_index, factor, nTau, nNewObs, nSample, nStrata, p, diag, exportSE, exportIF, exportIFmean, exportHazard, exportCumhazard, exportSurvival, debug)
}

calcAIFsurv_cpp <- function(ls_IFcumhazard, IFbeta, cumhazard0, survival, eXb, X, prevStrata, ls_indexStrata, factor, nTimes, nObs, nStrata, nVar, diag, exportCumHazard, exportSurvival) {
    .Call(`_riskRegression_calcAIFsurv_cpp`, ls_IFcumhazard, IFbeta, cumhazard0, survival, eXb, X, prevStrata, ls_indexStrata, factor, nTimes, nObs, nStrata, nVar, diag, exportCumHazard, exportSurvival)
}

calculateDelongCovarianceFast <- function(Xs, Ys) {
    .Call(`_riskRegression_calculateDelongCovarianceFast`, Xs, Ys)
}

#' Apply cumsum in each column 
#'
#' @description Fast computation of apply(x,2,cumsum)
#' @param x A matrix.
#' @return A matrix of same size as x.
#' @author Thomas Alexander Gerds <tag@@biostat.ku.dk>
#' @examples
#' x <- matrix(1:8,ncol=2)
#' colCumSum(x)
#' @export
colCumSum <- function(x) {
    .Call(`_riskRegression_colCumSum`, x)
}

quantileProcess_cpp <- function(nSample, nContrast, nSim, iid, alternative, global, confLevel) {
    .Call(`_riskRegression_quantileProcess_cpp`, nSample, nContrast, nSim, iid, alternative, global, confLevel)
}

pProcess_cpp <- function(nSample, nContrast, nTime, nSim, value, iid, alternative, global) {
    .Call(`_riskRegression_pProcess_cpp`, nSample, nContrast, nTime, nSim, value, iid, alternative, global)
}

sampleMaxProcess_cpp <- function(nSample, nContrast, nSim, value, iid, alternative, type, global) {
    .Call(`_riskRegression_sampleMaxProcess_cpp`, nSample, nContrast, nSim, value, iid, alternative, type, global)
}

getIC0AUC <- function(time, status, tau, risk, GTiminus, Gtau, auc) {
    .Call(`_riskRegression_getIC0AUC`, time, status, tau, risk, GTiminus, Gtau, auc)
}

getInfluenceFunctionAUCKMCensoringTerm <- function(time, status, tau, ic0Case, ic0Controls, weights, firsthit, muCase, muControls, nu1, Gtau, auc, startControls1) {
    .Call(`_riskRegression_getInfluenceFunctionAUCKMCensoringTerm`, time, status, tau, ic0Case, ic0Controls, weights, firsthit, muCase, muControls, nu1, Gtau, auc, startControls1)
}

getInfluenceFunctionBrierKMCensoringTerm <- function(tau, time, residuals, status) {
    .Call(`_riskRegression_getInfluenceFunctionBrierKMCensoringTerm`, tau, time, residuals, status)
}

calcE_cpp <- function(eventtime, status, eXb, X, p, add0) {
    .Call(`_riskRegression_calcE_cpp`, eventtime, status, eXb, X, p, add0)
}

IFbeta_cpp <- function(newT, neweXb, newX, newStatus, newIndexJump, S01, E1, time1, iInfo, p) {
    .Call(`_riskRegression_IFbeta_cpp`, newT, neweXb, newX, newStatus, newIndexJump, S01, E1, time1, iInfo, p)
}

IFlambda0_cpp <- function(tau, IFbeta, newT, neweXb, newStatus, newStrata, newIndexJump, S01, E1, time1, lastTime1, lambda0, p, strata, minimalExport) {
    .Call(`_riskRegression_IFlambda0_cpp`, tau, IFbeta, newT, neweXb, newStatus, newStrata, newIndexJump, S01, E1, time1, lastTime1, lambda0, p, strata, minimalExport)
}

predictCIF_cpp <- function(hazard, cumhazard, eXb, strata, newtimes, etimes, etimeMax, t0, nEventTimes, nNewTimes, nData, cause, nCause, survtype, productLimit, diag, exportSurv) {
    .Call(`_riskRegression_predictCIF_cpp`, hazard, cumhazard, eXb, strata, newtimes, etimes, etimeMax, t0, nEventTimes, nNewTimes, nData, cause, nCause, survtype, productLimit, diag, exportSurv)
}

#' Apply cumsum in each row 
#'
#' @description Fast computation of t(apply(x,1,cumsum))
#' @param x A matrix.
#' @return A matrix of same size as x.
#' @author Thomas Alexander Gerds <tag@@biostat.ku.dk>
#' @examples
#' x <- matrix(1:8,ncol=2)
#' rowCumSum(x)
#' @export
rowCumSum <- function(x) {
    .Call(`_riskRegression_rowCumSum`, x)
}

#' Apply crossprod and rowSums
#'
#' @description Fast computation of crossprod(rowSums(X),Y)
#' @param X A matrix with dimensions n*k. Hence the result of \code{rowSums(X)} has length n.
#' @param Y A matrix with dimenions n*m. Can be a matrix with dimension m*n but then \code{transposeY} should be \code{TRUE}.
#' @param transposeY Logical. If \code{TRUE} transpose Y before matrix multiplication.
#' @return A vector of length m.
#' @author Thomas Alexander Gerds <tag@@biostat.ku.dk>
#' @examples
#' x <- matrix(1:10,nrow=5)
#' y <- matrix(1:20,ncol=4)
#' rowSumsCrossprod(x,y,0)
#'
#' x <- matrix(1:10,nrow=5)
#' y <- matrix(1:20,ncol=5)
#' rowSumsCrossprod(x,y,1)
#' @export
rowSumsCrossprod <- function(X, Y, transposeY) {
    .Call(`_riskRegression_rowSumsCrossprod`, X, Y, transposeY)
}

#' @title Apply - by column
#' @description Fast computation of sweep(X, MARGIN = 1, FUN = "-", STATS = center)
#' @name colCenter_cpp
#' 
#' 
#' @param X A matrix.
#' @param center a numeric vector of length equal to the number of rows of \code{x}
#' 
#' @return A matrix of same size as X.
#' 
#' @author Brice Ozenne <broz@@sund.ku.dk>
#' @examples
#' x <- matrix(1,6,5)
#' sweep(x, MARGIN = 1, FUN = "-", STATS = 1:6)
#' colCenter_cpp(x, 1:6 )
NULL

#' @title Apply - by row
#' @description Fast computation of sweep(X, MARGIN = 2, FUN = "-", STATS = center)
#' @name rowCenter_cpp
#' 
#' @param X A matrix.
#' @param center a numeric vector of length equal to the number of rows of \code{x}
#' 
#' @return A matrix of same size as X.
#' @author Brice Ozenne <broz@@sund.ku.dk>
#' @examples
#' x <- matrix(1,6,5)
#' sweep(x, MARGIN = 2, FUN = "-", STATS = 1:5)
#' rowCenter_cpp(x, 1:5 )
#' 
#' rowCenter_cpp(x, colMeans(x) )
NULL

#' @title Apply / by column
#' @description Fast computation of sweep(X, MARGIN = 1, FUN = "/", STATS = scale)
#' @name colScale_cpp
#'
#' @param X A matrix.
#' @param scale a numeric vector of length equal to the number of rows of \code{x}
#' 
#' @return A matrix of same size as X.
#' @author Brice Ozenne <broz@@sund.ku.dk>
#' @examples
#' x <- matrix(1,6,5)
#' sweep(x, MARGIN = 1, FUN = "/", STATS = 1:6)
#' colScale_cpp(x, 1:6 )
NULL

#' @title Apply / by row
#' @description Fast computation of sweep(X, MARGIN = 2, FUN = "/", STATS = scale)
#' @name rowScale_cpp
#' 
#' @param X A matrix.
#' @param scale a numeric vector of length equal to the number of rows of \code{x}
#' 
#' @return A matrix of same size as X.
#' @author Brice Ozenne <broz@@sund.ku.dk>
#' @examples
#' x <- matrix(1,6,5)
#' sweep(x, MARGIN = 2, FUN = "/", STATS = 1:5)
#' rowScale_cpp(x, 1:5 )
#' 
#' rowScale_cpp(x, colMeans(x) )
NULL

#' @title Apply * by column
#' @description Fast computation of sweep(X, MARGIN = 1, FUN = "*", STATS = scale)
#' @name colMultiply_cpp
#' 
#' @param X A matrix.
#' @param scale a numeric vector of length equal to the number of rows of \code{x}
#' 
#' @return A matrix of same size as X.
#' @author Brice Ozenne <broz@@sund.ku.dk>
#' @examples
#' x <- matrix(1,6,5)
#' sweep(x, MARGIN = 1, FUN = "*", STATS = 1:6)
#' colMultiply_cpp(x, 1:6 )
NULL

#' @title Apply * by row
#' @description Fast computation of sweep(X, MARGIN = 2, FUN = "*", STATS = scale)
#' @name rowMultiply_cpp
#' 
#' @param X A matrix.
#' @param scale a numeric vector of length equal to the number of rows of \code{x}
#' 
#' @return A matrix of same size as X.
#' @author Brice Ozenne <broz@@sund.ku.dk>
#' @examples
#' x <- matrix(1,6,5)
#' sweep(x, MARGIN = 2, FUN = "*", STATS = 1:5)
#' rowMultiply_cpp(x, 1:5 )
#' 
#' rowMultiply_cpp(x, 1/colMeans(x) )
#' 
NULL

#' @rdname colCenter_cpp
#' @export
colCenter_cpp <- function(X, center) {
    .Call(`_riskRegression_colCenter_cpp`, X, center)
}

#' @rdname rowCenter_cpp
#' @export
rowCenter_cpp <- function(X, center) {
    .Call(`_riskRegression_rowCenter_cpp`, X, center)
}

#' @rdname colScale_cpp
#' @export
colScale_cpp <- function(X, scale) {
    .Call(`_riskRegression_colScale_cpp`, X, scale)
}

#' @rdname rowScale_cpp
#' @export
rowScale_cpp <- function(X, scale) {
    .Call(`_riskRegression_rowScale_cpp`, X, scale)
}

#' @name colMultiply_cpp
#' @export
colMultiply_cpp <- function(X, scale) {
    .Call(`_riskRegression_colMultiply_cpp`, X, scale)
}

#' @name rowMultiply_cpp
#' @export
rowMultiply_cpp <- function(X, scale) {
    .Call(`_riskRegression_rowMultiply_cpp`, X, scale)
}

weightedAverageIFCumhazard_cpp <- function(seqTau, cumhazard0, newX, neweXb, IFbeta, cumEhazard0, cumhazard_iS0, delta_iS0, sample_eXb, sample_time, indexJumpSample_time, jump_time, indexJumpTau, lastSampleTime, newdata_index, nTau, nSample, nStrata, p, diag, debug, weights, isBeforeTau, tau) {
    .Call(`_riskRegression_weightedAverageIFCumhazard_cpp`, seqTau, cumhazard0, newX, neweXb, IFbeta, cumEhazard0, cumhazard_iS0, delta_iS0, sample_eXb, sample_time, indexJumpSample_time, jump_time, indexJumpTau, lastSampleTime, newdata_index, nTau, nSample, nStrata, p, diag, debug, weights, isBeforeTau, tau)
}

Try the riskRegression package in your browser

Any scripts or data that you put into this service are public.

riskRegression documentation built on May 29, 2024, 10:59 a.m.