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

 /* moved from printutils.c */
 static void MatrixColumnLabel(SEXP cl, int j, int w)
+{
-    int l;
-    SEXP tmp;
     if (!isNull(cl)) {
-	tmp = STRING_ELT(cl, j);
+	SEXP tmp = STRING_ELT(cl, j);
-	if(tmp == NA_STRING) l = R_print.na_width_noquote;
+	int l = (tmp == NA_STRING) ? R_print.na_width_noquote : Rstrlen(tmp, 0);
-	else l = Rstrlen(tmp, 0);
 	Rprintf("%*s%s", w-l, "",
 		EncodeString(tmp, l, 0, Rprt_adj_left));
+    }
     else {
 	Rprintf("%*s[,%ld]", w-IndexWidth(j+1)-3, "", j+1);
+    }
+}
 static void RightMatrixColumnLabel(SEXP cl, int j, int w)
+{
-    int l;
-    SEXP tmp;
     if (!isNull(cl)) {
-	tmp = STRING_ELT(cl, j);
+	SEXP tmp = STRING_ELT(cl, j);
-	if(tmp == NA_STRING) l = R_print.na_width_noquote;
+	int l = (tmp == NA_STRING) ? R_print.na_width_noquote : Rstrlen(tmp, 0);
-	else l = Rstrlen(tmp, 0);
 	/* This does not work correctly at least on FC3
 	Rprintf("%*s", R_print.gap+w,
 		EncodeString(tmp, l, 0, Rprt_adj_right)); */
 	Rprintf("%*s%s", R_print.gap+w-l, "",
 		EncodeString(tmp, l, 0, Rprt_adj_right));
+    }
+}
 static void LeftMatrixColumnLabel(SEXP cl, int j, int w)
+{
-    int l;
-    SEXP tmp;
     if (!isNull(cl)) {
-	tmp= STRING_ELT(cl, j);
+	SEXP tmp = STRING_ELT(cl, j);
-	if(tmp == NA_STRING) l = R_print.na_width_noquote;
+	int l = (tmp == NA_STRING) ? R_print.na_width_noquote : Rstrlen(tmp, 0);
-	else l = Rstrlen(tmp, 0);
 	Rprintf("%*s%s%*s", R_print.gap, "",
 		EncodeString(tmp, l, 0, Rprt_adj_left), w-l, "");
+    }
     else {
 	Rprintf("%*s[,%ld]%*s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");
+    }
+}
 static void MatrixRowLabel(SEXP rl, int i, int rlabw, int lbloff)
