Last active
August 29, 2015 14:05
-
-
Save wch/e3ec5b20eb712f1b22b2 to your computer and use it in GitHub Desktop.
R function with C code for escaping characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#include <R.h> | |
#include <Rdefines.h> | |
// Given a CHARSXP, return a CHARSXP with some characters escaped. | |
SEXP C_escape_chars_one(SEXP x) { | |
if (TYPEOF(x) != CHARSXP) | |
error("x must be a CHARSXP"); | |
const char* old = CHAR(x); | |
char* old_p = (char*)old; | |
// Count up the number of matches | |
int matches = 0; | |
char oldc; | |
do { | |
oldc = *old_p; | |
switch(oldc) { | |
case '\\': | |
case '"': | |
case '\n': | |
case '\r': | |
case '\t': | |
case '\b': | |
case '\f': | |
matches++; | |
} | |
old_p++; | |
} while(oldc != '\0'); | |
// Copy old string to new string, replacing where necessary. | |
old_p = (char*)old; | |
// Allocate string memory; add 3 for start and end quotes and \0. | |
char* newstr = (char*)malloc(strlen(old) + matches + 3); | |
char* new_p = newstr; | |
*new_p = '"'; | |
new_p++; | |
do { | |
oldc = *old_p; | |
switch(oldc) { | |
case '\\': | |
*new_p = '\\'; | |
new_p++; | |
*new_p = '\\'; | |
break; | |
case '"': | |
*new_p = '\\'; | |
new_p++; | |
*new_p = '"'; | |
break; | |
case '\n': | |
*new_p = '\\'; | |
new_p++; | |
*new_p = 'n'; | |
break; | |
case '\r': | |
*new_p = '\\'; | |
new_p++; | |
*new_p = 'r'; | |
break; | |
case '\t': | |
*new_p = '\\'; | |
new_p++; | |
*new_p = 't'; | |
break; | |
case '\b': | |
*new_p = '\\'; | |
new_p++; | |
*new_p = 'b'; | |
break; | |
case '\f': | |
*new_p = '\\'; | |
new_p++; | |
*new_p = 'f'; | |
break; | |
case '\0': | |
// End with a quote char | |
*new_p = '"'; | |
new_p++; | |
*new_p = '\0'; | |
break; | |
default: | |
*new_p = oldc; | |
} | |
old_p++; | |
new_p++; | |
} while(oldc != '\0'); | |
SEXP val = mkChar(newstr); | |
free(newstr); | |
return val; | |
} | |
// Given a character vector, escape all the individual strings in it. | |
SEXP C_escape_chars(SEXP x) { | |
if (!isString(x)) | |
error("x must be a character vector."); | |
if (x == R_NilValue || length(x) == 0) | |
return x; | |
int len = length(x); | |
SEXP out = PROTECT(allocVector(STRSXP, len)); | |
for (int i=0; i<len; i++) { | |
SET_STRING_ELT(out, i, C_escape_chars_one(STRING_ELT(x, i))); | |
} | |
UNPROTECT(1); | |
return out; | |
} |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' @useDynLib nameOfPackage C_escape_chars | |
deparse_vector3 <- function(x) { | |
.Call(C_escape_chars, x) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment