// use this constructor for new fts objects
BackendBase(SEXPTYPE rtype, R_len_t nr, R_len_t nc) : Robject(PROTECT(Rf_allocMatrix(rtype, nr, nc))) {
// add fts class to Robject
SEXP r_tseries_class = PROTECT(Rf_allocVector(STRSXP, 2));
SET_STRING_ELT(r_tseries_class, 0, Rf_mkChar("fts"));
SET_STRING_ELT(r_tseries_class, 1, Rf_mkChar("zoo"));
Rf_classgets(Robject, r_tseries_class);
UNPROTECT(1); // r_tseries_class
}
JulianBackend(const TSDIM rows, const TSDIM cols) : BackendBase(Rallocator<TDATA>::getType(), rows, cols) {
// create dates
SEXP R_dates = PROTECT(Rallocator<TDATE>::Vector(rows));
// create and add dates class to dates object
SEXP r_dates_class = PROTECT(Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(r_dates_class, 0, Rf_mkChar("Date"));
Rf_classgets(R_dates, r_dates_class);
// attach dates to Robject
Rf_setAttrib(Robject, Rf_install("index"), R_dates);
UNPROTECT(2); // R_dates, r_dates_class
}
void plot::save_snapshot_variable() {
rhost::util::errors_to_exceptions([&] {
pGEDevDesc ge_dev_desc = Rf_desc2GEDesc(_device_desc);
SEXP snapshot = Rf_protect(GEcreateSnapshot(ge_dev_desc));
SEXP klass = Rf_protect(Rf_mkString("recordedplot"));
Rf_classgets(snapshot, klass);
Rf_defineVar(Rf_install(_snapshot_varname.c_str()), snapshot, R_GlobalEnv);
Rf_unprotect(2);
});
}
void plot::set_snapshot(const rhost::util::protected_sexp& snapshot) {
// Ignore if we already created a snapshot
if (_snapshot_varname.empty()) {
_snapshot_varname = get_snapshot_varname();
}
rhost::util::errors_to_exceptions([&] {
SEXP klass = Rf_protect(Rf_mkString("recordedplot"));
Rf_classgets(snapshot.get(), klass);
SEXP duplicated_snapshot = Rf_protect(Rf_duplicate(snapshot.get()));
Rf_defineVar(Rf_install(_snapshot_varname.c_str()), duplicated_snapshot, R_GlobalEnv);
Rf_unprotect(2);
});
}
