| 26 | namespace internal{ |
| 27 | |
| 28 | class DimNameProxy { |
| 29 | |
| 30 | public: |
| 31 | |
| 32 | DimNameProxy(SEXP data, int dim): data_(data), dim_(dim) {} |
| 33 | DimNameProxy(DimNameProxy const& other): |
| 34 | data_(other.data_), dim_(other.dim_) {} |
| 35 | |
| 36 | inline DimNameProxy& assign(SEXP other) { |
| 37 | if (Rf_length(other) == 0) |
| 38 | { |
| 39 | Rf_setAttrib(data_, R_DimNamesSymbol, R_NilValue); |
| 40 | } else { |
| 41 | SEXP dims = Rf_getAttrib(data_, R_DimSymbol); |
| 42 | if (INTEGER(dims)[dim_] != Rf_length(other)) { |
| 43 | stop("dimension extent is '%d' while length of names is '%d'", INTEGER(dims)[dim_], Rf_length(other)); |
| 44 | } |
| 45 | |
| 46 | SEXP dimnames = Rf_getAttrib(data_, R_DimNamesSymbol); |
| 47 | if (Rf_isNull(dimnames)) { |
| 48 | Shield<SEXP> new_dimnames(Rf_allocVector(VECSXP, Rf_length(dims))); |
| 49 | SET_VECTOR_ELT(new_dimnames, dim_, other); |
| 50 | Rf_setAttrib(data_, R_DimNamesSymbol, new_dimnames); |
| 51 | } else { |
| 52 | SET_VECTOR_ELT(dimnames, dim_, other); |
| 53 | } |
| 54 | } |
| 55 | return *this; |
| 56 | } |
| 57 | |
| 58 | inline DimNameProxy& operator=(SEXP other) { |
| 59 | return assign(other); |
| 60 | } |
| 61 | |
| 62 | inline DimNameProxy& operator=(const DimNameProxy& other) { |
| 63 | return assign(SEXP(other)); |
| 64 | } |
| 65 | |
| 66 | inline operator SEXP() const { |
| 67 | SEXP dimnames = Rf_getAttrib(data_, R_DimNamesSymbol); |
| 68 | return Rf_isNull(dimnames) ? (R_NilValue) : (VECTOR_ELT(dimnames, dim_)); |
| 69 | } |
| 70 | |
| 71 | template <typename T> |
| 72 | inline operator T() const { |
| 73 | SEXP dimnames = Rf_getAttrib(data_, R_DimNamesSymbol); |
| 74 | if (Rf_isNull(dimnames)) { |
| 75 | return T(); |
| 76 | } else { |
| 77 | return T(VECTOR_ELT(dimnames, dim_)); |
| 78 | } |
| 79 | } |
| 80 | |
| 81 | private: |
| 82 | |
| 83 | SEXP data_; |
| 84 | int dim_; |
| 85 | }; |