SEXP cr_keys(SEXP sc, SEXP sPattern) {
rconn_t *c;
int n, i;
const char *pattern = "*";
redisReply *reply;
SEXP res;
if (!Rf_inherits(sc, "redisConnection")) Rf_error("invalid connection");
c = (rconn_t*) EXTPTR_PTR(sc);
if (!c) Rf_error("invalid connection (NULL)");
rc_validate_connection(c, 0);
if (TYPEOF(sPattern) == STRSXP && LENGTH(sPattern) > 0)
pattern = CHAR(STRING_ELT(sPattern, 0));
reply = redisCommand(c->rc, "KEYS %s", pattern);
if (!reply && (c->flags & RCF_RETRY)) {
rc_close(c);
rc_validate_connection(c, 0);
reply = redisCommand(c->rc, "KEYS %s", pattern);
}
if (!reply) {
SEXP es = Rf_mkChar(c->rc->errstr);
rc_close(c);
Rf_error("KEYS error: %s", CHAR(es));
}
if (reply->type != REDIS_REPLY_ARRAY) {
freeReplyObject(reply);
Rf_error("unexpected result type");
}
res = PROTECT(Rf_allocVector(STRSXP, (n = reply->elements)));
for (i = 0; i < n; i++) {
if (reply->element[i]->type == REDIS_REPLY_STRING)
SET_STRING_ELT(res, i, Rf_mkCharLenCE(reply->element[i]->str, reply->element[i]->len, CE_UTF8));
else if (reply->element[i]->type == REDIS_REPLY_NIL)
SET_STRING_ELT(res, i, R_NaString);
else {
freeReplyObject(reply);
Rf_error("invalid element (non-string) in the keys array");
}
}
freeReplyObject(reply);
UNPROTECT(1);
return res;
}
/** Export character vector to R
* THE OUTPUT IS ALWAYS IN UTF-8
* Recycle rule is applied, so length == nrecycle
* @return STRSXP
*/
SEXP StriContainerUTF16::toR() const
{
SEXP ret;
PROTECT(ret = Rf_allocVector(STRSXP, nrecycle));
std::string buf;
for (R_len_t i=0; i<nrecycle; ++i) {
if (!str[i%n])
SET_STRING_ELT(ret, i, NA_STRING);
else {
buf.clear();
str[i%n]->toUTF8String(buf);
SET_STRING_ELT(ret, i,
Rf_mkCharLenCE(buf.c_str(), (int)buf.length(), (cetype_t)CE_UTF8));
}
}
UNPROTECT(1);
return ret;
}
/**
* Convert character vector between given encodings
*
* @param str input character vector or list of raw vectors
* @param from source encoding, \code{NULL} or \code{""} for default enc
* @param to target encoding, \code{NULL} or \code{""} for default enc
* @param to_raw single logical, should list of raw vectors be returned?
* @return a converted character vector or list of raw vectors
*
* @version 0.1 (Marek Gagolewski)
* @version 0.2 (Marek Gagolewski) arg to_raw_added, encoding marking
* @version 0.3 (Marek Gagolewski, 2013-06-16) make StriException-friendly
* @version 0.4 (Marek Gagolewski, 2013-08-08) use StriContainerListRaw
* @version 0.5 (Marek Gagolewski, 2013-11-20) BUGFIX call stri_encode_from_marked if necessary
*/
SEXP stri_encode(SEXP str, SEXP from, SEXP to, SEXP to_raw)
{
const char* selected_from = stri__prepare_arg_enc(from, "from", true);
if (!selected_from && Rf_isVectorAtomic(str))
return stri_encode_from_marked(str, to, to_raw);
str = stri_prepare_arg_list_raw(str, "str");
const char* selected_to = stri__prepare_arg_enc(to, "to", true);
bool to_raw_logical = stri__prepare_arg_logical_1_notNA(to_raw, "to_raw");
UConverter* uconv_from = NULL;
UConverter* uconv_to = NULL;
STRI__ERROR_HANDLER_BEGIN
StriContainerListRaw str_cont(str);
R_len_t str_n = str_cont.get_n();
// get the number of strings to convert; if == 0, then you know what's the result
if (str_n <= 0) return Rf_allocVector(to_raw_logical?VECSXP:STRSXP, 0);
// Open converters
uconv_from = stri__ucnv_open(selected_from);
uconv_to = stri__ucnv_open(selected_to);
// Get target encoding mark
UErrorCode err = U_ZERO_ERROR;
const char* uconv_to_name = ucnv_getName(uconv_to, &err);
if (U_FAILURE(err))
throw StriException(err);
cetype_t encmark_to = CE_BYTES; // all other cases than the below ones
// - bytes enc (this is reasonable, isn't it?)
if (!to_raw_logical) { // otherwise not needed
if (!strcmp(uconv_to_name, "US-ASCII") || !strcmp(uconv_to_name, "UTF-8"))
encmark_to = CE_UTF8; // no CE for ASCII, will be auto-detected by mkCharLenCE
else if (!strcmp(uconv_to_name, "ISO-8859-1"))
encmark_to = CE_LATIN1;
else if (!strcmp(uconv_to_name, ucnv_getDefaultName()))
encmark_to = CE_NATIVE;
}
// Prepare out val
SEXP ret;
PROTECT(ret = Rf_allocVector(to_raw_logical?VECSXP:STRSXP, str_n));
String8 buf(0); // will be extended in a moment
for (R_len_t i=0; i<str_n; ++i) {
if (str_cont.isNA(i)) {
if (to_raw_logical) SET_VECTOR_ELT(ret, i, R_NilValue);
else SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
const char* curd = str_cont.get(i).c_str();
R_len_t curn = str_cont.get(i).length();
err = U_ZERO_ERROR;
UnicodeString encs(curd, curn, uconv_from, err); // FROM -> UTF-16 [this is the slow part]
if (U_FAILURE(err))
throw StriException(err);
R_len_t curn_tmp = encs.length();
const UChar* curs_tmp = encs.getBuffer(); // The buffer contents is (probably) not NUL-terminated.
if (!curs_tmp)
throw StriException(MSG__INTERNAL_ERROR);
R_len_t bufneed = UCNV_GET_MAX_BYTES_FOR_STRING(curn_tmp, ucnv_getMaxCharSize(uconv_to));
// "The calculated size is guaranteed to be sufficient for this conversion."
buf.resize(bufneed);
err = U_ZERO_ERROR;
// bufneed = encs.extract(buf.data(), buf.size(), uconv_to, err); // UTF-16 -> TO
ucnv_resetFromUnicode(uconv_to);
bufneed = ucnv_fromUChars(uconv_to, buf.data(), buf.size(), curs_tmp, curn_tmp, &err);
if (bufneed <= buf.size()) {
if (U_FAILURE(err))
throw StriException(err);
}
else {// larger buffer needed [this shouldn't happen?]
// warning("buf extending");
buf.resize(bufneed);
err = U_ZERO_ERROR;
bufneed = ucnv_fromUChars(uconv_to, buf.data(), buf.size(), curs_tmp, curn_tmp, &err);
if (U_FAILURE(err))
throw StriException(err);
if (bufneed > buf.size())
throw StriException(MSG__INTERNAL_ERROR);
}
if (to_raw_logical) {
SEXP outobj = Rf_allocVector(RAWSXP, bufneed);
memcpy(RAW(outobj), buf.data(), (size_t)bufneed);
SET_VECTOR_ELT(ret, i, outobj);
}
else {
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf.data(), bufneed, encmark_to));
}
}
if (uconv_from) {
ucnv_close(uconv_from);
uconv_from = NULL;
}
if (uconv_to) {
ucnv_close(uconv_to);
uconv_to = NULL;
}
UNPROTECT(1);
return ret;
STRI__ERROR_HANDLER_END({
if (uconv_from)
ucnv_close(uconv_from);
if (uconv_to)
ucnv_close(uconv_to);
})
}
/**
* Split a single string into text lines
*
* @param str character vector
*
* @return character vector
*
* @version 0.1 (Marek Gagolewski, 2013-08-04)
*/
SEXP stri_split_lines1(SEXP str)
{
str = stri_prepare_arg_string_1(str, "str");
R_len_t vectorize_length = LENGTH(str);
STRI__ERROR_HANDLER_BEGIN
StriContainerUTF8 str_cont(str, vectorize_length);
if (str_cont.isNA(0))
return str;
const char* str_cur_s = str_cont.get(0).c_str();
R_len_t str_cur_n = str_cont.get(0).length();
UChar32 c;
R_len_t jlast;
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; /* null */) {
jlast = j;
U8_NEXT(str_cur_s, j, str_cur_n, c);
switch (c) {
case ASCII_CR: /* CR */
/* check if next is LF */
if (str_cur_s[j] == ASCII_LF) { // look ahead one byte
j++; // just one byte
}
break;
case ASCII_LF: /* LF */
break;
case UCHAR_NEL: /* NEL */
break;
case ASCII_VT: /* VT */
break;
case ASCII_FF: /* FF */
break;
case UCHAR_LS: /* LS */
break;
case UCHAR_PS: /* PS */
break;
default:
/* not a newline character */
occurences.back().v2 = j;
continue;
}
occurences.back().v2 = jlast;
if (j < str_cur_n)
occurences.push_back(R_len_t_x2(j, j));
}
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 k = 0; iter != occurences.end(); ++iter, ++k) {
R_len_t_x2 curoccur = *iter;
SET_STRING_ELT(ans, k, Rf_mkCharLenCE(str_cur_s+curoccur.v1, curoccur.v2-curoccur.v1, CE_UTF8));
}
UNPROTECT(1);
return ans;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/**
* 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 */)
}
SEXP Rf_mkCharLen(const char *x, int y) {
return Rf_mkCharLenCE(x, y, CE_NATIVE);
}
/** Convert character vector to ASCII
*
* All charcodes > 127 are replaced with subst chars (0x1A)
*
* @param str character vector
* @return character vector
*
* @version 0.1-?? (Marek Gagolewski)
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-16)
* make StriException-friendly
*
* @version 0.2-1 (Marek Gagolewski, 2014-03-30)
* use single common buf;
* warn on invalid utf8 byte stream
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*/
SEXP stri_enc_toascii(SEXP str)
{
PROTECT(str = stri_prepare_arg_string(str, "str"));
R_len_t n = LENGTH(str);
STRI__ERROR_HANDLER_BEGIN(1)
// get buf size
R_len_t bufsize = 0;
for (R_len_t i=0; i<n; ++i) {
SEXP curs = STRING_ELT(str, i);
if (curs == NA_STRING)
continue;
R_len_t ni = LENGTH(curs);
if (ni > bufsize) bufsize = ni;
}
String8buf buf(bufsize); // no more bytes than this needed
char* bufdata = buf.data();
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, n));
for (R_len_t i=0; i<n; ++i) {
SEXP curs = STRING_ELT(str, i);
if (curs == NA_STRING || IS_ASCII(curs)) {
// nothing to do
SET_STRING_ELT(ret, i, curs);
continue;
}
R_len_t curn = LENGTH(curs);
const char* curs_tab = CHAR(curs);
if (IS_UTF8(curs)) {
R_len_t k = 0, j = 0;
UChar32 c;
while (j<curn) {
U8_NEXT(curs_tab, j, curn, c);
if (c < 0) {
Rf_warning(MSG__INVALID_CODE_POINT_FIXING);
bufdata[k++] = ASCII_SUBSTITUTE;
}
else if (c > ASCII_MAXCHARCODE)
bufdata[k++] = ASCII_SUBSTITUTE;
else
bufdata[k++] = (char)c;
}
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(bufdata, k, CE_UTF8));
// the string will be marked as ASCII anyway by mkCharLenCE
}
else { // some 8-bit encoding
R_len_t k = 0;
for (R_len_t j=0; j<curn; ++j) {
if (U8_IS_SINGLE(curs_tab[j]))
bufdata[k++] = curs_tab[j];
else {
bufdata[k++] = (char)ASCII_SUBSTITUTE; // subst char in ascii
}
}
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(bufdata, k, CE_UTF8));
// the string will be marked as ASCII anyway by mkCharLenCE
}
}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
SEXP find_password(SEXP svc, SEXP usr, SEXP new_pwd, SEXP quiet, SEXP del) {
SEXP res;
OSStatus status;
SecKeychainRef kc = NULL; /* default */
SecKeychainItemRef kci;
const char *un, *sn;
char *svc_name;
void *pwd;
UInt32 pwd_len = 0;
int l;
int silent = Rf_asInteger(quiet) == 1;
int do_rm = Rf_asInteger(del) == 1;
int modify = 0;
if (TYPEOF(svc) != STRSXP || LENGTH(svc) != 1) Rf_error("Invalid service name");
if (new_pwd != R_NilValue && (TYPEOF(new_pwd) != STRSXP || LENGTH(new_pwd) != 1))
Rf_error("Invalid password");
if (new_pwd != R_NilValue || do_rm) modify = 1;
if (usr == R_NilValue) {
un = getlogin();
if (!un) Rf_error("Unable to get current user name via getlogin()");
} else {
if (TYPEOF(usr) != STRSXP || LENGTH(usr) != 1)
Rf_error("Invalid user name (must be a character vector of length one)");
un = Rf_translateCharUTF8(STRING_ELT(usr, 0));
}
sn = Rf_translateCharUTF8(STRING_ELT(svc, 0));
l = strlen(sn);
if (l > sizeof(buf) - 16) {
svc_name = (char*) malloc(l + 16);
if (!svc_name) Rf_error("Cannot allocate memory for service name");
} else svc_name = buf;
/* we are enforcing R.keychain. prefix to avoid abuse to access other system keys */
strcpy(svc_name, SEC_PREFIX);
strcat(svc_name, sn);
status = SecKeychainFindGenericPassword(kc,
strlen(svc_name), svc_name,
strlen(un), un,
&pwd_len, &pwd,
modify ? &kci : NULL);
if (svc_name != buf) free(svc_name);
if (silent && status == errSecItemNotFound) return R_NilValue;
chk_status(status, "find");
res = PROTECT(Rf_ScalarString(Rf_mkCharLenCE(pwd, pwd_len, CE_UTF8)));
/* FIXME: we'll leak if the above fails in R */
SecKeychainItemFreeContent(NULL, pwd);
if (do_rm) {
status = SecKeychainItemDelete(kci);
chk_status(status, "delete");
} else if (new_pwd != R_NilValue) { /* set a new one */
const char *np = Rf_translateCharUTF8(STRING_ELT(new_pwd, 0));
status = SecKeychainItemModifyContent(kci, NULL, strlen(np), np);
chk_status(status, "modify");
}
UNPROTECT(1);
return res;
}
/**
* Substring replacement function
*
*
* @param str character vector
* @param from integer vector (possibly with negative indices)
* @param to integer vector (possibly with negative indices) or NULL
* @param length integer vector or NULL
* @param omit_na logical scalar
* @param value character vector replacement
* @return character vector
*
* @version 0.1-?? (Bartek Tartanus)
*
* @version 0.1-?? (Marek Gagolewski)
* use StriContainerUTF8 and stri__UChar32_to_UTF8_index
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-01)
* use StriContainerUTF8's UChar32-to-UTF8 index
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-16)
* make StriException-friendly
*
* @version 0.2-1 (Marek Gagolewski, 2014-03-20)
* Use StriContainerUTF8_indexable
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-03)
* Use stri__sub_prepare_from_to_length()
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*
* @version 0.5-9003 (Marek Gagolewski, 2015-08-05)
* Bugfix #183: floating point exception when to or length is an empty vector
*
* @version 1.0-2 (Marek Gagolewski, 2016-01-31)
* FR #199: new arg: `omit_na`
* FR #207: allow insertions
*
*
* @version 1.4.3 (Marek Gagolewski, 2019-03-12)
* #346: na_omit for `value`
*/
SEXP stri_sub_replacement(SEXP str, SEXP from, SEXP to, SEXP length, SEXP omit_na, SEXP value)
{
PROTECT(str = stri_prepare_arg_string(str, "str"));
PROTECT(value = stri_prepare_arg_string(value, "value"));
bool omit_na_1 = stri__prepare_arg_logical_1_notNA(omit_na, "omit_na");
R_len_t value_len = LENGTH(value);
R_len_t str_len = LENGTH(str);
R_len_t from_len = 0; // see below
R_len_t to_len = 0; // see below
R_len_t length_len = 0; // see below
int* from_tab = 0; // see below
int* to_tab = 0; // see below
int* length_tab = 0; // see below
R_len_t sub_protected = 2+ /* how many objects to PROTECT on ret? */
stri__sub_prepare_from_to_length(from, to, length,
from_len, to_len, length_len, from_tab, to_tab, length_tab);
R_len_t vectorize_len = stri__recycling_rule(true, 4,
str_len, value_len, from_len, (to_len>length_len)?to_len:length_len);
if (vectorize_len <= 0) {
UNPROTECT(sub_protected);
return Rf_allocVector(STRSXP, 0);
}
STRI__ERROR_HANDLER_BEGIN(sub_protected)
StriContainerUTF8_indexable str_cont(str, vectorize_len);
StriContainerUTF8 value_cont(value, vectorize_len);
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, vectorize_len));
String8buf buf(0); // @TODO: estimate bufsize a priori
for (R_len_t i = str_cont.vectorize_init();
i != str_cont.vectorize_end();
i = str_cont.vectorize_next(i))
{
R_len_t cur_from = from_tab[i % from_len];
R_len_t cur_to = (to_tab)?to_tab[i % to_len]:length_tab[i % length_len];
if (str_cont.isNA(i)) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
if (cur_from == NA_INTEGER || cur_to == NA_INTEGER || value_cont.isNA(i)) {
if (omit_na_1) {
SET_STRING_ELT(ret, i, str_cont.toR(i));
}
else {
SET_STRING_ELT(ret, i, NA_STRING);
}
continue;
}
if (length_tab) {
if (cur_to <= 0) {
// SET_STRING_ELT(ret, i, R_BlankString);
// continue;
cur_to = 0;
}
else {
cur_to = cur_from + cur_to - 1;
if (cur_from < 0 && cur_to >= 0) cur_to = -1;
}
}
const char* str_cur_s = str_cont.get(i).c_str();
R_len_t str_cur_n = str_cont.get(i).length();
const char* value_cur_s = value_cont.get(i).c_str();
R_len_t value_cur_n = value_cont.get(i).length();
R_len_t cur_from2; // UTF-8 byte indices
R_len_t cur_to2; // UTF-8 byte indices
stri__sub_get_indices(str_cont, i, cur_from, cur_to, cur_from2, cur_to2);
if (cur_to2 < cur_from2) cur_to2 = cur_from2;
R_len_t buflen = str_cur_n-(cur_to2-cur_from2)+value_cur_n;
buf.resize(buflen, false/*destroy contents*/);
memcpy(buf.data(), str_cur_s, (size_t)cur_from2);
memcpy(buf.data()+cur_from2, value_cur_s, (size_t)value_cur_n);
memcpy(buf.data()+cur_from2+value_cur_n, str_cur_s+cur_to2, (size_t)str_cur_n-cur_to2);
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf.data(), buflen, CE_UTF8));
}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/**
* Convert case (upper, lowercase)
*
*
* @param str character vector
* @param locale single string identifying
* the locale ("" or NULL for default locale)
* @return character vector
*
*
* @version 0.1-?? (Marek Gagolewski)
*
* @version 0.1-?? (Marek Gagolewski)
* use StriContainerUTF16
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-16)
* make StriException-friendly
*
* @version 0.1-?? (Marek Gagolewski, 2013-11-19)
* use UCaseMap + StriContainerUTF8
* **THIS DOES NOT WORK WITH ICU 4.8**, we have to revert the changes
* ** BTW, since stringi_0.1-25 we require ICU>=50 **
*
* @version 0.2-1 (Marek Gagolewski, 2014-03-18)
* use UCaseMap + StriContainerUTF8
* (this is much faster for UTF-8 and slightly faster for 8bit enc)
* Estimates minimal buffer size.
*
* @version 0.3-1 (Marek Gagolewski, 2014-10-24)
* Use a custom BreakIterator with stri_trans_totitle
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*
* @version 0.4-1 (Marek Gagolewski, 2014-12-03)
* use StriUBreakIterator
*
* @version 0.6-1 (Marek Gagolewski, 2015-07-11)
* now this is an internal function
*/
SEXP stri_trans_casemap(SEXP str, int _type, SEXP locale)
{
if (_type < 1 || _type > 2) Rf_error(MSG__INCORRECT_INTERNAL_ARG);
const char* qloc = stri__prepare_arg_locale(locale, "locale", true); /* this is R_alloc'ed */
PROTECT(str = stri_prepare_arg_string(str, "str")); // prepare string argument
// version 0.2-1 - Does not work with ICU 4.8 (but we require ICU >= 50)
UCaseMap* ucasemap = NULL;
STRI__ERROR_HANDLER_BEGIN(1)
UErrorCode status = U_ZERO_ERROR;
ucasemap = ucasemap_open(qloc, U_FOLD_CASE_DEFAULT, &status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
R_len_t str_n = LENGTH(str);
StriContainerUTF8 str_cont(str, str_n);
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, str_n));
// STEP 1.
// Estimate the required buffer length
// Notice: The resulting number of codepoints may be larger or smaller than
// the number before casefolding
R_len_t bufsize = str_cont.getMaxNumBytes();
bufsize += 10; // a small margin
String8buf buf(bufsize);
// STEP 2.
// Do case folding
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_STRING_ELT(ret, i, NA_STRING);
continue;
}
R_len_t str_cur_n = str_cont.get(i).length();
const char* str_cur_s = str_cont.get(i).c_str();
status = U_ZERO_ERROR;
int buf_need;
if (_type == 1) buf_need = ucasemap_utf8ToLower(ucasemap,
buf.data(), buf.size(), (const char*)str_cur_s, str_cur_n, &status);
else buf_need = ucasemap_utf8ToUpper(ucasemap,
buf.data(), buf.size(), (const char*)str_cur_s, str_cur_n, &status);
if (U_FAILURE(status)) { /* retry */
buf.resize(buf_need, false/*destroy contents*/);
status = U_ZERO_ERROR;
if (_type == 1) buf_need = ucasemap_utf8ToLower(ucasemap,
buf.data(), buf.size(), (const char*)str_cur_s, str_cur_n, &status);
else buf_need = ucasemap_utf8ToUpper(ucasemap,
buf.data(), buf.size(), (const char*)str_cur_s, str_cur_n, &status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */}) // this shouldn't happen
// we do have the buffer size required to complete this op
}
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf.data(), buf_need, CE_UTF8));
}
if (ucasemap) { ucasemap_close(ucasemap); ucasemap = NULL;}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END({
if (ucasemap) { ucasemap_close(ucasemap); ucasemap = NULL; }
})
}
/** List available time zone IDs
*
* @param offset single numeric
* @param region single string
* @return character vector
*
* @version 0.5-1 (Marek Gagolewski, 2014-12-24)
*/
SEXP stri_timezone_list(SEXP region, SEXP offset)
{
StringEnumeration* tz_enum = NULL;
PROTECT(region = stri_prepare_arg_string_1(region, "region"));
PROTECT(offset = stri_prepare_arg_double_1(offset, "offset"));
STRI__ERROR_HANDLER_BEGIN(2)
StriContainerUTF8 region_cont(region, 1);
UErrorCode status = U_ZERO_ERROR;
int32_t offset_hours = 0;
const int32_t* o = NULL;
const char* r = NULL;
if (!ISNA(REAL(offset)[0])) {
// 0.5 and 0.75 are represented exactly within the double type
offset_hours = (int32_t)(REAL(offset)[0]*1000.0*3600.0);
o = &offset_hours;
}
if (!region_cont.isNA(0))
r = region_cont.get(0).c_str();
tz_enum = TimeZone::createTimeZoneIDEnumeration(UCAL_ZONE_TYPE_ANY, r, o, status);
STRI__CHECKICUSTATUS_RFERROR(status, {/* do nothing special on err */})
status = U_ZERO_ERROR;
tz_enum->reset(status);
STRI__CHECKICUSTATUS_RFERROR(status, {/* do nothing special on err */})
status = U_ZERO_ERROR;
R_len_t n = (R_len_t)tz_enum->count(status);
STRI__CHECKICUSTATUS_RFERROR(status, {/* do nothing special on err */})
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, n));
// SEXP nam;
// STRI__PROTECT(nam = Rf_allocVector(STRSXP, n));
// MG: I reckon that IDs are more readable than DisplayNames (which are moreover localized)
for (R_len_t i=0; i<n; ++i) {
int len;
status = U_ZERO_ERROR;
const char* cur = tz_enum->next(&len, status);
STRI__CHECKICUSTATUS_RFERROR(status, {/* do nothing special on err */})
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(cur, len, CE_UTF8));
// TimeZone* curtz = TimeZone::createTimeZone(UnicodeString::fromUTF8(cur));
// UnicodeString curdn;
// curtz->getDisplayName(locale, curdn);
// delete curtz;
// string out;
// curdn.toUTF8String(out);
// SET_STRING_ELT(nam, i, Rf_mkCharCE(out.c_str(), CE_UTF8));
}
// Rf_setAttrib(ret, R_NamesSymbol, nam);
if (tz_enum) { delete tz_enum; tz_enum = NULL; }
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END(
if (tz_enum) { delete tz_enum; tz_enum = NULL; }
)
}
/**
* 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 */)
}
/**
* Extract all occurences of a character class in each string
*
* @param str character vector
* @param pattern character vector
* @return list of character vectors
*
* @version 0.1 (Marek Gagolewski, 2013-06-08)
* @version 0.2 (Marek Gagolewski, 2013-06-15) Use StrContainerCharClass
* @version 0.3 (Marek Gagolewski, 2013-06-16) make StriException-friendly
*/
SEXP stri_extract_all_charclass(SEXP str, SEXP pattern, SEXP merge)
{
str = stri_prepare_arg_string(str, "str");
pattern = stri_prepare_arg_string(pattern, "pattern");
merge = stri_prepare_arg_logical(merge, "merge");
R_len_t vectorize_length = stri__recycling_rule(true, 3, LENGTH(str), LENGTH(pattern), LENGTH(merge));
STRI__ERROR_HANDLER_BEGIN
StriContainerUTF8 str_cont(str, vectorize_length);
StriContainerCharClass pattern_cont(pattern, vectorize_length);
StriContainerLogical merge_cont(merge, vectorize_length);
SEXP notfound; // this vector will be set iff not found or NA
PROTECT(notfound = stri__vector_NA_strings(1));
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 (pattern_cont.isNA(i) || str_cont.isNA(i) || merge_cont.isNA(i)) {
SET_VECTOR_ELT(ret, i, notfound);
continue;
}
bool merge_cur = merge_cont.get(i);
CharClass pattern_cur = pattern_cont.get(i);
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 j, jlast;
UChar32 chr;
deque<R_len_t_x2> occurences; // codepoint based-indices
for (jlast=j=0; j<str_cur_n; ) {
U8_NEXT(str_cur_s, j, str_cur_n, chr);
if (pattern_cur.test(chr)) {
occurences.push_back(R_len_t_x2(jlast, j));
}
jlast = j;
}
R_len_t noccurences = (R_len_t)occurences.size();
if (noccurences == 0)
SET_VECTOR_ELT(ret, i, notfound);
else if (merge_cur && noccurences > 1) {
// do merge
deque<R_len_t_x2> occurences2;
deque<R_len_t_x2>::iterator iter = occurences.begin();
occurences2.push_back(*iter);
for (++iter; iter != occurences.end(); ++iter) {
R_len_t_x2 curoccur = *iter;
if (occurences2.back().v2 == curoccur.v1) { // continue seq
occurences2.back().v2 = curoccur.v2; // change `end`
}
else { // new seq
occurences2.push_back(curoccur);
}
}
// create resulting matrix from occurences2
R_len_t noccurences2 = (R_len_t)occurences2.size();
SEXP cur_res;
PROTECT(cur_res = Rf_allocVector(STRSXP, noccurences2));
iter = occurences2.begin();
for (R_len_t f = 0; iter != occurences2.end(); ++iter, ++f) {
R_len_t_x2 curo = *iter;
SET_STRING_ELT(cur_res, f, Rf_mkCharLenCE(str_cur_s+curo.v1, curo.v2-curo.v1, CE_UTF8));
}
SET_VECTOR_ELT(ret, i, cur_res);
UNPROTECT(1);
}
else {
// do not merge
SEXP cur_res;
PROTECT(cur_res = Rf_allocVector(STRSXP, noccurences));
deque<R_len_t_x2>::iterator iter = occurences.begin();
for (R_len_t f = 0; iter != occurences.end(); ++iter, ++f) {
R_len_t_x2 curo = *iter;
SET_STRING_ELT(cur_res, f, Rf_mkCharLenCE(str_cur_s+curo.v1, curo.v2-curo.v1, CE_UTF8));
}
SET_VECTOR_ELT(ret, i, cur_res);
UNPROTECT(1);
}
}
UNPROTECT(2);
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/**
* Escape Unicode code points
*
* @param str character vector
* @return character vector
*
* @version 0.1-?? (Marek Gagolewski, 2013-08-17)
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-01)
* fail on incorrect utf8 byte seqs;
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*/
SEXP stri_escape_unicode(SEXP str)
{
PROTECT(str = stri_prepare_arg_string(str, "str")); // prepare string argument
STRI__ERROR_HANDLER_BEGIN(1)
R_len_t str_length = LENGTH(str);
StriContainerUTF8 str_cont(str, str_length);
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, str_length));
std::string out; // @TODO: estimate len a priori?
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_STRING_ELT(ret, i, NA_STRING);
continue;
}
const char* str_cur_s = str_cont.get(i).c_str();
R_len_t str_cur_n = str_cont.get(i).length();
// estimate buf size
R_len_t bufsize = 0;
UChar32 c;
R_len_t j = 0;
while (j < str_cur_n) {
U8_NEXT(str_cur_s, j, str_cur_n, c);
if (c < 0)
throw StriException(MSG__INVALID_UTF8);
else if ((char)c >= 32 || (char)c <= 126)
bufsize += 1;
else if (c <= 0xff)
bufsize += 6; // for \a, \n this will be overestimated
else
bufsize += 10;
}
out.clear();
if ((size_t)bufsize > (size_t)out.size())
out.reserve(bufsize);
// do escape
j = 0;
char buf[11];
while (j < str_cur_n) {
U8_NEXT(str_cur_s, j, str_cur_n, c);
/* if (c < 0)
throw StriException(MSG__INVALID_UTF8); // this has already been checked :)
else */ if (c <= ASCII_MAXCHARCODE) {
switch ((char)c) {
case 0x07: out.append("\\a"); break;
case 0x08: out.append("\\b"); break;
case 0x09: out.append("\\t"); break;
case 0x0a: out.append("\\n"); break;
case 0x0b: out.append("\\v"); break;
case 0x0c: out.append("\\f"); break;
case 0x0d: out.append("\\r"); break;
// case 0x1b: out.append("\\e"); break; // R doesn't know that
case 0x22: out.append("\\\""); break;
case 0x27: out.append("\\'"); break;
case 0x5c: out.append("\\\\"); break;
default:
if ((char)c >= 32 || (char)c <= 126) // printable characters
out.append(1, (char)c);
else {
sprintf(buf, "\\u%4.4x", (uint16_t)c);
out.append(buf, 6);
}
}
}
else if (c <= 0xffff) {
sprintf(buf, "\\u%4.4x", (uint16_t)c);
out.append(buf, 6);
}
else {
sprintf(buf, "\\U%8.8x", (uint32_t)c);
out.append(buf, 10);
}
}
SET_STRING_ELT(ret, i,
Rf_mkCharLenCE(out.c_str(), (int)out.size(), (cetype_t)CE_UTF8)
);
}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/** Word wrap text
*
* @param str character vector
* @param width single integer
* @param cost_exponent single double
* @param indent single integer
* @param exdent single integer
* @param prefix single string
* @param initial single string
* @param locale locale identifier or NULL for default locale
* @param use_length single logical value
*
* @return list
*
* @version 0.1-?? (Bartek Tartanus)
*
* @version 0.2-2 (Marek Gagolewski, 2014-04-27)
* single function for wrap_greedy and wrap_dynamic
* (dispatch inside);
* use BreakIterator
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*
* @version 0.4-1 (Marek Gagolewski, 2014-12-06)
* new args: indent, exdent, prefix, initial
*
* @version 0.5-1 (Marek Gagolewski, 2014-12-19)
* #133 allow width <= 0
*
* @version 0.5-1 (Marek Gagolewski, 2015-02-28)
* don't trim so many white spaces at the end of each word (normalize arg does that)
* #139: allow a "whitespace" break iterator
*
* @version 0.5-1 (Marek Gagolewski, 2015-04-23)
* `use_length` arg added
*
*
* @version 0.5-1 (Marek Gagolewski, 2015-06-09)
* BIGSKIP: no more CHARSXP on out on "" input
*/
SEXP stri_wrap(SEXP str, SEXP width, SEXP cost_exponent,
SEXP indent, SEXP exdent, SEXP prefix, SEXP initial, SEXP whitespace_only,
SEXP use_length, SEXP locale)
{
bool use_length_val = stri__prepare_arg_logical_1_notNA(use_length, "use_length");
double exponent_val = stri__prepare_arg_double_1_notNA(cost_exponent, "cost_exponent");
bool whitespace_only_val = stri__prepare_arg_logical_1_notNA(whitespace_only, "whitespace_only");
int width_val = stri__prepare_arg_integer_1_notNA(width, "width");
if (width_val <= 0) width_val = 0;
int indent_val = stri__prepare_arg_integer_1_notNA(indent, "indent");
if (indent_val < 0) Rf_error(MSG__EXPECTED_POSITIVE, "indent");
int exdent_val = stri__prepare_arg_integer_1_notNA(exdent, "exdent");
if (exdent_val < 0) Rf_error(MSG__EXPECTED_POSITIVE, "exdent");
const char* qloc = stri__prepare_arg_locale(locale, "locale", true); /* this is R_alloc'ed */
Locale loc = Locale::createFromName(qloc);
PROTECT(str = stri_prepare_arg_string(str, "str"));
PROTECT(prefix = stri_prepare_arg_string_1(prefix, "prefix"));
PROTECT(initial = stri_prepare_arg_string_1(initial, "initial"));
BreakIterator* briter = NULL;
UText* str_text = NULL;
STRI__ERROR_HANDLER_BEGIN(3)
UErrorCode status = U_ZERO_ERROR;
briter = BreakIterator::createLineInstance(loc, status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
R_len_t str_length = LENGTH(str);
StriContainerUTF8_indexable str_cont(str, str_length);
StriContainerUTF8 prefix_cont(prefix, 1);
StriContainerUTF8 initial_cont(initial, 1);
// prepare indent/exdent/prefix/initial stuff:
// 1st line, 1st para (i==0, u==0): initial+indent
// nth line, 1st para (i==0, u> 0): prefix +exdent
// 1st line, nth para (i> 0, u==0): prefix +indent
// nth line, nth para (i> 0, u> 0): prefix +exdent
StriWrapLineStart ii(initial_cont.get(0), indent_val);
StriWrapLineStart pi(prefix_cont.get(0), indent_val);
StriWrapLineStart pe(prefix_cont.get(0), exdent_val);
status = U_ZERO_ERROR;
//Unicode Newline Guidelines - Unicode Technical Report #13
UnicodeSet uset_linebreaks(UnicodeString::fromUTF8("[\\u000A-\\u000D\\u0085\\u2028\\u2029]"), status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
uset_linebreaks.freeze();
status = U_ZERO_ERROR;
UnicodeSet uset_whitespaces(UnicodeString::fromUTF8("\\p{White_space}"), status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
uset_whitespaces.freeze();
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(VECSXP, str_length));
for (R_len_t i = 0; i < str_length; ++i)
{
if (str_cont.isNA(i) || prefix_cont.isNA(0) || initial_cont.isNA(0)) {
SET_VECTOR_ELT(ret, i, stri__vector_NA_strings(1));
continue;
}
status = U_ZERO_ERROR;
const char* str_cur_s = str_cont.get(i).c_str();
R_len_t str_cur_n = str_cont.get(i).length();
str_text = utext_openUTF8(str_text, str_cur_s, str_cont.get(i).length(), &status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
status = U_ZERO_ERROR;
briter->setText(str_text, status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
// all right, first let's generate a list of places at which we may do line breaks
deque< R_len_t > occurrences_list; // this could be an R_len_t queue
R_len_t match = briter->first();
while (match != BreakIterator::DONE) {
if (!whitespace_only_val)
occurrences_list.push_back(match);
else {
if (match > 0 && match < str_cur_n) {
UChar32 c;
U8_GET((const uint8_t*)str_cur_s, 0, match-1, str_cur_n, c);
if (uset_whitespaces.contains(c))
occurrences_list.push_back(match);
}
else
occurrences_list.push_back(match);
}
match = briter->next();
}
R_len_t noccurrences = (R_len_t)occurrences_list.size(); // number of boundaries
if (noccurrences <= 1) { // no match (1 boundary == 0)
SET_VECTOR_ELT(ret, i, Rf_ScalarString(str_cont.toR(i)));
continue;
}
// the number of "words" is:
R_len_t nwords = noccurrences - 1;
// convert occurrences_list to a vector
// in order to obtain end positions (in a string) of each "words",
// noting that occurrences_list.at(0) == 0
#ifndef NDEBUG
if (occurrences_list.at(0) != 0)
throw StriException("NDEBUG: stri_wrap: (occurrences_list.at(0) != 0)");
#endif
std::vector<R_len_t> end_pos_orig(nwords);
deque<R_len_t>::iterator iter = ++(occurrences_list.begin());
for (R_len_t j = 0; iter != occurrences_list.end(); ++iter, ++j) {
end_pos_orig[j] = (*iter); // this is a UTF-8 index
}
// now:
// we'll get the total widths/number of code points in each "word"
std::vector<R_len_t> widths_orig(nwords);
// we'll get the total widths/number of code points without trailing whitespaces
std::vector<R_len_t> widths_trim(nwords);
// we'll get the end positions without trailing whitespaces
std::vector<R_len_t> end_pos_trim(nwords);
// detect line endings (fail on a match)
UChar32 c = 0;
R_len_t j = 0;
R_len_t cur_block = 0;
R_len_t cur_width_orig = 0;
R_len_t cur_width_trim = 0;
R_len_t cur_count_orig = 0;
R_len_t cur_count_trim = 0;
R_len_t cur_end_pos_trim = 0;
while (j < str_cur_n) {
R_len_t jlast = j;
U8_NEXT(str_cur_s, j, str_cur_n, c);
if (c < 0) // invalid utf-8 sequence
throw StriException(MSG__INVALID_UTF8);
if (uset_linebreaks.contains(c))
throw StriException(MSG__NEWLINE_FOUND);
cur_width_orig += stri__width_char(c);
++cur_count_orig;
if (uset_whitespaces.contains(c)) {
// OLD: trim all white spaces from the end:
// ++cur_count_trim;
// [we have the normalize arg for that]
// NEW: trim just one white space at the end:
cur_width_trim = stri__width_char(c);
cur_count_trim = 1;
cur_end_pos_trim = jlast;
}
else {
cur_width_trim = 0;
cur_count_trim = 0;
cur_end_pos_trim = j;
}
if (j >= str_cur_n || end_pos_orig[cur_block] <= j) {
// we'll start a new block in a moment
if (use_length_val) {
widths_orig[cur_block] = cur_count_orig;
widths_trim[cur_block] = cur_count_orig-cur_count_trim;
}
else {
widths_orig[cur_block] = cur_width_orig;
widths_trim[cur_block] = cur_width_orig-cur_width_trim;
}
end_pos_trim[cur_block] = cur_end_pos_trim;
cur_block++;
cur_width_orig = 0;
cur_width_trim = 0;
cur_count_orig = 0;
cur_count_trim = 0;
cur_end_pos_trim = j;
}
}
// do wrap
std::deque<R_len_t> wrap_after; // wrap line after which word in {0..nwords-1}?
if (exponent_val <= 0.0) {
stri__wrap_greedy(wrap_after, nwords, width_val,
widths_orig, widths_trim,
(use_length_val)?((i==0)?ii.count:pi.count):((i==0)?ii.width:pi.width),
(use_length_val)?pe.count:pe.width);
}
else {
stri__wrap_dynamic(wrap_after, nwords, width_val, exponent_val,
widths_orig, widths_trim,
(use_length_val)?((i==0)?ii.count:pi.count):((i==0)?ii.width:pi.width),
(use_length_val)?pe.count:pe.width);
}
// wrap_after.size() line breaks => wrap_after.size()+1 lines
R_len_t nlines = (R_len_t)wrap_after.size()+1;
R_len_t last_pos = 0;
SEXP ans;
STRI__PROTECT(ans = Rf_allocVector(STRSXP, nlines));
deque<R_len_t>::iterator iter_wrap = wrap_after.begin();
for (R_len_t u = 0; iter_wrap != wrap_after.end(); ++iter_wrap, ++u) {
R_len_t wrap_after_cur = *iter_wrap;
R_len_t cur_pos = end_pos_trim[wrap_after_cur];
std::string cs;
if (i == 0 && u == 0) cs = ii.str;
else if (i > 0 && u == 0) cs = pi.str;
else cs = pe.str;
cs.append(str_cur_s+last_pos, cur_pos-last_pos);
SET_STRING_ELT(ans, u, Rf_mkCharLenCE(cs.c_str(), cs.size(), CE_UTF8));
last_pos = end_pos_orig[wrap_after_cur];
}
// last line goes here:
std::string cs;
if (i == 0 && nlines-1 == 0) cs = ii.str;
else if (i > 0 && nlines-1 == 0) cs = pi.str;
else cs = pe.str;
cs.append(str_cur_s+last_pos, end_pos_trim[nwords-1]-last_pos);
SET_STRING_ELT(ans, nlines-1, Rf_mkCharLenCE(cs.c_str(), cs.size(), CE_UTF8));
SET_VECTOR_ELT(ret, i, ans);
STRI__UNPROTECT(1);
}
if (briter) { delete briter; briter = NULL; }
if (str_text) { utext_close(str_text); str_text = NULL; }
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END({
if (briter) { delete briter; briter = NULL; }
if (str_text) { utext_close(str_text); str_text = NULL; }
})
}
/**
* Trim characters from a charclass from left AND/OR right side of the string
*
* @param str character vector
* @param pattern character vector
* @param left from left?
* @param right from left?
* @return character vector
*
* @version 0.1-?? (Bartek Tartanus)
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-04)
* Use StriContainerUTF8 and CharClass
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-16)
* make StriException-friendly & Use StrContainerCharClass
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-03)
* detects invalid UTF-8 byte stream
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-05)
* StriContainerCharClass now relies on UnicodeSet
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*/
SEXP stri__trim_leftright(SEXP str, SEXP pattern, bool left, bool right)
{
PROTECT(str = stri_prepare_arg_string(str, "str"));
PROTECT(pattern = stri_prepare_arg_string(pattern, "pattern"));
R_len_t vectorize_length =
stri__recycling_rule(true, 2, LENGTH(str), LENGTH(pattern));
STRI__ERROR_HANDLER_BEGIN(2)
StriContainerUTF8 str_cont(str, vectorize_length);
StriContainerCharClass pattern_cont(pattern, vectorize_length);
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, vectorize_length));
for (R_len_t i = pattern_cont.vectorize_init();
i != pattern_cont.vectorize_end();
i = pattern_cont.vectorize_next(i))
{
if (str_cont.isNA(i) || pattern_cont.isNA(i)) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
const UnicodeSet* pattern_cur = &pattern_cont.get(i);
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 jlast1 = 0;
R_len_t jlast2 = str_cur_n;
if (left) {
UChar32 chr;
for (R_len_t j=0; j<str_cur_n; ) {
U8_NEXT(str_cur_s, j, str_cur_n, chr); // "look ahead"
if (chr < 0) // invalid utf-8 sequence
throw StriException(MSG__INVALID_UTF8);
if (pattern_cur->contains(chr)) {
break; // break at first occurrence
}
jlast1 = j;
}
}
if (right && jlast1 < str_cur_n) {
UChar32 chr;
for (R_len_t j=str_cur_n; j>0; ) {
U8_PREV(str_cur_s, 0, j, chr); // "look behind"
if (chr < 0) // invalid utf-8 sequence
throw StriException(MSG__INVALID_UTF8);
if (pattern_cur->contains(chr)) {
break; // break at first occurrence
}
jlast2 = j;
}
}
// now jlast is the index, from which we start copying
SET_STRING_ELT(ret, i,
Rf_mkCharLenCE(str_cur_s+jlast1, (jlast2-jlast1), CE_UTF8));
}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/**
* Get substring
*
*
* @param str character vector
* @param from integer vector (possibly with negative indices)
* @param to integer vector (possibly with negative indices) or NULL
* @param length integer vector or NULL
* @return character vector
*
* @version 0.1-?? (Bartek Tartanus)
* stri_sub
*
* @version 0.1-?? (Marek Gagolewski)
* use StriContainerUTF8 and stri__UChar32_to_UTF8_index
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-01)
* use StriContainerUTF8's UChar32-to-UTF8 index
*
* @version 0.1-?? (Marek Gagolewski, 2013-06-16)
* make StriException-friendly
*
* @version 0.2-1 (Marek Gagolewski, 2014-03-20)
* Use StriContainerUTF8_indexable
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-03)
* Use stri__sub_prepare_from_to_length()
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*
* @version 0.5-9003 (Marek Gagolewski, 2015-08-05)
* Bugfix #183: floating point exception when to or length is an empty vector
*/
SEXP stri_sub(SEXP str, SEXP from, SEXP to, SEXP length)
{
PROTECT(str = stri_prepare_arg_string(str, "str"));
R_len_t str_len = LENGTH(str);
R_len_t from_len = 0;
R_len_t to_len = 0;
R_len_t length_len = 0;
int* from_tab = 0;
int* to_tab = 0;
int* length_tab = 0;
R_len_t sub_protected = 1+ /* how many objects to PROTECT on ret? */
stri__sub_prepare_from_to_length(from, to, length,
from_len, to_len, length_len, from_tab, to_tab, length_tab);
R_len_t vectorize_len = stri__recycling_rule(true, 3,
str_len, from_len, (to_len>length_len)?to_len:length_len);
if (vectorize_len <= 0) {
UNPROTECT(sub_protected);
return Rf_allocVector(STRSXP, 0);
}
STRI__ERROR_HANDLER_BEGIN(sub_protected)
StriContainerUTF8_indexable str_cont(str, vectorize_len);
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, vectorize_len));
for (R_len_t i = str_cont.vectorize_init();
i != str_cont.vectorize_end();
i = str_cont.vectorize_next(i))
{
R_len_t cur_from = from_tab[i % from_len];
R_len_t cur_to = (to_tab)?to_tab[i % to_len]:length_tab[i % length_len];
if (str_cont.isNA(i) || cur_from == NA_INTEGER || cur_to == NA_INTEGER) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
if (length_tab) {
if (cur_to <= 0) {
SET_STRING_ELT(ret, i, R_BlankString);
continue;
}
cur_to = cur_from + cur_to - 1;
if (cur_from < 0 && cur_to >= 0) cur_to = -1;
}
const char* str_cur_s = str_cont.get(i).c_str();
R_len_t cur_from2; // UTF-8 byte indices
R_len_t cur_to2; // UTF-8 byte indices
stri__sub_get_indices(str_cont, i, cur_from, cur_to, cur_from2, cur_to2);
if (cur_to2 > cur_from2) { // just copy
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(str_cur_s+cur_from2, cur_to2-cur_from2, CE_UTF8));
}
else {
// maybe a warning here?
SET_STRING_ELT(ret, i, Rf_mkCharLen(NULL, 0));
}
}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/**
* Convert case (TitleCase)
*
*
* @param str character vector
* @param opts_brkiter list
* @return character vector
*
* @version 0.4-1 (Marek Gagolewski, 2014-12-03)
* separated from stri_trans_casemap;
* use StriUBreakIterator
*/
SEXP stri_trans_totitle(SEXP str, SEXP opts_brkiter) {
StriBrkIterOptions opts_brkiter2(opts_brkiter, "word");
PROTECT(str = stri_prepare_arg_string(str, "str")); // prepare string argument
// version 0.2-1 - Does not work with ICU 4.8 (but we require ICU >= 50)
UCaseMap* ucasemap = NULL;
STRI__ERROR_HANDLER_BEGIN(1)
StriUBreakIterator brkiter(opts_brkiter2);
UErrorCode status = U_ZERO_ERROR;
ucasemap = ucasemap_open(brkiter.getLocale(), U_FOLD_CASE_DEFAULT, &status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
status = U_ZERO_ERROR;
ucasemap_setBreakIterator(ucasemap, brkiter.getIterator(), &status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
brkiter.free(false);
// ucasemap_setOptions(ucasemap, U_TITLECASE_NO_LOWERCASE, &status); // to do?
// now briter is owned by ucasemap.
// it will be released on ucasemap_close
// (checked with ICU man & src code)
R_len_t str_n = LENGTH(str);
StriContainerUTF8 str_cont(str, str_n);
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, str_n));
// STEP 1.
// Estimate the required buffer length
// Notice: The resulting number of codepoints may be larger or smaller than
// the number before casefolding
R_len_t bufsize = str_cont.getMaxNumBytes();
bufsize += 10; // a small margin
String8buf buf(bufsize);
// STEP 2.
// Do case folding
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_STRING_ELT(ret, i, NA_STRING);
continue;
}
R_len_t str_cur_n = str_cont.get(i).length();
const char* str_cur_s = str_cont.get(i).c_str();
status = U_ZERO_ERROR;
int buf_need = ucasemap_utf8ToTitle(ucasemap, buf.data(), buf.size(),
(const char*)str_cur_s, str_cur_n, &status);
if (U_FAILURE(status)) {
buf.resize(buf_need, false/*destroy contents*/);
status = U_ZERO_ERROR;
buf_need = ucasemap_utf8ToTitle(ucasemap, buf.data(), buf.size(),
(const char*)str_cur_s, str_cur_n, &status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */}) // this shouldn't happen
// we do have the buffer size required to complete this op
}
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf.data(), buf_need, CE_UTF8));
}
if (ucasemap) { ucasemap_close(ucasemap); ucasemap = NULL;}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END({
if (ucasemap) { ucasemap_close(ucasemap); ucasemap = NULL; }
})
}
/** internal function - replace multiple substrings in a single string
* can raise Rf_error
*
* @version 1.3.2 (Marek Gagolewski, 2019-02-23)
*
* @version 1.4.3 (Marek Gagolewski, 2019-03-12)
* #346: na_omit for `value`
*/
SEXP stri__sub_replacement_all_single(SEXP curs,
SEXP from, SEXP to, SEXP length, bool omit_na_1, SEXP value)
{
// curs is a CHARSXP in UTF-8
PROTECT(value = stri_enc_toutf8(value,
Rf_ScalarLogical(FALSE), Rf_ScalarLogical(FALSE)));
R_len_t value_len = LENGTH(value);
R_len_t from_len = 0; // see below
R_len_t to_len = 0; // see below
R_len_t length_len = 0; // see below
int* from_tab = 0; // see below
int* to_tab = 0; // see below
int* length_tab = 0; // see below
R_len_t sub_protected = 1+ /* how many objects to PROTECT on ret? */
stri__sub_prepare_from_to_length(from, to, length,
from_len, to_len, length_len, from_tab, to_tab, length_tab);
R_len_t vectorize_len = stri__recycling_rule(true, 2, // does not care about value_len
from_len, (to_len>length_len)?to_len:length_len);
if (vectorize_len <= 0) { // "nothing" is being replaced -> return the input as-is
UNPROTECT(sub_protected);
return curs;
}
if (value_len <= 0) { // things are supposed to be replaced with "nothing"...
UNPROTECT(sub_protected);
Rf_warning(MSG__REPLACEMENT_ZERO);
return NA_STRING;
}
if (vectorize_len % value_len != 0)
Rf_warning(MSG__WARN_RECYCLING_RULE2);
const char* curs_s = CHAR(curs); // already in UTF-8
R_len_t curs_n = LENGTH(curs);
// first check for NAs....
if (!omit_na_1) {
for (R_len_t i=0; i<vectorize_len; ++i) {
R_len_t cur_from = from_tab[i % from_len];
R_len_t cur_to = (to_tab)?to_tab[i % to_len]:length_tab[i % length_len];
if (cur_from == NA_INTEGER || cur_to == NA_INTEGER) {
UNPROTECT(sub_protected);
if (omit_na_1) return curs;
else return NA_STRING;
}
}
for (R_len_t i=0; i<vectorize_len; ++i) {
if (STRING_ELT(value, i%value_len) == NA_STRING) {
UNPROTECT(sub_protected);
return NA_STRING;
}
}
}
// get the number of code points in curs, if required (for negative indexes)
R_len_t curs_m = -1;
if (IS_ASCII(curs)) curs_m = curs_n;
else { // is UTF-8
curs_m = 0; // code points count
R_len_t j = 0; // byte pos
while (j < curs_n) {
U8_FWD_1_UNSAFE(curs_s, j);
++curs_m;
}
}
STRI__ERROR_HANDLER_BEGIN(sub_protected)
std::vector<char> buf; // convenience >> speed
R_len_t buf_size;
R_len_t last_pos = 0;
R_len_t byte_pos = 0, byte_pos_last;
for (R_len_t i=0; i<vectorize_len; ++i) {
R_len_t cur_from = from_tab[i % from_len];
R_len_t cur_to = (to_tab)?to_tab[i % to_len]:length_tab[i % length_len];
if (cur_from == NA_INTEGER || cur_to == NA_INTEGER || STRING_ELT(value, i%value_len) == NA_STRING) {
continue;
}
if (cur_from < 0) cur_from = curs_m+cur_from+1;
if (cur_from <= 0) cur_from = 1;
cur_from--; // 1-based -> 0-based index
if (cur_from >= curs_m) cur_from = curs_m;
// cur_from is in [0, curs_m]
if (length_tab) {
if (cur_to < 0) cur_to = 0;
cur_to = cur_from+cur_to;
}
else {
if (cur_to < 0) cur_to = curs_m+cur_to+1;
if (cur_to < cur_from) cur_to = cur_from; // insertion
}
if (cur_to >= curs_m) cur_to = curs_m;
// the chunk to replace is at code points [cur_from, cur_to)
// Rprintf("orig [%d,%d) repl [%d,%d)\n", last_pos, cur_from, cur_from, cur_to);
if (last_pos > cur_from)
throw StriException(MSG__OVERLAPPING_OR_UNSORTED_INDEXES);
// first, copy [last_pos, cur_from)
byte_pos_last = byte_pos;
while (last_pos < cur_from) {
U8_FWD_1_UNSAFE(curs_s, byte_pos);
++last_pos;
}
buf_size = buf.size();
buf.resize(buf_size+byte_pos-byte_pos_last);
memcpy(buf.data()+buf_size, curs_s+byte_pos_last, byte_pos-byte_pos_last);
// then, copy the corresponding replacement string
SEXP value_cur = STRING_ELT(value, i%value_len);
const char* value_s = CHAR(value_cur);
R_len_t value_n = LENGTH(value_cur);
buf_size = buf.size();
buf.resize(buf_size+value_n);
memcpy(buf.data()+buf_size, value_s, value_n);
// lastly, update last_pos
// ---> last_pos = cur_to;
while (last_pos < cur_to) {
U8_FWD_1_UNSAFE(curs_s, byte_pos);
++last_pos;
}
}
// finally, copy [last_pos, curs_m)
// Rprintf("orig [%d,%d)\n", last_pos, curs_m);
buf_size = buf.size();
buf.resize(buf_size+curs_n-byte_pos);
memcpy(buf.data()+buf_size, curs_s+byte_pos, curs_n-byte_pos);
SEXP ret;
STRI__PROTECT(ret = Rf_mkCharLenCE(buf.data(), buf.size(), CE_UTF8));
STRI__UNPROTECT_ALL
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();
})
}
/** Convert character vector to UTF-8
*
* @param str character vector
* @param is_unknown_8bit single logical value;
* if TRUE, then in case of ENC_NATIVE or ENC_LATIN1, UTF-8
* REPLACEMENT CHARACTERs (U+FFFD) are
* put for codes > 127
* @param validate single logical value (or NA)
*
* @return character vector
*
* @version 0.1-XX (Marek Gagolewski)
*
* @version 0.1-XX (Marek Gagolewski, 2013-06-16)
* make StriException-friendly
*
* @version 0.2-1 (Marek Gagolewski, 2014-03-26)
* Use one String8buf;
* is_unknown_8bit_logical and UTF-8 tries now to remove BOMs
*
* @version 0.2-1 (Marek Gagolewksi, 2014-03-30)
* added validate arg
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*/
SEXP stri_enc_toutf8(SEXP str, SEXP is_unknown_8bit, SEXP validate)
{
PROTECT(validate = stri_prepare_arg_logical_1(validate, "validate"));
bool is_unknown_8bit_logical =
stri__prepare_arg_logical_1_notNA(is_unknown_8bit, "is_unknown_8bit");
PROTECT(str = stri_prepare_arg_string(str, "str"));
R_len_t n = LENGTH(str);
STRI__ERROR_HANDLER_BEGIN(2)
SEXP ret;
if (!is_unknown_8bit_logical) {
// Trivial - everything we need is in StriContainerUTF8 :)
// which removes BOMs silently
StriContainerUTF8 str_cont(str, n);
STRI__PROTECT(ret = str_cont.toR());
}
else {
// get buf size
R_len_t bufsize = 0;
for (R_len_t i=0; i<n; ++i) {
SEXP curs = STRING_ELT(str, i);
if (curs == NA_STRING || IS_ASCII(curs) || IS_UTF8(curs))
continue;
R_len_t ni = LENGTH(curs);
if (ni > bufsize) bufsize = ni;
}
String8buf buf(bufsize*3); // either 1 byte < 127 or U+FFFD == 3 bytes UTF-8
char* bufdata = buf.data();
STRI__PROTECT(ret = Rf_allocVector(STRSXP, n));
for (R_len_t i=0; i<n; ++i) {
SEXP curs = STRING_ELT(str, i);
if (curs == NA_STRING) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
if (IS_ASCII(curs) || IS_UTF8(curs)) {
R_len_t curs_n = LENGTH(curs);
const char* curs_s = CHAR(curs);
if (curs_n >= 3 &&
(uint8_t)(curs_s[0]) == UTF8_BOM_BYTE1 &&
(uint8_t)(curs_s[1]) == UTF8_BOM_BYTE2 &&
(uint8_t)(curs_s[2]) == UTF8_BOM_BYTE3) {
// has BOM - get rid of it
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(curs_s+3, curs_n-3, CE_UTF8));
}
else
SET_STRING_ELT(ret, i, curs);
continue;
}
// otherwise, we have an 8-bit encoding
R_len_t curn = LENGTH(curs);
const char* curs_tab = CHAR(curs);
R_len_t k = 0;
for (R_len_t j=0; j<curn; ++j) {
if (U8_IS_SINGLE(curs_tab[j]))
bufdata[k++] = curs_tab[j];
else { // 0xEF 0xBF 0xBD
bufdata[k++] = (char)UCHAR_REPLACEMENT_UTF8_BYTE1;
bufdata[k++] = (char)UCHAR_REPLACEMENT_UTF8_BYTE2;
bufdata[k++] = (char)UCHAR_REPLACEMENT_UTF8_BYTE3;
}
}
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(bufdata, k, CE_UTF8));
}
}
// validate utf8 byte stream
if (LOGICAL(validate)[0] != FALSE) { // NA or TRUE
R_len_t ret_n = LENGTH(ret);
for (R_len_t i=0; i<ret_n; ++i) {
SEXP curs = STRING_ELT(ret, i);
if (curs == NA_STRING) continue;
const char* s = CHAR(curs);
R_len_t sn = LENGTH(curs);
R_len_t j = 0;
UChar32 c = 0;
while (c >= 0 && j < sn) {
U8_NEXT(s, j, sn, c);
}
if (c >= 0) continue; // valid, nothing to do
if (LOGICAL(validate)[0] == NA_LOGICAL) {
Rf_warning(MSG__INVALID_CODE_POINT_REPLNA);
SET_STRING_ELT(ret, i, NA_STRING);
}
else {
int bufsize = sn*3; // maximum: 1 byte -> U+FFFD (3 bytes)
String8buf buf(bufsize); // maximum: 1 byte -> U+FFFD (3 bytes)
char* bufdata = buf.data();
j = 0;
R_len_t k = 0;
UBool err = FALSE;
while (!err && j < sn) {
U8_NEXT(s, j, sn, c);
if (c >= 0) {
U8_APPEND((uint8_t*)bufdata, k, bufsize, c, err);
} else {
Rf_warning(MSG__INVALID_CODE_POINT_FIXING);
bufdata[k++] = (char)UCHAR_REPLACEMENT_UTF8_BYTE1;
bufdata[k++] = (char)UCHAR_REPLACEMENT_UTF8_BYTE2;
bufdata[k++] = (char)UCHAR_REPLACEMENT_UTF8_BYTE3;
}
}
if (err) throw StriException(MSG__INTERNAL_ERROR);
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(bufdata, k, CE_UTF8));
}
}
}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END(;/* nothing special to be done on error */)
}
/** Generate random permutations of code points in each string
*
* @param str character vector
* @return character vector
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-04)
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*
* @version 1.2.5 (Marek Gagolewski, 2019-07-23)
* #319: Fixed overflow in `stri_rand_shuffle()`.
*/
SEXP stri_rand_shuffle(SEXP str)
{
PROTECT(str = stri_prepare_arg_string(str, "str"));
R_len_t n = LENGTH(str);
GetRNGstate();
STRI__ERROR_HANDLER_BEGIN(1)
StriContainerUTF8 str_cont(str, n);
R_len_t bufsize = 0;
for (R_len_t i=0; i<n; ++i) {
if (str_cont.isNA(i)) continue;
R_len_t ni = str_cont.get(i).length();
if (ni > bufsize) bufsize = ni;
}
std::vector<UChar32> buf1(bufsize); // at most bufsize UChars32 (bufsize/4 min.)
String8buf buf2(bufsize);
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(STRSXP, n));
for (R_len_t i=0; i<n; ++i) {
if (str_cont.isNA(i)) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
// fill buf1
UChar32 c = (UChar32)0;
const char* s = str_cont.get(i).c_str();
R_len_t sn = str_cont.get(i).length();
R_len_t j = 0;
R_len_t k = 0;
while (c >= 0 && j < sn) {
U8_NEXT(s, j, sn, c);
buf1[k++] = (int)c;
}
if (c < 0) {
Rf_warning(MSG__INVALID_UTF8);
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
// do shuffle buf1 at pos 0..k-1: (Fisher-Yates shuffle)
R_len_t cur_n = k;
for (j=0; j<cur_n-1; ++j) {
// rand from i to cur_n-1
R_len_t r = (R_len_t)floor(unif_rand()*(double)(cur_n-j)+(double)j);
UChar32 tmp = buf1[r];
buf1[r] = buf1[j];
buf1[j] = tmp;
}
// create string:
char* buf2data = buf2.data();
c = (UChar32)0;
j = 0;
k = 0;
UBool err = FALSE;
while (!err && k < cur_n) {
c = buf1[k++];
U8_APPEND((uint8_t*)buf2data, j, bufsize, c, err);
}
if (err) throw StriException(MSG__INTERNAL_ERROR);
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(buf2data, j, CE_UTF8));
}
PutRNGstate();
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END({
PutRNGstate();
})
}
/**
* Convert character vector between marked encodings and the encoding provided
*
* @param str input character vector or list of raw vectors
* @param to target encoding, \code{NULL} or \code{""} for default enc
* @param to_raw single logical, should list of raw vectors be returned?
* @return a converted character vector or list of raw vectors
*
* @version 0.1-?? (Marek Gagolewski, 2013-11-12)
*
* @version 0.2-1 (Marek Gagolewski, 2014-03-28)
* use StriUcnv
*
* @version 0.2-1 (Marek Gagolewski, 2014-04-01)
* calc required buf size a priori
*
* @version 0.3-1 (Marek Gagolewski, 2014-11-04)
* Issue #112: str_prepare_arg* retvals were not PROTECTed from gc
*/
SEXP stri_encode_from_marked(SEXP str, SEXP to, SEXP to_raw)
{
PROTECT(str = stri_prepare_arg_string(str, "str"));
const char* selected_to = stri__prepare_arg_enc(to, "to", true); /* this is R_alloc'ed */
bool to_raw_logical = stri__prepare_arg_logical_1_notNA(to_raw, "to_raw");
STRI__ERROR_HANDLER_BEGIN(1)
R_len_t str_n = LENGTH(str);
StriContainerUTF16 str_cont(str, str_n);
// get the number of strings to convert; if == 0, then you know what's the result
if (str_n <= 0) return Rf_allocVector(to_raw_logical?VECSXP:STRSXP, 0);
// Open converters
StriUcnv ucnv(selected_to);
UConverter* uconv_to = ucnv.getConverter(true /*register_callbacks*/);
// Get target encoding mark
cetype_t encmark_to = to_raw_logical?CE_BYTES:ucnv.getCE();
// Prepare out val
SEXP ret;
STRI__PROTECT(ret = Rf_allocVector(to_raw_logical?VECSXP:STRSXP, str_n));
// calculate required buf size
R_len_t bufsize = 0;
for (R_len_t i=0; i<str_n; ++i) {
if (!str_cont.isNA(i) && str_cont.get(i).length() > bufsize)
bufsize = str_cont.get(i).length();
}
bufsize = UCNV_GET_MAX_BYTES_FOR_STRING(bufsize, ucnv_getMaxCharSize(uconv_to));
// "The calculated size is guaranteed to be sufficient for this conversion."
String8buf buf(bufsize);
for (R_len_t i=0; i<str_n; ++i) {
if (str_cont.isNA(i)) {
if (to_raw_logical) SET_VECTOR_ELT(ret, i, R_NilValue);
else SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
R_len_t curn_tmp = str_cont.get(i).length();
const UChar* curs_tmp = str_cont.get(i).getBuffer(); // The buffer content is (probably) not NUL-terminated.
if (!curs_tmp)
throw StriException(MSG__INTERNAL_ERROR);
UErrorCode status = U_ZERO_ERROR;
ucnv_resetFromUnicode(uconv_to);
R_len_t bufneed = ucnv_fromUChars(uconv_to, buf.data(), buf.size(),
curs_tmp, curn_tmp, &status);
if (bufneed <= buf.size()) {
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
}
else {// larger buffer needed [this shouldn't happen?]
buf.resize(bufneed, false/*destroy contents*/);
status = U_ZERO_ERROR;
bufneed = ucnv_fromUChars(uconv_to, buf.data(), buf.size(),
curs_tmp, curn_tmp, &status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
}
if (to_raw_logical) {
SEXP outobj;
STRI__PROTECT(outobj = Rf_allocVector(RAWSXP, bufneed));
memcpy(RAW(outobj), buf.data(), (size_t)bufneed);
SET_VECTOR_ELT(ret, i, outobj);
STRI__UNPROTECT(1);
}
else {
SET_STRING_ELT(ret, i,
Rf_mkCharLenCE(buf.data(), bufneed, encmark_to));
}
}
STRI__UNPROTECT_ALL
return ret;
STRI__ERROR_HANDLER_END({/* nothing special on error */})
}
/**
* Format date-time objects
*
* @param time
* @param format
* @param tz
* @param locale
*
* @return character vector
*
* @version 0.5-1 (Marek Gagolewski, 2015-01-05)
*
* @version 0.5-1 (Marek Gagolewski, 2015-02-22)
* use tz
*/
SEXP stri_datetime_format(SEXP time, SEXP format, SEXP tz, SEXP locale) {
PROTECT(time = stri_prepare_arg_POSIXct(time, "time"));
const char* locale_val = stri__prepare_arg_locale(locale, "locale", true);
const char* format_val = stri__prepare_arg_string_1_notNA(format, "format");
// "format" may be one of:
const char* format_opts[] = {
"date_full", "date_long", "date_medium", "date_short",
"date_relative_full", "date_relative_long", "date_relative_medium", "date_relative_short",
"time_full", "time_long", "time_medium", "time_short",
"time_relative_full", "time_relative_long", "time_relative_medium", "time_relative_short",
"datetime_full", "datetime_long", "datetime_medium", "datetime_short",
"datetime_relative_full", "datetime_relative_long", "datetime_relative_medium", "datetime_relative_short",
NULL};
int format_cur = stri__match_arg(format_val, format_opts);
TimeZone* tz_val = stri__prepare_arg_timezone(tz, "tz", true/*allowdefault*/);
Calendar* cal = NULL;
DateFormat* fmt = NULL;
STRI__ERROR_HANDLER_BEGIN(1)
R_len_t vectorize_length = LENGTH(time);
StriContainerDouble time_cont(time, vectorize_length);
UnicodeString format_str(format_val);
UErrorCode status = U_ZERO_ERROR;
if (format_cur >= 0) {
DateFormat::EStyle style = DateFormat::kNone;
switch (format_cur % 8) {
case 0: style = DateFormat::kFull; break;
case 1: style = DateFormat::kLong; break;
case 2: style = DateFormat::kMedium; break;
case 3: style = DateFormat::kShort; break;
case 4: style = DateFormat::kFullRelative; break;
case 5: style = DateFormat::kLongRelative; break;
case 6: style = DateFormat::kMediumRelative; break;
case 7: style = DateFormat::kShortRelative; break;
default: style = DateFormat::kNone; break;
}
/* ICU 54.1: Relative time styles are not currently supported. */
switch (format_cur / 8) {
case 0:
fmt = DateFormat::createDateInstance(style,
Locale::createFromName(locale_val));
break;
case 1:
fmt = DateFormat::createTimeInstance(
(DateFormat::EStyle)(style & ~DateFormat::kRelative),
Locale::createFromName(locale_val));
break;
case 2:
fmt = DateFormat::createDateTimeInstance(style,
(DateFormat::EStyle)(style & ~DateFormat::kRelative),
Locale::createFromName(locale_val));
break;
default:
fmt = NULL;
break;
}
}
else
fmt = new SimpleDateFormat(format_str, Locale::createFromName(locale_val), status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
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(STRSXP, vectorize_length));
for (R_len_t i=0; i<vectorize_length; ++i) {
if (time_cont.isNA(i)) {
SET_STRING_ELT(ret, i, NA_STRING);
continue;
}
status = U_ZERO_ERROR;
cal->setTime((UDate)(time_cont.get(i)*1000.0), status);
STRI__CHECKICUSTATUS_THROW(status, {/* do nothing special on err */})
FieldPosition pos;
UnicodeString out;
fmt->format(*cal, out, pos);
std::string s;
out.toUTF8String(s);
SET_STRING_ELT(ret, i, Rf_mkCharLenCE(s.c_str(), (int)s.length(), (cetype_t)CE_UTF8));
}
if (tz_val) { delete tz_val; tz_val = NULL; }
if (fmt) { delete fmt; fmt = 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 (fmt) { delete fmt; fmt = NULL; }
if (cal) { delete cal; cal = NULL; }
})
}
