Skip to content

Commit

Permalink
fix shift neg n for double type, closes #3335, also removes DATAPTR #…
Browse files Browse the repository at this point in the history 
…3301
  • Loading branch information
@jangorecki
jangorecki committed Feb 4, 2019
1 parent b351963 commit cc88c87
Show file tree
Hide file tree
Showing 2 changed files with 45 additions and 57 deletions.
8 changes: 8 additions & 0 deletions inst/tests/tests.Rraw
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12943,6 +12943,14 @@ test(1963.7, shift(DT, -1:1),
c(NA, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L),
c(9L, 8L, 7L, 6L, 5L, 4L, 3L, 2L, 1L, NA), 10:1,
c(NA, 10L, 9L, 8L, 7L, 6L, 5L, 4L, 3L, 2L)))
# more detailed tests for negative shift due to #3335
DT = data.table(a=1:5, b=as.double(1:5), c=c(TRUE,FALSE,FALSE,TRUE,TRUE), d=letters[1:5], e=as.list(1:5), f=factor(letters[1:5]))
if (test_bit64) DT[, "g" := as.integer64(1:5)]
for (i in seq_along(DT)) test(1963.80+i/1000, shift(DT, 1L, type="lag"), shift(DT, -1L, type="lead"))
for (i in seq_along(DT)) test(1963.90+i/1000, shift(DT, 3L, type="lag"), shift(DT, -3L, type="lead"))
for (i in seq_along(DT)) test(1963.10+i/1000, shift(DT, -1L, type="lag"), shift(DT, 1L, type="lead"))
for (i in seq_along(DT)) test(1963.11+i/1000, shift(DT, -3L, type="lag"), shift(DT, 3L, type="lead"))

## some coverage tests for good measure
test(1963.8, shift(DT$x, type = 'some_other_type'), error='should be one of.*lag.*lead')
test(1963.9, shift(c(1+3i, 2-1i)), error = 'Unsupported type')
Expand Down
94 changes: 37 additions & 57 deletions src/shift.c
View file
Original file line number Diff line number Diff line change
@@ -1,15 +1,15 @@
#include "data.table.h"
#include <Rdefines.h>
#include <time.h>

