View | Details | Raw Unified | Return to bug 17139 | Differences between
and this patch

Collapse All | Expand All

(-)split.c (-1 / +65 lines)
Lines 1-7 Link Here
1
/*
1
/*
2
 *  R : A Computer Langage for Statistical Data Analysis
2
 *  R : A Computer Langage for Statistical Data Analysis
3
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
3
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
4
 *  Copyright (C) 2006-2015 The R Core Team
4
 *  Copyright (C) 2006-2016 The R Core Team
5
 *
5
 *
6
 *  This program is free software; you can redistribute it and/or modify
6
 *  This program is free software; you can redistribute it and/or modify
7
 *  it under the terms of the GNU General Public License as published by
7
 *  it under the terms of the GNU General Public License as published by
Lines 48-53 Link Here
48
	warning(_("data length is not a multiple of split variable"));
48
	warning(_("data length is not a multiple of split variable"));
49
    nm = getAttrib(x, R_NamesSymbol);
49
    nm = getAttrib(x, R_NamesSymbol);
50
    have_names = nm != R_NilValue;
50
    have_names = nm != R_NilValue;
51
#ifdef LONG_VECTOR_SUPPORT
52
    if (IS_LONG_VEC(x)) {
53
    PROTECT(counts = allocVector(REALSXP, nlevs));
54
    for (int i = 0; i < nlevs; i++) REAL(counts)[i] = 0;
55
    R_xlen_t i, i1;
56
    MOD_ITERATE1(nobs, nfac, i, i1, {
57
	int j = INTEGER(f)[i1];
58
	if (j != NA_INTEGER) {
59
	    /* protect against malformed factors */
60
	    if (j > nlevs || j < 1) error(_("factor has bad level"));
61
	    REAL(counts)[j - 1]++;
62
	}
63
    });
64
    /* Allocate a generic vector to hold the results. */
65
    /* The i-th element will hold the split-out data */
66
    /* for the ith group. */
67
    PROTECT(vec = allocVector(VECSXP, nlevs));
68
    for (R_xlen_t i = 0;  i < nlevs; i++) {
69
	SET_VECTOR_ELT(vec, i, allocVector(TYPEOF(x), REAL(counts)[i]));
70
	setAttrib(VECTOR_ELT(vec, i), R_LevelsSymbol,
71
		  getAttrib(x, R_LevelsSymbol));
72
	if(have_names)
73
	    setAttrib(VECTOR_ELT(vec, i), R_NamesSymbol,
74
		      allocVector(STRSXP, REAL(counts)[i]));
75
    }
76
    for (int i = 0; i < nlevs; i++) REAL(counts)[i] = 0;
77
    MOD_ITERATE1(nobs, nfac, i, i1, {
78
	int j = INTEGER(f)[i1];
79
	if (j != NA_INTEGER) {
80
	    R_xlen_t k = REAL(counts)[j - 1];
81
	    switch (TYPEOF(x)) {
82
	    case LGLSXP:
83
	    case INTSXP:
84
		INTEGER(VECTOR_ELT(vec, j - 1))[k] = INTEGER(x)[i];
85
		break;
86
	    case REALSXP:
87
		REAL(VECTOR_ELT(vec, j - 1))[k] = REAL(x)[i];
88
		break;
89
	    case CPLXSXP:
90
		COMPLEX(VECTOR_ELT(vec, j - 1))[k] = COMPLEX(x)[i];
91
		break;
92
	    case STRSXP:
93
		SET_STRING_ELT(VECTOR_ELT(vec, j - 1), k, STRING_ELT(x, i));
94
		break;
95
	    case VECSXP:
96
		SET_VECTOR_ELT(VECTOR_ELT(vec, j - 1), k, VECTOR_ELT(x, i));
97
		break;
98
	    case RAWSXP:
99
		RAW(VECTOR_ELT(vec, j - 1))[k] = RAW(x)[i];
100
		break;
101
	    default:
102
		UNIMPLEMENTED_TYPE("split", x);
103
	    }
104
	    if(have_names) {
105
		nmj = getAttrib(VECTOR_ELT(vec, j - 1), R_NamesSymbol);
106
		SET_STRING_ELT(nmj, k, STRING_ELT(nm, i));
107
	    }
108
	    REAL(counts)[j - 1] += 1;
109
	}
110
    });
111
    } else
112
#endif
113
    {
51
    PROTECT(counts = allocVector(INTSXP, nlevs));
114
    PROTECT(counts = allocVector(INTSXP, nlevs));
52
    for (int i = 0; i < nlevs; i++) INTEGER(counts)[i] = 0;
115
    for (int i = 0; i < nlevs; i++) INTEGER(counts)[i] = 0;
53
    R_xlen_t i, i1;
116
    R_xlen_t i, i1;
Lines 106-111 Link Here
106
	    INTEGER(counts)[j - 1] += 1;
169
	    INTEGER(counts)[j - 1] += 1;
107
	}
170
	}
108
    });
171
    });
172
    }
109
    setAttrib(vec, R_NamesSymbol, getAttrib(f, R_LevelsSymbol));
173
    setAttrib(vec, R_NamesSymbol, getAttrib(f, R_LevelsSymbol));
110
    UNPROTECT(2);
174
    UNPROTECT(2);
111
    return vec;
175
    return vec;

Return to bug 17139