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

 /*
  *  R : A Computer Language for Statistical Data Analysis
  *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
- *  Copyright (C) 1997--2003  Robert Gentleman, Ross Ihaka and the
+ *  Copyright (C) 1997--2005  Robert Gentleman, Ross Ihaka and the
  *                            R Development Core Team
+ *
  *  This program is free software; you can redistribute it and/or modify
  *  it under the terms of the GNU General Public License as published by
  *  the Free Software Foundation; either version 2 of the License, or
 /* Special Matrix Subscripting: Handles the case x[i] where */
 /* x is an n-way array and i is a matrix with n columns. */
 /* This code returns a vector containing the integer subscripts */
 /* to be extracted when x is regarded as unravelled. */
+/* Negative indices are not allowed. */
+/* A zero anywhere in a row will cause a zero in the same */
+/* position in the result. */
 SEXP mat2indsub(SEXP dims, SEXP s)
+{
-    int tdim, j, i, nrs = nrows(s);
+    int tdim, j, i, k, nrs = nrows(s);
     SEXP rvec;
+    if (ncols(s) != LENGTH(dims))
+	error(_("incorrect number of columns in matrix subscript"));
     PROTECT(rvec = allocVector(INTSXP, nrs));
     s = coerceVector(s, INTSXP);
     setIVector(INTEGER(rvec), nrs, 0);
-    /* compute 0-based subscripts */
     for (i = 0; i < nrs; i++) {
 	tdim = 1;
+	/* compute 0-based subscripts for a row (0 in the input gets -1
+	   in the output here) */
 	for (j = 0; j < LENGTH(dims); j++) {
-	    if(INTEGER(s)[i + j * nrs] == NA_INTEGER) {
+	    k = INTEGER(s)[i + j * nrs];
+	    if(k == NA_INTEGER) {
 		INTEGER(rvec)[i] = NA_INTEGER;
 		break;
+	    }
+	    if(k < 0) error(_("negative values are not allowed in a matrix subscript"));
+	    if(k == 0) {
+		INTEGER(rvec)[i] = -1;
+		break;
+	    }
-	    if (INTEGER(s)[i + j * nrs] > INTEGER(dims)[j])
+	    if (k > INTEGER(dims)[j])
 		error(_("subscript out of bounds"));
-	    INTEGER(rvec)[i] += (INTEGER(s)[i+j*nrs] - 1) * tdim;
+	    INTEGER(rvec)[i] += (k - 1) * tdim;
 	    tdim *= INTEGER(dims)[j];
+	}
-	/* transform to 1 based subscripting */
+	/* transform to 1 based subscripting (0 in the input gets 0
+	   in the output here) */
 	if(INTEGER(rvec)[i] != NA_INTEGER)
 	    INTEGER(rvec)[i]++;
+    }
     UNPROTECT(1);
     return (rvec);

The R Project SVN R

(root)/trunk/src/main/subscript.c – Rev 33387 → 34194