#include #include "c_optim.h" namespace rstpm2 { using namespace Rcpp; using namespace arma; // assume right censored values in ascending order of time RcppExport SEXP test_cox_tvc2(SEXP args) { List largs = as(args); vec time = as(largs["time"]); // length n vec event = as(largs["event"]); // length n mat X = as(largs["X"]); // design matrix, n*c vec beta = as(largs["beta"]); // length c+1 int k = as(largs["k"]); // column to use for tvc int n = time.size(); int c = X.n_cols; double llike = 0.0, lsum; vec eta; vec eta0 = X * beta(span(0,c-1)); for (int i=0; i(args); vec time = as(largs["time"]); // length n vec event = as(largs["event"]); // length n mat X = as(largs["X"]); // design matrix, n*c vec beta = as(largs["beta"]); // length c+1 int k = as(largs["k"]); // column to use for tvc int n = time.size(); int c = X.n_cols; double logHk, lsum; std::vector H, etimes; vec eta; vec eta0 = X * beta(span(0,c-1)); for (int i=0; i(args); // vec time = as(largs["time"]); // length n // vec event = as(largs["event"]); // length n // mat X = as(largs["X"]); // design matrix, n*c // vec x0 = as(largs["x0"]); // design row for specific covariate pattern, length c // vec beta = as(largs["beta"]); // length c+1 // int k = as(largs["k"]); // column to use for tvc // int n = time.size(); // int c = X.n_cols; // double logHk, lsum; // std::vector H, etimes; // vec eta; // vec eta1 = X * beta(span(0,c-1)); // double eta0; // for (int i=0; i(args); vec time = as(largs["time"]); // length n vec event = as(largs["event"]); // length n mat X = as(largs["X"]); // one covariate, length n vec beta = as(largs["beta"]); // length 2 int k = as(largs["k"]); // column to use for tvc int n = time.size(); int c = X.n_cols; vec grad(beta.size(),fill::zeros); vec lsum(beta.size(),fill::zeros); vec eta0 = X * beta(span(0,c-1)); vec risk; mat Xrisk; for (int i=0; in; ++i) { if (data->event(i) == 1) { eta = beta[0]*data->x(span(i,data->n-1)) + beta[1]*log(data->time(i)) * data->x(span(i,data->n-1)); llike += eta(0) - log(sum(exp(eta))); } } return -llike; } void test_cox_tvc3_negll_gr(int ncoef, double * beta, double * gr, void * e) { Tvc * data = (Tvc *) e; vec risk, subx; gr[0] = gr[1] = 0.0; for (int i=0; in; ++i) { if (data->event(i) == 1) { subx = data->x(span(i,data->n-1)); risk = exp(beta[0]*subx + beta[1]*log(data->time(i)) * subx); gr[0] -= data->x(i) - sum(subx % risk)/sum(risk); gr[1] -= data->x(i)*log(data->time(i)) - sum(log(data->time(i)) * subx % risk)/sum(risk); } } } RcppExport SEXP test_cox_tvc3(SEXP args) { List largs = as(args); vec time = as(largs["time"]); // length n vec event = as(largs["event"]); // length n vec x = as(largs["x"]); // one covariate, length n NumericVector beta = clone(as(largs["beta"])); // length 2 int n = time.size(); Tvc data = {n, time, event, x, beta}; BFGS bfgs; bfgs.optim(test_cox_tvc3_negll,test_cox_tvc3_negll_gr,beta, (void *) &data); return wrap(List::create(_("coef")=bfgs.coef, _("negll")=bfgs.Fmin, _("hessian")=bfgs.hessian)); } } // namespace