+{
-    int l;
-    SEXP tmp;
     if (!isNull(rl)) {
-	tmp= STRING_ELT(rl, i);
+	SEXP tmp = STRING_ELT(rl, i);
-	if(tmp == NA_STRING) l = R_print.na_width_noquote;
+	int l = (tmp == NA_STRING) ? R_print.na_width_noquote : Rstrlen(tmp, 0);
-	else l = Rstrlen(tmp, 0);
 	Rprintf("\n%*s%s%*s", lbloff, "",
 		EncodeString(tmp, l, 0, Rprt_adj_left),
 		rlabw-l-lbloff, "");
+    }
     else {
 /* This is the first (of 6)  print<TYPE>Matrix()  functions.
  * We define macros that will be re-used in the other functions,
  * and comment the common code here (only):
 */
 static void printLogicalMatrix(SEXP sx, int offset, int r_pr, int r, int c,
-			       SEXP rl, SEXP cl, const char *rn, const char *cn)
+			       SEXP rl, SEXP cl, const char *rn, const char *cn,
+			       Rboolean print_ij)
+{
 /* initialization; particularly of row labels, rl= dimnames(.)[[1]] and
  * rn = names(dimnames(.))[1] : */
 #define _PRINT_INIT_rl_rn				\
     int *w = (int *) R_alloc(c, sizeof(int));		\
 	    lbloff = rnw - rlabw;			\
+							\
 	rlabw += lbloff;				\
+    }
-    _PRINT_INIT_rl_rn;
-    int *x = LOGICAL(sx) + offset;
+#   define _COMPUTE_W2_(_FORMAT_j_, _LAST_j_)				\
-    /* compute w[j] = column-width of j(+1)-th column : */
+    /* compute w[j] = column-width of j(+1)-th column : */		\
-    for (j = 0; j < c; j++) {
+    for (j = 0; j < c; j++) {						\
-	formatLogical(&x[j * r], (R_xlen_t) r, &w[j]);
-#	define _PRINT_SET_clabw					\
+	if(print_ij) { _FORMAT_j_; } else w[j] = 0;			\
-								\
+									\
-	if (!isNull(cl)) {					\
+	if (!isNull(cl)) {						\
-	    const void *vmax = vmaxget();			\
+	    const void *vmax = vmaxget();				\
-	    if(STRING_ELT(cl, j) == NA_STRING)			\
+	    if(STRING_ELT(cl, j) == NA_STRING)				\
-		clabw = R_print.na_width_noquote;		\
+		clabw = R_print.na_width_noquote;			\
 	    else clabw = strwidth(translateChar(STRING_ELT(cl, j)));	\
-	    vmaxset(vmax);					\
+	    vmaxset(vmax);						\
-	} else							\
+	} else								\
-	    clabw = IndexWidth(j + 1) + 3;
+	    clabw = IndexWidth(j + 1) + 3;				\
-	_PRINT_SET_clabw;
+									\
-	if (w[j] < clabw)
+	if (w[j] < clabw)						\
-	    w[j] = clabw;
+	    w[j] = clabw;						\
-	w[j] += R_print.gap;
+	_LAST_j_;							\
+    }
-#   define _PRINT_DEAL_c_eq_0				\
+#   define _COMPUTE_W_(F_j) _COMPUTE_W2_(F_j, w[j] += R_print.gap)
-							\
-    if (c == 0) {					\
-	for (i = 0; i < r; i++)				\
-	    MatrixRowLabel(rl, i, rlabw, lbloff);	\
+    //                               _LAST_j  ------------------- for all but String
-	Rprintf("\n");					\
-	return;						\
-    }
-    _PRINT_DEAL_c_eq_0;
+#   define _PRINT_ROW_LAB			\
+						\
+    if (cn != NULL)				\
+	Rprintf("%*s%s\n", rlabw, "", cn);	\
+    if (rn != NULL)				\
+	Rprintf("%*s", -rlabw, rn);		\
+    else					\
+	Rprintf("%*s", rlabw, "")
+#   define _PRINT_MATRIX_(_W_EXTRA_, DO_COLUMN_LABELS, ENCODE_I_J)	\
+									\
+    if (c == 0) {							\
+	_PRINT_ROW_LAB;							\
+	for (i = 0; i < r; i++)						\
+	    MatrixRowLabel(rl, i, rlabw, lbloff);			\
+	Rprintf("\n");							\
+    }									\
-    while (jmin < c) {
+    else while (jmin < c) {						\
-	/* print columns  jmin:(jmax-1)	 where jmax has to be determined first */
+	/* print columns  jmin:(jmax-1)	 where jmax has to be determined first */ \
+									\
+	width = rlabw;							\
+	/* initially, jmax = jmin */					\
+	do {								\
+	    width += w[jmax] _W_EXTRA_;					\
+	    jmax++;							\
+	}								\
+	while (jmax < c && width + w[jmax] _W_EXTRA_ < R_print.width);	\
+									\
+	_PRINT_ROW_LAB;							\
+									\
+	DO_COLUMN_LABELS;						\
+									\
+	for (i = 0; i < r_pr; i++) {					\
+	    MatrixRowLabel(rl, i, rlabw, lbloff); /* starting with an "\n" */ \
+	    if(print_ij) for (j = jmin; j < jmax; j++) {		\
+		ENCODE_I_J;						\
+	    }								\
+	}								\
+	Rprintf("\n");							\
+	jmin = jmax;							\
+    }
+#   define STD_ColumnLabels			\
+	for (j = jmin; j < jmax ; j++)		\
+	    MatrixColumnLabel(cl, j, w[j])
-	width = rlabw;
+    _PRINT_INIT_rl_rn;
-	/* initially, jmax = jmin */
-	do {
-	    width += w[jmax]; jmax++;
+    int *x = LOGICAL(sx) + offset;
+    _COMPUTE_W_(formatLogical(&x[j * r], (R_xlen_t) r, &w[j]));
+    _PRINT_MATRIX_( , STD_ColumnLabels,
-	} while (jmax < c && width + w[jmax] < R_print.width);
+		   Rprintf("%s", EncodeLogical(x[i + j * r], w[j])));
-#	define _PRINT_ROW_LAB			\
-						\
-	if (cn != NULL)				\
-	    Rprintf("%*s%s\n", rlabw, "", cn);	\
-						\
-	if (rn != NULL)				\
-	    Rprintf("%*s", -rlabw, rn);		\
-	else					\
-	    Rprintf("%*s", rlabw, "");
-	_PRINT_ROW_LAB;
-	for (j = jmin; j < jmax ; j++)
-	    MatrixColumnLabel(cl, j, w[j]);
-	for (i = 0; i < r_pr; i++) {
-	    MatrixRowLabel(rl, i, rlabw, lbloff); /* starting with an "\n" */
-	    for (j = jmin; j < jmax; j++) {
-		Rprintf("%s", EncodeLogical(x[i + j * r], w[j]));
-	    }
-	}
-	Rprintf("\n");
-	jmin = jmax;
-    }
+}
 static void printIntegerMatrix(SEXP sx, int offset, int r_pr, int r, int c,
-			       SEXP rl, SEXP cl, const char *rn, const char *cn)
+			       SEXP rl, SEXP cl, const char *rn, const char *cn,
+			       Rboolean print_ij)
+{
     _PRINT_INIT_rl_rn;
     int *x = INTEGER(sx) + offset;
-    for (j = 0; j < c; j++) {
-	formatInteger(&x[j * r], (R_xlen_t) r, &w[j]);
+    _COMPUTE_W_( formatInteger(&x[j * r], (R_xlen_t) r, &w[j]) );
-	_PRINT_SET_clabw;
-	if (w[j] < clabw)
-	    w[j] = clabw;
-	w[j] += R_print.gap;
-    }
-    _PRINT_DEAL_c_eq_0;
-    while (jmin < c) {
-	width = rlabw;
-	do {
-	    width += w[jmax];
-	    jmax++;
-	}
-	while (jmax < c && width + w[jmax] < R_print.width);
-	_PRINT_ROW_LAB;
-	for (j = jmin; j < jmax ; j++)
-	    MatrixColumnLabel(cl, j, w[j]);
-	for (i = 0; i < r_pr; i++) {
-	    MatrixRowLabel(rl, i, rlabw, lbloff);
+    _PRINT_MATRIX_( , STD_ColumnLabels,
-	    for (j = jmin; j < jmax; j++) {
-		Rprintf("%s", EncodeInteger(x[i + j * r], w[j]));
+		   Rprintf("%s", EncodeInteger(x[i + j * r], w[j])));
-	    }
-	}
-	Rprintf("\n");
-	jmin = jmax;
-    }
+}
 static void printRealMatrix(SEXP sx, int offset, int r_pr, int r, int c,
-			    SEXP rl, SEXP cl, const char *rn, const char *cn)
+			    SEXP rl, SEXP cl, const char *rn, const char *cn,
+			    Rboolean print_ij)
+{
     _PRINT_INIT_rl_rn;
     double *x = REAL(sx) + offset;
     int *d = (int *) R_alloc(c, sizeof(int)),
 	*e = (int *) R_alloc(c, sizeof(int));
-    for (j = 0; j < c; j++) {
-	formatReal(&x[j * r], (R_xlen_t) r, &w[j], &d[j], &e[j], 0);
+    _COMPUTE_W_( formatReal(&x[j * r], (R_xlen_t) r, &w[j], &d[j], &e[j], 0) );
-	_PRINT_SET_clabw;
-	if (w[j] < clabw)
-	    w[j] = clabw;
-	w[j] += R_print.gap;
-    }
-    _PRINT_DEAL_c_eq_0;
-    while (jmin < c) {
-	width = rlabw;
-	do {
-	    width += w[jmax];
-	    jmax++;
-	}
-	while (jmax < c && width + w[jmax] < R_print.width);
-	_PRINT_ROW_LAB;
-	for (j = jmin; j < jmax ; j++)
-	    MatrixColumnLabel(cl, j, w[j]);
-	for (i = 0; i < r_pr; i++) {
-	    MatrixRowLabel(rl, i, rlabw, lbloff);
+    _PRINT_MATRIX_( , STD_ColumnLabels,
-	    for (j = jmin; j < jmax; j++) {
-		Rprintf("%s", EncodeReal0(x[i + j * r], w[j], d[j], e[j], OutDec));
+		   Rprintf("%s", EncodeReal0(x[i + j * r], w[j], d[j], e[j], OutDec)) );
-	    }
-	}
-	Rprintf("\n");
-	jmin = jmax;
-    }
+}
 static void printComplexMatrix(SEXP sx, int offset, int r_pr, int r, int c,
-			       SEXP rl, SEXP cl, const char *rn, const char *cn)
+			       SEXP rl, SEXP cl, const char *rn, const char *cn,
+			       Rboolean print_ij)
+{
     _PRINT_INIT_rl_rn;
     Rcomplex *x = COMPLEX(sx) + offset;
     int *dr = (int *) R_alloc(c, sizeof(int)),
 	*er = (int *) R_alloc(c, sizeof(int)),
 	*wr = (int *) R_alloc(c, sizeof(int)),
 	*di = (int *) R_alloc(c, sizeof(int)),
 	*ei = (int *) R_alloc(c, sizeof(int)),
 	*wi = (int *) R_alloc(c, sizeof(int));
     /* Determine the column widths */
-    for (j = 0; j < c; j++) {
-	formatComplex(&x[j * r], (R_xlen_t) r,
+    _COMPUTE_W_( formatComplex(&x[j * r], (R_xlen_t) r,
-		      &wr[j], &dr[j], &er[j],
+			       &wr[j], &dr[j], &er[j],
-		      &wi[j], &di[j], &ei[j], 0);
+			       &wi[j], &di[j], &ei[j], 0);
-	_PRINT_SET_clabw;
-	w[j] = wr[j] + wi[j] + 2;
+		 w[j] = wr[j] + wi[j] + 2 );
-	if (w[j] < clabw)
-	    w[j] = clabw;
-	w[j] += R_print.gap;
-    }
-    _PRINT_DEAL_c_eq_0;
+    _PRINT_MATRIX_( , STD_ColumnLabels,
-    while (jmin < c) {
-	width = rlabw;
-	do {
-	    width += w[jmax];
-	    jmax++;
-	}
-	while (jmax < c && width + w[jmax] < R_print.width);
-	_PRINT_ROW_LAB;
-	for (j = jmin; j < jmax ; j++)
-	    MatrixColumnLabel(cl, j, w[j]);
-	for (i = 0; i < r_pr; i++) {
-	    MatrixRowLabel(rl, i, rlabw, lbloff);
-	    for (j = jmin; j < jmax; j++) {
-		if (ISNA(x[i + j * r].r) || ISNA(x[i + j * r].i))
+		   if (ISNA(x[i + j * r].r) || ISNA(x[i + j * r].i))
-		    Rprintf("%s", EncodeReal0(NA_REAL, w[j], 0, 0, OutDec));
+		       Rprintf("%s", EncodeReal0(NA_REAL, w[j], 0, 0, OutDec));
-		else
+		   else
-		    Rprintf("%s",
+		       Rprintf("%s",
-			    EncodeComplex(x[i + j * r],
+			       EncodeComplex(x[i + j * r],
-					  wr[j] + R_print.gap, dr[j], er[j],
+					     wr[j] + R_print.gap, dr[j], er[j],
-					  wi[j], di[j], ei[j], OutDec));
+					     wi[j], di[j], ei[j], OutDec)) )
-	    }
-	}
-	Rprintf("\n");
-	jmin = jmax;
-    }
+}
 static void printStringMatrix(SEXP sx, int offset, int r_pr, int r, int c,
 			      int quote, int right, SEXP rl, SEXP cl,
-			      const char *rn, const char *cn)
+			      const char *rn, const char *cn, Rboolean print_ij)
+{
     _PRINT_INIT_rl_rn;
     SEXP *x = STRING_PTR(sx)+offset;
-    for (j = 0; j < c; j++) {
-	formatString(&x[j * r], (R_xlen_t) r, &w[j], quote);
+    _COMPUTE_W2_( formatString(&x[j * r], (R_xlen_t) r, &w[j], quote), );
-	_PRINT_SET_clabw;
-	if (w[j] < clabw)
-	    w[j] = clabw;
-    }
-    _PRINT_DEAL_c_eq_0;
-    while (jmin < c) {
-	width = rlabw;
-	do {
-	    width += w[jmax] + R_print.gap;
-	    jmax++;
-	}
-	while (jmax < c && width + w[jmax] + R_print.gap < R_print.width);
-	_PRINT_ROW_LAB;
+    _PRINT_MATRIX_( + R_print.gap,
+	           /* DO_COLUMN_LABELS = */
-	if (right) {
+		   if (right) {
-	    for (j = jmin; j < jmax ; j++)
+		       for (j = jmin; j < jmax ; j++)
-		RightMatrixColumnLabel(cl, j, w[j]);
+			   RightMatrixColumnLabel(cl, j, w[j]);
-	}
+		   }
-	else {
+		   else {
-	    for (j = jmin; j < jmax ; j++)
+		       for (j = jmin; j < jmax ; j++)
-		LeftMatrixColumnLabel(cl, j, w[j]);
+			   LeftMatrixColumnLabel(cl, j, w[j]);
-	}
+		   },
-	for (i = 0; i < r_pr; i++) {
+		   /* ENCODE_I = */
-	    MatrixRowLabel(rl, i, rlabw, lbloff);
-	    for (j = jmin; j < jmax; j++) {
-		Rprintf("%*s%s", R_print.gap, "",
+		   Rprintf("%*s%s", R_print.gap, "",
-			EncodeString(x[i + j * r], w[j], quote, right));
+			   EncodeString(x[i + j * r], w[j], quote, right)) );
-	    }
-	}
-	Rprintf("\n");
-	jmin = jmax;
-    }
+}
 static void printRawMatrix(SEXP sx, int offset, int r_pr, int r, int c,
-			   SEXP rl, SEXP cl, const char *rn, const char *cn)
+			   SEXP rl, SEXP cl, const char *rn, const char *cn,
+			   Rboolean print_ij)
+{
     _PRINT_INIT_rl_rn;
     Rbyte *x = RAW(sx) + offset;
-    for (j = 0; j < c; j++) {
-	formatRaw(&x[j * r], (R_xlen_t) r, &w[j]);
+    _COMPUTE_W_( formatRaw(&x[j * r], (R_xlen_t) r, &w[j]) )
-	_PRINT_SET_clabw;
-	if (w[j] < clabw)
-	    w[j] = clabw;
-	w[j] += R_print.gap;
-    }
-    _PRINT_DEAL_c_eq_0;
-    while (jmin < c) {
-	width = rlabw;
-	do {
-	    width += w[jmax];
-	    jmax++;
-	}
-	while (jmax < c && width + w[jmax] < R_print.width);
-	_PRINT_ROW_LAB;
-	for (j = jmin; j < jmax ; j++)
-	    MatrixColumnLabel(cl, j, w[j]);
-	for (i = 0; i < r_pr; i++) {
-	    MatrixRowLabel(rl, i, rlabw, lbloff);
+    _PRINT_MATRIX_( , STD_ColumnLabels,
-	    for (j = jmin; j < jmax; j++)
-		Rprintf("%*s%s", w[j]-2, "", EncodeRaw(x[i + j * r], ""));
+		   Rprintf("%*s%s", w[j]-2, "", EncodeRaw(x[i + j * r], "")) );
-	}
-	Rprintf("\n");
-	jmin = jmax;
-    }
+}
 attribute_hidden
 void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,
 		 SEXP rl, SEXP cl, const char *rn, const char *cn)
     /* PR#850 */
     if ((rl != R_NilValue) && (r > length(rl)))
 	error(_("too few row labels"));
     if ((cl != R_NilValue) && (c > length(cl)))
 	error(_("too few column labels"));
