[Rd] unique.default() drops names (PR#9130)
Seth Falcon
sfalcon at fhcrc.org
Thu Aug 10 17:17:56 CEST 2006
Gregor Gorjanc <gregor.gorjanc at bfro.uni-lj.si> writes:
> Thank you for the reply! I appologize for not reading the latest
> documentation - there was no word about droping names in 2.3.1. However,
> I do wonder why simple fix (as shown in previous mail) is not OK.
I see value in unique() keeping names and from what I understand
the documentation could be changed to match ;-)
I don't know if there are good reasons for dropping names from
vectors.
Given that unique is very commonly used, I think the way to make such
a change is in the C code, not at the R level. So in that sense, I
think the patch you sent is not ideal. Below is a patch to
do_duplicated that keeps names. Lightly tested. No doc included. I
would consider more testing and doc if there was interest.
+ seth
diff --git a/src/main/unique.c b/src/main/unique.c
index a3c7a87..d8d31fa 100644
--- a/src/main/unique.c
+++ b/src/main/unique.c
@@ -382,7 +382,7 @@ SEXP duplicated(SEXP x)
*/
SEXP attribute_hidden do_duplicated(SEXP call, SEXP op, SEXP args, SEXP env)
{
- SEXP x, dup, ans;
+ SEXP x, xnames, dup, ans, ansnames;
int i, k, n;
checkArity(op, args);
@@ -410,25 +410,38 @@ SEXP attribute_hidden do_duplicated(SEXP
k++;
PROTECT(dup);
- ans = allocVector(TYPEOF(x), k);
- UNPROTECT(1);
+ PROTECT(ans = allocVector(TYPEOF(x), k));
+ xnames = getAttrib(x, R_NamesSymbol);
+ if (xnames != R_NilValue)
+ ansnames = allocVector(STRSXP, k);
+ else
+ ansnames = R_NilValue;
+ UNPROTECT(2);
k = 0;
switch (TYPEOF(x)) {
case LGLSXP:
case INTSXP:
for (i = 0; i < n; i++)
- if (LOGICAL(dup)[i] == 0)
+ if (LOGICAL(dup)[i] == 0) {
+ if (ansnames != R_NilValue)
+ SET_STRING_ELT(ansnames, k, STRING_ELT(xnames, i));
INTEGER(ans)[k++] = INTEGER(x)[i];
+ }
break;
case REALSXP:
for (i = 0; i < n; i++)
- if (LOGICAL(dup)[i] == 0)
+ if (LOGICAL(dup)[i] == 0) {
+ if (ansnames != R_NilValue)
+ SET_STRING_ELT(ansnames, k, STRING_ELT(xnames, i));
REAL(ans)[k++] = REAL(x)[i];
+ }
break;
case CPLXSXP:
for (i = 0; i < n; i++)
if (LOGICAL(dup)[i] == 0) {
+ if (ansnames != R_NilValue)
+ SET_STRING_ELT(ansnames, k, STRING_ELT(xnames, i));
COMPLEX(ans)[k].r = COMPLEX(x)[i].r;
COMPLEX(ans)[k].i = COMPLEX(x)[i].i;
k++;
@@ -436,22 +449,33 @@ SEXP attribute_hidden do_duplicated(SEXP
break;
case STRSXP:
for (i = 0; i < n; i++)
- if (LOGICAL(dup)[i] == 0)
+ if (LOGICAL(dup)[i] == 0) {
+ if (ansnames != R_NilValue)
+ SET_STRING_ELT(ansnames, k, STRING_ELT(xnames, i));
SET_STRING_ELT(ans, k++, STRING_ELT(x, i));
+ }
break;
case VECSXP:
for (i = 0; i < n; i++)
- if (LOGICAL(dup)[i] == 0)
- SET_VECTOR_ELT(ans, k++, VECTOR_ELT(x, i));
+ if (LOGICAL(dup)[i] == 0) {
+ if (ansnames != R_NilValue)
+ SET_STRING_ELT(ansnames, k, STRING_ELT(xnames, i));
+ SET_VECTOR_ELT(ans, k++, VECTOR_ELT(x, i));
+ }
break;
case RAWSXP:
for (i = 0; i < n; i++)
- if (LOGICAL(dup)[i] == 0)
+ if (LOGICAL(dup)[i] == 0) {
+ if (ansnames != R_NilValue)
+ SET_STRING_ELT(ansnames, k, STRING_ELT(xnames, i));
RAW(ans)[k++] = RAW(x)[i];
+ }
break;
default:
UNIMPLEMENTED_TYPE("duplicated", x);
}
+ if (ansnames != R_NilValue)
+ setAttrib(ans, R_NamesSymbol, ansnames);
return ans;
}
More information about the R-devel
mailing list