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--2006	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., 51 Franklin Street Fifth Floor, Boston, MA 02110-1301  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.
 */
 
/* <UTF8> char here is handled as a whole,
   but lengths were used as display widths */
 
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
 
#include "Defn.h"
#include "Print.h"
 
#include <stdlib.h> /* for div() */
 
/* We need display width of a string */
int Rstrwid(const char *str, int slen, int quote);  /* from printutils.c */
#define strwidth(x) Rstrwid(x, strlen(x), 0)
 
/* ceil_DIV(a,b) :=  ceil(a / b)  in _int_ arithmetic : */
static R_INLINE
int ceil_DIV(int a, int b)
{
    div_t div_res = div(a, b);
    return div_res.quot + ((div_res.rem != 0) ? 1 : 0);
}
 
/* 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);
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
	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);
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
	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));
    }
    else {
	Rprintf("%*s[,%ld]%*s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");
    }
}
 
static void LeftMatrixColumnLabel(SEXP cl, int j, int w)
{
    int l;
    SEXP tmp;
 
    if (!isNull(cl)) {
        tmp= STRING_ELT(cl, j);
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
	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);
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
	else l = Rstrlen(tmp, 0);
	Rprintf("\n%*s%s%*s", lbloff, "",
		EncodeString(tmp, l, 0, Rprt_adj_left),
		rlabw-l-lbloff, "");
    }
    else {
	Rprintf("\n%*s[%ld,]", rlabw-3-IndexWidth(i + 1), "", i+1);
    }
}
 
 
 
/* 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)
{
    int *x;
 
/* initialization; particularly of row labels, rl= dimnames(.)[[1]] and
 * rn = names(dimnames(.))[1] : */
#define _PRINT_INIT_rl_rn				\
    SEXP sw;						\
    int *w;						\
    int width, rlabw = -1, clabw = -1; /* -Wall */	\
    int i, j, jmin = 0, jmax = 0, lbloff = 0;		\
							\
    if (!isNull(rl))					\
	formatString(STRING_PTR(rl), r, &rlabw, 0);	\
    else						\
	rlabw = IndexWidth(r + 1) + 3;			\
							\
    if (rn) {						\
	int rnw = strwidth(rn);				\
	if ( rnw < rlabw + R_MIN_LBLOFF )		\
	    lbloff = R_MIN_LBLOFF;			\
	else						\
	    lbloff = rnw - rlabw;			\
							\
	rlabw += lbloff;				\
    }
 
    _PRINT_INIT_rl_rn;
 
    sw = allocVector(INTSXP, c);
    x = LOGICAL(sx) + offset;
    w = INTEGER(sw);
    /* compute w[j] = column-width of j(+1)-th column : */
    for (j = 0; j < c; j++) {
	formatLogical(&x[j * r], r, &w[j]);
 
#	define _PRINT_SET_clabw					\
								\
	if (!isNull(cl)) {					\
	    if(STRING_ELT(cl, j) == NA_STRING)			\
		clabw = R_print.na_width_noquote;		\
	    else clabw = strwidth(translateChar(STRING_ELT(cl, j)));	\
	} else							\
	    clabw = IndexWidth(j + 1) + 3;
 
	_PRINT_SET_clabw;
 
	if (w[j] < clabw)
	    w[j] = clabw;
	w[j] += R_print.gap;
    }
 
#   define _PRINT_DEAL_c_eq_0				\
							\
    if (c == 0) {					\
	for (i = 0; i < r; i++)				\
	    MatrixRowLabel(rl, i, rlabw, lbloff);	\
	Rprintf("\n");					\
	return;						\
    }
    _PRINT_DEAL_c_eq_0;
 
    while (jmin < c) {
	/* print columns  jmin:(jmax-1)	 where jmax has to be determined first */
 
	width = rlabw;
	/* initially, jmax = jmin */
	do {
	    width += w[jmax]; jmax++;
 
	} while (jmax < c && width + w[jmax] < R_print.width);
 
#	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)
{
    int *x;
 
    _PRINT_INIT_rl_rn;
 
    sw = allocVector(INTSXP, c);
    x = INTEGER(sx) + offset;
    w = INTEGER(sw);
    for (j = 0; j < c; j++) {
	formatInteger(&x[j * r], 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);
	    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_pr, int r, int c,
			    SEXP rl, SEXP cl, const char *rn, const char *cn)
{
    SEXP sd, se;
    double *x;
    int *d, *e;
    _PRINT_INIT_rl_rn;
 
    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);
	_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);
	    for (j = jmin; j < jmax; j++) {
		Rprintf("%s", EncodeReal(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 sdr, ser, swr, sdi, sei, swi;
    Rcomplex *x;
    int *dr, *er, *wr, *di, *ei, *wi;
    _PRINT_INIT_rl_rn;
 
    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);
	_PRINT_SET_clabw;
	w[j] = wr[j] + wi[j] + 2;
	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);
	    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, OutDec));
		else
		    Rprintf("%s",
			    EncodeComplex(x[i + j * r],
					  wr[j] + R_print.gap, dr[j], er[j],
					  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)
{
    SEXP *x;
    _PRINT_INIT_rl_rn;
 
    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);
	_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;
 
	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_pr; 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;
    }
}
 
static void printRawMatrix(SEXP sx, int offset, int r_pr, int r, int c,
			   SEXP rl, SEXP cl, const char *rn, const char *cn)
{
    Rbyte *x;
    _PRINT_INIT_rl_rn;
 
    sw = allocVector(INTSXP, c);
    x = RAW(sx) + offset;
    w = INTEGER(sw);
    for (j = 0; j < c; j++) {
	formatRaw(&x[j * r], 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);
	    for (j = jmin; j < jmax; j++)
		Rprintf("%*s%s", w[j]-2, "", EncodeRaw(x[i + j * r]));
	}
	Rprintf("\n");
	jmin = jmax;
    }
}
 