-    if (r == 0 && c == 0) {
+    if (r == 0 && c == 0) { // FIXME?  names(dimnames(.)) :
 	Rprintf("<0 x 0 matrix>\n");
 	return;
+    }
     r_pr = r;
     if(c > 0 && R_print.max / c < r) /* avoid integer overflow */
 	/* using floor(), not ceil(), since 'c' could be huge: */
 	r_pr = R_print.max / c;
     switch (TYPEOF(x)) {
     case LGLSXP:
-	printLogicalMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
+	printLogicalMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 	break;
     case INTSXP:
-	printIntegerMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
+	printIntegerMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 	break;
     case REALSXP:
-	printRealMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn);
+	printRealMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 	break;
     case CPLXSXP:
-	printComplexMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
+	printComplexMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 	break;
     case STRSXP:
 	if (quote) quote = '"';
-	printStringMatrix (x, offset, r_pr, r, c, quote, right, rl, cl, rn, cn);
+	printStringMatrix (x, offset, r_pr, r, c, quote, right, rl, cl, rn, cn, TRUE);
 	break;
     case RAWSXP:
-	printRawMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn);
+	printRawMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 	break;
     default:
 	UNIMPLEMENTED_TYPE("printMatrix", x);
+    }
 #ifdef ENABLE_NLS
 	Rprintf(ngettext(" [ reached getOption(\"max.print\") -- omitted %d row ]\n",
 			 " [ reached getOption(\"max.print\") -- omitted %d rows ]\n",
 			 r - r_pr),
 		r - r_pr);
 #else
     if(r_pr < r)
 	Rprintf(" [ reached getOption(\"max.print\") -- omitted %d rows ]\n",
 		r - r_pr);
 #endif
     vmaxset(vmax);
