The R Project SVN – R – Diff – /branches/djm-source/src/main/printarray.c


/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1995, 1996	Robert Gentleman and Ross Ihaka
 *  Copyright (C) 2000--2002	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
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 *
 *  EXPORTS	printMatrix()
 *		printArray()
 *
 *  See ./printutils.c	 for general remarks on Printing
 *			 and the Encode.. utils.
 *
 *  See ./format.c	 for the  format_FOO_  functions used below.
 */
 
 
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
 
#include "Defn.h"
#include "Print.h"
 
static void printLogicalMatrix(SEXP sx, int offset, int r, int c,
			       SEXP rl, SEXP cl, char *rn, char *cn)
{
    SEXP sw;
    int *x, *w;
    int width, rlabw, clabw, rnw;
    int i, j, jmin, jmax, lbloff = 0;
 
    if (!isNull(rl))
	formatString(STRING_PTR(rl), r, &rlabw, 0);
    else
	rlabw = IndexWidth(r + 1) + 3;
 
    if (rn) {
	rnw = strlen(rn);
	if ( rnw < rlabw + R_MIN_LBLOFF )
	    lbloff = R_MIN_LBLOFF;
	else
	    lbloff = rnw - rlabw;
 
	rlabw += lbloff;
    }
 
    sw = allocVector(INTSXP, c);
    x = INTEGER(sx) + offset;
    w = INTEGER(sw);
 
    for (j = 0; j < c; j++) {
	formatLogical(&x[j * r], r, &w[j]);
	if (!isNull(cl)) {
	    if(STRING_ELT(cl, j) == NA_STRING) 
		clabw = R_print.na_width_noquote;
	    else clabw = strlen(CHAR(STRING_ELT(cl, j)));
	} else
	    clabw = IndexWidth(j + 1) + 3;
	if (w[j] < clabw)
	    w[j] = clabw;
	w[j] += R_print.gap;
    }
    jmin = 0;
    jmax = 0;
    if (c == 0) {
	for (i = 0; i < r; i++)
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	Rprintf("\n");
	return;
    }
    while (jmin < c) {
	width = rlabw;
	do {
	    width += w[jmax];
	    jmax++;
	}
	while (jmax < c && width + w[jmax] < R_print.width);
 
	if (cn != NULL)
	    Rprintf("%*s%s\n", rlabw, "", cn);
 
	if (rn != NULL)
	    Rprintf("%*s", -rlabw, rn);
	else
	    Rprintf("%*s", rlabw, "");
 
	for (j = jmin; j < jmax ; j++)
	    MatrixColumnLabel(cl, j, w[j]);
	for (i = 0; i < r; i++) {
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	    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, int c,
			       SEXP rl, SEXP cl, char *rn, char *cn)
{
    SEXP sw;
    int *x, *w;
    int width, rlabw, clabw, rnw;
    int i, j, jmin, jmax, lbloff = 0;
 
    if (!isNull(rl))
	formatString(STRING_PTR(rl), r, &rlabw, 0);
    else
	rlabw = IndexWidth(r + 1) + 3;
 
    if (rn) {
	rnw = strlen(rn);
	if ( rnw < rlabw + R_MIN_LBLOFF )
	    lbloff = R_MIN_LBLOFF;
	else
	    lbloff = rnw - rlabw;
 
	rlabw += lbloff;
    }
 
    sw = allocVector(INTSXP, c);
    x = INTEGER(sx) + offset;
    w = INTEGER(sw);
    for (j = 0; j < c; j++) {
	formatInteger(&x[j * r], r, &w[j]);
	if (!isNull(cl)) {
	    if(STRING_ELT(cl, j) == NA_STRING) 
		clabw = R_print.na_width_noquote;
	    else clabw = strlen(CHAR(STRING_ELT(cl, j)));
	} else
	    clabw = IndexWidth(j + 1) + 3;
	if (w[j] < clabw)
	    w[j] = clabw;
	w[j] += R_print.gap;
    }
    jmin = 0;
    jmax = 0;
    if (c == 0) {
	for (i = 0; i < r; i++)
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	Rprintf("\n");
	return;
    }
    while (jmin < c) {
	width = rlabw;
	do {
	    width += w[jmax];
	    jmax++;
	}
	while (jmax < c && width + w[jmax] < R_print.width);
 
	if (cn != NULL)
	    Rprintf("%*s%s\n", rlabw, "", cn);
 
	if (rn != NULL)
	    Rprintf("%*s", -rlabw, rn);
	else
	    Rprintf("%*s", rlabw, "");
 
	for (j = jmin; j < jmax ; j++)
	    MatrixColumnLabel(cl, j, w[j]);
	for (i = 0; i < r; i++) {
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	    for (j = jmin; j < jmax; j++) {
		Rprintf("%s", EncodeInteger(x[i + j * r], w[j]));
	    }
	}
	Rprintf("\n");
	jmin = jmax;
    }
}
 
static void printRealMatrix(SEXP sx, int offset, int r, int c,
			    SEXP rl, SEXP cl, char *rn, char *cn)
{
    SEXP sd, se, sw;
    double *x;
    int *d, *e, *w;
    int width, rlabw, clabw, rnw;
    int i, j, jmin, jmax, lbloff = 0;
 
    if (!isNull(rl))
	formatString(STRING_PTR(rl), r, &rlabw, 0);
    else
	rlabw = IndexWidth(r + 1) + 3;
 
    if (rn) {
	rnw = strlen(rn);
	if ( rnw < rlabw + R_MIN_LBLOFF )
	    lbloff = R_MIN_LBLOFF;
	else
	    lbloff = rnw - rlabw;
 
	rlabw += lbloff;
    }
 
    PROTECT(sd = allocVector(INTSXP, c));
    PROTECT(se = allocVector(INTSXP, c));
    sw = allocVector(INTSXP, c);
    UNPROTECT(2);
    x = REAL(sx) + offset;
    d = INTEGER(sd);
    e = INTEGER(se);
    w = INTEGER(sw);
 
    for (j = 0; j < c; j++) {
	formatReal(&x[j * r], r, &w[j], &d[j], &e[j], 0);
	if (!isNull(cl)) {
	    if(STRING_ELT(cl, j) == NA_STRING) 
		clabw = R_print.na_width_noquote;
	    else clabw = strlen(CHAR(STRING_ELT(cl, j)));
	} else
	    clabw = IndexWidth(j + 1) + 3;
	if (w[j] < clabw)
	    w[j] = clabw;
	w[j] += R_print.gap;
    }
    jmin = 0;
    jmax = 0;
    if (c == 0) {
	for (i = 0; i < r; i++)
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	Rprintf("\n");
	return;
    }
    while (jmin < c) {
	width = rlabw;
	do {
	    width += w[jmax];
	    jmax++;
	}
	while (jmax < c && width + w[jmax] < R_print.width);
 
	if (cn != NULL)
	    Rprintf("%*s%s\n", rlabw, "", cn);
 
	if (rn != NULL)
	    Rprintf("%*s", -rlabw, rn);
	else
	    Rprintf("%*s", rlabw, "");
 
	for (j = jmin; j < jmax ; j++)
	    MatrixColumnLabel(cl, j, w[j]);
	for (i = 0; i < r; i++) {
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	    for (j = jmin; j < jmax; j++) {
		Rprintf("%s", EncodeReal(x[i + j * r], w[j], d[j], e[j]));
	    }
	}
	Rprintf("\n");
	jmin = jmax;
    }
}
 
static void printComplexMatrix(SEXP sx, int offset, int r, int c,
			       SEXP rl, SEXP cl, char *rn, char *cn)
{
    SEXP sdr, ser, swr, sdi, sei, swi, sw;
    Rcomplex *x;
    int *dr, *er, *wr, *di, *ei, *wi, *w;
    int width, rlabw, clabw, rnw;
    int i, j, jmin, jmax, lbloff = 0;
 
    if (!isNull(rl))
	formatString(STRING_PTR(rl), r, &rlabw, 0);
    else
	rlabw = IndexWidth(r + 1) + 3;
 
    if (rn) {
	rnw = strlen(rn);
	if ( rnw < rlabw + R_MIN_LBLOFF )
	    lbloff = R_MIN_LBLOFF;
	else
	    lbloff = rnw - rlabw;
 
	rlabw += lbloff;
    }
 
    PROTECT(sdr = allocVector(INTSXP, c));
    PROTECT(ser = allocVector(INTSXP, c));
    PROTECT(swr = allocVector(INTSXP, c));
    PROTECT(sdi = allocVector(INTSXP, c));
    PROTECT(sei = allocVector(INTSXP, c));
    PROTECT(swi = allocVector(INTSXP, c));
    PROTECT(sw  = allocVector(INTSXP, c));
    UNPROTECT(7);
    x = COMPLEX(sx) + offset;
    dr = INTEGER(sdr);
    er = INTEGER(ser);
    wr = INTEGER(swr);
    di = INTEGER(sdi);
    ei = INTEGER(sei);
    wi = INTEGER(swi);
    w = INTEGER(sw);
 
    /* Determine the column widths */
 
    for (j = 0; j < c; j++) {
	formatComplex(&x[j * r], r,
		      &wr[j], &dr[j], &er[j],
		      &wi[j], &di[j], &ei[j], 0);
	if (!isNull(cl)) {
	    if(STRING_ELT(cl, j) == NA_STRING) 
		clabw = R_print.na_width_noquote;
	    else clabw = strlen(CHAR(STRING_ELT(cl, j)));
	} else
	    clabw = IndexWidth(j + 1) + 3;
	w[j] = wr[j] + wi[j] + 2;
	if (w[j] < clabw)
	    w[j] = clabw;
	w[j] += R_print.gap;
    }
 
    jmin = 0;
    jmax = 0;
    if (c == 0) {
	for (i = 0; i < r; i++)
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	Rprintf("\n");
	return;
    }
    while (jmin < c) {
	width = rlabw;
	do {
	    width += w[jmax];
	    jmax++;
	}
	while (jmax < c && width+w[jmax] < R_print.width);
 
	if (cn != NULL)
	    Rprintf("%*s%s\n", rlabw, "", cn);
 
	if (rn != NULL)
	    Rprintf("%*s", -rlabw, rn);
	else
	    Rprintf("%*s", rlabw, "");
 
	for (j = jmin; j < jmax ; j++)
	    MatrixColumnLabel(cl, j, w[j]);
	for (i = 0; i < r; 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))
		    Rprintf("%s", EncodeReal(NA_REAL, w[j], 0, 0));
		else
		    Rprintf("%s",
			    EncodeComplex(x[i + j * r],
					  wr[j] + R_print.gap, dr[j], er[j],
					  wi[j], di[j], ei[j]));
	    }
	}
	Rprintf("\n");
	jmin = jmax;
    }
}
 
