#include #include #include #include namespace rstpm2 { double gsm::link(double S) { return link_type==PH ? std::log(-std::log(S)) : -100.0; } double gsm::linkinv(double eta) { return link_type==PH ? std::exp(-std::exp(eta)) : 1.0e-10; } gsm::gsm() {} double gsm::eta(double y) { double eta = etap(index); for (std::vector::size_type i=0; iindex = index; target = (tentry==0.0 ? link(u) : link(u*linkinv(eta(ymin)))); double root = std::get<0>(R_zeroin2_functor_ptr(ymin, ymax, this, 1.0e-8, 100)); return log_time ? std::exp(root) : root; } gsm::gsm(Rcpp::List list) { try { using namespace Rcpp; std::string link_name = as(list("link_name")); tmin = as(list("tmin")); tmax = as(list("tmax")); double inflate = as(list("inflate")); tmin = tmin/inflate; tmax = tmax*inflate; etap = as(list("etap")); List lterms = as(list("terms")); for (int i=0; i(lterms(i)); gsm_term term; term.gamma = as(lterm("gamma")); arma::vec knots = as(lterm("knots")); arma::vec Boundary_knots = as(lterm("Boundary_knots")); int intercept = as(lterm("intercept")); arma::mat q_const = as(lterm("q_const")); int cure = as(lterm("cure")); term.ns1 = ns(Boundary_knots, knots, q_const, intercept, cure); term.x = as(lterm("x")); terms.push_back(term); } log_time = as(list("log_time")); target = 0.0; index = 0; if (link_name == "PH") link_type = PH; } catch(std::exception &ex) { forward_exception_to_r(ex); } catch(...) { ::Rf_error("c++ exception (unknown reason)"); } } gsm::gsm(SEXP args) : gsm(Rcpp::as(args)) { } RcppExport SEXP test_read_gsm(SEXP args) { Rcpp::RNGScope rngScope; gsm gsm1(args); return Rcpp::wrap(gsm1.rand()); } }