+}
 	GetMatrixDimnames(x, &rl, &cl, &rn, &cn);
 	printMatrix(x, 0, dim, quote, 0, rl, cl, rn, cn);
+    }
     else { /* ndim >= 3 */
 	SEXP dn, dnn, dn0, dn1;
-	int i, j, has_dimnames, has_dnn, nb, nb_pr;
+	int i, j, nb, nb_pr, nr_last,
-	int nr = INTEGER(dim)[0], nr_last;
+	    *dims = INTEGER(dim), nr = dims[0], nc = dims[1],
-	int nc = INTEGER(dim)[1];
-	int b = nr * nc;
+	    b = nr * nc;
+	Rboolean max_reached, has_dimnames = (dimnames != R_NilValue),
-	Rboolean max_reached;
+	    has_dnn = has_dimnames;
-	if (dimnames == R_NilValue) {
-	    has_dimnames = 0;
+	if (!has_dimnames) {
-	    has_dnn = 0;
 	    dn0 = R_NilValue;
 	    dn1 = R_NilValue;
 	    dnn = R_NilValue; /* -Wall */
+	}
 	else {
 	    dn0 = VECTOR_ELT(dimnames, 0);
 	    dn1 = VECTOR_ELT(dimnames, 1);
-	    has_dimnames = 1;
 	    dnn = getAttrib(dimnames, R_NamesSymbol);
 	    has_dnn = !isNull(dnn);
 	    if ( has_dnn ) {
 		rn = (char *) translateChar(STRING_ELT(dnn, 0));
 		cn = (char *) translateChar(STRING_ELT(dnn, 1));
+	}
 	/* nb := #{entries} in a slice such as x[1,1,..] or equivalently,
 	 *       the number of matrix slices   x[ , , *, ..]  which
 	 *       are printed as matrices -- if options("max.print") allows */
 	for (i = 2, nb = 1; i < ndim; i++)
-	    nb *= INTEGER(dim)[i];
+	    nb *= dims[i];
 	max_reached = (b > 0 && R_print.max / b < nb);
 	if (max_reached) { /* i.e., also  b > 0, nr > 0, nc > 0, nb > 0 */
 	    /* nb_pr := the number of matrix slices to be printed */
 	    nb_pr = ceil_DIV(R_print.max, b);
 	    /* for the last, (nb_pr)th matrix slice, use only nr_last rows;
 	     *  using floor(), not ceil(), since 'nc' could be huge: */
 	    nr_last = (R_print.max - b * (nb_pr - 1)) / nc;
 	    if(nr_last == 0) { nb_pr--; nr_last = nr; }
 	} else {
-	    nb_pr = nb;
+	    nb_pr = (nb > 0) ? nb : 1; // do print *something* when dim = c(a,b,0)
 	    nr_last = nr;
+	}
 	for (i = 0; i < nb_pr; i++) {
-	    int k = 1, use_nr = nr;
+	    Rboolean do_ij = nb > 0,
-	    if (i == nb_pr - 1) { /* for the last slice :*/
+		i_last = (i == nb_pr - 1); /* for the last slice */
-		use_nr = nr_last;
+	    int use_nr = i_last ? nr_last : nr;
+	    if(do_ij) {
-	    }
+		int k = 1;
-	    Rprintf(", ");
+		Rprintf(", ");
-	    for (j = 2 ; j < ndim; j++) {
+		for (j = 2 ; j < ndim; j++) {
-		int l = (i / k) % INTEGER(dim)[j] + 1;
+		    int l = (i / k) % dims[j] + 1;
-		if (has_dimnames &&
+		    if (has_dimnames &&
-		    ((dn = VECTOR_ELT(dimnames, j)) != R_NilValue)) {
+			((dn = VECTOR_ELT(dimnames, j)) != R_NilValue)) {
-		    if ( has_dnn )
+			if ( has_dnn )
-			Rprintf(", %s = %s",
+			    Rprintf(", %s = %s",
-				translateChar(STRING_ELT(dnn, j)),
+				    translateChar(STRING_ELT(dnn, j)),
-				translateChar(STRING_ELT(dn, l - 1)));
+				    translateChar(STRING_ELT(dn, l - 1)));
-		    else
+			else
-			Rprintf(", %s", translateChar(STRING_ELT(dn, l - 1)));
+			    Rprintf(", %s", translateChar(STRING_ELT(dn, l - 1)));
-		} else
+		    } else
-		    Rprintf(", %d", l);
+			Rprintf(", %d", l);
-		k = k * INTEGER(dim)[j];
+		    k *= dims[j];
+		}
+		Rprintf("\n\n");
+	    } else { // nb == 0 -- e.g. <2 x 3 x 0 array of logical>
+		for (i = 0; i < ndim; i++)
+		    Rprintf("%s%d", (i == 0) ? "<" : " x ", dims[i]);
+		Rprintf(" array of %s>\n", CHAR(type2str_nowarn(TYPEOF(x))));
+	    }
-	    Rprintf("\n\n");
 	    switch (TYPEOF(x)) {
 	    case LGLSXP:
-		printLogicalMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
+		printLogicalMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 		break;
 	    case INTSXP:
-		printIntegerMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
+		printIntegerMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 		break;
 	    case REALSXP:
-		printRealMatrix   (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
+		printRealMatrix   (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 		break;
 	    case CPLXSXP:
-		printComplexMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
+		printComplexMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 		break;
 	    case STRSXP:
 		if (quote) quote = '"';
 		printStringMatrix (x, i * b, use_nr, nr, nc,
-				   quote, right, dn0, dn1, rn, cn);
+				   quote, right, dn0, dn1, rn, cn, do_ij);
 		break;
 	    case RAWSXP:
-		printRawMatrix    (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
+		printRawMatrix    (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 		break;
+	    }
 	    Rprintf("\n");
+	}

The R Project SVN R

(root)/trunk/src/main/printarray.c @ 63243 – Rev 66087 → 66734