void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,
		 SEXP rl, SEXP cl, const char *rn, const char *cn)
{
/* 'rl' and 'cl' are dimnames(.)[[1]] and dimnames(.)[[2]]  whereas
 * 'rn' and 'cn' are the  names(dimnames(.))
 */
    int r = INTEGER(dim)[0];
    int c = INTEGER(dim)[1], r_pr;
    /* 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;
    }
    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);
	break;
    case INTSXP:
	printIntegerMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
	break;
    case REALSXP:
	printRealMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn);
	break;
    case CPLXSXP:
	printComplexMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
	break;
    case STRSXP:
	if (quote) quote = '"';
	printStringMatrix (x, offset, r_pr, r, c, quote, right, rl, cl, rn, cn);
	break;
    case RAWSXP:
	printRawMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn);
	break;
    default:
	UNIMPLEMENTED_TYPE("printMatrix", x);
    }
#ifdef ENABLE_NLS
    if(r_pr < r) /* FIXME? use _P() and "Defn.h" ? */
	Rprintf(ngettext(" [ reached getOption(\"max.print\") -- omitted last row ]]\n",
			 " [ reached getOption(\"max.print\") -- omitted %d rows ]]\n",
			 r - r_pr),
		r - r_pr);
#else
    if(r_pr < r) /* FIXME? use _P() and "Defn.h" ? */
	Rprintf(" [ reached getOption(\"max.print\") -- omitted %d rows ]]\n",
		r - r_pr);
#endif
}
 
