Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Update API header and standardize two signatures (closes #317) #337

Merged
merged 4 commits into from
Jul 22, 2020
Merged

Update API header and standardize two signatures (closes #317) #337

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
4d9ae73
update xtsMerge entry in xtsApi.h to signature in package
eddelbuettel Jul 19, 2020
0565635
correct do_merge_xts to be an all-SEXP interface
eddelbuettel Jul 19, 2020
1c7e9bd
update xtsMerge in xtsAPI.h to updated do_xts_merge interface
eddelbuettel Jul 19, 2020
6287228
change isXts to return SEXP and update interfaces
eddelbuettel Jul 19, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions inst/include/xts.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,7 @@ SEXP make_index_unique(SEXP x, SEXP eps);
SEXP make_unique(SEXP X, SEXP eps);
SEXP endpoints(SEXP _x, SEXP _on, SEXP _k, SEXP _addlast);
SEXP do_merge_xts(SEXP x, SEXP y, SEXP all, SEXP fill, SEXP retclass, SEXP colnames,
SEXP suffixes, SEXP retside, SEXP check_names, SEXP env, int coerce);
SEXP suffixes, SEXP retside, SEXP check_names, SEXP env, SEXP coerce);
SEXP na_omit_xts(SEXP x);
SEXP na_locf(SEXP x, SEXP fromlast, SEXP maxgap, SEXP limit);

Expand All @@ -95,7 +95,7 @@ void copyAttributes(SEXP x, SEXP y); // internal only
void copy_xtsAttributes(SEXP x, SEXP y); // internal only
void copy_xtsCoreAttributes(SEXP x, SEXP y);// internal only

int isXts(SEXP x); // is.xts analogue
SEXP isXts(SEXP x); // is.xts analogue
int firstNonNA(SEXP x);
SEXP extract_col (SEXP x, SEXP j, SEXP drop, SEXP first_, SEXP last_);
#endif /* _XTS */
Expand Down
15 changes: 8 additions & 7 deletions inst/include/xtsAPI.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,10 +41,10 @@ extern "C" {
fun = ( RETURNTYPE(*)(ARG1,ARG2)) R_GetCCallable("PACKAGENAME", "FUNCTIONNAME")

*/
int attribute_hidden xtsIs(SEXP x)
SEXP attribute_hidden xtsIs(SEXP x)
{
static int(*fun)(SEXP) = NULL;
if (fun == NULL) fun = (int(*)(SEXP)) R_GetCCallable("xts","isXts");
static SEXP(*fun)(SEXP) = NULL;
if (fun == NULL) fun = (SEXP(*)(SEXP)) R_GetCCallable("xts","isXts");
return fun(x);
}

Expand Down Expand Up @@ -105,11 +105,12 @@ SEXP attribute_hidden xtsEndpoints(SEXP x, SEXP on, SEXP k, SEXP addlast) {
}

SEXP attribute_hidden xtsMerge(SEXP x, SEXP y, SEXP all, SEXP fill, SEXP retclass,
SEXP colnames, SEXP suffixes, SEXP retside, SEXP env, int coerce) {
static SEXP(*fun)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,int) = NULL;
SEXP colnames, SEXP suffixes, SEXP retside, SEXP check_names,
SEXP env, SEXP coerce) {
static SEXP(*fun)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP) = NULL;
if (fun == NULL)
fun = (SEXP(*)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,int)) R_GetCCallable("xts","do_merge_xts");
return fun(x, y, all, fill, retclass, colnames, suffixes, retside, env, coerce);
fun = (SEXP(*)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP)) R_GetCCallable("xts","do_merge_xts");
return fun(x, y, all, fill, retclass, colnames, suffixes, retside, check_names, env, coerce);
}

