The R Project SVN – R – Diff – /trunk/src/main/array.c



    else
	return R_NilValue;
}
 
// .Internal(matrix(data, nrow, ncol, byrow, dimnames, missing(nrow), missing(ncol)))
attribute_hidden SEXP do_matrix(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP vals, ans, snr, snc, dimnames;
    int nr = 1, nc = 1, byrow, miss_nr, miss_nc;
    R_xlen_t lendat;
 

    }
    UNPROTECT(2); /* dimnames, x */
    return x;
}
 
attribute_hidden SEXP do_drop(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP x, xdims;
    int i, n, shorten;
 
    checkArity(op, args);

    return x;
}
 
/* Length of Primitive Objects */
 
attribute_hidden SEXP do_length(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    checkArity(op, args);
    check1arg(args, call, "x");
 
    SEXP x = CAR(args), ans;

    if (len > INT_MAX) return ScalarReal((double) len);
#endif
    return ScalarInteger(length(x));
}
 
attribute_hidden R_len_t dispatch_length(SEXP x, SEXP call, SEXP rho) {
    R_xlen_t len = dispatch_xlength(x, call, rho);
#ifdef LONG_VECTOR_SUPPORT
    if (len > INT_MAX) return R_BadLongVector(x, __FILE__, __LINE__);
#endif
    return (R_len_t) len;
}
 
attribute_hidden R_xlen_t dispatch_xlength(SEXP x, SEXP call, SEXP rho) {
    static SEXP length_op = NULL;
    if (isObject(x)) {
        SEXP len, args;
        if (length_op == NULL)
            length_op = R_Primitive("length");

    UNPROTECT(1);
    return ans;
}
#endif
 
attribute_hidden SEXP do_lengths(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    checkArity(op, args);
    SEXP x = CAR(args), ans;
    R_xlen_t x_len, i;
    int *ans_elt;

    }
    UNPROTECT(1);
    return ans;
}
 