static void printArrayGeneral(SEXP x, SEXP dim, int quote, int right,
			      SEXP dimnames)
{
/* == printArray(.) */
 
    int ndim = LENGTH(dim);
    const char *rn = NULL, *cn = NULL;
 
    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 { /* ndim >= 3 */
	SEXP dn, dnn, dn0, dn1;
	int i, j, has_dimnames, has_dnn, nb, nb_pr;
	int nr = INTEGER(dim)[0], nr_last;
	int nc = INTEGER(dim)[1];
	int b = nr * nc;
	Rboolean max_reached;
 
	if (dimnames == R_NilValue) {
	    has_dimnames = 0;
	    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];
	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;
	    nr_last = nr;
	}
	for (i = 0; i < nb_pr; i++) {
	    int k = 1, use_nr = nr;
	    if (i == nb_pr - 1) { /* for the last slice :*/
		use_nr = nr_last;
	    }
	    Rprintf(", ");
	    for (j = 2 ; j < ndim; j++) {
		int l = (i / k) % INTEGER(dim)[j] + 1;
		if (has_dimnames &&
		    ((dn = VECTOR_ELT(dimnames, j)) != R_NilValue)) {
		    if ( has_dnn )
			Rprintf(", %s = %s",
				translateChar(STRING_ELT(dnn, j)),
				translateChar(STRING_ELT(dn, l - 1)));
		    else
			Rprintf(", %s", translateChar(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, use_nr, nr, nc, dn0, dn1, rn, cn);
		break;
	    case INTSXP:
		printIntegerMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
		break;
	    case REALSXP:
		printRealMatrix   (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
		break;
	    case CPLXSXP:
		printComplexMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
		break;
	    case STRSXP:
		if (quote) quote = '"';
		printStringMatrix (x, i * b, use_nr, nr, nc,
				   quote, right, dn0, dn1, rn, cn);
		break;
	    case RAWSXP:
		printRawMatrix    (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
		break;
	    }
	    Rprintf("\n");
	}
 
	if(max_reached && nb_pr < nb) {
	    Rprintf(" [ reached getOption(\"max.print\") -- omitted");
	    if(nr_last < nr) Rprintf(" %d row(s) and", nr - nr_last);
	    Rprintf(" %d matrix slice(s) ]\n", nb - nb_pr);
	}
    }
}
 
void printArray(SEXP x, SEXP dim, int quote, int right, SEXP dimnames)
{
    printArrayGeneral(x, dim, quote, right, dimnames);
}

Rev 42077	Rev 42208
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--2006 The R Development Core Team.`	4	`* Copyright (C) 2000--2006 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., 51 Franklin Street Fifth Floor, Boston, MA 02110-1301 USA`	18	`* Foundation, Inc., 51 Franklin Street Fifth Floor, Boston, MA 02110-1301 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	`/* <UTF8> char here is handled as a whole,`	30	`/* <UTF8> char here is handled as a whole,`
31	`but lengths were used as display widths */`	31	`but lengths were used as display widths */`
32		32
33	`#ifdef HAVE_CONFIG_H`	33	`#ifdef HAVE_CONFIG_H`
34	`#include <config.h>`	34	`#include <config.h>`
35	`#endif`	35	`#endif`
36		36
37	`#include "Defn.h"`	37	`#include "Defn.h"`
38	`#include "Print.h"`	38	`#include "Print.h"`
39		39
40	`#include <stdlib.h> /* for div() */`	40	`#include <stdlib.h> /* for div() */`
41		41
42	`/* We need display width of a string */`	42	`/* We need display width of a string */`
43	`int Rstrwid(const char str, int slen, int quote); / from printutils.c */`	43	`int Rstrwid(const char str, int slen, int quote); / from printutils.c */`
44	`#define strwidth(x) Rstrwid(x, strlen(x), 0)`	44	`#define strwidth(x) Rstrwid(x, strlen(x), 0)`
45		45
46	`/* ceil_DIV(a,b) := ceil(a / b) in _int_ arithmetic : */`	46	`/* ceil_DIV(a,b) := ceil(a / b) in _int_ arithmetic : */`
47	`static R_INLINE`	47	`static R_INLINE`
48	`int ceil_DIV(int a, int b)`	48	`int ceil_DIV(int a, int b)`
49	`{`	49	`{`
50	`div_t div_res = div(a, b);`	50	`div_t div_res = div(a, b);`
51	`return div_res.quot + ((div_res.rem != 0) ? 1 : 0);`	51	`return div_res.quot + ((div_res.rem != 0) ? 1 : 0);`
52	`}`	52	`}`
53		53
54	`/* moved from printutils.c */`	54	`/* moved from printutils.c */`
55		55
56	`static void MatrixColumnLabel(SEXP cl, int j, int w)`	56	`static void MatrixColumnLabel(SEXP cl, int j, int w)`
57	`{`	57	`{`
58	`int l;`	58	`int l;`
59	`SEXP tmp;`	59	`SEXP tmp;`
60		60
61	`if (!isNull(cl)) {`	61	`if (!isNull(cl)) {`
62	`tmp = STRING_ELT(cl, j);`	62	`tmp = STRING_ELT(cl, j);`
63	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`	63	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`
64	`else l = Rstrlen(tmp, 0);`	64	`else l = Rstrlen(tmp, 0);`
65	`Rprintf("%*s%s", w-l, "",`	65	`Rprintf("%*s%s", w-l, "",`
66	`EncodeString(tmp, l, 0, Rprt_adj_left));`	66	`EncodeString(tmp, l, 0, Rprt_adj_left));`
67	`}`	67	`}`
68	`else {`	68	`else {`
69	`Rprintf("%*s[,%ld]", w-IndexWidth(j+1)-3, "", j+1);`	69	`Rprintf("%*s[,%ld]", w-IndexWidth(j+1)-3, "", j+1);`
70	`}`	70	`}`
71	`}`	71	`}`
72		72
73	`static void RightMatrixColumnLabel(SEXP cl, int j, int w)`	73	`static void RightMatrixColumnLabel(SEXP cl, int j, int w)`
74	`{`	74	`{`
75	`int l;`	75	`int l;`
76	`SEXP tmp;`	76	`SEXP tmp;`
77		77
78	`if (!isNull(cl)) {`	78	`if (!isNull(cl)) {`
79	`tmp = STRING_ELT(cl, j);`	79	`tmp = STRING_ELT(cl, j);`
80	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`	80	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`
81	`else l = Rstrlen(tmp, 0);`	81	`else l = Rstrlen(tmp, 0);`
82	`/* This does not work correctly at least on FC3`	82	`/* This does not work correctly at least on FC3`
83	`Rprintf("%*s", R_print.gap+w,`	83	`Rprintf("%*s", R_print.gap+w,`
84	`EncodeString(tmp, l, 0, Rprt_adj_right)); */`	84	`EncodeString(tmp, l, 0, Rprt_adj_right)); */`
85	`Rprintf("%*s%s", R_print.gap+w-l, "",`	85	`Rprintf("%*s%s", R_print.gap+w-l, "",`
86	`EncodeString(tmp, l, 0, Rprt_adj_right));`	86	`EncodeString(tmp, l, 0, Rprt_adj_right));`
87	`}`	87	`}`
88	`else {`	88	`else {`
89	`Rprintf("%s[,%ld]%s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");`	89	`Rprintf("%s[,%ld]%s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");`
90	`}`	90	`}`
91	`}`	91	`}`
92		92
93	`static void LeftMatrixColumnLabel(SEXP cl, int j, int w)`	93	`static void LeftMatrixColumnLabel(SEXP cl, int j, int w)`
94	`{`	94	`{`
95	`int l;`	95	`int l;`
96	`SEXP tmp;`	96	`SEXP tmp;`
97		97
98	`if (!isNull(cl)) {`	98	`if (!isNull(cl)) {`
99	`tmp= STRING_ELT(cl, j);`	99	`tmp= STRING_ELT(cl, j);`
100	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`	100	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`
101	`else l = Rstrlen(tmp, 0);`	101	`else l = Rstrlen(tmp, 0);`
102	`Rprintf("%s%s%s", R_print.gap, "",`	102	`Rprintf("%s%s%s", R_print.gap, "",`
103	`EncodeString(tmp, l, 0, Rprt_adj_left), w-l, "");`	103	`EncodeString(tmp, l, 0, Rprt_adj_left), w-l, "");`
104	`}`	104	`}`
105	`else {`	105	`else {`
106	`Rprintf("%s[,%ld]%s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");`	106	`Rprintf("%s[,%ld]%s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");`
107	`}`	107	`}`
108	`}`	108	`}`
109		109
110	`static void MatrixRowLabel(SEXP rl, int i, int rlabw, int lbloff)`	110	`static void MatrixRowLabel(SEXP rl, int i, int rlabw, int lbloff)`
111	`{`	111	`{`
112	`int l;`	112	`int l;`
113	`SEXP tmp;`	113	`SEXP tmp;`
114		114
115	`if (!isNull(rl)) {`	115	`if (!isNull(rl)) {`
116	`tmp= STRING_ELT(rl, i);`	116	`tmp= STRING_ELT(rl, i);`
117	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`	117	`if(tmp == NA_STRING) l = R_print.na_width_noquote;`
118	`else l = Rstrlen(tmp, 0);`	118	`else l = Rstrlen(tmp, 0);`
119	`Rprintf("\n%s%s%s", lbloff, "",`	119	`Rprintf("\n%s%s%s", lbloff, "",`
120	`EncodeString(tmp, l, 0, Rprt_adj_left),`	120	`EncodeString(tmp, l, 0, Rprt_adj_left),`
121	`rlabw-l-lbloff, "");`	121	`rlabw-l-lbloff, "");`
122	`}`	122	`}`
123	`else {`	123	`else {`
124	`Rprintf("\n%*s[%ld,]", rlabw-3-IndexWidth(i + 1), "", i+1);`	124	`Rprintf("\n%*s[%ld,]", rlabw-3-IndexWidth(i + 1), "", i+1);`
125	`}`	125	`}`
126	`}`	126	`}`
127		127
128		128
129		129
130	`/* This is the first (of 6) print<TYPE>Matrix() functions.`	130	`/* This is the first (of 6) print<TYPE>Matrix() functions.`
131	`* We define macros that will be re-used in the other functions,`	131	`* We define macros that will be re-used in the other functions,`
132	`* and comment the common code here (only):`	132	`* and comment the common code here (only):`
133	`*/`	133	`*/`
134	`static void printLogicalMatrix(SEXP sx, int offset, int r_pr, int r, int c,`	134	`static void printLogicalMatrix(SEXP sx, int offset, int r_pr, int r, int c,`
135	`SEXP rl, SEXP cl, const char rn, const char cn)`	135	`SEXP rl, SEXP cl, const char rn, const char cn)`
136	`{`	136	`{`
137	`int *x;`	137	`int *x;`
138		138
139	`/* initialization; particularly of row labels, rl= dimnames(.)[[1]] and`	139	`/* initialization; particularly of row labels, rl= dimnames(.)[[1]] and`
140	`* rn = names(dimnames(.))[1] : */`	140	`* rn = names(dimnames(.))[1] : */`
141	`#define _PRINT_INIT_rl_rn \`	141	`#define _PRINT_INIT_rl_rn \`
142	`SEXP sw; \`	142	`SEXP sw; \`
143	`int *w; \`	143	`int *w; \`
144	`int width, rlabw = -1, clabw = -1; /* -Wall */ \`	144	`int width, rlabw = -1, clabw = -1; /* -Wall */ \`
145	`int i, j, jmin = 0, jmax = 0, lbloff = 0; \`	145	`int i, j, jmin = 0, jmax = 0, lbloff = 0; \`
146	`\`	146	`\`
147	`if (!isNull(rl)) \`	147	`if (!isNull(rl)) \`
148	`formatString(STRING_PTR(rl), r, &rlabw, 0); \`	148	`formatString(STRING_PTR(rl), r, &rlabw, 0); \`
149	`else \`	149	`else \`
150	`rlabw = IndexWidth(r + 1) + 3; \`	150	`rlabw = IndexWidth(r + 1) + 3; \`
151	`\`	151	`\`
152	`if (rn) { \`	152	`if (rn) { \`
153	`int rnw = strwidth(rn); \`	153	`int rnw = strwidth(rn); \`
154	`if ( rnw < rlabw + R_MIN_LBLOFF ) \`	154	`if ( rnw < rlabw + R_MIN_LBLOFF ) \`
155	`lbloff = R_MIN_LBLOFF; \`	155	`lbloff = R_MIN_LBLOFF; \`
156	`else \`	156	`else \`
157	`lbloff = rnw - rlabw; \`	157	`lbloff = rnw - rlabw; \`
158	`\`	158	`\`
159	`rlabw += lbloff; \`	159	`rlabw += lbloff; \`
160	`}`	160	`}`
161		161
162	`_PRINT_INIT_rl_rn;`	162	`_PRINT_INIT_rl_rn;`
163		163
164	`sw = allocVector(INTSXP, c);`	164	`sw = allocVector(INTSXP, c);`
165	`x = LOGICAL(sx) + offset;`	165	`x = LOGICAL(sx) + offset;`
166	`w = INTEGER(sw);`	166	`w = INTEGER(sw);`
167	`/* compute w[j] = column-width of j(+1)-th column : */`	167	`/* compute w[j] = column-width of j(+1)-th column : */`
168	`for (j = 0; j < c; j++) {`	168	`for (j = 0; j < c; j++) {`
169	`formatLogical(&x[j * r], r, &w[j]);`	169	`formatLogical(&x[j * r], r, &w[j]);`
170		170
171	`# define _PRINT_SET_clabw \`	171	`# define _PRINT_SET_clabw \`
172	`\`	172	`\`
173	`if (!isNull(cl)) { \`	173	`if (!isNull(cl)) { \`
174	`if(STRING_ELT(cl, j) == NA_STRING) \`	174	`if(STRING_ELT(cl, j) == NA_STRING) \`
175	`clabw = R_print.na_width_noquote; \`	175	`clabw = R_print.na_width_noquote; \`
176	`else clabw = strwidth(translateChar(STRING_ELT(cl, j))); \`	176	`else clabw = strwidth(translateChar(STRING_ELT(cl, j))); \`
177	`} else \`	177	`} else \`
178	`clabw = IndexWidth(j + 1) + 3;`	178	`clabw = IndexWidth(j + 1) + 3;`
179		179
180	`_PRINT_SET_clabw;`	180	`_PRINT_SET_clabw;`
181		181
182	`if (w[j] < clabw)`	182	`if (w[j] < clabw)`
183	`w[j] = clabw;`	183	`w[j] = clabw;`
184	`w[j] += R_print.gap;`	184	`w[j] += R_print.gap;`
185	`}`	185	`}`
186		186
187	`# define _PRINT_DEAL_c_eq_0 \`	187	`# define _PRINT_DEAL_c_eq_0 \`
188	`\`	188	`\`
189	`if (c == 0) { \`	189	`if (c == 0) { \`
190	`for (i = 0; i < r; i++) \`	190	`for (i = 0; i < r; i++) \`
191	`MatrixRowLabel(rl, i, rlabw, lbloff); \`	191	`MatrixRowLabel(rl, i, rlabw, lbloff); \`
192	`Rprintf("\n"); \`	192	`Rprintf("\n"); \`
193	`return; \`	193	`return; \`
194	`}`	194	`}`
195	`_PRINT_DEAL_c_eq_0;`	195	`_PRINT_DEAL_c_eq_0;`
196		196
197	`while (jmin < c) {`	197	`while (jmin < c) {`
198	`/* print columns jmin:(jmax-1) where jmax has to be determined first */`	198	`/* print columns jmin:(jmax-1) where jmax has to be determined first */`
199		199
200	`width = rlabw;`	200	`width = rlabw;`
201	`/* initially, jmax = jmin */`	201	`/* initially, jmax = jmin */`
202	`do {`	202	`do {`
203	`width += w[jmax]; jmax++;`	203	`width += w[jmax]; jmax++;`
204		204
205	`} while (jmax < c && width + w[jmax] < R_print.width);`	205	`} while (jmax < c && width + w[jmax] < R_print.width);`
206		206
207	`# define _PRINT_ROW_LAB \`	207	`# define _PRINT_ROW_LAB \`
208	`\`	208	`\`
209	`if (cn != NULL) \`	209	`if (cn != NULL) \`
210	`Rprintf("%*s%s\n", rlabw, "", cn); \`	210	`Rprintf("%*s%s\n", rlabw, "", cn); \`
211	`\`	211	`\`
212	`if (rn != NULL) \`	212	`if (rn != NULL) \`
213	`Rprintf("%*s", -rlabw, rn); \`	213	`Rprintf("%*s", -rlabw, rn); \`
214	`else \`	214	`else \`
215	`Rprintf("%*s", rlabw, "");`	215	`Rprintf("%*s", rlabw, "");`
216		216
217	`_PRINT_ROW_LAB;`	217	`_PRINT_ROW_LAB;`
218		218
219	`for (j = jmin; j < jmax ; j++)`	219	`for (j = jmin; j < jmax ; j++)`
220	`MatrixColumnLabel(cl, j, w[j]);`	220	`MatrixColumnLabel(cl, j, w[j]);`
221	`for (i = 0; i < r_pr; i++) {`	221	`for (i = 0; i < r_pr; i++) {`
222	`MatrixRowLabel(rl, i, rlabw, lbloff); /* starting with an "\n" */`	222	`MatrixRowLabel(rl, i, rlabw, lbloff); /* starting with an "\n" */`
223	`for (j = jmin; j < jmax; j++) {`	223	`for (j = jmin; j < jmax; j++) {`
224	`Rprintf("%s", EncodeLogical(x[i + j * r], w[j]));`	224	`Rprintf("%s", EncodeLogical(x[i + j * r], w[j]));`
225	`}`	225	`}`
226	`}`	226	`}`
227	`Rprintf("\n");`	227	`Rprintf("\n");`
228	`jmin = jmax;`	228	`jmin = jmax;`
229	`}`	229	`}`
230	`}`	230	`}`
231		231
232	`static void printIntegerMatrix(SEXP sx, int offset, int r_pr, int r, int c,`	232	`static void printIntegerMatrix(SEXP sx, int offset, int r_pr, int r, int c,`
233	`SEXP rl, SEXP cl, const char rn, const char cn)`	233	`SEXP rl, SEXP cl, const char rn, const char cn)`
234	`{`	234	`{`
235	`int *x;`	235	`int *x;`
236		236
237	`_PRINT_INIT_rl_rn;`	237	`_PRINT_INIT_rl_rn;`
238		238
239	`sw = allocVector(INTSXP, c);`	239	`sw = allocVector(INTSXP, c);`
240	`x = INTEGER(sx) + offset;`	240	`x = INTEGER(sx) + offset;`
241	`w = INTEGER(sw);`	241	`w = INTEGER(sw);`
242	`for (j = 0; j < c; j++) {`	242	`for (j = 0; j < c; j++) {`
243	`formatInteger(&x[j * r], r, &w[j]);`	243	`formatInteger(&x[j * r], r, &w[j]);`
244	`_PRINT_SET_clabw;`	244	`_PRINT_SET_clabw;`
245	`if (w[j] < clabw)`	245	`if (w[j] < clabw)`
246	`w[j] = clabw;`	246	`w[j] = clabw;`
247	`w[j] += R_print.gap;`	247	`w[j] += R_print.gap;`
248	`}`	248	`}`
249	`_PRINT_DEAL_c_eq_0;`	249	`_PRINT_DEAL_c_eq_0;`
250	`while (jmin < c) {`	250	`while (jmin < c) {`
251	`width = rlabw;`	251	`width = rlabw;`
252	`do {`	252	`do {`
253	`width += w[jmax];`	253	`width += w[jmax];`
254	`jmax++;`	254	`jmax++;`
255	`}`	255	`}`
256	`while (jmax < c && width + w[jmax] < R_print.width);`	256	`while (jmax < c && width + w[jmax] < R_print.width);`
257		257
258	`_PRINT_ROW_LAB;`	258	`_PRINT_ROW_LAB;`
259		259
260	`for (j = jmin; j < jmax ; j++)`	260	`for (j = jmin; j < jmax ; j++)`
261	`MatrixColumnLabel(cl, j, w[j]);`	261	`MatrixColumnLabel(cl, j, w[j]);`
262	`for (i = 0; i < r_pr; i++) {`	262	`for (i = 0; i < r_pr; i++) {`
263	`MatrixRowLabel(rl, i, rlabw, lbloff);`	263	`MatrixRowLabel(rl, i, rlabw, lbloff);`
264	`for (j = jmin; j < jmax; j++) {`	264	`for (j = jmin; j < jmax; j++) {`
265	`Rprintf("%s", EncodeInteger(x[i + j * r], w[j]));`	265	`Rprintf("%s", EncodeInteger(x[i + j * r], w[j]));`
266	`}`	266	`}`
267	`}`	267	`}`
268	`Rprintf("\n");`	268	`Rprintf("\n");`
269	`jmin = jmax;`	269	`jmin = jmax;`
270	`}`	270	`}`
271	`}`	271	`}`
272		272
273	`static void printRealMatrix(SEXP sx, int offset, int r_pr, int r, int c,`	273	`static void printRealMatrix(SEXP sx, int offset, int r_pr, int r, int c,`
274	`SEXP rl, SEXP cl, const char rn, const char cn)`	274	`SEXP rl, SEXP cl, const char rn, const char cn)`
275	`{`	275	`{`
276	`SEXP sd, se;`	276	`SEXP sd, se;`
277	`double *x;`	277	`double *x;`
278	`int d, e;`	278	`int d, e;`
279	`_PRINT_INIT_rl_rn;`	279	`_PRINT_INIT_rl_rn;`
280		280
281	`PROTECT(sd = allocVector(INTSXP, c));`	281	`PROTECT(sd = allocVector(INTSXP, c));`
282	`PROTECT(se = allocVector(INTSXP, c));`	282	`PROTECT(se = allocVector(INTSXP, c));`
283	`sw = allocVector(INTSXP, c);`	283	`sw = allocVector(INTSXP, c);`
284	`UNPROTECT(2);`	284	`UNPROTECT(2);`
285	`x = REAL(sx) + offset;`	285	`x = REAL(sx) + offset;`
286	`d = INTEGER(sd);`	286	`d = INTEGER(sd);`
287	`e = INTEGER(se);`	287	`e = INTEGER(se);`
288	`w = INTEGER(sw);`	288	`w = INTEGER(sw);`
289		289
290	`for (j = 0; j < c; j++) {`	290	`for (j = 0; j < c; j++) {`
291	`formatReal(&x[j * r], r, &w[j], &d[j], &e[j], 0);`	291	`formatReal(&x[j * r], r, &w[j], &d[j], &e[j], 0);`
292	`_PRINT_SET_clabw;`	292	`_PRINT_SET_clabw;`
293	`if (w[j] < clabw)`	293	`if (w[j] < clabw)`
294	`w[j] = clabw;`	294	`w[j] = clabw;`
295	`w[j] += R_print.gap;`	295	`w[j] += R_print.gap;`
296	`}`	296	`}`
297	`_PRINT_DEAL_c_eq_0;`	297	`_PRINT_DEAL_c_eq_0;`
298	`while (jmin < c) {`	298	`while (jmin < c) {`
299	`width = rlabw;`	299	`width = rlabw;`
300	`do {`	300	`do {`
301	`width += w[jmax];`	301	`width += w[jmax];`
302	`jmax++;`	302	`jmax++;`
303	`}`	303	`}`
304	`while (jmax < c && width + w[jmax] < R_print.width);`	304	`while (jmax < c && width + w[jmax] < R_print.width);`
305		305
306	`_PRINT_ROW_LAB;`	306	`_PRINT_ROW_LAB;`
307		307
308	`for (j = jmin; j < jmax ; j++)`	308	`for (j = jmin; j < jmax ; j++)`
309	`MatrixColumnLabel(cl, j, w[j]);`	309	`MatrixColumnLabel(cl, j, w[j]);`
310	`for (i = 0; i < r_pr; i++) {`	310	`for (i = 0; i < r_pr; i++) {`
311	`MatrixRowLabel(rl, i, rlabw, lbloff);`	311	`MatrixRowLabel(rl, i, rlabw, lbloff);`
312	`for (j = jmin; j < jmax; j++) {`	312	`for (j = jmin; j < jmax; j++) {`
313	`Rprintf("%s", EncodeReal(x[i + j * r], w[j], d[j], e[j], OutDec));`	313	`Rprintf("%s", EncodeReal(x[i + j * r], w[j], d[j], e[j], OutDec));`
314	`}`	314	`}`
315	`}`	315	`}`
316	`Rprintf("\n");`	316	`Rprintf("\n");`
317	`jmin = jmax;`	317	`jmin = jmax;`
318	`}`	318	`}`
319	`}`	319	`}`
320		320
321	`static void printComplexMatrix(SEXP sx, int offset, int r_pr, int r, int c,`	321	`static void printComplexMatrix(SEXP sx, int offset, int r_pr, int r, int c,`
322	`SEXP rl, SEXP cl, const char rn, const char cn)`	322	`SEXP rl, SEXP cl, const char rn, const char cn)`
323	`{`	323	`{`
324	`SEXP sdr, ser, swr, sdi, sei, swi;`	324	`SEXP sdr, ser, swr, sdi, sei, swi;`
325	`Rcomplex *x;`	325	`Rcomplex *x;`
326	`int dr, er, wr, di, ei, wi;`	326	`int dr, er, wr, di, ei, wi;`
327	`_PRINT_INIT_rl_rn;`	327	`_PRINT_INIT_rl_rn;`
328		328
329	`PROTECT(sdr = allocVector(INTSXP, c));`	329	`PROTECT(sdr = allocVector(INTSXP, c));`
330	`PROTECT(ser = allocVector(INTSXP, c));`	330	`PROTECT(ser = allocVector(INTSXP, c));`
331	`PROTECT(swr = allocVector(INTSXP, c));`	331	`PROTECT(swr = allocVector(INTSXP, c));`
332	`PROTECT(sdi = allocVector(INTSXP, c));`	332	`PROTECT(sdi = allocVector(INTSXP, c));`
333	`PROTECT(sei = allocVector(INTSXP, c));`	333	`PROTECT(sei = allocVector(INTSXP, c));`
334	`PROTECT(swi = allocVector(INTSXP, c));`	334	`PROTECT(swi = allocVector(INTSXP, c));`
335	`PROTECT(sw = allocVector(INTSXP, c));`	335	`PROTECT(sw = allocVector(INTSXP, c));`
336	`UNPROTECT(7);`	336	`UNPROTECT(7);`
337	`x = COMPLEX(sx) + offset;`	337	`x = COMPLEX(sx) + offset;`
338	`dr = INTEGER(sdr);`	338	`dr = INTEGER(sdr);`
339	`er = INTEGER(ser);`	339	`er = INTEGER(ser);`
340	`wr = INTEGER(swr);`	340	`wr = INTEGER(swr);`
341	`di = INTEGER(sdi);`	341	`di = INTEGER(sdi);`
342	`ei = INTEGER(sei);`	342	`ei = INTEGER(sei);`
343	`wi = INTEGER(swi);`	343	`wi = INTEGER(swi);`
344	`w = INTEGER(sw);`	344	`w = INTEGER(sw);`
345		345
346	`/* Determine the column widths */`	346	`/* Determine the column widths */`
347		347
348	`for (j = 0; j < c; j++) {`	348	`for (j = 0; j < c; j++) {`
349	`formatComplex(&x[j * r], r,`	349	`formatComplex(&x[j * r], r,`
350	`&wr[j], &dr[j], &er[j],`	350	`&wr[j], &dr[j], &er[j],`
351	`&wi[j], &di[j], &ei[j], 0);`	351	`&wi[j], &di[j], &ei[j], 0);`
352	`_PRINT_SET_clabw;`	352	`_PRINT_SET_clabw;`
353	`w[j] = wr[j] + wi[j] + 2;`	353	`w[j] = wr[j] + wi[j] + 2;`
354	`if (w[j] < clabw)`	354	`if (w[j] < clabw)`
355	`w[j] = clabw;`	355	`w[j] = clabw;`
356	`w[j] += R_print.gap;`	356	`w[j] += R_print.gap;`
357	`}`	357	`}`
358		358
359	`_PRINT_DEAL_c_eq_0;`	359	`_PRINT_DEAL_c_eq_0;`
360	`while (jmin < c) {`	360	`while (jmin < c) {`
361	`width = rlabw;`	361	`width = rlabw;`
362	`do {`	362	`do {`
363	`width += w[jmax];`	363	`width += w[jmax];`
364	`jmax++;`	364	`jmax++;`
365	`}`	365	`}`
366	`while (jmax < c && width + w[jmax] < R_print.width);`	366	`while (jmax < c && width + w[jmax] < R_print.width);`
367		367
368	`_PRINT_ROW_LAB;`	368	`_PRINT_ROW_LAB;`
369		369
370	`for (j = jmin; j < jmax ; j++)`	370	`for (j = jmin; j < jmax ; j++)`
371	`MatrixColumnLabel(cl, j, w[j]);`	371	`MatrixColumnLabel(cl, j, w[j]);`
372	`for (i = 0; i < r_pr; i++) {`	372	`for (i = 0; i < r_pr; i++) {`
373	`MatrixRowLabel(rl, i, rlabw, lbloff);`	373	`MatrixRowLabel(rl, i, rlabw, lbloff);`
374	`for (j = jmin; j < jmax; j++) {`	374	`for (j = jmin; j < jmax; j++) {`
375	`if (ISNA(x[i + j * r].r) \|\| ISNA(x[i + j * r].i))`	375	`if (ISNA(x[i + j * r].r) \|\| ISNA(x[i + j * r].i))`
376	`Rprintf("%s", EncodeReal(NA_REAL, w[j], 0, 0, OutDec));`	376	`Rprintf("%s", EncodeReal(NA_REAL, w[j], 0, 0, OutDec));`
377	`else`	377	`else`
378	`Rprintf("%s",`	378	`Rprintf("%s",`
379	`EncodeComplex(x[i + j * r],`	379	`EncodeComplex(x[i + j * r],`
380	`wr[j] + R_print.gap, dr[j], er[j],`	380	`wr[j] + R_print.gap, dr[j], er[j],`
381	`wi[j], di[j], ei[j], OutDec));`	381	`wi[j], di[j], ei[j], OutDec));`
382	`}`	382	`}`
383	`}`	383	`}`
384	`Rprintf("\n");`	384	`Rprintf("\n");`
385	`jmin = jmax;`	385	`jmin = jmax;`
386	`}`	386	`}`
387	`}`	387	`}`
388		388
389	`static void printStringMatrix(SEXP sx, int offset, int r_pr, int r, int c,`	389	`static void printStringMatrix(SEXP sx, int offset, int r_pr, int r, int c,`
390	`int quote, int right, SEXP rl, SEXP cl,`	390	`int quote, int right, SEXP rl, SEXP cl,`
391	`const char rn, const char cn)`	391	`const char rn, const char cn)`
392	`{`	392	`{`
393	`SEXP *x;`	393	`SEXP *x;`
394	`_PRINT_INIT_rl_rn;`	394	`_PRINT_INIT_rl_rn;`
395		395
396	`sw = allocVector(INTSXP, c);`	396	`sw = allocVector(INTSXP, c);`
397	`x = STRING_PTR(sx)+offset;`	397	`x = STRING_PTR(sx)+offset;`
398	`w = INTEGER(sw);`	398	`w = INTEGER(sw);`
399	`for (j = 0; j < c; j++) {`	399	`for (j = 0; j < c; j++) {`
400	`formatString(&x[j * r], r, &w[j], quote);`	400	`formatString(&x[j * r], r, &w[j], quote);`
401	`_PRINT_SET_clabw;`	401	`_PRINT_SET_clabw;`
402	`if (w[j] < clabw)`	402	`if (w[j] < clabw)`
403	`w[j] = clabw;`	403	`w[j] = clabw;`
404	`}`	404	`}`
405	`_PRINT_DEAL_c_eq_0;`	405	`_PRINT_DEAL_c_eq_0;`
406	`while (jmin < c) {`	406	`while (jmin < c) {`
407	`width = rlabw;`	407	`width = rlabw;`
408	`do {`	408	`do {`
409	`width += w[jmax] + R_print.gap;`	409	`width += w[jmax] + R_print.gap;`
410	`jmax++;`	410	`jmax++;`
411	`}`	411	`}`
412	`while (jmax < c && width + w[jmax] + R_print.gap < R_print.width);`	412	`while (jmax < c && width + w[jmax] + R_print.gap < R_print.width);`
413		413
414	`_PRINT_ROW_LAB;`	414	`_PRINT_ROW_LAB;`
415		415
416	`if (right) {`	416	`if (right) {`
417	`for (j = jmin; j < jmax ; j++)`	417	`for (j = jmin; j < jmax ; j++)`
418	`RightMatrixColumnLabel(cl, j, w[j]);`	418	`RightMatrixColumnLabel(cl, j, w[j]);`
419	`}`	419	`}`
420	`else {`	420	`else {`
421	`for (j = jmin; j < jmax ; j++)`	421	`for (j = jmin; j < jmax ; j++)`
422	`LeftMatrixColumnLabel(cl, j, w[j]);`	422	`LeftMatrixColumnLabel(cl, j, w[j]);`
423	`}`	423	`}`
424	`for (i = 0; i < r_pr; i++) {`	424	`for (i = 0; i < r_pr; i++) {`
425	`MatrixRowLabel(rl, i, rlabw, lbloff);`	425	`MatrixRowLabel(rl, i, rlabw, lbloff);`
426	`for (j = jmin; j < jmax; j++) {`	426	`for (j = jmin; j < jmax; j++) {`
427	`Rprintf("%*s%s", R_print.gap, "",`	427	`Rprintf("%*s%s", R_print.gap, "",`
428	`EncodeString(x[i + j * r], w[j], quote, right));`	428	`EncodeString(x[i + j * r], w[j], quote, right));`
429	`}`	429	`}`
430	`}`	430	`}`
431	`Rprintf("\n");`	431	`Rprintf("\n");`
432	`jmin = jmax;`	432	`jmin = jmax;`
433	`}`	433	`}`
434	`}`	434	`}`
435		435
436	`static void printRawMatrix(SEXP sx, int offset, int r_pr, int r, int c,`	436	`static void printRawMatrix(SEXP sx, int offset, int r_pr, int r, int c,`
437	`SEXP rl, SEXP cl, const char rn, const char cn)`	437	`SEXP rl, SEXP cl, const char rn, const char cn)`
438	`{`	438	`{`
439	`Rbyte *x;`	439	`Rbyte *x;`
440	`_PRINT_INIT_rl_rn;`	440	`_PRINT_INIT_rl_rn;`
441		441
442	`sw = allocVector(INTSXP, c);`	442	`sw = allocVector(INTSXP, c);`
443	`x = RAW(sx) + offset;`	443	`x = RAW(sx) + offset;`
444	`w = INTEGER(sw);`	444	`w = INTEGER(sw);`
445	`for (j = 0; j < c; j++) {`	445	`for (j = 0; j < c; j++) {`
446	`formatRaw(&x[j * r], r, &w[j]);`	446	`formatRaw(&x[j * r], r, &w[j]);`
447	`_PRINT_SET_clabw;`	447	`_PRINT_SET_clabw;`
448	`if (w[j] < clabw)`	448	`if (w[j] < clabw)`
449	`w[j] = clabw;`	449	`w[j] = clabw;`
450	`w[j] += R_print.gap;`	450	`w[j] += R_print.gap;`
451	`}`	451	`}`
452	`_PRINT_DEAL_c_eq_0;`	452	`_PRINT_DEAL_c_eq_0;`
453	`while (jmin < c) {`	453	`while (jmin < c) {`
454	`width = rlabw;`	454	`width = rlabw;`
455	`do {`	455	`do {`
456	`width += w[jmax];`	456	`width += w[jmax];`
457	`jmax++;`	457	`jmax++;`
458	`}`	458	`}`
459	`while (jmax < c && width + w[jmax] < R_print.width);`	459	`while (jmax < c && width + w[jmax] < R_print.width);`
460		460
461	`_PRINT_ROW_LAB;`	461	`_PRINT_ROW_LAB;`
462		462
463	`for (j = jmin; j < jmax ; j++)`	463	`for (j = jmin; j < jmax ; j++)`
464	`MatrixColumnLabel(cl, j, w[j]);`	464	`MatrixColumnLabel(cl, j, w[j]);`
465	`for (i = 0; i < r_pr; i++) {`	465	`for (i = 0; i < r_pr; i++) {`
466	`MatrixRowLabel(rl, i, rlabw, lbloff);`	466	`MatrixRowLabel(rl, i, rlabw, lbloff);`
467	`for (j = jmin; j < jmax; j++)`	467	`for (j = jmin; j < jmax; j++)`
468	`Rprintf("%s%s", w[j]-2, "", EncodeRaw(x[i + j r]));`	468	`Rprintf("%s%s", w[j]-2, "", EncodeRaw(x[i + j r]));`
469	`}`	469	`}`
470	`Rprintf("\n");`	470	`Rprintf("\n");`
471	`jmin = jmax;`	471	`jmin = jmax;`
472	`}`	472	`}`
473	`}`	473	`}`
474		474
475	`void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,`	475	`void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,`
476	`SEXP rl, SEXP cl, const char rn, const char cn)`	476	`SEXP rl, SEXP cl, const char rn, const char cn)`
477	`{`	477	`{`
478	`/* 'rl' and 'cl' are dimnames(.)[[1]] and dimnames(.)[[2]] whereas`	478	`/* 'rl' and 'cl' are dimnames(.)[[1]] and dimnames(.)[[2]] whereas`
479	`* 'rn' and 'cn' are the names(dimnames(.))`	479	`* 'rn' and 'cn' are the names(dimnames(.))`
480	`*/`	480	`*/`
481	`int r = INTEGER(dim)[0];`	481	`int r = INTEGER(dim)[0];`
482	`int c = INTEGER(dim)[1], r_pr;`	482	`int c = INTEGER(dim)[1], r_pr;`
483	`/* PR#850 */`	483	`/* PR#850 */`
484	`if ((rl != R_NilValue) && (r > length(rl)))`	484	`if ((rl != R_NilValue) && (r > length(rl)))`
485	`error(_("too few row labels"));`	485	`error(_("too few row labels"));`
486	`if ((cl != R_NilValue) && (c > length(cl)))`	486	`if ((cl != R_NilValue) && (c > length(cl)))`
487	`error(_("too few column labels"));`	487	`error(_("too few column labels"));`
488	`if (r == 0 && c == 0) {`	488	`if (r == 0 && c == 0) {`
489	`Rprintf("<0 x 0 matrix>\n");`	489	`Rprintf("<0 x 0 matrix>\n");`
490	`return;`	490	`return;`
491	`}`	491	`}`
492	`r_pr = r;`	492	`r_pr = r;`
493	`if(c > 0 && R_print.max / c < r) /* avoid integer overflow */`	493	`if(c > 0 && R_print.max / c < r) /* avoid integer overflow */`
494	`/* using floor(), not ceil(), since 'c' could be huge: */`	494	`/* using floor(), not ceil(), since 'c' could be huge: */`
495	`r_pr = R_print.max / c;`	495	`r_pr = R_print.max / c;`
496	`switch (TYPEOF(x)) {`	496	`switch (TYPEOF(x)) {`
497	`case LGLSXP:`	497	`case LGLSXP:`
498	`printLogicalMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);`	498	`printLogicalMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);`
499	`break;`	499	`break;`
500	`case INTSXP:`	500	`case INTSXP:`

The R Project SVN R

(root)/branches/djm-source/src/main/printarray.c – Rev 42077 → 42208