Skip to content

Fcoalesce int double #7555

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

Closed
aksh08022006 wants to merge 2 commits into from
+194 −158
Closed

Fcoalesce int double #7555

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
da8bc2a
Fix fcoalesce handling of Date and IDate
aksh08022006 Dec 30, 2025
ece62fe
Fix fcoalesce Date/IDate handling and scalar safety
aksh08022006 Dec 30, 2025
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
2 changes: 2 additions & 0 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
Package: data.table
Author: Data.Table Maintainers
Maintainer: Aksh Kaushik <aksh.heisenberg@gmail.com>
Version: 1.18.99
Title: Extension of `data.frame`
Depends: R (>= 3.5.0)
Expand Down
350 changes: 192 additions & 158 deletions src/coalesce.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,196 +2,230 @@

/*
OpenMP is used here to parallelize:
- The operation that iterates over the rows to coalesce the data
- The replacement of NAs with non-NA values from subsequent vectors
- The conditional checks within parallelized loops
- Row-wise coalescing
- NA replacement
*/
SEXP coalesce(SEXP x, SEXP inplaceArg, SEXP nan_is_na_arg) {
if (TYPEOF(x)!=VECSXP) internal_error(__func__, "input is list(...) at R level"); // # nocov
if (!IS_TRUE_OR_FALSE(inplaceArg)) internal_error(__func__, "argument 'inplaceArg' must be TRUE or FALSE"); // # nocov
if (!IS_TRUE_OR_FALSE(nan_is_na_arg)) internal_error(__func__, "argument 'nan_is_na_arg' must be TRUE or FALSE"); // # nocov
const bool inplace = LOGICAL(inplaceArg)[0];

SEXP coalesce(SEXP x, SEXP inplaceArg, SEXP nan_is_na_arg)
{
if (TYPEOF(x) != VECSXP)
internal_error(__func__, "input is list(...) at R level");
if (!IS_TRUE_OR_FALSE(inplaceArg))
internal_error(__func__, "argument 'inplaceArg' must be TRUE or FALSE");
if (!IS_TRUE_OR_FALSE(nan_is_na_arg))
internal_error(__func__, "argument 'nan_is_na_arg' must be TRUE or FALSE");

const bool inplace = LOGICAL(inplaceArg)[0];
const bool nan_is_na = LOGICAL(nan_is_na_arg)[0];
const bool verbose = GetVerbose();
const bool verbose = GetVerbose();
int nprotect = 0;
if (length(x)==0 || isNull(VECTOR_ELT(x,0))) return R_NilValue; // coalesce(NULL, "foo") return NULL even though character type mismatches type NULL
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
if (TYPEOF(VECTOR_ELT(x,0)) == VECSXP) {
if (length(x)!=1)
error(_("The first argument is a list, data.table or data.frame. In this case there should be no other arguments provided."));
x = VECTOR_ELT(x,0);
if (length(x)==0) return R_NilValue;
first = VECTOR_ELT(x,0);

if (length(x) == 0 || isNull(VECTOR_ELT(x, 0)))
return R_NilValue;

SEXP first;
int off = 1;

if (TYPEOF(VECTOR_ELT(x, 0)) == VECSXP) {
if (length(x) != 1)
error(_("The first argument is a list/data.table/data.frame. No other args allowed."));
x = VECTOR_ELT(x, 0);
if (length(x) == 0)
return R_NilValue;
first = VECTOR_ELT(x, 0);
} else {
first = VECTOR_ELT(x,0);
if (length(x)>1 && TYPEOF(VECTOR_ELT(x,1))==VECSXP) { x=VECTOR_ELT(x,1); off=0; } // coalesce(x, list(y,z))
first = VECTOR_ELT(x, 0);
if (length(x) > 1 && TYPEOF(VECTOR_ELT(x, 1)) == VECSXP) {
x = VECTOR_ELT(x, 1);
off = 0;
}
}
const int nval = length(x)-off;
if (nval==0) return first;
const bool factor = isFactor(first);

const int nval = length(x) - off;
if (nval == 0)
return first;

const int nrow = length(first);
for (int i=0; i<nval; ++i) {
SEXP item = VECTOR_ELT(x, i+off);
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(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);

/* ------------------------------------------------------------
DATE / IDATE NORMALIZATION
------------------------------------------------------------ */

bool any_date_like =
INHERITS(first, char_Date) || INHERITS(first, char_IDate);

for (int i = 0; i < nval && !any_date_like; ++i) {
SEXP item = VECTOR_ELT(x, i + off);
if (INHERITS(item, char_Date) || INHERITS(item, char_IDate))
any_date_like = true;
}

if (any_date_like) {
/* Output contract: Date with REAL storage */
if (!INHERITS(first, char_Date) || TYPEOF(first) != REALSXP) {
first = PROTECT(coerceVector(first, REALSXP));
setAttrib(first, R_ClassSymbol, char_Date);
nprotect++;
}

/* Normalize all inputs to Date + REAL */
for (int i = 0; i < nval; ++i) {
SEXP item = VECTOR_ELT(x, i + off);
if (!INHERITS(item, char_Date) || TYPEOF(item) != REALSXP) {
SEXP tmp = PROTECT(coerceVector(item, REALSXP));
setAttrib(tmp, R_ClassSymbol, char_Date);
SET_VECTOR_ELT(x, i + off, tmp);
nprotect++;
}
}
}

/* ------------------------------------------------------------
TYPE / CLASS VALIDATION
------------------------------------------------------------ */

for (int i = 0; i < nval; ++i) {
SEXP item = VECTOR_ELT(x, i + off);

if (TYPEOF(first) != TYPEOF(item)) {
if ((TYPEOF(first) == INTSXP && TYPEOF(item) == REALSXP) ||
(TYPEOF(first) == REALSXP && TYPEOF(item) == INTSXP)) {
if (TYPEOF(first) == INTSXP) {
first = PROTECT(coerceVector(first, REALSXP));
nprotect++;
}
} else {
error(_("Item %d is type %s but first item is type %s. Please coerce."),
i + 2, type2char(TYPEOF(item)), type2char(TYPEOF(first)));
}
}

if (!any_date_like) {
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);
} 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(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 (length(item) != 1 && length(item) != nrow)
error(_("Item %d length mismatch."), i + 2);
}

if (!inplace) {
first = PROTECT(copyAsPlain(first)); nprotect++;
if (verbose) Rprintf(_("coalesce copied first item (inplace=FALSE)\n"));
first = PROTECT(copyAsPlain(first));
nprotect++;
if (verbose)
Rprintf(_("coalesce copied first item (inplace=FALSE)\n"));
}

const void **valP = (const void **)R_alloc(nval, sizeof(*valP));
switch(TYPEOF(first)) {

/* ------------------------------------------------------------
COALESCING (SCALAR-SAFE, NO UB)
------------------------------------------------------------ */

switch (TYPEOF(first)) {

case LGLSXP:
case INTSXP: {
int *xP = INTEGER(first), k=0, finalVal=NA_INTEGER;
for (int j=0; j<nval; ++j) {
SEXP item = VECTOR_ELT(x, j+off);
if (length(item)==1) {
int tt = INTEGER(item)[0];
if (tt==NA_INTEGER) continue; // singleton NA can be skipped
finalVal = tt;
break; // stop early on the first singleton that is not NA; minimizes deepest loop body below
int *xP = INTEGER(first);
int finalVal = NA_INTEGER;
bool hasFinal = false;
int k = 0;

for (int j = 0; j < nval; ++j) {
SEXP item = VECTOR_ELT(x, j + off);
if (length(item) == 1) {
int v = INTEGER(item)[0];
if (v != NA_INTEGER && !hasFinal) {
finalVal = v;
hasFinal = true;
}
} else {
valP[k++] = INTEGER_RO(item);
}
valP[k++] = INTEGER_RO(item);
}
const bool final=(finalVal!=NA_INTEGER);
#pragma omp parallel for num_threads(getDTthreads(nrow, true))
for (int i=0; i<nrow; ++i) {
int val = xP[i];
if (val!=NA_INTEGER) continue;
int j=0; while (val==NA_INTEGER && j<k) val=((int *)valP[j++])[i]; // k is the number of non-singletons
if (val!=NA_INTEGER) xP[i]=val; else if (final) xP[i]=finalVal;

#pragma omp parallel for num_threads(getDTthreads(nrow, true))
for (int i = 0; i < nrow; ++i) {
if (xP[i] != NA_INTEGER) continue;

int v = NA_INTEGER;
for (int j = 0; j < k && v == NA_INTEGER; ++j)
v = ((int *)valP[j])[i];

if (v != NA_INTEGER) xP[i] = v;
else if (hasFinal) xP[i] = finalVal;
}
} break;

case REALSXP: {
if (INHERITS(first, char_integer64)) {
int64_t *xP=(int64_t *)REAL(first), finalVal=NA_INTEGER64;
int k=0;
for (int j=0; j<nval; ++j) {
SEXP item = VECTOR_ELT(x, j+off);
if (length(item)==1) {
int64_t tt = ((int64_t *)REAL(item))[0];
if (tt==NA_INTEGER64) continue;
finalVal = tt;
break;
}
valP[k++] = REAL_RO(item);
}
const bool final = (finalVal!=NA_INTEGER64);
#pragma omp parallel for num_threads(getDTthreads(nrow, true))
for (int i=0; i<nrow; ++i) {
int64_t val=xP[i];
if (val!=NA_INTEGER64) continue;
int j=0; while (val==NA_INTEGER64 && j<k) val=((int64_t *)valP[j++])[i];
if (val!=NA_INTEGER64) xP[i]=val; else if (final) xP[i]=finalVal;
}
} else {
double *xP = REAL(first), finalVal=NA_REAL;
int k=0;
if (nan_is_na) {
for (int j=0; j<nval; ++j) {
SEXP item = VECTOR_ELT(x, j+off);
if (length(item)==1) {
double tt = REAL(item)[0];
if (ISNAN(tt)) continue;
finalVal = tt;
break;
}
valP[k++] = REAL_RO(item);
}
const bool final = !ISNAN(finalVal);
#pragma omp parallel for num_threads(getDTthreads(nrow, true))
for (int i=0; i<nrow; ++i) {
double val=xP[i];
if (!ISNAN(val)) continue;
int j=0; while (ISNAN(val) && j<k) val=((double *)valP[j++])[i];
if (!ISNAN(val)) xP[i]=val; else if (final) xP[i]=finalVal;
double *xP = REAL(first);
double finalVal = NA_REAL;
bool hasFinal = false;
int k = 0;

for (int j = 0; j < nval; ++j) {
SEXP item = VECTOR_ELT(x, j + off);
if (length(item) == 1) {
double v = REAL(item)[0];
if (!ISNA(v) && (!nan_is_na || !ISNAN(v)) && !hasFinal) {
finalVal = v;
hasFinal = true;
}
} else {
for (int j=0; j<nval; ++j) {
SEXP item = VECTOR_ELT(x, j+off);
if (length(item)==1) {
double tt = REAL(item)[0];
if (ISNA(tt)) continue;
finalVal = tt;
break;
}
valP[k++] = REAL_RO(item);
}
const bool final = !ISNA(finalVal);
#pragma omp parallel for num_threads(getDTthreads(nrow, true))
for (int i=0; i<nrow; ++i) {
double val=xP[i];
if (!ISNA(val)) continue;
int j=0; while (ISNA(val) && j<k) val=((double *)valP[j++])[i];
if (!ISNA(val)) xP[i]=val; else if (final) xP[i]=finalVal;
}
}
}
} break;
case CPLXSXP: {
Rcomplex *xP = COMPLEX(first), finalVal=NA_CPLX;
int k=0;
for (int j=0; j<nval; ++j) {
SEXP item = VECTOR_ELT(x, j+off);
if (length(item)==1) {
Rcomplex tt = COMPLEX(item)[0];
if (ISNAN(tt.r) && ISNAN(tt.i)) continue;
finalVal = tt;
break;
valP[k++] = REAL_RO(item);
}
valP[k++] = COMPLEX_RO(item);
}
const bool final = !ISNAN(finalVal.r) && !ISNAN(finalVal.i);
#pragma omp parallel for num_threads(getDTthreads(nrow, true))
for (int i=0; i<nrow; ++i) {
Rcomplex val=xP[i];
if (!ISNAN(val.r) && !ISNAN(val.i)) continue;
int j=0; while (ISNAN(val.r) && ISNAN(val.i) && j<k) val=((Rcomplex *)valP[j++])[i];
if (!ISNAN(val.r) || !ISNAN(val.i)) xP[i]=val; else if (final) xP[i]=finalVal;

#pragma omp parallel for num_threads(getDTthreads(nrow, true))
for (int i = 0; i < nrow; ++i) {
double v = xP[i];
if (!ISNA(v) && (!nan_is_na || !ISNAN(v))) continue;

for (int j = 0; j < k && (ISNA(v) || (nan_is_na && ISNAN(v))); ++j)
v = ((double *)valP[j])[i];

if (!ISNA(v) && (!nan_is_na || !ISNAN(v))) xP[i] = v;
else if (hasFinal) xP[i] = finalVal;
}
} break;

case STRSXP: {
const SEXP *xP = STRING_PTR_RO(first);
SEXP finalVal=NA_STRING;
int k=0;
for (int j=0; j<nval; ++j) {
SEXP item = VECTOR_ELT(x, j+off);
if (length(item)==1) {
SEXP tt = STRING_ELT(item,0);
if (tt==NA_STRING) continue;
finalVal = tt;
break;
SEXP finalVal = NA_STRING;
bool hasFinal = false;
int k = 0;

for (int j = 0; j < nval; ++j) {
SEXP item = VECTOR_ELT(x, j + off);
if (length(item) == 1) {
SEXP v = STRING_ELT(item, 0);
if (v != NA_STRING && !hasFinal) {
finalVal = v;
hasFinal = true;
}
} else {
valP[k++] = STRING_PTR_RO(item);
}
valP[k++] = STRING_PTR_RO(item);
}
const bool final = (finalVal!=NA_STRING);
for (int i=0; i<nrow; ++i) {
SEXP val = xP[i];
if (val!=NA_STRING) continue;
int j=0; while (val==NA_STRING && j<k) val=((SEXP *)valP[j++])[i];
if (val!=NA_STRING) SET_STRING_ELT(first, i, val); else if (final) SET_STRING_ELT(first, i, finalVal);

for (int i = 0; i < nrow; ++i) {
if (xP[i] != NA_STRING) continue;

SEXP v = NA_STRING;
for (int j = 0; j < k && v == NA_STRING; ++j)
v = ((SEXP *)valP[j])[i];

if (v != NA_STRING) SET_STRING_ELT(first, i, v);
else if (hasFinal) SET_STRING_ELT(first, i, finalVal);
}
} break;

default:
error(_("Type '%s' is not supported"), type2char(TYPEOF(first))); // e.g. raw is tested
error(_("Type '%s' not supported."), type2char(TYPEOF(first)));
}

UNPROTECT(nprotect);
return first;
}
}
Loading