SEXP attribute_hidden xtsNaOmit(SEXP x) {
Expand Down
2 changes: 1 addition & 1 deletion man/xtsAPI.Rd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ Callable from other R packages:
SEXP xtsLag(SEXP x, SEXP k, SEXP pad)

Internal use functions:
int isXts(SEXP x)
SEXP isXts(SEXP x)
void copy_xtsAttributes(SEXP x, SEXP y)
void copy_xtsCoreAttributes(SEXP x, SEXP y)

Expand Down
12 changes: 6 additions & 6 deletions src/isXts.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@
#include <Rdefines.h>
#include "xts.h"

int isXts(SEXP x)
SEXP isXts(SEXP x)
{
int i;
SEXP attr, index;
Expand All @@ -34,30 +34,30 @@ int isXts(SEXP x)
PROTECT( attr = coerceVector(getAttrib(x, R_ClassSymbol),STRSXP) );
if(length(attr) <= 1) {
UNPROTECT(1);
return 0;
return Rf_ScalarInteger(0);
}

for(i = 0; i < length(attr); i++) {
if(STRING_ELT(attr, i) == mkChar("xts")) {
/* check for index attribute */
if(TYPEOF(index)==REALSXP || TYPEOF(index)==INTSXP) {
UNPROTECT(1);
return 1;
return Rf_ScalarInteger(1);
} else {
UNPROTECT(1);
return 0;
return Rf_ScalarInteger(0);
}
}
}
UNPROTECT(1);
return FALSE;
return Rf_ScalarInteger(FALSE);

}

/* test function and example */
SEXP test_isXts(SEXP x)
{
if(isXts(x)) {
if(Rf_asInteger(isXts(x))) {
Rprintf("TRUE\n");
} else {
Rprintf("FALSE\n");
Expand Down
18 changes: 9 additions & 9 deletions src/merge.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ SEXP do_merge_xts (SEXP x, SEXP y,
SEXP retside,
SEXP check_names,
SEXP env,
int coerce)
SEXP coerce)
{
int nrx, ncx, nry, ncy, len;
int left_join, right_join;
Expand Down Expand Up @@ -102,7 +102,7 @@ SEXP do_merge_xts (SEXP x, SEXP y,
PROTECT( xindex = getAttrib(x, xts_IndexSymbol) ); p++;

/* convert to xts object if needed */
if( !isXts(y) ) {
if( !Rf_asInteger(isXts(y)) ) {
PROTECT(s = t = allocList(4)); p++;
SET_TYPEOF(s, LANGSXP);
SETCAR(t, install("try.xts")); t = CDR(t);
Expand All @@ -118,7 +118,7 @@ SEXP do_merge_xts (SEXP x, SEXP y,

mode = TYPEOF(x);

if( isXts(y) ) {
if( Rf_asInteger(isXts(y)) ) {
PROTECT( yindex = getAttrib(y, xts_IndexSymbol) ); p++;
} else {
PROTECT( yindex = getAttrib(x, xts_IndexSymbol) ); p++;
Expand Down Expand Up @@ -269,7 +269,7 @@ SEXP do_merge_xts (SEXP x, SEXP y,
either here or in the calling R code. I suspect here is
more useful if other function can call the C code as well.
If objects are not the same type, convert to REALSXP. */
if( coerce || TYPEOF(x) != TYPEOF(y) ) {
if( Rf_asInteger(coerce) || TYPEOF(x) != TYPEOF(y) ) {
PROTECT( x = coerceVector(x, REALSXP) ); p++;
PROTECT( y = coerceVector(y, REALSXP) ); p++;
}
Expand Down Expand Up @@ -1068,7 +1068,7 @@ SEXP mergeXts (SEXP args) // mergeXts {{{
args = CDR(args);

int leading_non_xts = 0;
while( !isXts(_x) ) {
while( !Rf_asInteger(isXts(_x)) ) {
if( args == R_NilValue ) error("no xts object to merge");
leading_non_xts = 1;
/*warning("leading non-xts objects may have been dropped");*/
Expand Down Expand Up @@ -1116,7 +1116,7 @@ SEXP mergeXts (SEXP args) // mergeXts {{{
rets,
check_names,
env,
coerce_to_double), &idx); P++;
Rf_ScalarInteger(coerce_to_double)), &idx); P++;

/* merge all objects into one zero-width common index */
while(args != R_NilValue) {
Expand All @@ -1131,7 +1131,7 @@ SEXP mergeXts (SEXP args) // mergeXts {{{
rets,
check_names,
env,
coerce_to_double), idx);
Rf_ScalarInteger(coerce_to_double)), idx);
}
args = CDR(args);
}
Expand Down Expand Up @@ -1169,7 +1169,7 @@ SEXP mergeXts (SEXP args) // mergeXts {{{
retside,
check_names,
env,
coerce_to_double), idxtmp);
Rf_ScalarInteger(coerce_to_double)), idxtmp);

nr = nrows(xtmp);
nc = (0 == nr) ? 0 : ncols(xtmp); // ncols(numeric(0)) == 1
Expand Down Expand Up @@ -1297,7 +1297,7 @@ SEXP mergeXts (SEXP args) // mergeXts {{{
retside,
check_names,
env,
coerce_to_double)); P++;
Rf_ScalarInteger(coerce_to_double))); P++;
}

SEXP index_tmp = getAttrib(result, xts_IndexSymbol);
Expand Down
2 changes: 1 addition & 1 deletion src/na.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -392,7 +392,7 @@ SEXP na_locf (SEXP x, SEXP fromLast, SEXP _maxgap, SEXP _limit)
error("unsupported type");
break;
}
if(isXts(x)) {
if(Rf_asInteger(isXts(x))) {
setAttrib(result, R_DimSymbol, getAttrib(x, R_DimSymbol));
setAttrib(result, R_DimNamesSymbol, getAttrib(x, R_DimNamesSymbol));
setAttrib(result, xts_IndexSymbol, getAttrib(x, xts_IndexSymbol));
Expand Down
4 changes: 2 additions & 2 deletions src/rbind.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,10 +57,10 @@ SEXP do_rbind_xts (SEXP x, SEXP y, SEXP dup)
return y;
}

if( !isXts(x) ) {
if( !Rf_asInteger(isXts(x)) ) {
PROTECT( x = tryXts(x) ); P++;
}
if( !isXts(y) ) {
if( !Rf_asInteger(isXts(y)) ) {
PROTECT( y = tryXts(y) ); P++;
}

Expand Down
4 changes: 2 additions & 2 deletions src/tryXts.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,14 +26,14 @@

SEXP tryXts (SEXP x)
{
if( !isXts(x) ) {
if( !Rf_asInteger(isXts(x)) ) {
SEXP s, t, result;
PROTECT(s = t = allocList(2));
SET_TYPEOF(s, LANGSXP);
SETCAR(t, install("try.xts")); t = CDR(t);
SETCAR(t, x); t=CDR(t);
PROTECT(result = eval(s, R_GlobalEnv));
if( !isXts(result) ) {
if( !Rf_asInteger(isXts(result)) ) {
UNPROTECT(2);
error("rbind.xts requires xtsible data");
}
Expand Down