/* R function qsort(x, index.return) */ SEXP attribute_hidden do_qsort(SEXP call, SEXP op, SEXP args, SEXP rho) { SEXP x, sx; int indx_ret, n; double *vx = NULL; int *ivx = NULL; Rboolean x_real, x_int; checkArity(op, args); x = CAR(args); if (!isNumeric(x)) error(_("argument is not a numeric vector")); x_real= TYPEOF(x) == REALSXP; x_int = !x_real && (TYPEOF(x) == INTSXP || TYPEOF(x) == LGLSXP); PROTECT(sx = (x_real || x_int) ? duplicate(x) : coerceVector(x, REALSXP)); SET_ATTRIB(sx, R_NilValue); SET_OBJECT(sx, 0); /* if x has names, drop them, since they won't be ordered if (!isNull(getAttrib(sx, R_NamesSymbol))) setAttrib(sx, R_NamesSymbol, R_NilValue); */ indx_ret = asLogical(CADR(args)); n = LENGTH(x); if(x_int) ivx = INTEGER(sx); else vx = REAL(sx); if(indx_ret) { SEXP ans, ansnames, indx; int i, *ix; /* answer will have x = sorted x , ix = index :*/ PROTECT(ans = allocVector(VECSXP, 2)); PROTECT(ansnames = allocVector(STRSXP, 2)); PROTECT(indx = allocVector(INTSXP, n)); ix = INTEGER(indx); for(i = 0; i < n; i++) ix[i] = i+1; if(x_int) R_qsort_int_I(ivx, ix, 1, n); else R_qsort_I(vx, ix, 1, n); SET_VECTOR_ELT(ans, 0, sx); SET_VECTOR_ELT(ans, 1, indx); SET_STRING_ELT(ansnames, 0, mkChar("x")); SET_STRING_ELT(ansnames, 1, mkChar("ix")); setAttrib(ans, R_NamesSymbol, ansnames); UNPROTECT(4); return ans; } else { if(x_int) R_qsort_int(ivx, 1, n); else R_qsort(vx, 1, n); UNPROTECT(1); return sx; } }
/* R function qsort(x, index.return) */ SEXP attribute_hidden do_qsort(SEXP call, SEXP op, SEXP args, SEXP rho) { SEXP x, sx; int indx_ret; double *vx = NULL; int *ivx = NULL; Rboolean x_real, x_int; checkArity(op, args); x = CAR(args); if (!isNumeric(x)) error(_("argument is not a numeric vector")); x_real= TYPEOF(x) == REALSXP; x_int = !x_real && (TYPEOF(x) == INTSXP || TYPEOF(x) == LGLSXP); PROTECT(sx = (x_real || x_int) ? duplicate(x) : coerceVector(x, REALSXP)); SET_ATTRIB(sx, R_NilValue); SET_OBJECT(sx, 0); indx_ret = asLogical(CADR(args)); R_xlen_t n = XLENGTH(x); #ifdef LONG_VECTOR_SUPPORT Rboolean isLong = n > INT_MAX; #endif if(x_int) ivx = INTEGER(sx); else vx = REAL(sx); if(indx_ret) { SEXP ans, ansnames, indx; /* answer will have x = sorted x , ix = index :*/ PROTECT(ans = allocVector(VECSXP, 2)); PROTECT(ansnames = allocVector(STRSXP, 2)); #ifdef LONG_VECTOR_SUPPORT if (isLong) { PROTECT(indx = allocVector(REALSXP, n)); double *ix = REAL(indx); for(R_xlen_t i = 0; i < n; i++) ix[i] = (double) (i+1); if(x_int) R_qsort_int_R(ivx, ix, 1, n); else R_qsort_R(vx, ix, 1, n); } else #endif { PROTECT(indx = allocVector(INTSXP, n)); int *ix = INTEGER(indx); int nn = (int) n; for(int i = 0; i < nn; i++) ix[i] = i+1; if(x_int) R_qsort_int_I(ivx, ix, 1, nn); else R_qsort_I(vx, ix, 1, nn); } SET_VECTOR_ELT(ans, 0, sx); SET_VECTOR_ELT(ans, 1, indx); SET_STRING_ELT(ansnames, 0, mkChar("x")); SET_STRING_ELT(ansnames, 1, mkChar("ix")); setAttrib(ans, R_NamesSymbol, ansnames); UNPROTECT(4); return ans; } else { if(x_int) R_qsort_int(ivx, 1, n); else R_qsort(vx, 1, n); UNPROTECT(1); return sx; } }