// [[Rcpp::export]]
bool result_active(XPtr<PqResult> rs) {
return rs.get() != NULL && rs->active();
}
// [[Rcpp::export]]
bool result_is_complete(XPtr<PqResult> rs) {
return rs->isComplete();
}
// [[Rcpp::export]]
void result_release(XPtr<PqResult> rs) {
rs.release();
}
// [[Rcpp::export]]
List result_fetch(XPtr<PqResult> rs, int n) {
return rs->fetch(n);
}
// [[Rcpp::export]]
void result_bind_params(XPtr<PqResult> rs, ListOf<CharacterVector> params) {
return rs->bind(params);
}
//' @title Get number of strata
//'
//' @description
//' \code{getNumberOfStrata} return the number of unique strata in an OHDSI Cyclops data object
//'
//' @param object An OHDSI Cyclops data object
//'
// [[Rcpp::export("getNumberOfStrata")]]
int cyclopsGetNumberOfStrata(Environment object) {
XPtr<bsccs::ModelData> data = parseEnvironmentForPtr(object);
return static_cast<int>(data->getNumberOfPatients());
}
// [[Rcpp::export]]
int xptr_2( XPtr< std::vector<int> > p){
/* just return the front of the vector as a SEXP */
return p->front() ;
}
// [[Rcpp::export(".cyclopsGetHasIntercept")]]
bool cyclopsGetHasIntercept(Environment x) {
using namespace bsccs;
XPtr<ModelData> data = parseEnvironmentForPtr(x);
return data->getHasInterceptCovariate();
}
// [[Rcpp::export(".cyclopsFinalizeData")]]
void cyclopsFinalizeData(
Environment x,
bool addIntercept,
SEXP sexpOffsetCovariate,
bool offsetAlreadyOnLogScale,
bool sortCovariates,
SEXP sexpCovariatesDense,
bool magicFlag = false) {
using namespace bsccs;
XPtr<ModelData> data = parseEnvironmentForPtr(x);
if (data->getIsFinalized()) {
::Rf_error("OHDSI data object is already finalized");
}
if (addIntercept) {
if (data->getHasInterceptCovariate()) {
::Rf_error("OHDSI data object already has an intercept");
}
// TODO add intercept as INTERCEPT_TYPE if magicFlag == true
data->insert(0, DENSE); // add to front, TODO fix if offset
data->setHasInterceptCovariate(true);
// CompressedDataColumn& intercept = data->getColumn(0);
const size_t numRows = data->getNumberOfRows();
for (size_t i = 0; i < numRows; ++i) {
data->getColumn(0).add_data(i, static_cast<real>(1.0));
}
}
if (!Rf_isNull(sexpOffsetCovariate)) {
// TODO handle offset
IdType covariate = as<IdType>(sexpOffsetCovariate);
int index;
if (covariate == -1) { // TODO Bad, magic number
//std::cout << "Trying to convert time to offset" << std::endl;
//data->push_back(NULL, NULL, offs.begin(), offs.end(), DENSE); // TODO Do not make copy
//data->push_back(NULL, &(data->getTimeVectorRef()), DENSE);
data->moveTimeToCovariate(true);
index = data->getNumberOfColumns() - 1;
} else {
index = data->getColumnIndexByName(covariate);
if (index == -1) {
std::ostringstream stream;
stream << "Variable " << covariate << " not found.";
stop(stream.str().c_str());
//error->throwError(stream);
}
}
data->moveToFront(index);
data->getColumn(0).add_label(-1); // TODO Generic label for offset?
data->setHasOffsetCovariate(true);
}
if (data->getHasOffsetCovariate() && !offsetAlreadyOnLogScale) {
//stop("Transforming the offset is not yet implemented");
data->getColumn(0).transform([](real x) {
return std::log(x);
});
}
if (!Rf_isNull(sexpCovariatesDense)) {
// TODO handle dense conversion
ProfileVector covariates = as<ProfileVector>(sexpCovariatesDense);
for (auto it = covariates.begin(); it != covariates.end(); ++it) {
IdType index = data->getColumnIndex(*it);
data->getColumn(index).convertColumnToDense(data->getNumberOfRows());
}
}
data->setIsFinalized(true);
}
// [[Rcpp::export]]
SEXP materialize_binding(int idx, XPtr<DataMaskWeakProxyBase> mask_proxy_xp) {
return mask_proxy_xp->materialize(idx);
}
// [[Rcpp::export(".cyclopsSetHasIntercept")]]
void cyclopsSetHasIntercept(Environment x, bool hasIntercept) {
using namespace bsccs;
XPtr<ModelData> data = parseEnvironmentForPtr(x);
data->setHasInterceptCovariate(hasIntercept);
}
// [[Rcpp::export]]
SEXP kdtree_range_query_multiple(SEXP tr, SEXP pminlist, SEXP pmaxlist, SEXP nr, SEXP nc, SEXP verb)
{
XPtr<KDTree> tree = as<XPtr<KDTree> >(tr);
int nrow = as<int>(nr);
int ncol = as<int>(nc);
NumericVector datamin(pminlist);
NumericVector datamax(pmaxlist);
bool verbose = as<int>(verb);
if (ncol != tree->ndims())
{
throw(length_error("pmin or pmax not same dimensionality as data in kdtree"));
}
vector<vector< double > > dataminMatrix
= convertMatrixToVector(datamin.begin(), nrow, ncol);
vector<vector< double > > datamaxMatrix
= convertMatrixToVector(datamax.begin(), nrow, ncol);
vector<int> finalCounts;
if (ncol != tree->ndims())
{
throw(length_error("Points not same dimensionality as data in kdtree"));
}
//RProgress::RProgress pb("[:bar]", nrow);
if (verbose==1)
{
Rcpp::Rcout << "Ball query... \n";
//pb.tick(0);
}
for (int i=0; i<nrow; i++)
{
vector<int> thisIndices;
vector<double> thisPointMin = dataminMatrix[i];
vector<double> thisPointMax = datamaxMatrix[i];
tree->range_query(thisPointMin, thisPointMax, thisIndices);
// store the number of points within the ball for each point
finalCounts.push_back(thisIndices.size());
if (i%10==0 && verbose==1)
{
//pb.update(1.0*(i+1)/nrow);
}
}
//pb.update(1);
if (verbose==1)
{
Rcpp::Rcout << "\ndone.\n";
}
return(wrap(finalCounts));
}
// [[Rcpp::export]]
SEXP kdtree_ball_query_id_multiple(SEXP tr, SEXP ptlist, SEXP nr, SEXP nc, SEXP r, SEXP verb)
{
XPtr<KDTree> tree = as<XPtr<KDTree> >(tr);
int nrow = as<int>(nr);
int ncol = as<int>(nc);
NumericVector data(ptlist);
double radius = as<double>(r);
bool verbose = as<int>(verb);
vector<vector< double > > dataMatrix
= convertMatrixToVector(data.begin(), nrow, ncol);
vector< vector< int > > finalIDs;
if (ncol != tree->ndims())
{
throw(length_error("Points not same dimensionality as data in kdtree"));
}
//RProgress::RProgress pb("[:bar]", nrow);
if (verbose==1)
{
Rcpp::Rcout << "Ball query... \n";
//pb.tick(0);
}
for (int i=0; i<nrow; i++)
{
vector<int> thisIndices;
vector<double> thisDistances;
vector<double> thisPoint = dataMatrix[i];
tree->ball_query(thisPoint, radius, thisIndices, thisDistances);
// store the number of points within the ball for each point
if (thisIndices.size() > 0)
{
finalIDs.push_back(thisIndices);
}
else
{
vector<int> empty;
empty.push_back(-1);
finalIDs.push_back(empty);
}
if (i%10==0 && verbose==1)
{
//pb.update(1.0*(i+1)/nrow);
}
}
//pb.update(1);
if (verbose==1)
{
Rcpp::Rcout << "\ndone.\n";
}
return(wrap(finalIDs));
}
// [[Rcpp::export]]
bool CloseAttribute(XPtr<Attribute> attribute) {
attribute->close();
return true;
}
// [[Rcpp::export]]
int xptr_use_released( XPtr< std::vector<int> > p ) {
return p->front();
}
// [[Rcpp::export]]
bool xptr_release( XPtr< std::vector<int> > p) {
p.release();
return !p;
}