/***
* used both in stri_sub and stri_sub_replacement
*
* @return number of objects PROTECTEd
*/
R_len_t stri__sub_prepare_from_to_length(SEXP& from, SEXP& to, SEXP& length,
R_len_t& from_len, R_len_t& to_len, R_len_t& length_len,
int*& from_tab, int*& to_tab, int*& length_tab)
{
R_len_t sub_protected = 0;
bool from_ismatrix = Rf_isMatrix(from);
if (from_ismatrix) {
SEXP t;
PROTECT(t = Rf_getAttrib(from, R_DimSymbol));
if (INTEGER(t)[1] == 1)
from_ismatrix = false; /* it's a column vector */
else if (INTEGER(t)[1] > 2) {
/* error() is allowed here */
UNPROTECT(1); // t
Rf_error(MSG__ARG_EXPECTED_MATRIX_WITH_GIVEN_COLUMNS, "from", 2);
}
UNPROTECT(1); // t
}
sub_protected++;
PROTECT(from = stri_prepare_arg_integer(from, "from"));
/* may remove R_DimSymbol */
if (from_ismatrix) {
from_len = LENGTH(from)/2;
to_len = from_len;
from_tab = INTEGER(from);
to_tab = from_tab+from_len;
//PROTECT(to); /* fake - not to provoke stack imbalance */
//PROTECT(length); /* fake - not to provoke stack imbalance */
}
else if (isNull(length)) {
sub_protected++;
PROTECT(to = stri_prepare_arg_integer(to, "to"));
from_len = LENGTH(from);
from_tab = INTEGER(from);
to_len = LENGTH(to);
to_tab = INTEGER(to);
//PROTECT(length); /* fake - not to provoke stack imbalance */
}
else {
sub_protected++;
PROTECT(length= stri_prepare_arg_integer(length, "length"));
from_len = LENGTH(from);
from_tab = INTEGER(from);
length_len = LENGTH(length);
length_tab = INTEGER(length);
//PROTECT(to); /* fake - not to provoke stack imbalance */
}
return sub_protected;
}
/**
* Split a string into parts [byte compare]
*
* The pattern matches identify delimiters that separate the input into fields.
* The input data between the matches becomes the fields themselves.
*
* @param str character vector
* @param pattern character vector
* @param n_max integer vector
* @param omit_empty logical vector
*
*
* @version 0.1 (Bartek Tartanus)
* @version 0.2 (Marek Gagolewski, 2013-06-25) StriException friendly, use StriContainerUTF8
* @version 0.3 (Marek Gagolewski, 2013-07-10) - BUGFIX: wrong behavior on empty str
*/
SEXP stri__split_fixed_byte(SEXP str, SEXP pattern, SEXP n_max, SEXP omit_empty)
{
str = stri_prepare_arg_string(str, "str");
pattern = stri_prepare_arg_string(pattern, "pattern");
n_max = stri_prepare_arg_integer(n_max, "n_max");
omit_empty = stri_prepare_arg_logical(omit_empty, "omit_empty");
STRI__ERROR_HANDLER_BEGIN
R_len_t vectorize_length = stri__recycling_rule(true, 4, LENGTH(str), LENGTH(pattern), LENGTH(n_max), LENGTH(omit_empty));
StriContainerUTF8 str_cont(str, vectorize_length);
StriContainerByteSearch pattern_cont(pattern, vectorize_length);
StriContainerInteger n_max_cont(n_max, vectorize_length);
StriContainerLogical omit_empty_cont(omit_empty, vectorize_length);
SEXP ret;
PROTECT(ret = Rf_allocVector(VECSXP, vectorize_length));
for (R_len_t i = pattern_cont.vectorize_init();
i != pattern_cont.vectorize_end();
i = pattern_cont.vectorize_next(i))
{
if (n_max_cont.isNA(i) || omit_empty_cont.isNA(i)) {
SET_VECTOR_ELT(ret, i, stri__vector_NA_strings(1));
continue;
}
int n_max_cur = n_max_cont.get(i);
int omit_empty_cur = omit_empty_cont.get(i);
STRI__CONTINUE_ON_EMPTY_OR_NA_STR_PATTERN(str_cont, pattern_cont,
SET_VECTOR_ELT(ret, i, stri__vector_NA_strings(1)); ,
SET_VECTOR_ELT(ret, i, stri__vector_empty_strings((omit_empty_cur || n_max_cur == 0)?0:1));)
/**
* Split a string into parts.
*
* The pattern matches identify delimiters that separate the input into fields.
* The input data between the matches becomes the fields themselves.
*
* @param str character vector
* @param pattern character vector
* @param n_max integer vector
* @param opts_regex
* @return list of character vectors
*
* @version 0.1 (Marek Gagolewski, 2013-06-21)
* @version 0.2 (Marek Gagolewski, 2013-07-10) - BUGFIX: wrong behavior on empty str
*/
SEXP stri_split_regex(SEXP str, SEXP pattern, SEXP n_max, SEXP omit_empty, SEXP opts_regex)
{
str = stri_prepare_arg_string(str, "str");
pattern = stri_prepare_arg_string(pattern, "pattern");
n_max = stri_prepare_arg_integer(n_max, "n_max");
omit_empty = stri_prepare_arg_logical(omit_empty, "omit_empty");
R_len_t vectorize_length = stri__recycling_rule(true, 4, LENGTH(str), LENGTH(pattern), LENGTH(n_max), LENGTH(omit_empty));
uint32_t pattern_flags = StriContainerRegexPattern::getRegexFlags(opts_regex);
UText* str_text = NULL; // may potentially be slower, but definitely is more convenient!
STRI__ERROR_HANDLER_BEGIN
StriContainerUTF8 str_cont(str, vectorize_length);
StriContainerInteger n_max_cont(n_max, vectorize_length);
StriContainerLogical omit_empty_cont(omit_empty, vectorize_length);
StriContainerRegexPattern pattern_cont(pattern, vectorize_length, pattern_flags);
SEXP ret;
PROTECT(ret = Rf_allocVector(VECSXP, vectorize_length));
for (R_len_t i = pattern_cont.vectorize_init();
i != pattern_cont.vectorize_end();
i = pattern_cont.vectorize_next(i))
{
if (n_max_cont.isNA(i) || omit_empty_cont.isNA(i)) {
SET_VECTOR_ELT(ret, i, stri__vector_NA_strings(1));
continue;
}
int n_max_cur = n_max_cont.get(i);
int omit_empty_cur = omit_empty_cont.get(i);
STRI__CONTINUE_ON_EMPTY_OR_NA_STR_PATTERN(str_cont, pattern_cont,
SET_VECTOR_ELT(ret, i, stri__vector_NA_strings(1));,
SET_VECTOR_ELT(ret, i, stri__vector_empty_strings((omit_empty_cur || n_max_cur == 0)?0:1));)
/** 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;
}
}
/**
* Split a string into text lines
*
* @param str character vector
* @param n_max integer vector
* @param omit_empty logical vector
*
* @return list of character vectors
*
* @version 0.1 (Marek Gagolewski, 2013-08-04)
*/
SEXP stri_split_lines(SEXP str, SEXP n_max, SEXP omit_empty)
{
str = stri_prepare_arg_string(str, "str");
n_max = stri_prepare_arg_integer(n_max, "n_max");
omit_empty = stri_prepare_arg_logical(omit_empty, "omit_empty");
R_len_t vectorize_length = stri__recycling_rule(true, 3, LENGTH(str), LENGTH(n_max), LENGTH(omit_empty));
STRI__ERROR_HANDLER_BEGIN
StriContainerUTF8 str_cont(str, vectorize_length);
StriContainerInteger n_max_cont(n_max, vectorize_length);
StriContainerLogical omit_empty_cont(omit_empty, vectorize_length);
SEXP ret;
PROTECT(ret = Rf_allocVector(VECSXP, vectorize_length));
for (R_len_t i = str_cont.vectorize_init();
i != str_cont.vectorize_end();
i = str_cont.vectorize_next(i))
{
if (str_cont.isNA(i)) {
SET_VECTOR_ELT(ret, i, stri__vector_NA_strings(1));
continue;
}
const char* str_cur_s = str_cont.get(i).c_str();
R_len_t str_cur_n = str_cont.get(i).length();
int n_max_cur = n_max_cont.get(i);
int omit_empty_cur = omit_empty_cont.get(i);
if (n_max_cur < 0)
n_max_cur = INT_MAX;
else if (n_max_cur == 0) {
SET_VECTOR_ELT(ret, i, Rf_allocVector(STRSXP, 0));
continue;
}
//#define STRI_INDEX_NEWLINE_CR 0
//#define STRI_INDEX_NEWLINE_LF 1
//#define STRI_INDEX_NEWLINE_CRLF 2
//#define STRI_INDEX_NEWLINE_NEL 3
//#define STRI_INDEX_NEWLINE_VT 4
//#define STRI_INDEX_NEWLINE_FF 5
//#define STRI_INDEX_NEWLINE_LS 6
//#define STRI_INDEX_NEWLINE_PS 7
//#define STRI_INDEX_NEWLINE_LAST 8
// int counts[STRI_INDEX_NEWLINE_LAST];
// for (R_len_t j=0; j<STRI_INDEX_NEWLINE_LAST; ++j)
// counts[j] = 0;
UChar32 c;
R_len_t jlast, k=1;
deque<R_len_t_x2> occurences;
occurences.push_back(R_len_t_x2(0, 0));
for (R_len_t j=0; j < str_cur_n && k < n_max_cur; /* null */) {
jlast = j;
U8_NEXT(str_cur_s, j, str_cur_n, c);
switch (c) {
case ASCII_CR: /* CR */
// counts[STRI_INDEX_NEWLINE_CR]++;
/* check if next is LF */
if (str_cur_s[j] == ASCII_LF) { // look ahead one byte
// counts[STRI_INDEX_NEWLINE_LF]++;
// counts[STRI_INDEX_NEWLINE_CRLF]++;
j++; // just one byte
}
break;
case ASCII_LF: /* LF */
// counts[STRI_INDEX_NEWLINE_LF]++;
break;
case UCHAR_NEL: /* NEL */
// counts[STRI_INDEX_NEWLINE_NEL]++;
break;
case ASCII_VT: /* VT */
// counts[STRI_INDEX_NEWLINE_VT]++;
break;
case ASCII_FF: /* FF */
// counts[STRI_INDEX_NEWLINE_FF]++;
break;
case UCHAR_LS: /* LS */
// counts[STRI_INDEX_NEWLINE_LS]++;
break;
case UCHAR_PS: /* PS */
// counts[STRI_INDEX_NEWLINE_PS]++;
break;
default:
/* not a newline character */
occurences.back().v2 = j;
continue;
}
// if here, then at newline
if (omit_empty_cur && occurences.back().v2 == occurences.back().v1)
occurences.back().v1 = occurences.back().v2 = j; // don't start new field
else {
occurences.back().v2 = jlast;
occurences.push_back(R_len_t_x2(j, j));
++k; // another field
}
}
if (k == n_max_cur)
occurences.back().v2 = str_cur_n;
if (omit_empty_cur && occurences.back().v1 == occurences.back().v2)
occurences.pop_back();
SEXP ans;
PROTECT(ans = Rf_allocVector(STRSXP, (R_len_t)occurences.size()));
deque<R_len_t_x2>::iterator iter = occurences.begin();
for (R_len_t l = 0; iter != occurences.end(); ++iter, ++l) {
R_len_t_x2 curoccur = *iter;
SET_STRING_ELT(ans, l, Rf_mkCharLenCE(str_cur_s+curoccur.v1, curoccur.v2-curoccur.v1, CE_UTF8));
}
SET_VECTOR_ELT(ret, i, ans);
UNPROTECT(1);
}
UNPROTECT(1);
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/** Generate random strings
*
* @param n single integer
* @param length integer vector
* @param pattern character vector
* @return character vector
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-04)
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-05)
* Use StriContainerCharClass which now contains UnicodeSets;
* vectorized also over pattern
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*/
SEXP stri_rand_strings(SEXP n, SEXP length, SEXP pattern)
{
int n_val = stri__prepare_arg_integer_1_notNA(n, "n");
PROTECT(length = stri_prepare_arg_integer(length, "length"));
PROTECT(pattern = stri_prepare_arg_string(pattern, "pattern"));
if (n_val < 0) n_val = 0; /* that's not NA for sure now */
R_len_t length_len = LENGTH(length);
if (length_len <= 0) {
UNPROTECT(2);
Rf_error(MSG__ARG_EXPECTED_NOT_EMPTY, "length");
}
else if (length_len > n_val || n_val % length_len != 0)
Rf_warning(MSG__WARN_RECYCLING_RULE2);
R_len_t pattern_len = LENGTH(pattern);
if (pattern_len <= 0) {
UNPROTECT(2);
Rf_error(MSG__ARG_EXPECTED_NOT_EMPTY, "pattern");
}
else if (pattern_len > n_val || n_val % pattern_len != 0)
Rf_warning(MSG__WARN_RECYCLING_RULE2);
GetRNGstate();
STRI__ERROR_HANDLER_BEGIN(2)
StriContainerCharClass pattern_cont(pattern, max(n_val, pattern_len));
StriContainerInteger length_cont(length, max(n_val, length_len));
// get max required bufsize
int* length_tab = INTEGER(length);
R_len_t bufsize = 0;
for (R_len_t i=0; i<length_len; ++i) {
if (length_tab[i] != NA_INTEGER && length_tab[i] > bufsize)
bufsize = length_tab[i];
}
bufsize *= 4; // 1 UChar32 -> max. 4 UTF-8 bytes
String8buf buf(bufsize);
char* bufdata = buf.data();
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, n_val));
for (R_len_t i=0; i<n_val; ++i) {
if (length_cont.isNA(i) || pattern_cont.isNA(i)) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
int length_cur = length_cont.get(i);
if (length_cur < 0) length_cur = 0;
const UnicodeSet* uset = &(pattern_cont.get(i));
int32_t uset_size = uset->size();
// generate string:
R_len_t j = 0;
UBool err = FALSE;
for (R_len_t k=0; k<length_cur; ++k) {
int32_t idx = (int32_t)floor(unif_rand()*(double)uset_size); /* 0..uset_size-1 */
UChar32 c = uset->charAt(idx);
if (c < 0) throw StriException(MSG__INTERNAL_ERROR);
U8_APPEND((uint8_t*)bufdata, j, bufsize, c, err);
if (err) throw StriException(MSG__INTERNAL_ERROR);
}
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(bufdata, j, CE_UTF8));
}
PutRNGstate();
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END({
PutRNGstate();
})
}
/**
* 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 */)
}
/** Date-time artithmetic
*
* @param time
* @param value
* @param units
* @param tz
* @param locale
*
* @return POSIXst
*
* @version 0.5-1 (Marek Gagolewski, 2014-12-30)
* @version 0.5-1 (Marek Gagolewski, 2015-03-06) tz arg added
*/
SEXP stri_datetime_add(SEXP time, SEXP value, SEXP units, SEXP tz, SEXP locale) {
PROTECT(time = stri_prepare_arg_POSIXct(time, "time"));
PROTECT(value = stri_prepare_arg_integer(value, "value"));
if (!isNull(tz)) PROTECT(tz = stri_prepare_arg_string_1(tz, "tz"));
else PROTECT(tz); /* needed to set tzone attrib */
R_len_t vectorize_length = stri__recycling_rule(true, 2, LENGTH(time), LENGTH(value));
const char* units_val = stri__prepare_arg_string_1_notNA(units, "units");
const char* units_opts[] = {"years", "months", "weeks", "days", "hours", "minutes", "seconds", "milliseconds", NULL};
int units_cur = stri__match_arg(units_val, units_opts);
const char* locale_val = stri__prepare_arg_locale(locale, "locale", true);
TimeZone* tz_val = stri__prepare_arg_timezone(tz, "tz", true/*allowdefault*/);
Calendar* cal = NULL;
STRI__ERROR_HANDLER_BEGIN(3)
StriContainerDouble time_cont(time, vectorize_length);
StriContainerInteger value_cont(value, vectorize_length);
UCalendarDateFields units_field;
switch (units_cur) {
case 0: units_field = UCAL_YEAR; break;
case 1: units_field = UCAL_MONTH; break;
case 2: units_field = UCAL_WEEK_OF_YEAR; break;
case 3: units_field = UCAL_DAY_OF_MONTH; break;
case 4: units_field = UCAL_HOUR_OF_DAY; break;
case 5: units_field = UCAL_MINUTE; break;
case 6: units_field = UCAL_SECOND; break;
case 7: units_field = UCAL_MILLISECOND; break;
default: throw StriException(MSG__INCORRECT_MATCH_OPTION, "units");
}
UErrorCode status = U_ZERO_ERROR;
cal = Calendar::createInstance(locale_val, status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
cal->adoptTimeZone(tz_val);
tz_val = NULL; /* The Calendar takes ownership of the TimeZone. */
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(REALSXP, vectorize_length));
double* ret_val = REAL(ret);
for (R_len_t i=0; i<vectorize_length; ++i) {
if (time_cont.isNA(i) || value_cont.isNA(i)) {
ret_val[i] = NA_REAL;
continue;
}
status = U_ZERO_ERROR;
cal->setTime((UDate)(time_cont.get(i)*1000.0), status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
status = U_ZERO_ERROR;
cal->add(units_field, value_cont.get(i), status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
status = U_ZERO_ERROR;
ret_val[i] = ((double)cal->getTime(status))/1000.0;
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
}
if (!isNull(tz)) Rf_setAttrib(ret, Rf_ScalarString(Rf_mkChar("tzone")), tz);
stri__set_class_POSIXct(ret);
if (tz_val) { delete tz_val; tz_val = NULL; }
if (cal) { delete cal; cal = NULL; }
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END({
if (tz_val) { delete tz_val; tz_val = NULL; }
if (cal) { delete cal; cal = NULL; }
})
}