static void printStringMatrix(SEXP sx, int offset, int r, int c,
			      int quote, int right, SEXP rl, SEXP cl,
			      char *rn, char *cn)
{
    SEXP sw;
    SEXP *x;
    int *w;
    int width, rlabw, clabw, rnw;
    int i, j, jmin, jmax, lbloff = 0;
 
    if (!isNull(rl))
	formatString(STRING_PTR(rl), r, &rlabw, 0);
    else
	rlabw = IndexWidth(r + 1) + 3;
 
    if (rn) {
	rnw = strlen(rn);
	if ( rnw < rlabw + R_MIN_LBLOFF )
	    lbloff = R_MIN_LBLOFF;
	else
	    lbloff = rnw - rlabw;
 
	rlabw += lbloff;
    }
 
    sw = allocVector(INTSXP, c);
    x = STRING_PTR(sx)+offset;
    w = INTEGER(sw);
    for (j = 0; j < c; j++) {
	formatString(&x[j * r], r, &w[j], quote);
	if (!isNull(cl)) {
	    if(STRING_ELT(cl, j) == NA_STRING) 
		clabw = R_print.na_width_noquote;
	    else clabw = strlen(CHAR(STRING_ELT(cl, j)));
	} else
	    clabw = IndexWidth(j + 1) + 3;
	if (w[j] < clabw)
	    w[j] = clabw;
    }
    jmin = 0;
    jmax = 0;
    if (c == 0) {
	for (i = 0; i < r; i++)
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	Rprintf("\n");
	return;
    }
    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);
 
	if (cn != NULL)
	    Rprintf("%*s%s\n", rlabw, "", cn);
 
	if (rn != NULL)
	    Rprintf("%*s", -rlabw, rn);
	else
	    Rprintf("%*s", rlabw, "");
 
	if (right) {
	    for (j = jmin; j < jmax ; j++)
		RightMatrixColumnLabel(cl, j, w[j]);
	}
	else {
	    for (j = jmin; j < jmax ; j++)
		LeftMatrixColumnLabel(cl, j, w[j]);
	}
	for (i = 0; i < r; i++) {
	    MatrixRowLabel(rl, i, rlabw, lbloff);
	    for (j = jmin; j < jmax; j++) {
		Rprintf("%*s%s", R_print.gap, "",
			EncodeString(x[i + j * r], w[j], quote, right));
	    }
	}
	Rprintf("\n");
	jmin = jmax;
    }
}
 
