From 49c220a63143dc313559176718e053b4d87707fa Mon Sep 17 00:00:00 2001 From: SebKrantz Date: Wed, 3 Dec 2025 20:57:58 -0500 Subject: [PATCH] Fixes #803. --- NEWS.md | 2 ++ src/pivot.c | 8 +++---- tests/testthat/test-miscellaneous-issues.R | 25 ++++++++++++++++++++++ 3 files changed, 31 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index d2ae99b9..ba93b3f8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # collapse 2.1.5.9000 +* Fixed bug in `pivot(..., how = "wider", FUN = "sum")` (using internal sum function) when columns to aggregate were integer typed. Thanks @ummel (#803). + * Faster installation from source thanks to the `#include ` option in *Rcpp* which loads only part of the header files. Thanks @eddelbuettel for the hint. # collapse 2.1.5 diff --git a/src/pivot.c b/src/pivot.c index 591c4a59..d3510b5f 100644 --- a/src/pivot.c +++ b/src/pivot.c @@ -184,14 +184,14 @@ switch(aggfun) { #define AGGFUN_SWITCH_NUM(tdef, TYPEACC, NONMISSCHECK, ISMISS) \ switch(aggfun) { \ case 4: { /* sum: no multithreading because possible race condition */ \ - for(int i = 0; i != l; ++i) if(NONMISSCHECK) TYPEACC(pout[pid[i]])[pix[i]-1] += pc[i]; \ + for(int i = 0; i != l; ++i) if(NONMISSCHECK) DBL_DATAPTR(pout[pid[i]])[pix[i]-1] += pc[i]; \ } break; \ case 5: { /* mean: no multithreading because possible race condition */ \ int *restrict count = (int*)R_Calloc(nr*nc+1, int); \ - tdef *meani = TYPEACC(pout[1]); \ + double *meani = DBL_DATAPTR(pout[1]); \ for(int i = 0; i != l; ++i) { \ if(NONMISSCHECK) { \ - meani = TYPEACC(pout[pid[i]])-1; \ + meani = DBL_DATAPTR(pout[pid[i]])-1; \ if(ISMISS(meani[pix[i]])) { \ meani[pix[i]] = pc[i]; \ ++count[(pid[i]-1)*nr+pix[i]]; \ @@ -247,7 +247,7 @@ SEXP pivot_wide(SEXP index, SEXP id, SEXP column, SEXP fill, SEXP Rnthreads, SEX if(aggfun < 3 || aggfun > 4) { SEXP fill_val; if(fill == R_NilValue || aggfun > 4) { - fill_val = tx == REALSXP ? ScalarReal(NA_REAL) : tx == INTSXP ? ScalarInteger(NA_INTEGER) : + fill_val = tx == REALSXP || aggfun == 5 ? ScalarReal(NA_REAL) : tx == INTSXP ? ScalarInteger(NA_INTEGER) : tx == LGLSXP ? ScalarLogical(NA_LOGICAL) : tx == STRSXP ? ScalarString(NA_STRING) : tx == CPLXSXP ? ScalarComplex(asComplex(ScalarReal(NA_REAL))) : tx == RAWSXP ? ScalarRaw(0) : R_NilValue; } else if(TYPEOF(fill) == tx) { diff --git a/tests/testthat/test-miscellaneous-issues.R b/tests/testthat/test-miscellaneous-issues.R index 9cdfab94..e388f52a 100644 --- a/tests/testthat/test-miscellaneous-issues.R +++ b/tests/testthat/test-miscellaneous-issues.R @@ -478,4 +478,29 @@ test_that("Misc bugs", { }) +test_that("Pivot with integers", { #803 + + iris_long <- pivot(iris, "Species") + iris_long$value <- round(iris_long$value) # Double + iris_long$value_int = as.integer(iris_long$value) # Integer + + for (f in c("sum", "mean")) { + expect_equal( + pivot( + data = iris_long, + ids = "Species", + values = "value", + how = "wider", # Pivoting to wide format + FUN = "sum" + ), + pivot( + data = iris_long, + ids = "Species", + values = "value_int", + how = "wider", # Pivoting to wide format + FUN = "sum" + )) + } +}) + options(warn = 1)