SEXP R_mpc_div(SEXP e1, SEXP e2) { /* N.B. We always use signed integers for e2 given R's type system. */ mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t)); if (Rf_inherits(e1, "mpc")) { mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1); if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpc_init2(*z, max(mpc_get_prec(*z1), mpc_get_prec(*z2))); mpc_div(*z, *z1, *z2, Rmpc_get_rounding()); } else if (Rf_isInteger(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpc_div_ui(*z, *z1, INTEGER(e2)[0], Rmpc_get_rounding()); } else if (Rf_isNumeric(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpfr_t x; mpfr_init2(x, 53); mpfr_set_d(x, REAL(e2)[0], GMP_RNDN); mpc_div_fr(*z, *z1, x, Rmpc_get_rounding()); } else { Rf_error("Invalid second operand for mpc division."); } } else if (Rf_isInteger(e1)) { if (Rf_inherits(e2, "mpc")) { /* TODO: sign issue here. mpc_ui_div is * unsigned, mult -1 if needed by asnwer? */ mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpc_init2(*z, mpc_get_prec(*z2)); mpc_ui_div(*z, INTEGER(e1)[0], *z2, Rmpc_get_rounding()); } else { Rf_error("Invalid second operand for mpc division."); } } else if (Rf_isNumeric(e1)) { if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpfr_t x; mpfr_init2(x, 53); mpfr_set_d(x, REAL(e2)[0], GMP_RNDN); mpc_fr_div(*z, x, *z2, Rmpc_get_rounding()); } else { Rf_error("Invalid second operand for mpc division."); } } else { Rf_error("Invalid operands for mpc division."); } SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z, Rf_install("mpc ptr"), R_NilValue)); Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc")); R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE); UNPROTECT(1); return retVal; }
SEXP R_mpc_pow(SEXP e1, SEXP e2) { mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t)); if (Rf_inherits(e1, "mpc")) { mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1); if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpc_init2(*z, max(mpc_get_prec(*z1), mpc_get_prec(*z2))); mpc_pow(*z, *z1, *z2, Rmpc_get_rounding()); } else if (Rf_isInteger(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpc_pow_si(*z, *z1, INTEGER(e2)[0], Rmpc_get_rounding()); } else if (Rf_isNumeric(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpc_pow_d(*z, *z1, REAL(e2)[0], Rmpc_get_rounding()); } else { Rf_error("Invalid second operand for mpc power."); } } else { Rf_error("Invalid first operand for MPC power."); } SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z, Rf_install("mpc ptr"), R_NilValue)); Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc")); R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE); UNPROTECT(1); return retVal; }
/* R_mpc - Create an MPC S3 object for arbitrary precision complex numbers. * * We currently use external pointers for performance reasons, which * means that we can't allocVector a list of length(n) MPC objects, * and instead must instantiate them one at a time, that a caller can * put into a list if they want, but not a vector. * * Args: * n - An integer, numeric, or complex number to convert to an MPC. * sprec - The number of bits of precision to use, e.g. 52 for doubles. */ SEXP R_mpc(SEXP n, SEXP sprec) { /* TODO: INTEGER returns 32bit integer but mpfr_prec_t may be * 64bit. This is based on how mpfr was compiled. Therefore we * could add this as a configure check? */ mpfr_prec_t prec = INTEGER(sprec)[0]; mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t)); if (z == NULL) { Rf_error("Could not allocate memory for MPC type."); } mpc_init2(*z, prec); if (Rf_isInteger(n)) { mpc_set_d(*z, INTEGER(n)[0], Rmpc_get_rounding()); } else if (Rf_isNumeric(n)) { mpc_set_d(*z, REAL(n)[0], Rmpc_get_rounding()); } else if (Rf_isComplex(n)) { mpc_set_d_d(*z, COMPLEX(n)[0].r, COMPLEX(n)[0].i, Rmpc_get_rounding()); } else if (Rf_isString(n)) { mpc_set_str(*z, CHAR(STRING_ELT(n, 0)), 10, Rmpc_get_rounding()); } else { Rf_error("Unsupported type conversion to MPC."); } return(MakeMPC(z)); }
inline R_adjacency_list(SEXP num_verts_in, SEXP num_edges_in, SEXP R_edges_in, SEXP R_weights_in) : Base(Rf_asInteger(num_verts_in)) { if (!Rf_isNumeric(R_weights_in)) error("R_weights_in should be Numeric"); if (!Rf_isInteger(R_edges_in)) error("R_edges_in should be integer"); int NE = Rf_asInteger(num_edges_in); int* edges_in = INTEGER(R_edges_in); if (Rf_isReal(R_weights_in)) { if (boost::is_integral<R_weight_type>::value) error("R_weights_in should be integer"); else { double* weights_in = REAL(R_weights_in); for (int i = 0; i < NE ; i++, edges_in += 2, weights_in++) { boost::add_edge(*edges_in, *(edges_in+1), *weights_in, *this); } } } else { int* weights_in = INTEGER(R_weights_in); for (int i = 0; i < NE ; i++, edges_in += 2, weights_in++) { boost::add_edge(*edges_in, *(edges_in+1), *weights_in, *this); } } }
/** * Construct Container from R cobject * @param rstr R object * * if you want nrecycle > n, call set_nrecycle */ StriContainerListInt::StriContainerListInt(SEXP rstr) { this->data = NULL; if (isNull(rstr)) { this->init_Base(1, 1, true); this->data = new IntVec[this->n]; // 1 vector, NA/NULL if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR); } else if (Rf_isInteger(rstr)) { this->init_Base(1, 1, true); this->data = new IntVec[this->n]; if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR); this->data[0].initialize((const int*)INTEGER(rstr), LENGTH(rstr)); // shallow copy } else // if (Rf_isVectorList(rstr)) -- args already checked { R_len_t nv = LENGTH(rstr); this->init_Base(nv, nv, true); this->data = new IntVec[this->n]; if (!this->data) throw StriException(MSG__MEM_ALLOC_ERROR); for (R_len_t i=0; i<this->n; ++i) { SEXP cur = VECTOR_ELT(rstr, i); if (!isNull(cur)) this->data[i].initialize((const int*)INTEGER(cur), LENGTH(cur)); // shallow copy // else leave as-is, i.e. NULL/NA } } }
std::vector<int> ToIntVector(SEXP r_int_vector) { if (!Rf_isInteger(r_int_vector)) { report_error("Argument to ToIntVector must be a vector of integers."); } int *values = INTEGER(r_int_vector); int length = Rf_length(r_int_vector); return std::vector<int>(values, values + length); }
/** Convert from UTF-32 * * @param vec integer vector or list with integer vectors * @return character vector * * @version 0.1 (Marek Gagolewski) */ SEXP stri_enc_fromutf32(SEXP vec) { if (Rf_isVectorList(vec)) { R_len_t n = LENGTH(vec); R_len_t bufsize = 0; for (R_len_t i=0; i<n; ++i) { SEXP cur = VECTOR_ELT(vec, i); if (isNull(cur)) continue; if (!Rf_isInteger(cur)) // this cannot be treated with stri_prepare_arg*, as vec may be a mem-shared object Rf_error(MSG__ARG_EXPECTED_INTEGER_NO_COERCION, "vec[[i]]"); // error() allowed here if (LENGTH(cur) > bufsize) bufsize = LENGTH(cur); } bufsize = U8_MAX_LENGTH*bufsize+1; char* buf = new char[bufsize]; // no call to error() between new and delete -> OK SEXP ret; PROTECT(ret = Rf_allocVector(STRSXP, n)); for (R_len_t i=0; i<n; ++i) { SEXP cur = VECTOR_ELT(vec, i); if (isNull(cur)) { SET_STRING_ELT(ret, i, NA_STRING); continue; } R_len_t chars = stri__enc_fromutf32(INTEGER(cur), LENGTH(cur), buf, bufsize); if (chars < 0) SET_STRING_ELT(ret, i, NA_STRING); else SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf, chars, CE_UTF8)); } delete [] buf; UNPROTECT(1); return ret; } else { vec = stri_prepare_arg_integer(vec, "vec"); // integer vector SEXP ret; PROTECT(ret = Rf_allocVector(STRSXP, 1)); int* data = INTEGER(vec); R_len_t ndata = LENGTH(vec); R_len_t bufsize = U8_MAX_LENGTH*ndata+1; char* buf = new char[bufsize]; // no call to error() between new and delete -> OK R_len_t chars = stri__enc_fromutf32(data, ndata, buf, bufsize); if (chars < 0) SET_STRING_ELT(ret, 0, NA_STRING); else SET_STRING_ELT(ret, 0, Rf_mkCharLenCE(buf, chars, CE_UTF8)); delete [] buf; UNPROTECT(1); return ret; } }
inline R_adjacency_list(SEXP num_verts_in, SEXP num_edges_in, SEXP R_edges_in) : Base(Rf_asInteger(num_verts_in)) { if (!Rf_isInteger(R_edges_in)) error("R_edges_in should be integer"); int NE = Rf_asInteger(num_edges_in); int* edges_in = INTEGER(R_edges_in); for (int i = 0; i < NE ; i++, edges_in += 2) { boost::add_edge(*edges_in, *(edges_in+1), 1, *this); } }
/** * Compare elements in 2 character vectors, with collation * * @param e1 character vector * @param e2 character vector * @param opts_collator passed to stri__ucol_open() * @param type [internal] vector of length 2, * type[0]: 0 for ==, -1 for < and 1 for >, * type[1]: 0 or 1 (whether to negate the results) * * @return logical vector * * @version 0.2-1 (Marek Gagolewski, 2014-03-19) * * @version 0.2-3 (Marek Gagolewski, 2014-05-07) * opts_collator == NA no longer allowed * * @version 0.3-1 (Marek Gagolewski, 2014-11-04) * Issue #112: str_prepare_arg* retvals were not PROTECTed from gc */ SEXP stri_cmp_logical(SEXP e1, SEXP e2, SEXP opts_collator, SEXP type) { // we'll perform a collator-based cmp // type is an internal arg, check manually, error() allowed here if (!Rf_isInteger(type) || LENGTH(type) != 2) Rf_error(MSG__INCORRECT_INTERNAL_ARG); int _type = INTEGER(type)[0]; int _negate = INTEGER(type)[1]; if (_type > 1 || _type < -1 || _negate < 0 || _negate > 1) Rf_error(MSG__INCORRECT_INTERNAL_ARG); PROTECT(e1 = stri_prepare_arg_string(e1, "e1")); // prepare string argument PROTECT(e2 = stri_prepare_arg_string(e2, "e2")); // prepare string argument // call stri__ucol_open after prepare_arg: // if prepare_arg had failed, we would have a mem leak UCollator* col = NULL; col = stri__ucol_open(opts_collator); STRI__ERROR_HANDLER_BEGIN(2) R_len_t vectorize_length = stri__recycling_rule(true, 2, LENGTH(e1), LENGTH(e2)); StriContainerUTF8 e1_cont(e1, vectorize_length); StriContainerUTF8 e2_cont(e2, vectorize_length); SEXP ret; STRI__PROTECT(ret = Rf_allocVector(LGLSXP, vectorize_length)); int* ret_tab = LOGICAL(ret); for (R_len_t i = 0; i < vectorize_length; ++i) { if (e1_cont.isNA(i) || e2_cont.isNA(i)) { ret_tab[i] = NA_LOGICAL; continue; } R_len_t cur1_n = e1_cont.get(i).length(); const char* cur1_s = e1_cont.get(i).c_str(); R_len_t cur2_n = e2_cont.get(i).length(); const char* cur2_s = e2_cont.get(i).c_str(); // with collation UErrorCode status = U_ZERO_ERROR; ret_tab[i] = (_type == (int)ucol_strcollUTF8(col, cur1_s, cur1_n, cur2_s, cur2_n, &status )); STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */}) if (_negate) ret_tab[i] = !ret_tab[i]; }
/** * Compare elements in 2 character vectors, without collation * * @param e1 character vector * @param e2 character vector * @param type [internal] integer; 0 or 1 (whether to negate the results) * * @return logical vector * * @version 0.2-3 (Marek Gagolewski, 2014-05-07) * * @version 0.3-1 (Marek Gagolewski, 2014-11-04) * Issue #112: str_prepare_arg* retvals were not PROTECTed from gc */ SEXP stri_cmp_codepoints(SEXP e1, SEXP e2, SEXP type) { // type is an internal arg, check manually, error() allowed here if (!Rf_isInteger(type) || LENGTH(type) != 1) Rf_error(MSG__INCORRECT_INTERNAL_ARG); int _negate = INTEGER(type)[0]; if (_negate < 0 || _negate > 1) Rf_error(MSG__INCORRECT_INTERNAL_ARG); PROTECT(e1 = stri_prepare_arg_string(e1, "e1")); // prepare string argument PROTECT(e2 = stri_prepare_arg_string(e2, "e2")); // prepare string argument STRI__ERROR_HANDLER_BEGIN(2) R_len_t vectorize_length = stri__recycling_rule(true, 2, LENGTH(e1), LENGTH(e2)); StriContainerUTF8 e1_cont(e1, vectorize_length); StriContainerUTF8 e2_cont(e2, vectorize_length); SEXP ret; STRI__PROTECT(ret = Rf_allocVector(LGLSXP, vectorize_length)); int* ret_tab = LOGICAL(ret); for (R_len_t i = 0; i < vectorize_length; ++i) { if (e1_cont.isNA(i) || e2_cont.isNA(i)) { ret_tab[i] = NA_LOGICAL; continue; } R_len_t cur1_n = e1_cont.get(i).length(); const char* cur1_s = e1_cont.get(i).c_str(); R_len_t cur2_n = e2_cont.get(i).length(); const char* cur2_s = e2_cont.get(i).c_str(); if (cur1_n != cur2_n) // different number of bytes => not equal ret_tab[i] = FALSE; else ret_tab[i] = (memcmp(cur1_s, cur2_s, cur1_n) == 0); if (_negate) ret_tab[i] = !ret_tab[i]; } STRI__UNPROTECT_ALL return ret; STRI__ERROR_HANDLER_END({/* no-op on err */}) }
/* R_mpc_cmp - Comparison function for MPC objects. * * Ops.mpc.R includes code to coerce complex numbers or numerics from * e2 into MPC objects for this comparison since the MPC library only * supports comparison against other MPC objects or integers. * * Arguments: * e1: SEXP for an mpc type. * e2: SEXP for an mpc type, or integer. * Return value: * True if e1 == e2. */ SEXP R_mpc_cmp(SEXP e1, SEXP e2) { if (Rf_inherits(e1, "mpc")) { mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1); if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); return(Rf_ScalarInteger(mpc_cmp(*z1, *z2))); } else if (Rf_isInteger(e2)) { return(Rf_ScalarInteger(mpc_cmp_si(*z1, INTEGER(e2)[0]))); } else { Rf_error("Invalid operand for mpc cmp."); } } else { Rf_error("Invalid operand for mpc cmp."); } }
int RcppParams::getIntValue(std::string name) { std::map<std::string,int>::iterator iter = pmap.find(name); if (iter == pmap.end()) { std::string mesg = "RcppParams::getIntValue: no such name: "; throw std::range_error(mesg+name); } int posn = iter->second; SEXP elt = VECTOR_ELT(_params,posn); if (!Rf_isNumeric(elt) || Rf_length(elt) != 1) { std::string mesg = "RcppParams::getIntValue: must be scalar: "; throw std::range_error(mesg+name); } if (Rf_isInteger(elt)) return INTEGER(elt)[0]; else if (Rf_isReal(elt)) return (int)REAL(elt)[0]; else { std::string mesg = "RcppParams::getIntValue: invalid value for: "; throw std::range_error(mesg+name); } return 0; // never get here }
SEXP R_mpc_add(SEXP e1, SEXP e2) { mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1); mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t)); if (z == NULL) { Rf_error("Could not allocate memory for MPC type."); } if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpfr_prec_t real_prec, imag_prec; Rmpc_get_max_prec(&real_prec, &imag_prec, *z1, *z2); mpc_init3(*z, real_prec, imag_prec); mpc_add(*z, *z1, *z2, Rmpc_get_rounding()); } else if (Rf_isInteger(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpc_add_ui(*z, *z1, INTEGER(e2)[0], Rmpc_get_rounding()); } else if (Rf_isNumeric(e2)) { mpfr_t x; mpfr_init2(x, 53); // We use GMP_RNDN rather than MPFR_RNDN for compatibility // with mpfr 2.4.x and earlier as well as more modern versions. mpfr_set_d(x, REAL(e2)[0], GMP_RNDN); /* Max of mpc precision z2 and 53 from e2. */ Rprintf("Precision: %d\n", mpc_get_prec(*z1)); mpc_init2(*z, max(mpc_get_prec(*z1), 53)); mpc_add_fr(*z, *z1, x, Rmpc_get_rounding()); } else { /* TODO(mstokely): Add support for mpfr types here. */ free(z); Rf_error("Invalid second operand for mpc addition."); } SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z, Rf_install("mpc ptr"), R_NilValue)); Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc")); R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE); UNPROTECT(1); return retVal; }
SEXP R_mpc_sub(SEXP e1, SEXP e2) { mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t)); if (z == NULL) { Rf_error("Could not allocate memory for MPC type."); } if (Rf_inherits(e1, "mpc")) { Rprintf("It's an mpc"); mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1); if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpc_init2(*z, max(mpc_get_prec(*z1), mpc_get_prec(*z2))); mpc_sub(*z, *z1, *z2, Rmpc_get_rounding()); } else if (Rf_isInteger(e2)) { mpc_init2(*z, mpc_get_prec(*z1)); mpc_sub_ui(*z, *z1, INTEGER(e2)[0], Rmpc_get_rounding()); } else if (Rf_isNumeric(e2)) { mpfr_t x; mpfr_init2(x, 53); mpfr_set_d(x, REAL(e2)[0], GMP_RNDN); Rprintf("Precision: %d\n", mpc_get_prec(*z1)); mpc_init2(*z, max(mpc_get_prec(*z1), 53)); mpc_sub_fr(*z, *z1, x, Rmpc_get_rounding()); } else { Rf_error("Unsupported type for operand 2 of MPC subtraction."); } } else if (Rf_isInteger(e1)) { if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpc_init2(*z, mpc_get_prec(*z2)); mpc_ui_sub(*z, INTEGER(e1)[0], *z2, Rmpc_get_rounding()); } else { Rf_error("Unsupported type for operands for MPC subtraction."); } } else if (Rf_isNumeric(e1)) { if (Rf_inherits(e2, "mpc")) { mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2); mpc_init2(*z, mpc_get_prec(*z2)); mpfr_t x; mpfr_init2(x, 53); mpfr_set_d(x, REAL(e1)[0], GMP_RNDN); mpc_fr_sub(*z, x, *z2, Rmpc_get_rounding()); } else { Rf_error("Unsupported type for operands for MPC subtraction."); } } else { /* TODO(mstokely): Add support for mpfr types here. */ Rprintf("It's unknown"); free(z); Rf_error("Invalid second operand for mpc subtraction."); } SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z, Rf_install("mpc ptr"), R_NilValue)); Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc")); R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE); UNPROTECT(1); return retVal; }
/** * Pad a string * * vectorized over str, length and pad * if str or pad or length is NA the result will be NA * * @param str character vector * @param min_length integer vector * @param side [internal int] * @param pad character vector * @param use_length single logical value * @return character vector * * @version 0.1-?? (Bartlomiej Tartanus) * * @version 0.2-2 (Marek Gagolewski, 2014-04-20) * use stri_error_handler, pad should be a single code point, not byte * * @version 0.3-1 (Marek Gagolewski, 2014-11-04) * Issue #112: str_prepare_arg* retvals were not PROTECTed from gc * * @version 0.5-1 (Marek Gagolewski, 2015-04-22) * `use_length` arg added, * second argument renamed `width` */ SEXP stri_pad(SEXP str, SEXP width, SEXP side, SEXP pad, SEXP use_length) { // this is an internal arg, check manually, error() allowed here if (!Rf_isInteger(side) || LENGTH(side) != 1) Rf_error(MSG__INCORRECT_INTERNAL_ARG); int _side = INTEGER(side)[0]; if (_side < 0 || _side > 2) Rf_error(MSG__INCORRECT_INTERNAL_ARG); bool use_length_val = stri__prepare_arg_logical_1_notNA(use_length, "use_length"); PROTECT(str = stri_prepare_arg_string(str, "str")); PROTECT(width = stri_prepare_arg_integer(width, "width")); PROTECT(pad = stri_prepare_arg_string(pad, "pad")); // side = stri_prepare_arg_string(side, "side"); // const char* side_opts[] = {"left", "right", "both", NULL}; R_len_t str_length = LENGTH(str); R_len_t width_length = LENGTH(width); // R_len_t side_length = LENGTH(side); R_len_t pad_length = LENGTH(pad); R_len_t vectorize_length = stri__recycling_rule(true, 3, str_length, width_length, /*side_length, */ pad_length); STRI__ERROR_HANDLER_BEGIN(3) StriContainerUTF8 str_cont(str, vectorize_length); StriContainerInteger width_cont(width, vectorize_length); // StriContainerUTF8 side_cont(side, vectorize_length); StriContainerUTF8 pad_cont(pad, vectorize_length); SEXP ret; STRI__PROTECT(ret = Rf_allocVector(STRSXP, vectorize_length)); String8buf buf(0); // TODO: prealloc for (R_len_t i=0; i<vectorize_length; ++i) { if (str_cont.isNA(i) || pad_cont.isNA(i) || /*side_cont.isNA(i) ||*/ width_cont.isNA(i)) { SET_STRING_ELT(ret, i, NA_STRING); continue; } // get the current string R_len_t str_cur_n = str_cont.get(i).length(); const char* str_cur_s = str_cont.get(i).c_str(); R_len_t str_cur_width; // get the width/length of padding code point(s) R_len_t pad_cur_n = pad_cont.get(i).length(); const char* pad_cur_s = pad_cont.get(i).c_str(); R_len_t pad_cur_width; if (use_length_val) { pad_cur_width = 1; str_cur_width = str_cont.get(i).countCodePoints(); R_len_t k = 0; UChar32 pad_cur = 0; U8_NEXT(pad_cur_s, k, pad_cur_n, pad_cur); if (pad_cur <= 0 || k < pad_cur_n) throw StriException(MSG__NOT_EQ_N_CODEPOINTS, "pad", 1); } else { pad_cur_width = stri__width_string(pad_cur_s, pad_cur_n); str_cur_width = stri__width_string(str_cur_s, str_cur_n); if (pad_cur_width != 1) throw StriException(MSG__NOT_EQ_N_WIDTH, "pad", 1); } // get the minimal width R_len_t width_cur = width_cont.get(i); if (str_cur_width >= width_cur) { // no padding at all SET_STRING_ELT(ret, i, str_cont.toR(i)); continue; } R_len_t padnum = width_cur-str_cur_width; buf.resize(str_cur_n+padnum*pad_cur_n, false); char* buftmp = buf.data(); R_len_t k = 0; switch(_side) { case 0: // left for (k=0; k<padnum; ++k) { memcpy(buftmp, pad_cur_s, pad_cur_n); buftmp += pad_cur_n; } memcpy(buftmp, str_cur_s, str_cur_n); buftmp += str_cur_n; break; case 1: // right memcpy(buftmp, str_cur_s, str_cur_n); buftmp += str_cur_n; for (k=0; k<padnum; ++k) { memcpy(buftmp, pad_cur_s, pad_cur_n); buftmp += pad_cur_n; } break; case 2: // both for (k=0; k<padnum/2; ++k) { memcpy(buftmp, pad_cur_s, pad_cur_n); buftmp += pad_cur_n; } memcpy(buftmp, str_cur_s, str_cur_n); buftmp += str_cur_n; for (; k<padnum; ++k) { memcpy(buftmp, pad_cur_s, pad_cur_n); buftmp += pad_cur_n; } break; } SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf.data(), (int)(buftmp-buf.data()), CE_UTF8)); } STRI__UNPROTECT_ALL return ret; STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */) }