void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,
		 SEXP rl, SEXP cl, char *rn, char *cn)
{
    int r, c;
 
    r = INTEGER(dim)[0];
    c = INTEGER(dim)[1];
    /* 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) {
	Rprintf("<0 x 0 matrix>\n");
	return;
    }
    switch (TYPEOF(x)) {
    case LGLSXP:
	printLogicalMatrix(x, offset, r, c, rl, cl, rn, cn);
	break;
    case INTSXP:
	printIntegerMatrix(x, offset, r, c, rl, cl, rn, cn);
	break;
    case REALSXP:
	printRealMatrix(x, offset, r, c, rl, cl, rn, cn);
	break;
    case CPLXSXP:
	printComplexMatrix(x, offset, r, c, rl, cl, rn, cn);
	break;
    case STRSXP:
	if (quote) quote = '"';
	printStringMatrix(x, offset, r, c, quote, right, rl, cl, rn, cn);
	break;
    }
}
 
static void printArrayGeneral(SEXP x, SEXP dim, int quote, SEXP dimnames)
{
/* == printArray(.) */
    SEXP dn, dnn;
    int i, j, k, l, b, nb, ndim;
    int nr, nc;
    int has_dimnames = 0, has_dnn = 0;
    char *rn = NULL, *cn = NULL;
 
    ndim = LENGTH(dim);
    if (ndim == 1)
	printVector(x, 1, quote);
    else if (ndim == 2) {
	SEXP rl, cl;
	GetMatrixDimnames(x, &rl, &cl, &rn, &cn);
	printMatrix(x, 0, dim, quote, 0, rl, cl, rn, cn);
    }
    else {
	SEXP dn0, dn1;
	nr = INTEGER(dim)[0];
	nc = INTEGER(dim)[1];
	b = nr * nc;
	nb = 1;
	for (i = 2 ; i < ndim ; i++)
	    nb *= INTEGER(dim)[i];
	dnn = R_NilValue;	/* -Wall */
	if (dimnames == R_NilValue) {
	    dn0 = R_NilValue;
	    dn1 = R_NilValue;
	}
	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(STRING_ELT(dnn, 0));
		cn = CHAR(STRING_ELT(dnn, 1));
	    }
	}
	for (i = 0; i < nb; i++) {
	    Rprintf(", ");
	    k = 1;
	    for (j = 2 ; j < ndim; j++) {
		l = (i / k) % INTEGER(dim)[j] + 1;
		if (has_dimnames &&
		    ((dn = VECTOR_ELT(dimnames, j)) != R_NilValue)) {
		    if ( has_dnn )
			Rprintf(", %s = %s",
				CHAR(STRING_ELT(dnn, j)),
				CHAR(STRING_ELT(dn, l - 1)));
		    else
			Rprintf(", %s", CHAR(STRING_ELT(dn, l - 1)));
		} else
		    Rprintf(", %d", l);
		k = k * INTEGER(dim)[j];
	    }
	    Rprintf("\n\n");
	    switch (TYPEOF(x)) {
	    case LGLSXP:
		printLogicalMatrix(x, i * b, nr, nc, dn0, dn1, rn, cn);
		break;
	    case INTSXP:
		printIntegerMatrix(x, i * b, nr, nc, dn0, dn1, rn, cn);
		break;
	    case REALSXP:
		printRealMatrix(x, i * b, nr, nc, dn0, dn1, rn, cn);
		break;
	    case CPLXSXP:
		printComplexMatrix(x, i * b, nr, nc, dn0, dn1, rn, cn);
		break;
	    case STRSXP:
		if (quote) quote = '"';
		printStringMatrix(x, i * b, nr, nc, quote, 0, dn0, dn1, rn, cn);
		break;
	    }
	    Rprintf("\n");
	}
    }
}
 
void printArray(SEXP x, SEXP dim, int quote, SEXP dimnames)
{
    printArrayGeneral(x, dim, quote, dimnames);
}