SEXP shift(SEXP obj, SEXP k, SEXP fill, SEXP type) {

size_t size;
R_len_t i=0, j, m, nx, nk, xrows, thisk, protecti=0;
R_len_t i=0, j, nx, nk, thisk, protecti=0;
R_xlen_t m, xrows;
SEXP x, tmp=R_NilValue, elem, ans, thisfill, klass;
unsigned long long *dthisfill;
enum {LAG, LEAD/*, SHIFT, CYCLIC*/} stype = LAG; // currently SHIFT maps to LAG and CYCLIC is unimplemented (see comments in #1708)
if (!length(obj)) return(obj); // NULL, list()
if (!xlength(obj)) return(obj); // NULL, list()
if (isVectorAtomic(obj)) {
x = PROTECT(allocVector(VECSXP, 1)); protecti++;
SET_VECTOR_ELT(x, 0, obj);
Expand All @@ -35,34 +35,29 @@ SEXP shift(SEXP obj, SEXP k, SEXP fill, SEXP type) {
for (i=0; i<nx; i++) {
elem = VECTOR_ELT(x, i);
size = SIZEOF(elem);
xrows = length(elem);
xrows = xlength(elem);
switch (TYPEOF(elem)) {
case INTSXP :
thisfill = PROTECT(coerceVector(fill, INTSXP)); protecti++;
int ifill = INTEGER(thisfill)[0];
for (j=0; j<nk; j++) {
thisk = (INTEGER(k)[j] >= 0) ? INTEGER(k)[j] : -INTEGER(k)[j];
thisk = (xrows >= thisk) ? thisk : xrows;
SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(INTSXP, xrows) );
// LAG when type = 'lag' and n >= 0 _or_ type = 'lead' and n < 0
int *itmp = INTEGER(tmp);
size_t shiftsize = thisk*size;
size_t mvsize = (xrows-thisk)*size;
if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) {
if (xrows - thisk > 0)
memmove((char *)DATAPTR(tmp)+(thisk*size),
(char *)DATAPTR(elem),
(xrows-thisk)*size);
for (m=0; m<thisk; m++)
INTEGER(tmp)[m] = INTEGER(thisfill)[0];
// only two possibilities left: type = 'lead', n>=0 _or_ type = 'lag', n<0
// LAG when type = 'lag' and n >= 0 _or_ type = 'lead' and n < 0
if (xrows - thisk > 0) memmove((char *)itmp+shiftsize, (char *)INTEGER(elem), mvsize);
for (m=0; m<thisk; m++) itmp[m] = ifill;
} else {
if (xrows - thisk > 0)
memmove((char *)DATAPTR(tmp),
(char *)DATAPTR(elem)+(thisk*size),
(xrows-thisk)*size);
for (m=xrows-thisk; m<xrows; m++)
INTEGER(tmp)[m] = INTEGER(thisfill)[0];
// only two possibilities left: type = 'lead', n>=0 _or_ type = 'lag', n<0
if (xrows - thisk > 0) memmove((char *)itmp, (char *)INTEGER(elem)+shiftsize, mvsize);
for (m=xrows-thisk; m<xrows; m++) itmp[m] = ifill;
}
copyMostAttrib(elem, tmp);
if (isFactor(elem))
setAttrib(tmp, R_LevelsSymbol, getAttrib(elem, R_LevelsSymbol));
if (isFactor(elem)) setAttrib(tmp, R_LevelsSymbol, getAttrib(elem, R_LevelsSymbol));
}
break;

Expand All @@ -77,51 +72,41 @@ SEXP shift(SEXP obj, SEXP k, SEXP fill, SEXP type) {
} else {
thisfill = PROTECT(coerceVector(fill, REALSXP)); protecti++;
}
double dfill = REAL(thisfill)[0];
for (j=0; j<nk; j++) {
thisk = (INTEGER(k)[j] >= 0) ? INTEGER(k)[j] : -INTEGER(k)[j];
thisk = (xrows >= INTEGER(k)[j]) ? INTEGER(k)[j] : xrows;
thisk = (xrows >= thisk) ? thisk : xrows;
SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(REALSXP, xrows) );
double *dtmp = REAL(tmp);
size_t shiftsize = thisk*size;
size_t mvsize = (xrows-thisk)*size;
if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) {
if (xrows - thisk > 0) {
memmove((char *)DATAPTR(tmp)+(thisk*size),
(char *)DATAPTR(elem),
(xrows-thisk)*size);
}
for (m=0; m<thisk; m++) {
REAL(tmp)[m] = REAL(thisfill)[0];
}
if (xrows - thisk > 0) memmove((char *)dtmp+shiftsize, (char *)REAL(elem), mvsize);
for (m=0; m<thisk; m++) dtmp[m] = dfill;
} else {
if (xrows - thisk > 0)
memmove((char *)DATAPTR(tmp),
(char *)DATAPTR(elem)+(thisk*size),
(xrows-thisk)*size);
for (m=xrows-thisk; m<xrows; m++)
REAL(tmp)[m] = REAL(thisfill)[0];
if (xrows - thisk > 0) memmove((char *)dtmp, (char *)REAL(elem)+shiftsize, mvsize);
for (m=xrows-thisk; m<xrows; m++) dtmp[m] = dfill;
}
copyMostAttrib(elem, tmp);
}
break;

case LGLSXP :
thisfill = PROTECT(coerceVector(fill, LGLSXP)); protecti++;
int lfill = LOGICAL(thisfill)[0];
for (j=0; j<nk; j++) {
thisk = (INTEGER(k)[j] >= 0) ? INTEGER(k)[j] : -INTEGER(k)[j];
thisk = (xrows >= thisk) ? thisk : xrows;
SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(LGLSXP, xrows) );
int *ltmp = LOGICAL(tmp);
size_t shiftsize = thisk*size;
size_t mvsize = (xrows-thisk)*size;
if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) {
if (xrows - thisk > 0)
memmove((char *)DATAPTR(tmp)+(thisk*size),
(char *)DATAPTR(elem),
(xrows-thisk)*size);
for (m=0; m<thisk; m++)
LOGICAL(tmp)[m] = LOGICAL(thisfill)[0];
if (xrows - thisk > 0) memmove((char *)ltmp+shiftsize, (char *)LOGICAL(elem), mvsize);
for (m=0; m<thisk; m++) ltmp[m] = lfill;
} else {
if (xrows - thisk > 0)
memmove((char *)DATAPTR(tmp),
(char *)DATAPTR(elem)+(thisk*size),
(xrows-thisk)*size);
for (m=xrows-thisk; m<xrows; m++)
LOGICAL(tmp)[m] = LOGICAL(thisfill)[0];
if (xrows - thisk > 0) memmove((char *)ltmp, (char *)LOGICAL(elem)+shiftsize, mvsize);
for (m=xrows-thisk; m<xrows; m++) ltmp[m] = lfill;
}
copyMostAttrib(elem, tmp);
}
Expand All @@ -130,31 +115,26 @@ SEXP shift(SEXP obj, SEXP k, SEXP fill, SEXP type) {
case STRSXP :
thisfill = PROTECT(coerceVector(fill, STRSXP)); protecti++;
for (j=0; j<nk; j++) {
SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(STRSXP, xrows) );
thisk = (INTEGER(k)[j] >= 0) ? INTEGER(k)[j] : -INTEGER(k)[j];
SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(STRSXP, xrows) );
if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) {
for (m=0; m<xrows; m++)
SET_STRING_ELT(tmp, m, (m < thisk) ? STRING_ELT(thisfill, 0) : STRING_ELT(elem, m - thisk));
for (m=0; m<xrows; m++) SET_STRING_ELT(tmp, m, (m < thisk) ? STRING_ELT(thisfill, 0) : STRING_ELT(elem, m - thisk));
} else {
for (m=0; m<xrows; m++)
SET_STRING_ELT(tmp, m, (xrows-m <= thisk) ? STRING_ELT(thisfill, 0) : STRING_ELT(elem, m + thisk));
for (m=0; m<xrows; m++) SET_STRING_ELT(tmp, m, (xrows-m <= thisk) ? STRING_ELT(thisfill, 0) : STRING_ELT(elem, m + thisk));
}
copyMostAttrib(elem, tmp);
}
break;


