The R Project SVN R

Rev

Rev 74030 | Rev 75325 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 74030 Rev 75324
Line 1... Line 1...
1
/*
1
/*
2
 *  R : A Computer Language for Statistical Data Analysis
2
 *  R : A Computer Language for Statistical Data Analysis
3
 *  Copyright (C) 1998-2017   The R Core Team
3
 *  Copyright (C) 1998-2018   The R Core Team
4
 *  Copyright (C) 2002-2015   The R Foundation
4
 *  Copyright (C) 2002-2015   The R Foundation
5
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
5
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
6
 *
6
 *
7
 *  This program is free software; you can redistribute it and/or modify
7
 *  This program is free software; you can redistribute it and/or modify
8
 *  it under the terms of the GNU General Public License as published by
8
 *  it under the terms of the GNU General Public License as published by
Line 240... Line 240...
240
 
240
 
241
    if (nrow < 0 || ncol < 0 || nface < 0)
241
    if (nrow < 0 || ncol < 0 || nface < 0)
242
	error(_("negative extents to 3D array"));
242
	error(_("negative extents to 3D array"));
243
#ifndef LONG_VECTOR_SUPPORT
243
#ifndef LONG_VECTOR_SUPPORT
244
    if ((double)nrow * (double)ncol * (double)nface > INT_MAX)
244
    if ((double)nrow * (double)ncol * (double)nface > INT_MAX)
245
	error(_("'alloc3Darray': too many elements specified"));
245
	error(_("'alloc3DArray': too many elements specified"));
246
#endif
246
#endif
247
    n = ((R_xlen_t) nrow) * ncol * nface;
247
    n = ((R_xlen_t) nrow) * ncol * nface;
248
    PROTECT(s = allocVector(mode, n));
248
    PROTECT(s = allocVector(mode, n));
249
    PROTECT(t = allocVector(INTSXP, 3));
249
    PROTECT(t = allocVector(INTSXP, 3));
250
    INTEGER(t)[0] = nrow;
250
    INTEGER(t)[0] = nrow;
Line 262... Line 262...
262
    int i;
262
    int i;
263
    R_xlen_t n = 1;
263
    R_xlen_t n = 1;
264
    double dn = 1;
264
    double dn = 1;
265
 
265
 
266
    for (i = 0; i < LENGTH(dims); i++) {
266
    for (i = 0; i < LENGTH(dims); i++) {
267
	dn *= INTEGER(dims)[i];
-
 
268
#ifndef LONG_VECTOR_SUPPORT
267
#ifndef LONG_VECTOR_SUPPORT
-
 
268
	dn *= INTEGER(dims)[i];
269
	if(dn > INT_MAX)
269
	if(dn > INT_MAX)
270
	    error(_("'allocArray': too many elements specified by 'dims'"));
270
	    error(_("'allocArray': too many elements specified by 'dims'"));
271
#endif
271
#endif
272
	n *= INTEGER(dims)[i];
272
	n *= INTEGER(dims)[i];
273
    }
273
    }
Line 567... Line 567...
567
    return ans;
567
    return ans;
568
}
568
}
569
 
569
 
570
SEXP attribute_hidden do_rowscols(SEXP call, SEXP op, SEXP args, SEXP rho)
570
SEXP attribute_hidden do_rowscols(SEXP call, SEXP op, SEXP args, SEXP rho)
571
{
571
{
572
    SEXP x, ans;
-
 
573
    int i, j, nr, nc;
-
 
574
 
-
 
575
    checkArity(op, args);
572
    checkArity(op, args);
576
    /* This is the dimensions vector */
573
    SEXP dim = CAR(args);
577
    x = CAR(args);
574
    int nprot = 0;
578
    if (!isInteger(x) || LENGTH(x) != 2)
575
    if (!isInteger(dim)) {
-
 
576
	PROTECT(dim = coerceVector(dim, INTSXP)); nprot++;
-
 
577
    }
-
 
578
    if (LENGTH(dim) != 2)
579
	error(_("a matrix-like object is required as argument to '%s'"),
579
	error(_("a matrix-like object is required as argument to '%s'"),
580
	      (PRIMVAL(op) == 2) ? "col" : "row");
580
	      (PRIMVAL(op) == 2) ? "col" : "row");
581
 
581
 
582
    nr = INTEGER(x)[0];
582
    int nr = INTEGER(dim)[0],
583
    nc = INTEGER(x)[1];
583
	nc = INTEGER(dim)[1];
-
 
584
    if(nprot) UNPROTECT(nprot);
584
 
585
 
585
    ans = allocMatrix(INTSXP, nr, nc);
586
    SEXP ans = allocMatrix(INTSXP, nr, nc);
586
 
587
 
587
    R_xlen_t NR = nr;
588
    R_xlen_t NR = nr;
588
    switch (PRIMVAL(op)) {
589
    switch (PRIMVAL(op)) {
589
    case 1:
590
    case 1: // row() & .row()
590
	for (i = 0; i < nr; i++)
591
	for (int i = 0; i < nr; i++)
591
	    for (j = 0; j < nc; j++)
592
	    for (int j = 0; j < nc; j++)
592
		INTEGER(ans)[i + j * NR] = i + 1;
593
		INTEGER(ans)[i + j * NR] = i + 1;
593
	break;
594
	break;
594
    case 2:
595
    case 2: // col() & .col()
595
	for (i = 0; i < nr; i++)
596
	for (int i = 0; i < nr; i++)
596
	    for (j = 0; j < nc; j++)
597
	    for (int j = 0; j < nc; j++)
597
		INTEGER(ans)[i + j * NR] = j + 1;
598
		INTEGER(ans)[i + j * NR] = j + 1;
598
	break;
599
	break;
599
    }
600
    }
600
    return ans;
601
    return ans;
601
}
602
}