[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