case VECSXP :
thisfill = PROTECT(coerceVector(fill, VECSXP)); protecti++;
for (j=0; j<nk; j++) {
SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(VECSXP, xrows) );
thisk = (INTEGER(k)[j] >= 0) ? INTEGER(k)[j] : -INTEGER(k)[j];
if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) {
for (m=0; m<xrows; m++)
SET_VECTOR_ELT(tmp, m, (m < thisk) ? VECTOR_ELT(thisfill, 0) : VECTOR_ELT(elem, m - thisk));
for (m=0; m<xrows; m++) SET_VECTOR_ELT(tmp, m, (m < thisk) ? VECTOR_ELT(thisfill, 0) : VECTOR_ELT(elem, m - thisk));
} else {
for (m=0; m<xrows; m++)
SET_VECTOR_ELT(tmp, m, (xrows-m <= thisk) ? VECTOR_ELT(thisfill, 0) : VECTOR_ELT(elem, m + thisk));
for (m=0; m<xrows; m++) SET_VECTOR_ELT(tmp, m, (xrows-m <= thisk) ? VECTOR_ELT(thisfill, 0) : VECTOR_ELT(elem, m + thisk));
}
copyMostAttrib(elem, tmp);
}
Expand Down

0 comments on commit cc88c87

Please sign in to comment.