Rev 29510	Rev 29864
1	`/*`	1	`/*`
2	`* R : A Computer Language for Statistical Data Analysis`	2	`* R : A Computer Language for Statistical Data Analysis`
3	`* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka`	3	`* Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka`
4	`* Copyright (C) 2000--2002 The R Development Core Team.`	4	`* Copyright (C) 2000--2002 The R Development Core Team.`
5	`*`	5	`*`
6	`* This program is free software; you can redistribute it and/or modify`	6	`* This program is free software; you can redistribute it and/or modify`
7	`* it under the terms of the GNU General Public License as published by`	7	`* it under the terms of the GNU General Public License as published by`
8	`* the Free Software Foundation; either version 2 of the License, or`	8	`* the Free Software Foundation; either version 2 of the License, or`
9	`* (at your option) any later version.`	9	`* (at your option) any later version.`
10	`*`	10	`*`
11	`* This program is distributed in the hope that it will be useful,`	11	`* This program is distributed in the hope that it will be useful,`
12	`* but WITHOUT ANY WARRANTY; without even the implied warranty of`	12	`* but WITHOUT ANY WARRANTY; without even the implied warranty of`
13	`* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`	13	`* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`
14	`* GNU General Public License for more details.`	14	`* GNU General Public License for more details.`
15	`*`	15	`*`
16	`* You should have received a copy of the GNU General Public License`	16	`* You should have received a copy of the GNU General Public License`
17	`* along with this program; if not, write to the Free Software`	17	`* along with this program; if not, write to the Free Software`
18	`* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA`	18	`* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA`
19	`*`	19	`*`
20	`*`	20	`*`
21	`* EXPORTS printMatrix()`	21	`* EXPORTS printMatrix()`
22	`* printArray()`	22	`* printArray()`
23	`*`	23	`*`
24	`* See ./printutils.c for general remarks on Printing`	24	`* See ./printutils.c for general remarks on Printing`
25	`* and the Encode.. utils.`	25	`* and the Encode.. utils.`
26	`*`	26	`*`
27	`* See ./format.c for the format_FOO_ functions used below.`	27	`* See ./format.c for the format_FOO_ functions used below.`
28	`*/`	28	`*/`
29		29
30		30
31	`#ifdef HAVE_CONFIG_H`	31	`#ifdef HAVE_CONFIG_H`
32	`#include <config.h>`	32	`#include <config.h>`
33	`#endif`	33	`#endif`
34		34
35	`#include "Defn.h"`	35	`#include "Defn.h"`
36	`#include "Print.h"`	36	`#include "Print.h"`
37		37
38	`static void printLogicalMatrix(SEXP sx, int offset, int r, int c,`	38	`static void printLogicalMatrix(SEXP sx, int offset, int r, int c,`
39	`SEXP rl, SEXP cl, char rn, char cn)`	39	`SEXP rl, SEXP cl, char rn, char cn)`
40	`{`	40	`{`
41	`SEXP sw;`	41	`SEXP sw;`
42	`int x, w;`	42	`int x, w;`
43	`int width, rlabw, clabw, rnw;`	43	`int width, rlabw, clabw, rnw;`
44	`int i, j, jmin, jmax, lbloff = 0;`	44	`int i, j, jmin, jmax, lbloff = 0;`
45		45
46	`if (!isNull(rl))`	46	`if (!isNull(rl))`
47	`formatString(STRING_PTR(rl), r, &rlabw, 0);`	47	`formatString(STRING_PTR(rl), r, &rlabw, 0);`
48	`else`	48	`else`
49	`rlabw = IndexWidth(r + 1) + 3;`	49	`rlabw = IndexWidth(r + 1) + 3;`
50		50
51	`if (rn) {`	51	`if (rn) {`
52	`rnw = strlen(rn);`	52	`rnw = strlen(rn);`
53	`if ( rnw < rlabw + R_MIN_LBLOFF )`	53	`if ( rnw < rlabw + R_MIN_LBLOFF )`
54	`lbloff = R_MIN_LBLOFF;`	54	`lbloff = R_MIN_LBLOFF;`
55	`else`	55	`else`
56	`lbloff = rnw - rlabw;`	56	`lbloff = rnw - rlabw;`
57		57
58	`rlabw += lbloff;`	58	`rlabw += lbloff;`
59	`}`	59	`}`
60		60
61	`sw = allocVector(INTSXP, c);`	61	`sw = allocVector(INTSXP, c);`
62	`x = INTEGER(sx) + offset;`	62	`x = INTEGER(sx) + offset;`
63	`w = INTEGER(sw);`	63	`w = INTEGER(sw);`
64		64
65	`for (j = 0; j < c; j++) {`	65	`for (j = 0; j < c; j++) {`
66	`formatLogical(&x[j * r], r, &w[j]);`	66	`formatLogical(&x[j * r], r, &w[j]);`
67	`if (!isNull(cl)) {`	67	`if (!isNull(cl)) {`
68	`if(STRING_ELT(cl, j) == NA_STRING)`	68	`if(STRING_ELT(cl, j) == NA_STRING)`
69	`clabw = R_print.na_width_noquote;`	69	`clabw = R_print.na_width_noquote;`
70	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`	70	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`
71	`} else`	71	`} else`
72	`clabw = IndexWidth(j + 1) + 3;`	72	`clabw = IndexWidth(j + 1) + 3;`
73	`if (w[j] < clabw)`	73	`if (w[j] < clabw)`
74	`w[j] = clabw;`	74	`w[j] = clabw;`
75	`w[j] += R_print.gap;`	75	`w[j] += R_print.gap;`
76	`}`	76	`}`
77	`jmin = 0;`	77	`jmin = 0;`
78	`jmax = 0;`	78	`jmax = 0;`
79	`if (c == 0) {`	79	`if (c == 0) {`
80	`for (i = 0; i < r; i++)`	80	`for (i = 0; i < r; i++)`
81	`MatrixRowLabel(rl, i, rlabw, lbloff);`	81	`MatrixRowLabel(rl, i, rlabw, lbloff);`
82	`Rprintf("\n");`	82	`Rprintf("\n");`
83	`return;`	83	`return;`
84	`}`	84	`}`
85	`while (jmin < c) {`	85	`while (jmin < c) {`
86	`width = rlabw;`	86	`width = rlabw;`
87	`do {`	87	`do {`
88	`width += w[jmax];`	88	`width += w[jmax];`
89	`jmax++;`	89	`jmax++;`
90	`}`	90	`}`
91	`while (jmax < c && width + w[jmax] < R_print.width);`	91	`while (jmax < c && width + w[jmax] < R_print.width);`
92		92
93	`if (cn != NULL)`	93	`if (cn != NULL)`
94	`Rprintf("%*s%s\n", rlabw, "", cn);`	94	`Rprintf("%*s%s\n", rlabw, "", cn);`
95		95
96	`if (rn != NULL)`	96	`if (rn != NULL)`
97	`Rprintf("%*s", -rlabw, rn);`	97	`Rprintf("%*s", -rlabw, rn);`
98	`else`	98	`else`
99	`Rprintf("%*s", rlabw, "");`	99	`Rprintf("%*s", rlabw, "");`
100		100
101	`for (j = jmin; j < jmax ; j++)`	101	`for (j = jmin; j < jmax ; j++)`
102	`MatrixColumnLabel(cl, j, w[j]);`	102	`MatrixColumnLabel(cl, j, w[j]);`
103	`for (i = 0; i < r; i++) {`	103	`for (i = 0; i < r; i++) {`
104	`MatrixRowLabel(rl, i, rlabw, lbloff);`	104	`MatrixRowLabel(rl, i, rlabw, lbloff);`
105	`for (j = jmin; j < jmax; j++) {`	105	`for (j = jmin; j < jmax; j++) {`
106	`Rprintf("%s", EncodeLogical(x[i + j * r], w[j]));`	106	`Rprintf("%s", EncodeLogical(x[i + j * r], w[j]));`
107	`}`	107	`}`
108	`}`	108	`}`
109	`Rprintf("\n");`	109	`Rprintf("\n");`
110	`jmin = jmax;`	110	`jmin = jmax;`
111	`}`	111	`}`
112	`}`	112	`}`
113		113
114	`static void printIntegerMatrix(SEXP sx, int offset, int r, int c,`	114	`static void printIntegerMatrix(SEXP sx, int offset, int r, int c,`
115	`SEXP rl, SEXP cl, char rn, char cn)`	115	`SEXP rl, SEXP cl, char rn, char cn)`
116	`{`	116	`{`
117	`SEXP sw;`	117	`SEXP sw;`
118	`int x, w;`	118	`int x, w;`
119	`int width, rlabw, clabw, rnw;`	119	`int width, rlabw, clabw, rnw;`
120	`int i, j, jmin, jmax, lbloff = 0;`	120	`int i, j, jmin, jmax, lbloff = 0;`
121		121
122	`if (!isNull(rl))`	122	`if (!isNull(rl))`
123	`formatString(STRING_PTR(rl), r, &rlabw, 0);`	123	`formatString(STRING_PTR(rl), r, &rlabw, 0);`
124	`else`	124	`else`
125	`rlabw = IndexWidth(r + 1) + 3;`	125	`rlabw = IndexWidth(r + 1) + 3;`
126		126
127	`if (rn) {`	127	`if (rn) {`
128	`rnw = strlen(rn);`	128	`rnw = strlen(rn);`
129	`if ( rnw < rlabw + R_MIN_LBLOFF )`	129	`if ( rnw < rlabw + R_MIN_LBLOFF )`
130	`lbloff = R_MIN_LBLOFF;`	130	`lbloff = R_MIN_LBLOFF;`
131	`else`	131	`else`
132	`lbloff = rnw - rlabw;`	132	`lbloff = rnw - rlabw;`
133		133
134	`rlabw += lbloff;`	134	`rlabw += lbloff;`
135	`}`	135	`}`
136		136
137	`sw = allocVector(INTSXP, c);`	137	`sw = allocVector(INTSXP, c);`
138	`x = INTEGER(sx) + offset;`	138	`x = INTEGER(sx) + offset;`
139	`w = INTEGER(sw);`	139	`w = INTEGER(sw);`
140	`for (j = 0; j < c; j++) {`	140	`for (j = 0; j < c; j++) {`
141	`formatInteger(&x[j * r], r, &w[j]);`	141	`formatInteger(&x[j * r], r, &w[j]);`
142	`if (!isNull(cl)) {`	142	`if (!isNull(cl)) {`
143	`if(STRING_ELT(cl, j) == NA_STRING)`	143	`if(STRING_ELT(cl, j) == NA_STRING)`
144	`clabw = R_print.na_width_noquote;`	144	`clabw = R_print.na_width_noquote;`
145	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`	145	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`
146	`} else`	146	`} else`
147	`clabw = IndexWidth(j + 1) + 3;`	147	`clabw = IndexWidth(j + 1) + 3;`
148	`if (w[j] < clabw)`	148	`if (w[j] < clabw)`
149	`w[j] = clabw;`	149	`w[j] = clabw;`
150	`w[j] += R_print.gap;`	150	`w[j] += R_print.gap;`
151	`}`	151	`}`
152	`jmin = 0;`	152	`jmin = 0;`
153	`jmax = 0;`	153	`jmax = 0;`
154	`if (c == 0) {`	154	`if (c == 0) {`
155	`for (i = 0; i < r; i++)`	155	`for (i = 0; i < r; i++)`
156	`MatrixRowLabel(rl, i, rlabw, lbloff);`	156	`MatrixRowLabel(rl, i, rlabw, lbloff);`
157	`Rprintf("\n");`	157	`Rprintf("\n");`
158	`return;`	158	`return;`
159	`}`	159	`}`
160	`while (jmin < c) {`	160	`while (jmin < c) {`
161	`width = rlabw;`	161	`width = rlabw;`
162	`do {`	162	`do {`
163	`width += w[jmax];`	163	`width += w[jmax];`
164	`jmax++;`	164	`jmax++;`
165	`}`	165	`}`
166	`while (jmax < c && width + w[jmax] < R_print.width);`	166	`while (jmax < c && width + w[jmax] < R_print.width);`
167		167
168	`if (cn != NULL)`	168	`if (cn != NULL)`
169	`Rprintf("%*s%s\n", rlabw, "", cn);`	169	`Rprintf("%*s%s\n", rlabw, "", cn);`
170		170
171	`if (rn != NULL)`	171	`if (rn != NULL)`
172	`Rprintf("%*s", -rlabw, rn);`	172	`Rprintf("%*s", -rlabw, rn);`
173	`else`	173	`else`
174	`Rprintf("%*s", rlabw, "");`	174	`Rprintf("%*s", rlabw, "");`
175		175
176	`for (j = jmin; j < jmax ; j++)`	176	`for (j = jmin; j < jmax ; j++)`
177	`MatrixColumnLabel(cl, j, w[j]);`	177	`MatrixColumnLabel(cl, j, w[j]);`
178	`for (i = 0; i < r; i++) {`	178	`for (i = 0; i < r; i++) {`
179	`MatrixRowLabel(rl, i, rlabw, lbloff);`	179	`MatrixRowLabel(rl, i, rlabw, lbloff);`
180	`for (j = jmin; j < jmax; j++) {`	180	`for (j = jmin; j < jmax; j++) {`
181	`Rprintf("%s", EncodeInteger(x[i + j * r], w[j]));`	181	`Rprintf("%s", EncodeInteger(x[i + j * r], w[j]));`
182	`}`	182	`}`
183	`}`	183	`}`
184	`Rprintf("\n");`	184	`Rprintf("\n");`
185	`jmin = jmax;`	185	`jmin = jmax;`
186	`}`	186	`}`
187	`}`	187	`}`
188		188
189	`static void printRealMatrix(SEXP sx, int offset, int r, int c,`	189	`static void printRealMatrix(SEXP sx, int offset, int r, int c,`
190	`SEXP rl, SEXP cl, char rn, char cn)`	190	`SEXP rl, SEXP cl, char rn, char cn)`
191	`{`	191	`{`
192	`SEXP sd, se, sw;`	192	`SEXP sd, se, sw;`
193	`double *x;`	193	`double *x;`
194	`int d, e, *w;`	194	`int d, e, *w;`
195	`int width, rlabw, clabw, rnw;`	195	`int width, rlabw, clabw, rnw;`
196	`int i, j, jmin, jmax, lbloff = 0;`	196	`int i, j, jmin, jmax, lbloff = 0;`
197		197
198	`if (!isNull(rl))`	198	`if (!isNull(rl))`
199	`formatString(STRING_PTR(rl), r, &rlabw, 0);`	199	`formatString(STRING_PTR(rl), r, &rlabw, 0);`
200	`else`	200	`else`
201	`rlabw = IndexWidth(r + 1) + 3;`	201	`rlabw = IndexWidth(r + 1) + 3;`
202		202
203	`if (rn) {`	203	`if (rn) {`
204	`rnw = strlen(rn);`	204	`rnw = strlen(rn);`
205	`if ( rnw < rlabw + R_MIN_LBLOFF )`	205	`if ( rnw < rlabw + R_MIN_LBLOFF )`
206	`lbloff = R_MIN_LBLOFF;`	206	`lbloff = R_MIN_LBLOFF;`
207	`else`	207	`else`
208	`lbloff = rnw - rlabw;`	208	`lbloff = rnw - rlabw;`
209		209
210	`rlabw += lbloff;`	210	`rlabw += lbloff;`
211	`}`	211	`}`
212		212
213	`PROTECT(sd = allocVector(INTSXP, c));`	213	`PROTECT(sd = allocVector(INTSXP, c));`
214	`PROTECT(se = allocVector(INTSXP, c));`	214	`PROTECT(se = allocVector(INTSXP, c));`
215	`sw = allocVector(INTSXP, c);`	215	`sw = allocVector(INTSXP, c);`
216	`UNPROTECT(2);`	216	`UNPROTECT(2);`
217	`x = REAL(sx) + offset;`	217	`x = REAL(sx) + offset;`
218	`d = INTEGER(sd);`	218	`d = INTEGER(sd);`
219	`e = INTEGER(se);`	219	`e = INTEGER(se);`
220	`w = INTEGER(sw);`	220	`w = INTEGER(sw);`
221		221
222	`for (j = 0; j < c; j++) {`	222	`for (j = 0; j < c; j++) {`
223	`formatReal(&x[j * r], r, &w[j], &d[j], &e[j], 0);`	223	`formatReal(&x[j * r], r, &w[j], &d[j], &e[j], 0);`
224	`if (!isNull(cl)) {`	224	`if (!isNull(cl)) {`
225	`if(STRING_ELT(cl, j) == NA_STRING)`	225	`if(STRING_ELT(cl, j) == NA_STRING)`
226	`clabw = R_print.na_width_noquote;`	226	`clabw = R_print.na_width_noquote;`
227	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`	227	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`
228	`} else`	228	`} else`
229	`clabw = IndexWidth(j + 1) + 3;`	229	`clabw = IndexWidth(j + 1) + 3;`
230	`if (w[j] < clabw)`	230	`if (w[j] < clabw)`
231	`w[j] = clabw;`	231	`w[j] = clabw;`
232	`w[j] += R_print.gap;`	232	`w[j] += R_print.gap;`
233	`}`	233	`}`
234	`jmin = 0;`	234	`jmin = 0;`
235	`jmax = 0;`	235	`jmax = 0;`
236	`if (c == 0) {`	236	`if (c == 0) {`
237	`for (i = 0; i < r; i++)`	237	`for (i = 0; i < r; i++)`
238	`MatrixRowLabel(rl, i, rlabw, lbloff);`	238	`MatrixRowLabel(rl, i, rlabw, lbloff);`
239	`Rprintf("\n");`	239	`Rprintf("\n");`
240	`return;`	240	`return;`
241	`}`	241	`}`
242	`while (jmin < c) {`	242	`while (jmin < c) {`
243	`width = rlabw;`	243	`width = rlabw;`
244	`do {`	244	`do {`
245	`width += w[jmax];`	245	`width += w[jmax];`
246	`jmax++;`	246	`jmax++;`
247	`}`	247	`}`
248	`while (jmax < c && width + w[jmax] < R_print.width);`	248	`while (jmax < c && width + w[jmax] < R_print.width);`
249		249
250	`if (cn != NULL)`	250	`if (cn != NULL)`
251	`Rprintf("%*s%s\n", rlabw, "", cn);`	251	`Rprintf("%*s%s\n", rlabw, "", cn);`
252		252
253	`if (rn != NULL)`	253	`if (rn != NULL)`
254	`Rprintf("%*s", -rlabw, rn);`	254	`Rprintf("%*s", -rlabw, rn);`
255	`else`	255	`else`
256	`Rprintf("%*s", rlabw, "");`	256	`Rprintf("%*s", rlabw, "");`
257		257
258	`for (j = jmin; j < jmax ; j++)`	258	`for (j = jmin; j < jmax ; j++)`
259	`MatrixColumnLabel(cl, j, w[j]);`	259	`MatrixColumnLabel(cl, j, w[j]);`
260	`for (i = 0; i < r; i++) {`	260	`for (i = 0; i < r; i++) {`
261	`MatrixRowLabel(rl, i, rlabw, lbloff);`	261	`MatrixRowLabel(rl, i, rlabw, lbloff);`
262	`for (j = jmin; j < jmax; j++) {`	262	`for (j = jmin; j < jmax; j++) {`
263	`Rprintf("%s", EncodeReal(x[i + j * r], w[j], d[j], e[j]));`	263	`Rprintf("%s", EncodeReal(x[i + j * r], w[j], d[j], e[j]));`
264	`}`	264	`}`
265	`}`	265	`}`
266	`Rprintf("\n");`	266	`Rprintf("\n");`
267	`jmin = jmax;`	267	`jmin = jmax;`
268	`}`	268	`}`
269	`}`	269	`}`
270		270
271	`static void printComplexMatrix(SEXP sx, int offset, int r, int c,`	271	`static void printComplexMatrix(SEXP sx, int offset, int r, int c,`
272	`SEXP rl, SEXP cl, char rn, char cn)`	272	`SEXP rl, SEXP cl, char rn, char cn)`
273	`{`	273	`{`
274	`SEXP sdr, ser, swr, sdi, sei, swi, sw;`	274	`SEXP sdr, ser, swr, sdi, sei, swi, sw;`
275	`Rcomplex *x;`	275	`Rcomplex *x;`
276	`int dr, er, wr, di, ei, wi, *w;`	276	`int dr, er, wr, di, ei, wi, *w;`
277	`int width, rlabw, clabw, rnw;`	277	`int width, rlabw, clabw, rnw;`
278	`int i, j, jmin, jmax, lbloff = 0;`	278	`int i, j, jmin, jmax, lbloff = 0;`
279		279
280	`if (!isNull(rl))`	280	`if (!isNull(rl))`
281	`formatString(STRING_PTR(rl), r, &rlabw, 0);`	281	`formatString(STRING_PTR(rl), r, &rlabw, 0);`
282	`else`	282	`else`
283	`rlabw = IndexWidth(r + 1) + 3;`	283	`rlabw = IndexWidth(r + 1) + 3;`
284		284
285	`if (rn) {`	285	`if (rn) {`
286	`rnw = strlen(rn);`	286	`rnw = strlen(rn);`
287	`if ( rnw < rlabw + R_MIN_LBLOFF )`	287	`if ( rnw < rlabw + R_MIN_LBLOFF )`
288	`lbloff = R_MIN_LBLOFF;`	288	`lbloff = R_MIN_LBLOFF;`
289	`else`	289	`else`
290	`lbloff = rnw - rlabw;`	290	`lbloff = rnw - rlabw;`
291		291
292	`rlabw += lbloff;`	292	`rlabw += lbloff;`
293	`}`	293	`}`
294		294
295	`PROTECT(sdr = allocVector(INTSXP, c));`	295	`PROTECT(sdr = allocVector(INTSXP, c));`
296	`PROTECT(ser = allocVector(INTSXP, c));`	296	`PROTECT(ser = allocVector(INTSXP, c));`
297	`PROTECT(swr = allocVector(INTSXP, c));`	297	`PROTECT(swr = allocVector(INTSXP, c));`
298	`PROTECT(sdi = allocVector(INTSXP, c));`	298	`PROTECT(sdi = allocVector(INTSXP, c));`
299	`PROTECT(sei = allocVector(INTSXP, c));`	299	`PROTECT(sei = allocVector(INTSXP, c));`
300	`PROTECT(swi = allocVector(INTSXP, c));`	300	`PROTECT(swi = allocVector(INTSXP, c));`
301	`PROTECT(sw = allocVector(INTSXP, c));`	301	`PROTECT(sw = allocVector(INTSXP, c));`
302	`UNPROTECT(7);`	302	`UNPROTECT(7);`
303	`x = COMPLEX(sx) + offset;`	303	`x = COMPLEX(sx) + offset;`
304	`dr = INTEGER(sdr);`	304	`dr = INTEGER(sdr);`
305	`er = INTEGER(ser);`	305	`er = INTEGER(ser);`
306	`wr = INTEGER(swr);`	306	`wr = INTEGER(swr);`
307	`di = INTEGER(sdi);`	307	`di = INTEGER(sdi);`
308	`ei = INTEGER(sei);`	308	`ei = INTEGER(sei);`
309	`wi = INTEGER(swi);`	309	`wi = INTEGER(swi);`
310	`w = INTEGER(sw);`	310	`w = INTEGER(sw);`
311		311
312	`/* Determine the column widths */`	312	`/* Determine the column widths */`
313		313
314	`for (j = 0; j < c; j++) {`	314	`for (j = 0; j < c; j++) {`
315	`formatComplex(&x[j * r], r,`	315	`formatComplex(&x[j * r], r,`
316	`&wr[j], &dr[j], &er[j],`	316	`&wr[j], &dr[j], &er[j],`
317	`&wi[j], &di[j], &ei[j], 0);`	317	`&wi[j], &di[j], &ei[j], 0);`
318	`if (!isNull(cl)) {`	318	`if (!isNull(cl)) {`
319	`if(STRING_ELT(cl, j) == NA_STRING)`	319	`if(STRING_ELT(cl, j) == NA_STRING)`
320	`clabw = R_print.na_width_noquote;`	320	`clabw = R_print.na_width_noquote;`
321	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`	321	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`
322	`} else`	322	`} else`
323	`clabw = IndexWidth(j + 1) + 3;`	323	`clabw = IndexWidth(j + 1) + 3;`
324	`w[j] = wr[j] + wi[j] + 2;`	324	`w[j] = wr[j] + wi[j] + 2;`
325	`if (w[j] < clabw)`	325	`if (w[j] < clabw)`
326	`w[j] = clabw;`	326	`w[j] = clabw;`
327	`w[j] += R_print.gap;`	327	`w[j] += R_print.gap;`
328	`}`	328	`}`
329		329
330	`jmin = 0;`	330	`jmin = 0;`
331	`jmax = 0;`	331	`jmax = 0;`
332	`if (c == 0) {`	332	`if (c == 0) {`
333	`for (i = 0; i < r; i++)`	333	`for (i = 0; i < r; i++)`
334	`MatrixRowLabel(rl, i, rlabw, lbloff);`	334	`MatrixRowLabel(rl, i, rlabw, lbloff);`
335	`Rprintf("\n");`	335	`Rprintf("\n");`
336	`return;`	336	`return;`
337	`}`	337	`}`
338	`while (jmin < c) {`	338	`while (jmin < c) {`
339	`width = rlabw;`	339	`width = rlabw;`
340	`do {`	340	`do {`
341	`width += w[jmax];`	341	`width += w[jmax];`
342	`jmax++;`	342	`jmax++;`
343	`}`	343	`}`
344	`while (jmax < c && width+w[jmax] < R_print.width);`	344	`while (jmax < c && width+w[jmax] < R_print.width);`
345		345
346	`if (cn != NULL)`	346	`if (cn != NULL)`
347	`Rprintf("%*s%s\n", rlabw, "", cn);`	347	`Rprintf("%*s%s\n", rlabw, "", cn);`
348		348
349	`if (rn != NULL)`	349	`if (rn != NULL)`
350	`Rprintf("%*s", -rlabw, rn);`	350	`Rprintf("%*s", -rlabw, rn);`
351	`else`	351	`else`
352	`Rprintf("%*s", rlabw, "");`	352	`Rprintf("%*s", rlabw, "");`
353		353
354	`for (j = jmin; j < jmax ; j++)`	354	`for (j = jmin; j < jmax ; j++)`
355	`MatrixColumnLabel(cl, j, w[j]);`	355	`MatrixColumnLabel(cl, j, w[j]);`
356	`for (i = 0; i < r; i++) {`	356	`for (i = 0; i < r; i++) {`
357	`MatrixRowLabel(rl, i, rlabw, lbloff);`	357	`MatrixRowLabel(rl, i, rlabw, lbloff);`
358	`for (j = jmin; j < jmax; j++) {`	358	`for (j = jmin; j < jmax; j++) {`
359	`if (ISNA(x[i + j * r].r) \|\| ISNA(x[i + j * r].i))`	359	`if (ISNA(x[i + j * r].r) \|\| ISNA(x[i + j * r].i))`
360	`Rprintf("%s", EncodeReal(NA_REAL, w[j], 0, 0));`	360	`Rprintf("%s", EncodeReal(NA_REAL, w[j], 0, 0));`
361	`else`	361	`else`
362	`Rprintf("%s",`	362	`Rprintf("%s",`
363	`EncodeComplex(x[i + j * r],`	363	`EncodeComplex(x[i + j * r],`
364	`wr[j] + R_print.gap, dr[j], er[j],`	364	`wr[j] + R_print.gap, dr[j], er[j],`
365	`wi[j], di[j], ei[j]));`	365	`wi[j], di[j], ei[j]));`
366	`}`	366	`}`
367	`}`	367	`}`
368	`Rprintf("\n");`	368	`Rprintf("\n");`
369	`jmin = jmax;`	369	`jmin = jmax;`
370	`}`	370	`}`
371	`}`	371	`}`
372		372
373	`static void printStringMatrix(SEXP sx, int offset, int r, int c,`	373	`static void printStringMatrix(SEXP sx, int offset, int r, int c,`
374	`int quote, int right, SEXP rl, SEXP cl,`	374	`int quote, int right, SEXP rl, SEXP cl,`
375	`char rn, char cn)`	375	`char rn, char cn)`
376	`{`	376	`{`
377	`SEXP sw;`	377	`SEXP sw;`
378	`SEXP *x;`	378	`SEXP *x;`
379	`int *w;`	379	`int *w;`
380	`int width, rlabw, clabw, rnw;`	380	`int width, rlabw, clabw, rnw;`
381	`int i, j, jmin, jmax, lbloff = 0;`	381	`int i, j, jmin, jmax, lbloff = 0;`
382		382
383	`if (!isNull(rl))`	383	`if (!isNull(rl))`
384	`formatString(STRING_PTR(rl), r, &rlabw, 0);`	384	`formatString(STRING_PTR(rl), r, &rlabw, 0);`
385	`else`	385	`else`
386	`rlabw = IndexWidth(r + 1) + 3;`	386	`rlabw = IndexWidth(r + 1) + 3;`
387		387
388	`if (rn) {`	388	`if (rn) {`
389	`rnw = strlen(rn);`	389	`rnw = strlen(rn);`
390	`if ( rnw < rlabw + R_MIN_LBLOFF )`	390	`if ( rnw < rlabw + R_MIN_LBLOFF )`
391	`lbloff = R_MIN_LBLOFF;`	391	`lbloff = R_MIN_LBLOFF;`
392	`else`	392	`else`
393	`lbloff = rnw - rlabw;`	393	`lbloff = rnw - rlabw;`
394		394
395	`rlabw += lbloff;`	395	`rlabw += lbloff;`
396	`}`	396	`}`
397		397
398	`sw = allocVector(INTSXP, c);`	398	`sw = allocVector(INTSXP, c);`
399	`x = STRING_PTR(sx)+offset;`	399	`x = STRING_PTR(sx)+offset;`
400	`w = INTEGER(sw);`	400	`w = INTEGER(sw);`
401	`for (j = 0; j < c; j++) {`	401	`for (j = 0; j < c; j++) {`
402	`formatString(&x[j * r], r, &w[j], quote);`	402	`formatString(&x[j * r], r, &w[j], quote);`
403	`if (!isNull(cl)) {`	403	`if (!isNull(cl)) {`
404	`if(STRING_ELT(cl, j) == NA_STRING)`	404	`if(STRING_ELT(cl, j) == NA_STRING)`
405	`clabw = R_print.na_width_noquote;`	405	`clabw = R_print.na_width_noquote;`
406	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`	406	`else clabw = strlen(CHAR(STRING_ELT(cl, j)));`
407	`} else`	407	`} else`
408	`clabw = IndexWidth(j + 1) + 3;`	408	`clabw = IndexWidth(j + 1) + 3;`
409	`if (w[j] < clabw)`	409	`if (w[j] < clabw)`
410	`w[j] = clabw;`	410	`w[j] = clabw;`
411	`}`	411	`}`
412	`jmin = 0;`	412	`jmin = 0;`
413	`jmax = 0;`	413	`jmax = 0;`
414	`if (c == 0) {`	414	`if (c == 0) {`
415	`for (i = 0; i < r; i++)`	415	`for (i = 0; i < r; i++)`
416	`MatrixRowLabel(rl, i, rlabw, lbloff);`	416	`MatrixRowLabel(rl, i, rlabw, lbloff);`
417	`Rprintf("\n");`	417	`Rprintf("\n");`
418	`return;`	418	`return;`
419	`}`	419	`}`
420	`while (jmin < c) {`	420	`while (jmin < c) {`
421	`width = rlabw;`	421	`width = rlabw;`
422	`do {`	422	`do {`
423	`width += w[jmax] + R_print.gap;`	423	`width += w[jmax] + R_print.gap;`
424	`jmax++;`	424	`jmax++;`
425	`}`	425	`}`
426	`while (jmax < c && width + w[jmax] + R_print.gap < R_print.width);`	426	`while (jmax < c && width + w[jmax] + R_print.gap < R_print.width);`
427		427
428	`if (cn != NULL)`	428	`if (cn != NULL)`
429	`Rprintf("%*s%s\n", rlabw, "", cn);`	429	`Rprintf("%*s%s\n", rlabw, "", cn);`
430		430
431	`if (rn != NULL)`	431	`if (rn != NULL)`
432	`Rprintf("%*s", -rlabw, rn);`	432	`Rprintf("%*s", -rlabw, rn);`
433	`else`	433	`else`
434	`Rprintf("%*s", rlabw, "");`	434	`Rprintf("%*s", rlabw, "");`
435		435
436	`if (right) {`	436	`if (right) {`
437	`for (j = jmin; j < jmax ; j++)`	437	`for (j = jmin; j < jmax ; j++)`
438	`RightMatrixColumnLabel(cl, j, w[j]);`	438	`RightMatrixColumnLabel(cl, j, w[j]);`
439	`}`	439	`}`
440	`else {`	440	`else {`
441	`for (j = jmin; j < jmax ; j++)`	441	`for (j = jmin; j < jmax ; j++)`
442	`LeftMatrixColumnLabel(cl, j, w[j]);`	442	`LeftMatrixColumnLabel(cl, j, w[j]);`
443	`}`	443	`}`
444	`for (i = 0; i < r; i++) {`	444	`for (i = 0; i < r; i++) {`
445	`MatrixRowLabel(rl, i, rlabw, lbloff);`	445	`MatrixRowLabel(rl, i, rlabw, lbloff);`
446	`for (j = jmin; j < jmax; j++) {`	446	`for (j = jmin; j < jmax; j++) {`
447	`Rprintf("%*s%s", R_print.gap, "",`	447	`Rprintf("%*s%s", R_print.gap, "",`
448	`EncodeString(x[i + j * r], w[j], quote, right));`	448	`EncodeString(x[i + j * r], w[j], quote, right));`
449	`}`	449	`}`
450	`}`	450	`}`
451	`Rprintf("\n");`	451	`Rprintf("\n");`
452	`jmin = jmax;`	452	`jmin = jmax;`
453	`}`	453	`}`
454	`}`	454	`}`
455		455
456	`void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,`	456	`void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,`
457	`SEXP rl, SEXP cl, char rn, char cn)`	457	`SEXP rl, SEXP cl, char rn, char cn)`
458	`{`	458	`{`
459	`int r, c;`	459	`int r, c;`
460		460
461	`r = INTEGER(dim)[0];`	461	`r = INTEGER(dim)[0];`
462	`c = INTEGER(dim)[1];`	462	`c = INTEGER(dim)[1];`
463	`/* PR#850 */`	463	`/* PR#850 */`
464	`if ((rl!=R_NilValue) && (r>length(rl)))`	464	`if ((rl!=R_NilValue) && (r>length(rl)))`
465	`error("too few row labels");`	465	`error("too few row labels");`
466	`if ((cl!=R_NilValue) && (c>length(cl)))`	466	`if ((cl!=R_NilValue) && (c>length(cl)))`
467	`error("too few column labels");`	467	`error("too few column labels");`
468	`if (r == 0 && c == 0) {`	468	`if (r == 0 && c == 0) {`
469	`Rprintf("<0 x 0 matrix>\n");`	469	`Rprintf("<0 x 0 matrix>\n");`
470	`return;`	470	`return;`
471	`}`	471	`}`
472	`switch (TYPEOF(x)) {`	472	`switch (TYPEOF(x)) {`
473	`case LGLSXP:`	473	`case LGLSXP:`
474	`printLogicalMatrix(x, offset, r, c, rl, cl, rn, cn);`	474	`printLogicalMatrix(x, offset, r, c, rl, cl, rn, cn);`
475	`break;`	475	`break;`
476	`case INTSXP:`	476	`case INTSXP:`
477	`printIntegerMatrix(x, offset, r, c, rl, cl, rn, cn);`	477	`printIntegerMatrix(x, offset, r, c, rl, cl, rn, cn);`
478	`break;`	478	`break;`
479	`case REALSXP:`	479	`case REALSXP:`
480	`printRealMatrix(x, offset, r, c, rl, cl, rn, cn);`	480	`printRealMatrix(x, offset, r, c, rl, cl, rn, cn);`
481	`break;`	481	`break;`
482	`case CPLXSXP:`	482	`case CPLXSXP:`
483	`printComplexMatrix(x, offset, r, c, rl, cl, rn, cn);`	483	`printComplexMatrix(x, offset, r, c, rl, cl, rn, cn);`
484	`break;`	484	`break;`
485	`case STRSXP:`	485	`case STRSXP:`
486	`if (quote) quote = '"';`	486	`if (quote) quote = '"';`
487	`printStringMatrix(x, offset, r, c, quote, right, rl, cl, rn, cn);`	487	`printStringMatrix(x, offset, r, c, quote, right, rl, cl, rn, cn);`
488	`break;`	488	`break;`
489	`}`	489	`}`
490	`}`	490	`}`
491		491
492	`static void printArrayGeneral(SEXP x, SEXP dim, int quote, SEXP dimnames)`	492	`static void printArrayGeneral(SEXP x, SEXP dim, int quote, SEXP dimnames)`
493	`{`	493	`{`
494	`/* == printArray(.) */`	494	`/* == printArray(.) */`
495	`SEXP dn, dnn;`	495	`SEXP dn, dnn;`
496	`int i, j, k, l, b, nb, ndim;`	496	`int i, j, k, l, b, nb, ndim;`
497	`int nr, nc;`	497	`int nr, nc;`
498	`int has_dimnames = 0, has_dnn = 0;`	498	`int has_dimnames = 0, has_dnn = 0;`
499	`char rn = NULL, cn = NULL;`	499	`char rn = NULL, cn = NULL;`
500		500

The R Project SVN R

(root)/branches/djm-source/src/main/printarray.c @ 34412 – Rev 29510 → 29864