SEXP BWGSectionList_add(SEXP r_sections, SEXP r_seq, SEXP r_ranges,
SEXP r_score, SEXP r_format)
{
struct bwgSection *sections = NULL;
const char *seq = CHAR(asChar(r_seq));
double *score = REAL(r_score);
const char *format = CHAR(asChar(r_format));
SEXP ans;
struct lm *lm;
enum bwgSectionType type = bwgTypeBedGraph;
if (sameString(format, "fixedStep"))
type = bwgTypeFixedStep;
else if (sameString(format, "variableStep"))
type = bwgTypeVariableStep;
if (r_sections != R_NilValue) {
sections = R_ExternalPtrAddr(r_sections);
lm = R_ExternalPtrAddr(R_ExternalPtrTag(r_sections));
} else lm = lmInit(0);
pushRHandlers();
if (r_ranges != R_NilValue) {
BWGSectionList_addRle(§ions, seq, r_ranges, score, type, lm);
} else {
BWGSectionList_addAtomic(§ions, seq, score, length(r_score), lm);
}
popRHandlers();
PROTECT(ans = R_MakeExternalPtr(sections, R_NilValue, R_NilValue));
R_SetExternalPtrTag(ans, R_MakeExternalPtr(lm, R_NilValue, R_NilValue));
UNPROTECT(1);
return ans;
}
SEXP BWGSectionList_add(SEXP r_sections, SEXP r_seq, SEXP r_ranges,
SEXP r_score, SEXP r_format)
{
struct bwgSection *sections = NULL;
const char *seq = CHAR(asChar(r_seq));
int *start = INTEGER(get_IRanges_start(r_ranges));
int *width = INTEGER(get_IRanges_width(r_ranges));
double *score = REAL(r_score);
const char *format = CHAR(asChar(r_format));
int num = get_IRanges_length(r_ranges);
int numLeft = num;
SEXP ans;
struct lm *lm;
enum bwgSectionType type = bwgTypeBedGraph;
if (sameString(format, "fixedStep"))
type = bwgTypeFixedStep;
else if (sameString(format, "variableStep"))
type = bwgTypeVariableStep;
if (r_sections != R_NilValue) {
sections = R_ExternalPtrAddr(r_sections);
lm = R_ExternalPtrAddr(R_ExternalPtrTag(r_sections));
} else lm = lmInit(0);
pushRHandlers();
while(numLeft) {
int numSection = numLeft > itemsPerSlot ? itemsPerSlot : numLeft;
numLeft -= numSection;
slAddHead(§ions,
createBWGSection(seq, start, width, score, numSection, type, lm));
start += numSection;
width += numSection;
score += numSection;
}
popRHandlers();
PROTECT(ans = R_MakeExternalPtr(sections, R_NilValue, R_NilValue));
R_SetExternalPtrTag(ans, R_MakeExternalPtr(lm, R_NilValue, R_NilValue));
UNPROTECT(1);
return ans;
}
SEXP R_RngStreams_SetData (SEXP R_obj, SEXP R_stream, SEXP R_stream_data, SEXP R_name)
/*----------------------------------------------------------------------*/
/* Create and initialize Stream generator object and */
/* set data structure of Stream object. */
/* */
/* parameters: */
/* obj ... (S4 class) ... rstream object */
/* R_stream ... (pointer) ... pointer the Stream object */
/* R_stream_data ... (double[20]) ... pointer the Stream object */
/* R_name ... (string) ... name of the Stream */
/* */
/* return: */
/* pointer to Stream object */
/*----------------------------------------------------------------------*/
{
RngStream newstream;
const char *name;
size_t len;
/* check argument */
if (!R_name || TYPEOF(R_name) != STRSXP)
error("bad string\n");
if (LENGTH(R_stream_data) != 20) {
error("invalid data for Stream object\n");
}
/* get name */
name = CHAR(STRING_ELT(R_name,0));
len = strlen(name);
/* allocate memory */
newstream = malloc(sizeof(struct RngStream_InfoState));
if (newstream == NULL) {
error("no more memory\n");
}
newstream->name = malloc(len+1);
if (newstream->name == NULL) {
free(newstream);
error("no more memory\n");
}
/* copy data */
PROTECT(R_stream_data = AS_NUMERIC(R_stream_data));
memcpy(newstream->Cg, NUMERIC_POINTER(R_stream_data) , 6*sizeof(double));
memcpy(newstream->Bg, NUMERIC_POINTER(R_stream_data)+ 6, 6*sizeof(double));
memcpy(newstream->Ig, NUMERIC_POINTER(R_stream_data)+12, 6*sizeof(double));
newstream->Anti = (int) NUMERIC_POINTER(R_stream_data)[18];
newstream->IncPrec = (int) NUMERIC_POINTER(R_stream_data)[19];
strncpy(newstream->name, name, len+1);
UNPROTECT(1);
/* store pointer to Stream generator in R external pointer */
R_SetExternalPtrAddr(R_stream, newstream);
/* ... and reset the protector just in case R_obj is different from the */
/* orignal protector of R_stream */
R_SetExternalPtrProtected(R_stream, R_obj);
/* update tag */
R_SetExternalPtrTag(R_stream, RngStreams_tag());
/* There is no need to return an object to R */
return R_NilValue;
} /* end of R_RngStreams_SetData() */