src/main/split-incl.c

/* included  twice  from  ./split.c   after defining
    _L_INTSXP_, _L_INTEG_,  _L_int_
    ===========  =========  ========    as
      INTSXP  ,  INTEGER ,  int         or
      REALSXP ,  REAL    ,  R_xlen_t
*/
{
    PROTECT(counts = allocVector(_L_INTSXP_, nlevs));
    for (int i = 0; i < nlevs; i++) _L_INTEG_(counts)[i] = 0;
    R_xlen_t i, i1;
    MOD_ITERATE1(nobs, nfac, i, i1, {
	int j = INTEGER(f)[i1];
	if (j != NA_INTEGER) {
	    /* protect against malformed factors */
	    if (j > nlevs || j < 1) error(_("factor has bad level"));
	    _L_INTEG_(counts)[j - 1]++;
	}
    });
    /* Allocate a generic vector to hold the results. */
    /* The i-th element will hold the split-out data */
    /* for the ith group. */
    PROTECT(vec = allocVector(VECSXP, nlevs));
    for (R_xlen_t i = 0;  i < nlevs; i++) {
	SET_VECTOR_ELT(vec, i, 
		       allocVector(TYPEOF(x), (_L_int_)_L_INTEG_(counts)[i]));
	setAttrib(VECTOR_ELT(vec, i), R_LevelsSymbol,
		  getAttrib(x, R_LevelsSymbol));
	if(have_names)
	    setAttrib(VECTOR_ELT(vec, i), R_NamesSymbol,
		      allocVector(STRSXP, (_L_int_)_L_INTEG_(counts)[i]));
    }
    for (int i = 0; i < nlevs; i++) _L_INTEG_(counts)[i] = 0;
    MOD_ITERATE1(nobs, nfac, i, i1, {
	int j = INTEGER(f)[i1];
	if (j != NA_INTEGER) {
	    _L_int_ k = (_L_int_)_L_INTEG_(counts)[j - 1];
	    switch (TYPEOF(x)) {
	    case LGLSXP:
	    case INTSXP:
		INTEGER(VECTOR_ELT(vec, j - 1))[k] = INTEGER(x)[i];
		break;
	    case REALSXP:
		REAL(VECTOR_ELT(vec, j - 1))[k] = REAL(x)[i];
		break;
	    case CPLXSXP:
		COMPLEX(VECTOR_ELT(vec, j - 1))[k] = COMPLEX(x)[i];
		break;
	    case STRSXP:
		SET_STRING_ELT(VECTOR_ELT(vec, j - 1), k, STRING_ELT(x, i));
		break;
	    case VECSXP:
		SET_VECTOR_ELT(VECTOR_ELT(vec, j - 1), k, VECTOR_ELT(x, i));
		break;
	    case RAWSXP:
		RAW(VECTOR_ELT(vec, j - 1))[k] = RAW(x)[i];
		break;
	    default:
		UNIMPLEMENTED_TYPE("split", x);
	    }
	    if(have_names) {
		nmj = getAttrib(VECTOR_ELT(vec, j - 1), R_NamesSymbol);
		SET_STRING_ELT(nmj, k, STRING_ELT(nm, i));
	    }
	    _L_INTEG_(counts)[j - 1] += 1;
	}
    });
}