The R Project SVN – R – Diff – /branches/R-exp-API/src/main/seq.c



    if( n2 > 1 )
	warningcall(call, "Numerical expression has %d elements: only the first used", (int) n2);
    n1 = asReal(s1);
    n2 = asReal(s2);
    if (ISNAN(n1) || ISNAN(n2))
	errorcall(call, "NA/NaN argument");
 
    if (n1 <= INT_MIN || n2 <= INT_MIN || n1 > INT_MAX || n2 > INT_MAX
	|| fabs(n2 - n1) >= INT_MAX)
	errorcall(call, "argument too large in magnitude");
 
    n = fabs(n2 - n1) + 1 + FLT_EPSILON;
    if (n1 == (in1 = (int)(n1))) {
	ans = allocVector(INTSXP, n);
	if (n1 <= n2)

SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    checkArity(op, args);
    if (isFactor(CAR(args)) && isFactor(CADR(args))) {
	if (length(CAR(args)) != length(CADR(args)))
	    errorcall(call, "unequal factor lengths");
	return(cross(CAR(args), CADR(args)));
    }
    return seq(call, CAR(args), CADR(args));
}
 

 
    nc = length(ncopy);
    na = 0;
    for (i = 0; i < nc; i++) {
	if (INTEGER(t)[i] == NA_INTEGER)
	    error("invalid number of copies in \"rep\"");
	na += INTEGER(t)[i];
    }
 
    if (isVector(s))
	a = allocVector(TYPEOF(s), na);

{
    int i, ns, na, nc;
    SEXP a, t;
 
    if (!isVector(ncopy))
	error("\"rep\" incorrect type for second argument");
 
    if (!isVector(s) && (!isList(s)))
	error("attempt to replicate non-vector");
 
    if ((length(ncopy) == length(s)))
	return rep2(s, ncopy);
 
    if ((length(ncopy) != 1))
	error("invalid number of copies in \"rep\"");
 
    if ((nc = asInteger(ncopy)) == NA_INTEGER || nc <= 0)
	error("invalid number of copies in \"rep\"");
 
    ns = length(s);
    na = nc * ns;
    if (isVector(s))
	a = allocVector(TYPEOF(s), na);

Rev 5458	Rev 5731
Line 85...	Line 85...
85	`if( n2 > 1 )`	85	`if( n2 > 1 )`
86	`warningcall(call, "Numerical expression has %d elements: only the first used", (int) n2);`	86	`warningcall(call, "Numerical expression has %d elements: only the first used", (int) n2);`
87	`n1 = asReal(s1);`	87	`n1 = asReal(s1);`
88	`n2 = asReal(s2);`	88	`n2 = asReal(s2);`
89	`if (ISNAN(n1) \|\| ISNAN(n2))`	89	`if (ISNAN(n1) \|\| ISNAN(n2))`
90	`errorcall(call, "NA/NaN argument\n");`	90	`errorcall(call, "NA/NaN argument");`
91		91
92	`if (n1 <= INT_MIN \|\| n2 <= INT_MIN \|\| n1 > INT_MAX \|\| n2 > INT_MAX`	92	`if (n1 <= INT_MIN \|\| n2 <= INT_MIN \|\| n1 > INT_MAX \|\| n2 > INT_MAX`
93	`\|\| fabs(n2 - n1) >= INT_MAX)`	93	`\|\| fabs(n2 - n1) >= INT_MAX)`
94	`errorcall(call, "argument too large in magnitude\n");`	94	`errorcall(call, "argument too large in magnitude");`
95		95
96	`n = fabs(n2 - n1) + 1 + FLT_EPSILON;`	96	`n = fabs(n2 - n1) + 1 + FLT_EPSILON;`
97	`if (n1 == (in1 = (int)(n1))) {`	97	`if (n1 == (in1 = (int)(n1))) {`
98	`ans = allocVector(INTSXP, n);`	98	`ans = allocVector(INTSXP, n);`
99	`if (n1 <= n2)`	99	`if (n1 <= n2)`
Line 113...	Line 113...
113	`SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho)`	113	`SEXP do_seq(SEXP call, SEXP op, SEXP args, SEXP rho)`
114	`{`	114	`{`
115	`checkArity(op, args);`	115	`checkArity(op, args);`
116	`if (isFactor(CAR(args)) && isFactor(CADR(args))) {`	116	`if (isFactor(CAR(args)) && isFactor(CADR(args))) {`
117	`if (length(CAR(args)) != length(CADR(args)))`	117	`if (length(CAR(args)) != length(CADR(args)))`
118	`errorcall(call, "unequal factor lengths\n");`	118	`errorcall(call, "unequal factor lengths");`
119	`return(cross(CAR(args), CADR(args)));`	119	`return(cross(CAR(args), CADR(args)));`
120	`}`	120	`}`
121	`return seq(call, CAR(args), CADR(args));`	121	`return seq(call, CAR(args), CADR(args));`
122	`}`	122	`}`
123		123
Line 132...	Line 132...
132		132
133	`nc = length(ncopy);`	133	`nc = length(ncopy);`
134	`na = 0;`	134	`na = 0;`
135	`for (i = 0; i < nc; i++) {`	135	`for (i = 0; i < nc; i++) {`
136	`if (INTEGER(t)[i] == NA_INTEGER)`	136	`if (INTEGER(t)[i] == NA_INTEGER)`
137	`error("invalid number of copies in \"rep\"\n");`	137	`error("invalid number of copies in \"rep\"");`
138	`na += INTEGER(t)[i];`	138	`na += INTEGER(t)[i];`
139	`}`	139	`}`
140		140
141	`if (isVector(s))`	141	`if (isVector(s))`
142	`a = allocVector(TYPEOF(s), na);`	142	`a = allocVector(TYPEOF(s), na);`
Line 210...	Line 210...
210	`{`	210	`{`
211	`int i, ns, na, nc;`	211	`int i, ns, na, nc;`
212	`SEXP a, t;`	212	`SEXP a, t;`
213		213
214	`if (!isVector(ncopy))`	214	`if (!isVector(ncopy))`
215	`error("\"rep\" incorrect type for second argument\n");`	215	`error("\"rep\" incorrect type for second argument");`
216		216
217	`if (!isVector(s) && (!isList(s)))`	217	`if (!isVector(s) && (!isList(s)))`
218	`error("attempt to replicate non-vector\n");`	218	`error("attempt to replicate non-vector");`
219		219
220	`if ((length(ncopy) == length(s)))`	220	`if ((length(ncopy) == length(s)))`
221	`return rep2(s, ncopy);`	221	`return rep2(s, ncopy);`
222		222
223	`if ((length(ncopy) != 1))`	223	`if ((length(ncopy) != 1))`
224	`error("invalid number of copies in \"rep\"\n");`	224	`error("invalid number of copies in \"rep\"");`
225		225
226	`if ((nc = asInteger(ncopy)) == NA_INTEGER \|\| nc <= 0)`	226	`if ((nc = asInteger(ncopy)) == NA_INTEGER \|\| nc <= 0)`
227	`error("invalid number of copies in \"rep\"\n");`	227	`error("invalid number of copies in \"rep\"");`
228		228
229	`ns = length(s);`	229	`ns = length(s);`
230	`na = nc * ns;`	230	`na = nc * ns;`
231	`if (isVector(s))`	231	`if (isVector(s))`
232	`a = allocVector(TYPEOF(s), na);`	232	`a = allocVector(TYPEOF(s), na);`

The R Project SVN R

(root)/branches/R-exp-API/src/main/seq.c @ 28362 – Rev 5458 → 5731