Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ Authors@R: c(
person("Laurent", "Berge", role = "ctb"),
person("Kevin", "Tappe", role = "ctb"),
person("Alina", "Cherkas", role = "ctb"),
person("Ivan", "Krylov", role = "ctb"),
person("R Core Team and contributors worldwide", role = "ctb"),
person("Martyn", "Plummer", role = "cph"),
person("1999-2016 The R Core Team", role = "cph")
Expand Down
4 changes: 4 additions & 0 deletions src/collapse_c.h
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,10 @@
#undef ISNAN
#define ISNAN(x) ((x) != (x))

#ifndef ANY_ATTRIB
#define ANY_ATTRIB(x) (ATTTR(x) != R_NilValue)
#endif

// Initialized in data.table_init.c
extern int max_threads;
extern SEXP sym_label;
Expand Down
4 changes: 2 additions & 2 deletions src/ffirst.c
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ SEXP ffirst_impl(SEXP x, int ng, SEXP g, int narm, int *gl) {
default: error("Unsupported SEXP type!");
}
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out);
if(!isNull(getAttrib(x, R_NamesSymbol)))
namesgets(out, ScalarString(STRING_ELT(getAttrib(x, R_NamesSymbol), j)));
Expand Down Expand Up @@ -171,7 +171,7 @@ SEXP ffirst_impl(SEXP x, int ng, SEXP g, int narm, int *gl) {
default: error("Unsupported SEXP type!");
}
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out); // SHALLOW_DUPLICATE_ATTRIB(out, x);
UNPROTECT(1);
return out;
Expand Down
4 changes: 2 additions & 2 deletions src/flast.c
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@ SEXP flast_impl(SEXP x, int ng, SEXP g, int narm, int *gl) {
default: error("Unsupported SEXP type!");
}
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out);
if(!isNull(getAttrib(x, R_NamesSymbol)))
namesgets(out, ScalarString(STRING_ELT(getAttrib(x, R_NamesSymbol), j)));
Expand Down Expand Up @@ -152,7 +152,7 @@ SEXP flast_impl(SEXP x, int ng, SEXP g, int narm, int *gl) {
default: error("Unsupported SEXP type!");
}
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out);
UNPROTECT(1);
return out;
Expand Down
12 changes: 6 additions & 6 deletions src/fmean.c
Original file line number Diff line number Diff line change
Expand Up @@ -274,7 +274,7 @@ SEXP fmeanC(SEXP x, SEXP Rng, SEXP g, SEXP gs, SEXP w, SEXP Rnarm, SEXP Rnthread
fmean_weights_omp_impl(px, pw, narm, l, nthreads);
} else fmean_weights_g_impl(REAL(out), px, ng, INTEGER(g), pw, narm, l);
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out); // For example "Units" objects...
UNPROTECT(nprotect);
return out;
Expand Down Expand Up @@ -444,7 +444,7 @@ SEXP fmean_g_impl(SEXP x, const int ng, const int *pg, const int *pgs, int narm)
default: error("Unsupported SEXP type: '%s'", type2char(TYPEOF(x)));
}

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(1);
return res;
}
Expand Down Expand Up @@ -475,7 +475,7 @@ SEXP fmean_wg_impl(SEXP x, const int ng, const int *pg, double *pw, int narm) {
SEXP res = PROTECT(allocVector(REALSXP, ng));
fmean_weights_g_impl(REAL(res), REAL(x), ng, pg, pw, narm, l);

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(nprotect);
return res;
}
Expand Down Expand Up @@ -536,7 +536,7 @@ SEXP fmeanlC(SEXP x, SEXP Rng, SEXP g, SEXP gs, SEXP w, SEXP Rnarm, SEXP Rdrop,
// Needed because including it in an OpenMP loop together with ScalarReal() is not thread safe
for(int j = 0; j < l; ++j) {
SEXP xj = px[j];
if(ATTRIB(xj) != R_NilValue && !(isObject(xj) && inherits(xj, "ts")))
if(ANY_ATTRIB(xj) && !(isObject(xj) && inherits(xj, "ts")))
copyMostAttrib(xj, pout[j]);
}
} else {
Expand All @@ -560,7 +560,7 @@ SEXP fmeanlC(SEXP x, SEXP Rng, SEXP g, SEXP gs, SEXP w, SEXP Rnarm, SEXP Rdrop,
for(int j = 0; j != l; ++j) {
SEXP xj = px[j], outj;
SET_VECTOR_ELT(out, j, outj = allocVector(REALSXP, ng));
if(ATTRIB(xj) != R_NilValue && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
if(ANY_ATTRIB(xj) && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
}
#pragma omp parallel for num_threads(nthreads)
for(int j = 0; j < l; ++j) fmean_g_omp_impl(px[j], DPTR(pout[j]), ng, pg, pgs, narm);
Expand All @@ -574,7 +574,7 @@ SEXP fmeanlC(SEXP x, SEXP Rng, SEXP g, SEXP gs, SEXP w, SEXP Rnarm, SEXP Rdrop,
for(int j = 0, dup = 0; j != l; ++j) {
SEXP xj = px[j], outj;
SET_VECTOR_ELT(out, j, outj = allocVector(REALSXP, ng));
if(ATTRIB(xj) != R_NilValue && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
if(ANY_ATTRIB(xj) && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
if(TYPEOF(xj) != REALSXP) {
if(TYPEOF(xj) != INTSXP && TYPEOF(xj) != LGLSXP) error("Unsupported SEXP type: '%s'", type2char(TYPEOF(xj)));
if(dup == 0) {x = PROTECT(shallow_duplicate(x)); ++nprotect; dup = 1;}
Expand Down
4 changes: 2 additions & 2 deletions src/fmin_fmax.c
Original file line number Diff line number Diff line change
Expand Up @@ -160,7 +160,7 @@ SEXP fminC(SEXP x, SEXP Rng, SEXP g, SEXP Rnarm) {
break;
default: error("Unsupported SEXP type");
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out);
UNPROTECT(1);
return out;
Expand Down Expand Up @@ -234,7 +234,7 @@ SEXP fmaxC(SEXP x, SEXP Rng, SEXP g, SEXP Rnarm) {
break;
default: error("Unsupported SEXP type");
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out);
UNPROTECT(1);
return out;
Expand Down
18 changes: 9 additions & 9 deletions src/fnth_fmedian_fquantile.c
Original file line number Diff line number Diff line change
Expand Up @@ -819,7 +819,7 @@ SEXP nth_impl_plain(SEXP x, int narm, int ret, double Q) {

SEXP nth_impl(SEXP x, int narm, int ret, double Q) {
if(length(x) <= 1) return x;
if(ATTRIB(x) == R_NilValue || (isObject(x) && inherits(x, "ts")))
if(!ANY_ATTRIB(x) || (isObject(x) && inherits(x, "ts")))
return nth_impl_plain(x, narm, ret, Q);
SEXP res = PROTECT(nth_impl_plain(x, narm, ret, Q));
copyMostAttrib(x, res);
Expand Down Expand Up @@ -878,7 +878,7 @@ SEXP nth_ord_impl(SEXP x, int *pxo, int narm, int ret, double Q) {
default: error("Not Supported SEXP Type: '%s'", type2char(TYPEOF(x)));
}

if(ATTRIB(x) == R_NilValue || (isObject(x) && inherits(x, "ts"))) return res;
if(!ANY_ATTRIB(x) || (isObject(x) && inherits(x, "ts"))) return res;
PROTECT(res); // Needed ??
copyMostAttrib(x, res);
UNPROTECT(1);
Expand All @@ -901,7 +901,7 @@ SEXP w_nth_ord_impl_plain(SEXP x, int *pxo, double *pw, int narm, int ret, doubl
// Expects pointer pw to be decremented by 1
SEXP w_nth_ord_impl(SEXP x, int *pxo, double *pw, int narm, int ret, double Q, double h) {
if(length(x) <= 1) return x;
if(ATTRIB(x) == R_NilValue || (isObject(x) && inherits(x, "ts")))
if(!ANY_ATTRIB(x) || (isObject(x) && inherits(x, "ts")))
return w_nth_ord_impl_plain(x, pxo, pw, narm, ret, Q, h);
SEXP res = PROTECT(w_nth_ord_impl_plain(x, pxo, pw, narm, ret, Q, h));
copyMostAttrib(x, res);
Expand Down Expand Up @@ -970,7 +970,7 @@ SEXP nth_g_impl(SEXP x, int ng, int *pgs, int *po, int *pst, int sorted, int nar
}
}

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(1);
return res;
}
Expand Down Expand Up @@ -1013,7 +1013,7 @@ SEXP nth_g_impl_noalloc(SEXP x, int ng, int *pgs, int *po, int *pst, int sorted,
}
}

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(1);
return res;
}
Expand Down Expand Up @@ -1045,7 +1045,7 @@ SEXP nth_g_ord_impl(SEXP x, int ng, int *pgs, int *po, int *pst, int narm, int r
default: error("Not Supported SEXP Type: '%s'", type2char(TYPEOF(x)));
}

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(1);
return res;
}
Expand Down Expand Up @@ -1077,7 +1077,7 @@ SEXP w_nth_g_ord_impl(SEXP x, double *pw, int ng, int *pgs, int *po, int *pst, i
default: error("Not Supported SEXP Type: '%s'", type2char(TYPEOF(x)));
}

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(1);
return res;
}
Expand Down Expand Up @@ -1130,7 +1130,7 @@ SEXP w_nth_g_qsort_impl(SEXP x, double *pw, int ng, int *pgs, int *po, int *pst,
}
}

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(1);
return res;
}
Expand Down Expand Up @@ -1397,7 +1397,7 @@ SEXP fnthlC(SEXP x, SEXP p, SEXP g, SEXP w, SEXP Rnarm, SEXP Rdrop, SEXP Rret, S
// Needed because including it in an OpenMP loop together with ScalarReal() is not thread safe
for(int j = 0; j != l; ++j) {
SEXP xj = px[j];
if(ATTRIB(xj) != R_NilValue && !(isObject(xj) && inherits(xj, "ts")))
if(ANY_ATTRIB(xj) && !(isObject(xj) && inherits(xj, "ts")))
copyMostAttrib(xj, pout[j]);
}

Expand Down
2 changes: 1 addition & 1 deletion src/fprod.c
Original file line number Diff line number Diff line change
Expand Up @@ -155,7 +155,7 @@ SEXP fprodC(SEXP x, SEXP Rng, SEXP g, SEXP w, SEXP Rnarm) {
} else px = REAL(x);
fprod_weights_impl(REAL(out), px, ng, INTEGER(g), pw, narm, l);
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out); // For example "Units" objects...
UNPROTECT(nprotect);
return out;
Expand Down
16 changes: 8 additions & 8 deletions src/fsum.c
Original file line number Diff line number Diff line change
Expand Up @@ -354,7 +354,7 @@ SEXP fsumC(SEXP x, SEXP Rng, SEXP g, SEXP w, SEXP Rnarm, SEXP fill, SEXP Rnthrea
fsum_weights_omp_impl(px, pw, narm, l, nthreads);
} else fsum_weights_g_impl(REAL(out), px, ng, INTEGER(g), pw, narm, l);
}
if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts")))
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts")))
copyMostAttrib(x, out); // For example "Units" objects...
UNPROTECT(nprotect);
return out;
Expand Down Expand Up @@ -502,7 +502,7 @@ SEXP fsum_impl_SEXP(SEXP x, int narm, int nthreads) {
return ScalarReal(fsum_impl_dbl(x, narm, nthreads));
// This is not thread safe... need to do separate serial loop
// SEXP res = ScalarReal(fsum_impl_dbl(x, narm, nthreads));
// if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) {
// if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) {
// PROTECT(res);
// copyMostAttrib(x, res);
// UNPROTECT(1);
Expand All @@ -529,7 +529,7 @@ SEXP fsum_w_impl_SEXP(SEXP x, double *pw, int narm, int nthreads) {
return ScalarReal(fsum_w_impl_dbl(x, pw, narm, nthreads));
// This is not thread safe... need to do separate serial loop
// SEXP res = ScalarReal(fsum_w_impl_dbl(x, pw, narm, nthreads));
// if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) {
// if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) {
// PROTECT(res);
// copyMostAttrib(x, res);
// UNPROTECT(1);
Expand Down Expand Up @@ -557,7 +557,7 @@ SEXP fsum_g_impl(SEXP x, const int ng, const int *pg, int narm) {
default: error("Unsupported SEXP type: '%s'", type2char(TYPEOF(x)));
}

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(1);
return res;
}
Expand Down Expand Up @@ -587,7 +587,7 @@ SEXP fsum_wg_impl(SEXP x, const int ng, const int *pg, double *pw, int narm) {
SEXP res = PROTECT(allocVector(REALSXP, ng));
fsum_weights_g_impl(REAL(res), REAL(x), ng, pg, pw, narm, l);

if(ATTRIB(x) != R_NilValue && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
if(ANY_ATTRIB(x) && !(isObject(x) && inherits(x, "ts"))) copyMostAttrib(x, res);
UNPROTECT(nprotect);
return res;
}
Expand Down Expand Up @@ -650,7 +650,7 @@ SEXP fsumlC(SEXP x, SEXP Rng, SEXP g, SEXP w, SEXP Rnarm, SEXP fill, SEXP Rdrop,
// Needed because including it in an OpenMP loop together with ScalarReal() is not thread safe
for(int j = 0; j < l; ++j) {
SEXP xj = px[j];
if(ATTRIB(xj) != R_NilValue && !(isObject(xj) && inherits(xj, "ts")))
if(ANY_ATTRIB(xj) && !(isObject(xj) && inherits(xj, "ts")))
copyMostAttrib(xj, pout[j]);
}
} else {
Expand All @@ -663,7 +663,7 @@ SEXP fsumlC(SEXP x, SEXP Rng, SEXP g, SEXP w, SEXP Rnarm, SEXP fill, SEXP Rdrop,
for(int j = 0; j != l; ++j) {
SEXP xj = px[j], outj;
SET_VECTOR_ELT(out, j, outj = allocVector(TYPEOF(px[j]) == REALSXP ? REALSXP : INTSXP, ng));
if(ATTRIB(xj) != R_NilValue && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
if(ANY_ATTRIB(xj) && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
}
#pragma omp parallel for num_threads(nthreads)
for(int j = 0; j < l; ++j) fsum_g_omp_impl(px[j], DPTR(pout[j]), ng, pg, narm);
Expand All @@ -677,7 +677,7 @@ SEXP fsumlC(SEXP x, SEXP Rng, SEXP g, SEXP w, SEXP Rnarm, SEXP fill, SEXP Rdrop,
for(int j = 0, dup = 0; j != l; ++j) {
SEXP xj = px[j], outj;
SET_VECTOR_ELT(out, j, outj = allocVector(REALSXP, ng));
if(ATTRIB(xj) != R_NilValue && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
if(ANY_ATTRIB(xj) && !(isObject(xj) && inherits(xj, "ts"))) copyMostAttrib(xj, outj);
if(TYPEOF(xj) != REALSXP) {
if(TYPEOF(xj) != INTSXP && TYPEOF(xj) != LGLSXP) error("Unsupported SEXP type: '%s'", type2char(TYPEOF(xj)));
if(dup == 0) {x = PROTECT(shallow_duplicate(x)); ++nprotect; dup = 1;}
Expand Down
Loading