Skip to content

Commit

Permalink
gsum, gmean, gfirst, glast, g[ for complex vectors (#3692)
Browse files Browse the repository at this point in the history
  • Loading branch information
@MichaelChirico @mattdowle
MichaelChirico authored and mattdowle committed Jul 17, 2019
1 parent 99d8fb1 commit b4057af
Show file tree
Hide file tree
Showing 3 changed files with 214 additions and 46 deletions.
38 changes: 27 additions & 11 deletions inst/tests/tests.Rraw
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13602,7 +13602,6 @@ test(1967.78, x[1:5, sum(v), by = list(i5 = 1:5 %% 2L), verbose = TRUE],

# gforce integer overflow coerce to double
DT = data.table(A=1:5, B=-3i, C=2147483647L)
test(1968.1, DT[, sum(B), by=A%%2L], error="Type 'complex' not supported by GForce sum (gsum). Either add the")
test(1968.2, storage.mode(DT$C), "integer")
test(1968.3, DT[, sum(C), by=A%%2L], data.table(A=c(1L,0L), V1=c(6442450941, 4294967294)),
warning="sum.*integer column.*more than type 'integer' can hold.*coerced to 'numeric'")
Expand Down Expand Up @@ -14257,16 +14256,16 @@ if (test_bit64) {
DT = data.table(id=c(rep(1L,3), rep(2L, 3)), v=bit64::as.integer64(c(1:3, 4L, 5:6)))
test(2019, DT[2:6, sum(v), id], data.table(id=1:2, V1=bit64::as.integer64(c(5L,15L)))) # gather, case of int64 and irows
}
DT = data.table(id = c(1L,1L,2L), v = c(1i, 2i, 3i))
test(2020.01, DT[, min(v), by=id], error="'complex' not supported by GForce min")
test(2020.02, DT[, max(v), by=id], error="'complex' not supported by GForce max")
test(2020.03, DT[, median(v), by=id], error="'complex' not supported by GForce median")
test(2020.04, DT[, head(v, 1), by=id], error="'complex' not supported by GForce head")
test(2020.05, DT[, tail(v, 1), by=id], error="'complex' not supported by GForce tail")
test(2020.06, DT[, v[1], by=id], error="'complex' not supported by GForce subset")
test(2020.07, DT[, sd(v), by=id], error="'complex' not supported by GForce sd")
test(2020.08, DT[, var(v), by=id], error="'complex' not supported by GForce var")
test(2020.09, DT[, prod(v), by=id], error="'complex' not supported by GForce prod")
DT = data.table(id = c(1L,1L,2L), v = as.raw(0:2))
test(2020.01, DT[, min(v), by=id], error="'raw' not supported by GForce min")
test(2020.02, DT[, max(v), by=id], error="'raw' not supported by GForce max")
test(2020.03, DT[, median(v), by=id], error="'raw' not supported by GForce median")
test(2020.04, DT[, head(v, 1), by=id], error="'raw' not supported by GForce head")
test(2020.05, DT[, tail(v, 1), by=id], error="'raw' not supported by GForce tail")
test(2020.06, DT[, v[1], by=id], error="'raw' not supported by GForce subset")
test(2020.07, DT[, sd(v), by=id], error="'raw' not supported by GForce sd")
test(2020.08, DT[, var(v), by=id], error="'raw' not supported by GForce var")
test(2020.09, DT[, prod(v), by=id], error="'raw' not supported by GForce prod")
DT = data.table(id = c(1L,1L,2L,2L), v = c(1L, 2L, NA, NA))
test(2020.10, DT[, median(v), id], data.table(id=1:2, V1=c(1.5, NA))) # median whole group has NAs

Expand Down Expand Up @@ -15298,6 +15297,23 @@ test(2065.6, DT[ , z_sum := base::sum(z), by = .(a, b)][1:3, z_sum],
c(1.8791864549242+0i, 3.17903639358309+0i, -4.18868631527035+0i))
test(2065.7, DT[1L, z_sum := 1i][1L, z_sum], 1i)

# GForce for complex columns, part of #3690
DT = data.table(id=c(1L,1L,2L), v=c(1i, 2i, 3i))
test(2066.01, DT[, min(v), by=id], error="'complex' has no well-defined min")
test(2066.02, DT[, max(v), by=id], error="'complex' has no well-defined max")
test(2066.03, DT[, head(v, 1), by=id], data.table(id=1:2, V1=c(1, 3)*1i))
test(2066.04, DT[, tail(v, 1), by=id], data.table(id=1:2, V1=(2:3)*1i))
test(2066.05, DT[, v[2], by=id], data.table(id = 1:2, V1=c(2i, NA)))
## former test 1968.1
DT = data.table(A=1:5, B=-3i, C=2147483647L)
test(2066.06, DT[, .(sum(B), mean(B)), by=A%%2L], data.table(A=1:0, V1=c(-9i, -6i), V2=-3i))
test(2066.07, DT[2:4, .(sum(B), mean(B)), by=A%%2L], data.table(A=0:1, V1=c(-6i, -3i), V2=-3i))
DT[4, B:=NA]
test(2066.08, DT[, .(sum(B), mean(B)), by=A%%2L], data.table(A=1:0, V1=c(-9i, NA), V2=c(-3i, NA)))
test(2066.09, DT[2:4, .(sum(B), mean(B)), by=A%%2L], data.table(A=0:1, V1=c(NA, -3i), V2=c(NA, -3i)))
test(2066.10, DT[, .(sum(B, na.rm=TRUE), mean(B, na.rm=TRUE)), by=A%%2L], data.table(A=1:0, V1=c(-9i, -3i), V2=-3i))
test(2066.11, DT[2:4, .(sum(B, na.rm=TRUE), mean(B, na.rm=TRUE)), by=A%%2L], data.table(A=0:1, V1=c(-3i, -3i), V2=-3i))


###################################
# Add new tests above this line #
Expand Down
11 changes: 7 additions & 4 deletions src/coalesce.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ SEXP coalesce(SEXP x, SEXP inplaceArg) {
error("Internal error in coalesce.c: argument 'inplaceArg' must be TRUE or FALSE"); // # nocov
const bool inplace = LOGICAL(inplaceArg)[0];
const bool verbose = GetVerbose();
int nprotect = 0;
if (length(x)==0) return R_NilValue;
SEXP first; // the first vector (it might be the first argument, or it might be the first column of a data.table|frame
int off = 1; // when x has been pointed to the list of replacement candidates, is the first candidate in position 0 or 1 in the list
Expand All @@ -29,21 +30,23 @@ SEXP coalesce(SEXP x, SEXP inplaceArg) {
if (factor) {
if (!isFactor(item))
error("Item 1 is a factor but item %d is not a factor. When factors are involved, all items must be factor.", i+2);
if (!R_compute_identical(getAttrib(first, R_LevelsSymbol), getAttrib(item, R_LevelsSymbol), 0))
if (!R_compute_identical(PROTECT(getAttrib(first, R_LevelsSymbol)), PROTECT(getAttrib(item, R_LevelsSymbol)), 0))
error("Item %d is a factor but its levels are not identical to the first item's levels.", i+2);
UNPROTECT(2);
} else {
if (isFactor(item))
error("Item %d is a factor but item 1 is not a factor. When factors are involved, all items must be factor.", i+2);
}
if (TYPEOF(first) != TYPEOF(item))
error("Item %d is type %s but the first item is type %s. Please coerce before coalescing.", i+2, type2char(TYPEOF(item)), type2char(TYPEOF(first)));
if (!R_compute_identical(getAttrib(first, R_ClassSymbol), getAttrib(item, R_ClassSymbol), 0))
if (!R_compute_identical(PROTECT(getAttrib(first, R_ClassSymbol)), PROTECT(getAttrib(item, R_ClassSymbol)), 0))
error("Item %d has a different class than item 1.", i+2);
UNPROTECT(2);
if (length(item)!=1 && length(item)!=nrow)
error("Item %d is length %d but the first item is length %d. Only singletons are recycled.", i+2, length(item), nrow);
}
if (!inplace) {
first = PROTECT(duplicate(first));
first = PROTECT(duplicate(first)); nprotect++;
if (verbose) Rprintf("coalesce copied first item (inplace=FALSE)\n");
}
void **valP = (void **)R_alloc(nval, sizeof(void *));
Expand Down Expand Up @@ -140,7 +143,7 @@ SEXP coalesce(SEXP x, SEXP inplaceArg) {
default:
error("Unsupported type: %s", type2char(TYPEOF(first))); // e.g. raw is tested
}
if (!inplace) UNPROTECT(1);
UNPROTECT(nprotect);
return first;
}

Loading

0 comments on commit b4057af

Please sign in to comment.