|
| 1 | +// utilities.cpp: Rcpp R/C++ interface class library -- attribute utilities |
| 2 | +// |
| 3 | +// Copyright (C) 2025 - current Dirk Eddelbuettel |
| 4 | +// |
| 5 | +// This file is part of Rcpp. |
| 6 | +// |
| 7 | +// Rcpp is free software: you can redistribute it and/or modify it |
| 8 | +// under the terms of the GNU General Public License as published by |
| 9 | +// the Free Software Foundation, either version 2 of the License, or |
| 10 | +// (at your option) any later version. |
| 11 | +// |
| 12 | +// Rcpp is distributed in the hope that it will be useful, but |
| 13 | +// WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 | +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 | +// GNU General Public License for more details. |
| 16 | +// |
| 17 | +// You should have received a copy of the GNU General Public License |
| 18 | +// along with Rcpp. If not, see <http://www.gnu.org/licenses/>. |
| 19 | + |
| 20 | +#define COMPILING_RCPP |
| 21 | + |
| 22 | +#include <vector> |
| 23 | +#include <string> |
| 24 | +#include <Rcpp/Lighter> |
| 25 | + |
| 26 | +// See WRE Section 6.22.6 'Working with attributes' under R 4.6.0 or later |
| 27 | +// This function collects the names from 'tag' in a vector passed via *data |
| 28 | +// It is used by AttributeProxyPolicy::attributeNames() in a call to R_mapAttrib |
| 29 | +// [[Rcpp::register]] |
| 30 | +SEXP get_attr_names(SEXP tag, SEXP attr, void* data) { |
| 31 | + std::vector<std::string>* vecptr = static_cast<std::vector<std::string>*>(data); |
| 32 | + std::string s{CHAR(Rf_asChar(tag))}; |
| 33 | + vecptr->push_back(s); |
| 34 | + return NULL; |
| 35 | +} |
| 36 | + |
| 37 | +// See WRE Section 6.22.6 'Working with attributes' under R 4.6.0 or later |
| 38 | +// This function extract the number of rows in a data frame |
| 39 | +// It is used DataFrame_impl::nrow() in a call to R_mapAttrib() |
| 40 | +// [[Rcpp::register]] |
| 41 | +SEXP get_row_count(SEXP tag, SEXP attr, void* data) { |
| 42 | + if (tag == R_RowNamesSymbol) { |
| 43 | + if (TYPEOF(attr) == INTSXP && LENGTH(attr) == 2 && INTEGER(attr)[0] == NA_INTEGER) { |
| 44 | + int n = std::abs(INTEGER(attr)[1]); |
| 45 | + //Rcpp::Rcout << "Seeing " << n << std::endl; |
| 46 | + return Rf_ScalarInteger(n); |
| 47 | + } |
| 48 | + if (Rf_isNull(attr)) { |
| 49 | + return Rf_ScalarInteger(0); |
| 50 | + } |
| 51 | + return Rf_ScalarInteger(LENGTH(attr)); |
| 52 | + } |
| 53 | + return NULL; |
| 54 | +} |
0 commit comments