attribute_hidden SEXP do_rowscols(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    checkArity(op, args);
    SEXP dim = CAR(args);
    int nprot = 0;
    if (!isInteger(dim)) {

#endif
}
 
 
/* "%*%" (op = 0), crossprod (op = 1) or tcrossprod (op = 2) */
attribute_hidden SEXP do_matprod(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    int ldx, ldy, nrx, ncx, nry, ncy, mode;
    SEXP x = CAR(args), y = CADR(args), xdims, ydims, ans;
    Rboolean sym;
 

    UNPROTECT(3);
    return ans;
}
#undef YDIMS_ET_CETERA
 
attribute_hidden SEXP do_transpose(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP a, r, dims, dimnames, dimnamesnames = R_NilValue,
	ndimnamesnames, rnames, cnames;
    int ldim, ncol = 0, nrow = 0;
    R_xlen_t len = 0;

	}						\
    for (lj = 0, itmp = 0; itmp < n; itmp++)		\
	lj += iip[itmp] * stride[itmp];
 
/* aperm (a, perm, resize = TRUE) */
attribute_hidden SEXP do_aperm(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP a, perm, r, dimsa, dimsr, dna;
    int i, j, n, itmp;
 
    checkArity(op, args);

    UNPROTECT(3); /* dimsa, r, dimsr */
    return r;
}
 
/* colSums(x, n, p, na.rm) and friends */
attribute_hidden SEXP do_colsum(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP x, ans = R_NilValue;
    int type;
    Rboolean NaRm, keepNA;
 

    data
}
*/
 
/* array(data, dim, dimnames) */
attribute_hidden SEXP do_array(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP vals, ans, dims, dimnames;
    R_xlen_t lendat, i, nans;
 
    checkArity(op, args);

 
    UNPROTECT(2);
    return ans;
}
 
attribute_hidden SEXP do_diag(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    SEXP ans, x, snr, snc;
    int nr = 1, nc = 1, nprotect = 1;
 
    checkArity(op, args);

   return ans;
}
 
 
/* backsolve(r, b, k, upper.tri, transpose) */
attribute_hidden SEXP do_backsolve(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    int nprot = 1;
    checkArity(op, args);
 
    SEXP r = CAR(args); args = CDR(args);

    UNPROTECT(nprot);
    return ans;
}
 
/* max.col(m, ties.method) */
attribute_hidden SEXP do_maxcol(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    checkArity(op, args);
    SEXP m = CAR(args);
    int method = asInteger(CADR(args));
    int nr = nrows(m), nc = ncols(m), nprot = 1;

Rev 81479	Rev 83446
Line 62...	Line 62...
62	`else`	62	`else`
63	`return R_NilValue;`	63	`return R_NilValue;`
64	`}`	64	`}`
65		65
66	`// .Internal(matrix(data, nrow, ncol, byrow, dimnames, missing(nrow), missing(ncol)))`	66	`// .Internal(matrix(data, nrow, ncol, byrow, dimnames, missing(nrow), missing(ncol)))`
67	`SEXP attribute_hidden do_matrix(SEXP call, SEXP op, SEXP args, SEXP rho)`	67	`attribute_hidden SEXP do_matrix(SEXP call, SEXP op, SEXP args, SEXP rho)`
68	`{`	68	`{`
69	`SEXP vals, ans, snr, snc, dimnames;`	69	`SEXP vals, ans, snr, snc, dimnames;`
70	`int nr = 1, nc = 1, byrow, miss_nr, miss_nc;`	70	`int nr = 1, nc = 1, byrow, miss_nr, miss_nc;`
71	`R_xlen_t lendat;`	71	`R_xlen_t lendat;`
72		72
Line 409...	Line 409...
409	`}`	409	`}`
410	`UNPROTECT(2); /* dimnames, x */`	410	`UNPROTECT(2); /* dimnames, x */`
411	`return x;`	411	`return x;`
412	`}`	412	`}`
413		413
414	`SEXP attribute_hidden do_drop(SEXP call, SEXP op, SEXP args, SEXP rho)`	414	`attribute_hidden SEXP do_drop(SEXP call, SEXP op, SEXP args, SEXP rho)`
415	`{`	415	`{`
416	`SEXP x, xdims;`	416	`SEXP x, xdims;`
417	`int i, n, shorten;`	417	`int i, n, shorten;`
418		418
419	`checkArity(op, args);`	419	`checkArity(op, args);`
Line 431...	Line 431...
431	`return x;`	431	`return x;`
432	`}`	432	`}`
433		433
434	`/* Length of Primitive Objects */`	434	`/* Length of Primitive Objects */`
435		435
436	`SEXP attribute_hidden do_length(SEXP call, SEXP op, SEXP args, SEXP rho)`	436	`attribute_hidden SEXP do_length(SEXP call, SEXP op, SEXP args, SEXP rho)`
437	`{`	437	`{`
438	`checkArity(op, args);`	438	`checkArity(op, args);`
439	`check1arg(args, call, "x");`	439	`check1arg(args, call, "x");`
440		440
441	`SEXP x = CAR(args), ans;`	441	`SEXP x = CAR(args), ans;`
Line 462...	Line 462...
462	`if (len > INT_MAX) return ScalarReal((double) len);`	462	`if (len > INT_MAX) return ScalarReal((double) len);`
463	`#endif`	463	`#endif`
464	`return ScalarInteger(length(x));`	464	`return ScalarInteger(length(x));`
465	`}`	465	`}`
466		466
467	`R_len_t attribute_hidden dispatch_length(SEXP x, SEXP call, SEXP rho) {`	467	`attribute_hidden R_len_t dispatch_length(SEXP x, SEXP call, SEXP rho) {`
468	`R_xlen_t len = dispatch_xlength(x, call, rho);`	468	`R_xlen_t len = dispatch_xlength(x, call, rho);`
469	`#ifdef LONG_VECTOR_SUPPORT`	469	`#ifdef LONG_VECTOR_SUPPORT`
470	`if (len > INT_MAX) return R_BadLongVector(x, __FILE__, __LINE__);`	470	`if (len > INT_MAX) return R_BadLongVector(x, __FILE__, __LINE__);`
471	`#endif`	471	`#endif`
472	`return (R_len_t) len;`	472	`return (R_len_t) len;`
473	`}`	473	`}`
474		474
475	`R_xlen_t attribute_hidden dispatch_xlength(SEXP x, SEXP call, SEXP rho) {`	475	`attribute_hidden R_xlen_t dispatch_xlength(SEXP x, SEXP call, SEXP rho) {`
476	`static SEXP length_op = NULL;`	476	`static SEXP length_op = NULL;`
477	`if (isObject(x)) {`	477	`if (isObject(x)) {`
478	`SEXP len, args;`	478	`SEXP len, args;`
479	`if (length_op == NULL)`	479	`if (length_op == NULL)`
480	`length_op = R_Primitive("length");`	480	`length_op = R_Primitive("length");`
Line 515...	Line 515...
515	`UNPROTECT(1);`	515	`UNPROTECT(1);`
516	`return ans;`	516	`return ans;`
517	`}`	517	`}`
518	`#endif`	518	`#endif`
519		519
520	`SEXP attribute_hidden do_lengths(SEXP call, SEXP op, SEXP args, SEXP rho)`	520	`attribute_hidden SEXP do_lengths(SEXP call, SEXP op, SEXP args, SEXP rho)`
521	`{`	521	`{`
522	`checkArity(op, args);`	522	`checkArity(op, args);`
523	`SEXP x = CAR(args), ans;`	523	`SEXP x = CAR(args), ans;`
524	`R_xlen_t x_len, i;`	524	`R_xlen_t x_len, i;`
525	`int *ans_elt;`	525	`int *ans_elt;`
Line 576...	Line 576...
576	`}`	576	`}`
577	`UNPROTECT(1);`	577	`UNPROTECT(1);`
578	`return ans;`	578	`return ans;`
579	`}`	579	`}`
580		580
581	`SEXP attribute_hidden do_rowscols(SEXP call, SEXP op, SEXP args, SEXP rho)`	581	`attribute_hidden SEXP do_rowscols(SEXP call, SEXP op, SEXP args, SEXP rho)`
582	`{`	582	`{`
583	`checkArity(op, args);`	583	`checkArity(op, args);`
584	`SEXP dim = CAR(args);`	584	`SEXP dim = CAR(args);`
585	`int nprot = 0;`	585	`int nprot = 0;`
586	`if (!isInteger(dim)) {`	586	`if (!isInteger(dim)) {`
Line 1229...	Line 1229...
1229	`#endif`	1229	`#endif`
1230	`}`	1230	`}`
1231		1231
1232		1232
1233	`/* "%%" (op = 0), crossprod (op = 1) or tcrossprod (op = 2) /`	1233	`/* "%%" (op = 0), crossprod (op = 1) or tcrossprod (op = 2) /`
1234	`SEXP attribute_hidden do_matprod(SEXP call, SEXP op, SEXP args, SEXP rho)`	1234	`attribute_hidden SEXP do_matprod(SEXP call, SEXP op, SEXP args, SEXP rho)`
1235	`{`	1235	`{`
1236	`int ldx, ldy, nrx, ncx, nry, ncy, mode;`	1236	`int ldx, ldy, nrx, ncx, nry, ncy, mode;`
1237	`SEXP x = CAR(args), y = CADR(args), xdims, ydims, ans;`	1237	`SEXP x = CAR(args), y = CADR(args), xdims, ydims, ans;`
1238	`Rboolean sym;`	1238	`Rboolean sym;`
1239		1239
Line 1545...	Line 1545...
1545	`UNPROTECT(3);`	1545	`UNPROTECT(3);`
1546	`return ans;`	1546	`return ans;`
1547	`}`	1547	`}`
1548	`#undef YDIMS_ET_CETERA`	1548	`#undef YDIMS_ET_CETERA`
1549		1549
1550	`SEXP attribute_hidden do_transpose(SEXP call, SEXP op, SEXP args, SEXP rho)`	1550	`attribute_hidden SEXP do_transpose(SEXP call, SEXP op, SEXP args, SEXP rho)`
1551	`{`	1551	`{`
1552	`SEXP a, r, dims, dimnames, dimnamesnames = R_NilValue,`	1552	`SEXP a, r, dims, dimnames, dimnamesnames = R_NilValue,`
1553	`ndimnamesnames, rnames, cnames;`	1553	`ndimnamesnames, rnames, cnames;`
1554	`int ldim, ncol = 0, nrow = 0;`	1554	`int ldim, ncol = 0, nrow = 0;`
1555	`R_xlen_t len = 0;`	1555	`R_xlen_t len = 0;`
Line 1692...	Line 1692...
1692	`} \`	1692	`} \`
1693	`for (lj = 0, itmp = 0; itmp < n; itmp++) \`	1693	`for (lj = 0, itmp = 0; itmp < n; itmp++) \`
1694	`lj += iip[itmp] * stride[itmp];`	1694	`lj += iip[itmp] * stride[itmp];`
1695		1695
1696	`/* aperm (a, perm, resize = TRUE) */`	1696	`/* aperm (a, perm, resize = TRUE) */`
1697	`SEXP attribute_hidden do_aperm(SEXP call, SEXP op, SEXP args, SEXP rho)`	1697	`attribute_hidden SEXP do_aperm(SEXP call, SEXP op, SEXP args, SEXP rho)`
1698	`{`	1698	`{`
1699	`SEXP a, perm, r, dimsa, dimsr, dna;`	1699	`SEXP a, perm, r, dimsa, dimsr, dna;`
1700	`int i, j, n, itmp;`	1700	`int i, j, n, itmp;`
1701		1701
1702	`checkArity(op, args);`	1702	`checkArity(op, args);`
Line 1872...	Line 1872...
1872	`UNPROTECT(3); /* dimsa, r, dimsr */`	1872	`UNPROTECT(3); /* dimsa, r, dimsr */`
1873	`return r;`	1873	`return r;`
1874	`}`	1874	`}`
1875		1875
1876	`/* colSums(x, n, p, na.rm) and friends */`	1876	`/* colSums(x, n, p, na.rm) and friends */`
1877	`SEXP attribute_hidden do_colsum(SEXP call, SEXP op, SEXP args, SEXP rho)`	1877	`attribute_hidden SEXP do_colsum(SEXP call, SEXP op, SEXP args, SEXP rho)`
1878	`{`	1878	`{`
1879	`SEXP x, ans = R_NilValue;`	1879	`SEXP x, ans = R_NilValue;`
1880	`int type;`	1880	`int type;`
1881	`Rboolean NaRm, keepNA;`	1881	`Rboolean NaRm, keepNA;`
1882		1882
Line 2045...	Line 2045...
2045	`data`	2045	`data`
2046	`}`	2046	`}`
2047	`*/`	2047	`*/`
2048		2048
2049	`/* array(data, dim, dimnames) */`	2049	`/* array(data, dim, dimnames) */`
2050	`SEXP attribute_hidden do_array(SEXP call, SEXP op, SEXP args, SEXP rho)`	2050	`attribute_hidden SEXP do_array(SEXP call, SEXP op, SEXP args, SEXP rho)`
2051	`{`	2051	`{`
2052	`SEXP vals, ans, dims, dimnames;`	2052	`SEXP vals, ans, dims, dimnames;`
2053	`R_xlen_t lendat, i, nans;`	2053	`R_xlen_t lendat, i, nans;`
2054		2054
2055	`checkArity(op, args);`	2055	`checkArity(op, args);`
Line 2159...	Line 2159...
2159		2159
2160	`UNPROTECT(2);`	2160	`UNPROTECT(2);`
2161	`return ans;`	2161	`return ans;`
2162	`}`	2162	`}`
2163		2163
2164	`SEXP attribute_hidden do_diag(SEXP call, SEXP op, SEXP args, SEXP rho)`	2164	`attribute_hidden SEXP do_diag(SEXP call, SEXP op, SEXP args, SEXP rho)`
2165	`{`	2165	`{`
2166	`SEXP ans, x, snr, snc;`	2166	`SEXP ans, x, snr, snc;`
2167	`int nr = 1, nc = 1, nprotect = 1;`	2167	`int nr = 1, nc = 1, nprotect = 1;`
2168		2168
2169	`checkArity(op, args);`	2169	`checkArity(op, args);`
Line 2254...	Line 2254...
2254	`return ans;`	2254	`return ans;`
2255	`}`	2255	`}`
2256		2256
2257		2257
2258	`/* backsolve(r, b, k, upper.tri, transpose) */`	2258	`/* backsolve(r, b, k, upper.tri, transpose) */`
2259	`SEXP attribute_hidden do_backsolve(SEXP call, SEXP op, SEXP args, SEXP rho)`	2259	`attribute_hidden SEXP do_backsolve(SEXP call, SEXP op, SEXP args, SEXP rho)`
2260	`{`	2260	`{`
2261	`int nprot = 1;`	2261	`int nprot = 1;`
2262	`checkArity(op, args);`	2262	`checkArity(op, args);`
2263		2263
2264	`SEXP r = CAR(args); args = CDR(args);`	2264	`SEXP r = CAR(args); args = CDR(args);`
Line 2300...	Line 2300...
2300	`UNPROTECT(nprot);`	2300	`UNPROTECT(nprot);`
2301	`return ans;`	2301	`return ans;`
2302	`}`	2302	`}`
2303		2303
2304	`/* max.col(m, ties.method) */`	2304	`/* max.col(m, ties.method) */`
2305	`SEXP attribute_hidden do_maxcol(SEXP call, SEXP op, SEXP args, SEXP rho)`	2305	`attribute_hidden SEXP do_maxcol(SEXP call, SEXP op, SEXP args, SEXP rho)`
2306	`{`	2306	`{`
2307	`checkArity(op, args);`	2307	`checkArity(op, args);`
2308	`SEXP m = CAR(args);`	2308	`SEXP m = CAR(args);`
2309	`int method = asInteger(CADR(args));`	2309	`int method = asInteger(CADR(args));`
2310	`int nr = nrows(m), nc = ncols(m), nprot = 1;`	2310	`int nr = nrows(m), nc = ncols(m), nprot = 1;`

The R Project SVN R

(root)/trunk/src/main/array.c @ 77458 – Rev 81479 → 83446