The R Project SVN R

Rev

Rev 63155 | Rev 66087 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 r 1 
/*
465 maechler 2 
 *  R : A Computer Language for Statistical Data Analysis
8552 maechler 3 
 *  Copyright (C) 1995, 1996	Robert Gentleman and Ross Ihaka
59035 ripley 4 
 *  Copyright (C) 2000--2012	The R Core Team
58298 maechler 5 
 *  Copyright (C) 2001--2012	The R Foundation
2 r 6 
 *
7 
 *  This program is free software; you can redistribute it and/or modify
8 
 *  it under the terms of the GNU General Public License as published by
9 
 *  the Free Software Foundation; either version 2 of the License, or
10 
 *  (at your option) any later version.
11 
 *
12 
 *  This program is distributed in the hope that it will be useful,
13 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 
 *  GNU General Public License for more details.
16 
 *
17 
 *  You should have received a copy of the GNU General Public License
42307 ripley 18 
 *  along with this program; if not, a copy is available at
19 
 *  http://www.r-project.org/Licenses/
1895 ihaka 20 
 *
21 
 *
22 
 *  EXPORTS	printMatrix()
4717 maechler 23 
 *		printArray()
1754 pd 24 
 *
1895 ihaka 25 
 *  See ./printutils.c	 for general remarks on Printing
4717 maechler 26 
 *			 and the Encode.. utils.
1895 ihaka 27 
 *
28 
 *  See ./format.c	 for the  format_FOO_  functions used below.
2 r 29 
 */
1895 ihaka 30 
 
5187 hornik 31 
#ifdef HAVE_CONFIG_H
7701 hornik 32 
#include <config.h>
5187 hornik 33 
#endif
34 
 
2 r 35 
#include "Defn.h"
36 
#include "Print.h"
37 
 
39079 ripley 38 
#include <stdlib.h> /* for div() */
39 
 
44027 ripley 40 
/* FIXME: sort out encodings */
34073 ripley 41 
/* We need display width of a string */
44027 ripley 42 
int Rstrwid(const char *str, int slen, int enc, int quote);  /* from printutils.c */
59177 ripley 43 
#define strwidth(x) Rstrwid(x, (int) strlen(x), CE_NATIVE, 0)
34073 ripley 44 
 
38980 maechler 45 
/* ceil_DIV(a,b) :=  ceil(a / b)  in _int_ arithmetic : */
46 
static R_INLINE
47 
int ceil_DIV(int a, int b)
48 
{
49 
    div_t div_res = div(a, b);
50 
    return div_res.quot + ((div_res.rem != 0) ? 1 : 0);
51 
}
52 
 
42077 ripley 53 
/* moved from printutils.c */
38980 maechler 54 
 
42077 ripley 55 
static void MatrixColumnLabel(SEXP cl, int j, int w)
56 
{
57 
    int l;
58 
    SEXP tmp;
59 
 
60 
    if (!isNull(cl)) {
45446 ripley 61 
	tmp = STRING_ELT(cl, j);
42077 ripley 62 
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
63 
	else l = Rstrlen(tmp, 0);
64 
	Rprintf("%*s%s", w-l, "",
65 
		EncodeString(tmp, l, 0, Rprt_adj_left));
66 
    }
67 
    else {
68 
	Rprintf("%*s[,%ld]", w-IndexWidth(j+1)-3, "", j+1);
69 
    }
70 
}
71 
 
72 
static void RightMatrixColumnLabel(SEXP cl, int j, int w)
73 
{
74 
    int l;
75 
    SEXP tmp;
76 
 
77 
    if (!isNull(cl)) {
45446 ripley 78 
	tmp = STRING_ELT(cl, j);
42077 ripley 79 
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
80 
	else l = Rstrlen(tmp, 0);
81 
	/* This does not work correctly at least on FC3
82 
	Rprintf("%*s", R_print.gap+w,
83 
		EncodeString(tmp, l, 0, Rprt_adj_right)); */
84 
	Rprintf("%*s%s", R_print.gap+w-l, "",
45446 ripley 85 
		EncodeString(tmp, l, 0, Rprt_adj_right));
42077 ripley 86 
    }
87 
    else {
88 
	Rprintf("%*s[,%ld]%*s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");
89 
    }
90 
}
91 
 
92 
static void LeftMatrixColumnLabel(SEXP cl, int j, int w)
93 
{
94 
    int l;
95 
    SEXP tmp;
96 
 
97 
    if (!isNull(cl)) {
45446 ripley 98 
	tmp= STRING_ELT(cl, j);
42077 ripley 99 
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
100 
	else l = Rstrlen(tmp, 0);
101 
	Rprintf("%*s%s%*s", R_print.gap, "",
102 
		EncodeString(tmp, l, 0, Rprt_adj_left), w-l, "");
103 
    }
104 
    else {
105 
	Rprintf("%*s[,%ld]%*s", R_print.gap, "", j+1, w-IndexWidth(j+1)-3, "");
106 
    }
107 
}
108 
 
109 
static void MatrixRowLabel(SEXP rl, int i, int rlabw, int lbloff)
110 
{
111 
    int l;
112 
    SEXP tmp;
113 
 
114 
    if (!isNull(rl)) {
45446 ripley 115 
	tmp= STRING_ELT(rl, i);
42077 ripley 116 
	if(tmp == NA_STRING) l = R_print.na_width_noquote;
117 
	else l = Rstrlen(tmp, 0);
118 
	Rprintf("\n%*s%s%*s", lbloff, "",
119 
		EncodeString(tmp, l, 0, Rprt_adj_left),
120 
		rlabw-l-lbloff, "");
121 
    }
122 
    else {
123 
	Rprintf("\n%*s[%ld,]", rlabw-3-IndexWidth(i + 1), "", i+1);
124 
    }
125 
}
126 
 
127 
 
128 
 
38954 maechler 129 
/* This is the first (of 6)  print<TYPE>Matrix()  functions.
130 
 * We define macros that will be re-used in the other functions,
131 
 * and comment the common code here (only):
132 
*/
38961 maechler 133 
static void printLogicalMatrix(SEXP sx, int offset, int r_pr, int r, int c,
41784 ripley 134 
			       SEXP rl, SEXP cl, const char *rn, const char *cn)
2 r 135 
{
38954 maechler 136 
/* initialization; particularly of row labels, rl= dimnames(.)[[1]] and
137 
 * rn = names(dimnames(.))[1] : */
138 
#define _PRINT_INIT_rl_rn				\
58298 maechler 139 
    int *w = (int *) R_alloc(c, sizeof(int));		\
38954 maechler 140 
    int width, rlabw = -1, clabw = -1; /* -Wall */	\
141 
    int i, j, jmin = 0, jmax = 0, lbloff = 0;		\
142 
							\
143 
    if (!isNull(rl))					\
144 
	formatString(STRING_PTR(rl), r, &rlabw, 0);	\
145 
    else						\
146 
	rlabw = IndexWidth(r + 1) + 3;			\
147 
							\
148 
    if (rn) {						\
149 
	int rnw = strwidth(rn);				\
150 
	if ( rnw < rlabw + R_MIN_LBLOFF )		\
151 
	    lbloff = R_MIN_LBLOFF;			\
152 
	else						\
153 
	    lbloff = rnw - rlabw;			\
154 
							\
155 
	rlabw += lbloff;				\
156 
    }
4731 pd 157 
 
38954 maechler 158 
    _PRINT_INIT_rl_rn;
58298 maechler 159 
    int *x = LOGICAL(sx) + offset;
4731 pd 160 
 
38954 maechler 161 
    /* compute w[j] = column-width of j(+1)-th column : */
1858 ihaka 162 
    for (j = 0; j < c; j++) {
60241 ripley 163 
	formatLogical(&x[j * r], (R_xlen_t) r, &w[j]);
38954 maechler 164 
 
165 
#	define _PRINT_SET_clabw					\
166 
								\
167 
	if (!isNull(cl)) {					\
63181 ripley 168 
	    const void *vmax = vmaxget();			\
38954 maechler 169 
	    if(STRING_ELT(cl, j) == NA_STRING)			\
170 
		clabw = R_print.na_width_noquote;		\
40705 ripley 171 
	    else clabw = strwidth(translateChar(STRING_ELT(cl, j)));	\
63181 ripley 172 
	    vmaxset(vmax);					\
38954 maechler 173 
	} else							\
1895 ihaka 174 
	    clabw = IndexWidth(j + 1) + 3;
38954 maechler 175 
 
176 
	_PRINT_SET_clabw;
177 
 
1895 ihaka 178 
	if (w[j] < clabw)
179 
	    w[j] = clabw;
4619 maechler 180 
	w[j] += R_print.gap;
1820 ihaka 181 
    }
38954 maechler 182 
 
183 
#   define _PRINT_DEAL_c_eq_0				\
184 
							\
185 
    if (c == 0) {					\
186 
	for (i = 0; i < r; i++)				\
187 
	    MatrixRowLabel(rl, i, rlabw, lbloff);	\
188 
	Rprintf("\n");					\
189 
	return;						\
20812 ripley 190 
    }
38954 maechler 191 
    _PRINT_DEAL_c_eq_0;
192 
 
1858 ihaka 193 
    while (jmin < c) {
38954 maechler 194 
	/* print columns  jmin:(jmax-1)	 where jmax has to be determined first */
195 
 
1820 ihaka 196 
	width = rlabw;
38954 maechler 197 
	/* initially, jmax = jmin */
1820 ihaka 198 
	do {
38961 maechler 199 
	    width += w[jmax]; jmax++;
4731 pd 200 
 
38961 maechler 201 
	} while (jmax < c && width + w[jmax] < R_print.width);
202 
 
38954 maechler 203 
#	define _PRINT_ROW_LAB			\
204 
						\
205 
	if (cn != NULL)				\
206 
	    Rprintf("%*s%s\n", rlabw, "", cn);	\
207 
						\
208 
	if (rn != NULL)				\
209 
	    Rprintf("%*s", -rlabw, rn);		\
210 
	else					\
4731 pd 211 
	    Rprintf("%*s", rlabw, "");
212 
 
38954 maechler 213 
	_PRINT_ROW_LAB;
214 
 
1858 ihaka 215 
	for (j = jmin; j < jmax ; j++)
1820 ihaka 216 
	    MatrixColumnLabel(cl, j, w[j]);
38961 maechler 217 
	for (i = 0; i < r_pr; i++) {
38954 maechler 218 
	    MatrixRowLabel(rl, i, rlabw, lbloff); /* starting with an "\n" */
1820 ihaka 219 
	    for (j = jmin; j < jmax; j++) {
1858 ihaka 220 
		Rprintf("%s", EncodeLogical(x[i + j * r], w[j]));
1820 ihaka 221 
	    }
2 r 222 
	}
1820 ihaka 223 
	Rprintf("\n");
224 
	jmin = jmax;
225 
    }
2 r 226 
}
227 
 
38961 maechler 228 
static void printIntegerMatrix(SEXP sx, int offset, int r_pr, int r, int c,
41784 ripley 229 
			       SEXP rl, SEXP cl, const char *rn, const char *cn)
2 r 230 
{
38954 maechler 231 
    _PRINT_INIT_rl_rn;
58298 maechler 232 
    int *x = INTEGER(sx) + offset;
4717 maechler 233 
 
1858 ihaka 234 
    for (j = 0; j < c; j++) {
60241 ripley 235 
	formatInteger(&x[j * r], (R_xlen_t) r, &w[j]);
38954 maechler 236 
	_PRINT_SET_clabw;
1895 ihaka 237 
	if (w[j] < clabw)
238 
	    w[j] = clabw;
4619 maechler 239 
	w[j] += R_print.gap;
1820 ihaka 240 
    }
38954 maechler 241 
    _PRINT_DEAL_c_eq_0;
1858 ihaka 242 
    while (jmin < c) {
1820 ihaka 243 
	width = rlabw;
244 
	do {
245 
	    width += w[jmax];
246 
	    jmax++;
1858 ihaka 247 
	}
4619 maechler 248 
	while (jmax < c && width + w[jmax] < R_print.width);
4710 pd 249 
 
38954 maechler 250 
	_PRINT_ROW_LAB;
4710 pd 251 
 
1858 ihaka 252 
	for (j = jmin; j < jmax ; j++)
1820 ihaka 253 
	    MatrixColumnLabel(cl, j, w[j]);
38961 maechler 254 
	for (i = 0; i < r_pr; i++) {
4710 pd 255 
	    MatrixRowLabel(rl, i, rlabw, lbloff);
1820 ihaka 256 
	    for (j = jmin; j < jmax; j++) {
1858 ihaka 257 
		Rprintf("%s", EncodeInteger(x[i + j * r], w[j]));
1820 ihaka 258 
	    }
2 r 259 
	}
1820 ihaka 260 
	Rprintf("\n");
261 
	jmin = jmax;
262 
    }
2 r 263 
}
264 
 
38961 maechler 265 
static void printRealMatrix(SEXP sx, int offset, int r_pr, int r, int c,
41784 ripley 266 
			    SEXP rl, SEXP cl, const char *rn, const char *cn)
2 r 267 
{
38954 maechler 268 
    _PRINT_INIT_rl_rn;
58298 maechler 269 
    double *x = REAL(sx) + offset;
2 r 270 
 
58298 maechler 271 
    int *d = (int *) R_alloc(c, sizeof(int)),
272 
	*e = (int *) R_alloc(c, sizeof(int));
2 r 273 
 
1858 ihaka 274 
    for (j = 0; j < c; j++) {
60241 ripley 275 
	formatReal(&x[j * r], (R_xlen_t) r, &w[j], &d[j], &e[j], 0);
38954 maechler 276 
	_PRINT_SET_clabw;
1895 ihaka 277 
	if (w[j] < clabw)
278 
	    w[j] = clabw;
4619 maechler 279 
	w[j] += R_print.gap;
1820 ihaka 280 
    }
38954 maechler 281 
    _PRINT_DEAL_c_eq_0;
1858 ihaka 282 
    while (jmin < c) {
1820 ihaka 283 
	width = rlabw;
284 
	do {
285 
	    width += w[jmax];
286 
	    jmax++;
1858 ihaka 287 
	}
4619 maechler 288 
	while (jmax < c && width + w[jmax] < R_print.width);
4731 pd 289 
 
38954 maechler 290 
	_PRINT_ROW_LAB;
4731 pd 291 
 
1858 ihaka 292 
	for (j = jmin; j < jmax ; j++)
1820 ihaka 293 
	    MatrixColumnLabel(cl, j, w[j]);
38961 maechler 294 
	for (i = 0; i < r_pr; i++) {
4710 pd 295 
	    MatrixRowLabel(rl, i, rlabw, lbloff);
1820 ihaka 296 
	    for (j = jmin; j < jmax; j++) {
34294 ripley 297 
		Rprintf("%s", EncodeReal(x[i + j * r], w[j], d[j], e[j], OutDec));
1820 ihaka 298 
	    }
2 r 299 
	}
1820 ihaka 300 
	Rprintf("\n");
301 
	jmin = jmax;
302 
    }
2 r 303 
}
304 
 
38961 maechler 305 
static void printComplexMatrix(SEXP sx, int offset, int r_pr, int r, int c,
41784 ripley 306 
			       SEXP rl, SEXP cl, const char *rn, const char *cn)
2 r 307 
{
38954 maechler 308 
    _PRINT_INIT_rl_rn;
58298 maechler 309 
    Rcomplex *x = COMPLEX(sx) + offset;
2 r 310 
 
58298 maechler 311 
    int *dr = (int *) R_alloc(c, sizeof(int)),
312 
	*er = (int *) R_alloc(c, sizeof(int)),
313 
	*wr = (int *) R_alloc(c, sizeof(int)),
314 
	*di = (int *) R_alloc(c, sizeof(int)),
315 
	*ei = (int *) R_alloc(c, sizeof(int)),
316 
	*wi = (int *) R_alloc(c, sizeof(int));
2 r 317 
 
580 ihaka 318 
    /* Determine the column widths */
2 r 319 
 
1858 ihaka 320 
    for (j = 0; j < c; j++) {
60241 ripley 321 
	formatComplex(&x[j * r], (R_xlen_t) r,
4928 maechler 322 
		      &wr[j], &dr[j], &er[j],
14357 ripley 323 
		      &wi[j], &di[j], &ei[j], 0);
38954 maechler 324 
	_PRINT_SET_clabw;
580 ihaka 325 
	w[j] = wr[j] + wi[j] + 2;
1895 ihaka 326 
	if (w[j] < clabw)
327 
	    w[j] = clabw;
4619 maechler 328 
	w[j] += R_print.gap;
580 ihaka 329 
    }
2 r 330 
 
38954 maechler 331 
    _PRINT_DEAL_c_eq_0;
1858 ihaka 332 
    while (jmin < c) {
580 ihaka 333 
	width = rlabw;
334 
	do {
335 
	    width += w[jmax];
336 
	    jmax++;
1858 ihaka 337 
	}
38954 maechler 338 
	while (jmax < c && width + w[jmax] < R_print.width);
4731 pd 339 
 
38954 maechler 340 
	_PRINT_ROW_LAB;
4731 pd 341 
 
1858 ihaka 342 
	for (j = jmin; j < jmax ; j++)
580 ihaka 343 
	    MatrixColumnLabel(cl, j, w[j]);
38961 maechler 344 
	for (i = 0; i < r_pr; i++) {
4710 pd 345 
	    MatrixRowLabel(rl, i, rlabw, lbloff);
1858 ihaka 346 
	    for (j = jmin; j < jmax; j++) {
347 
		if (ISNA(x[i + j * r].r) || ISNA(x[i + j * r].i))
34294 ripley 348 
		    Rprintf("%s", EncodeReal(NA_REAL, w[j], 0, 0, OutDec));
580 ihaka 349 
		else
8552 maechler 350 
		    Rprintf("%s",
5055 pd 351 
			    EncodeComplex(x[i + j * r],
352 
					  wr[j] + R_print.gap, dr[j], er[j],
34294 ripley 353 
					  wi[j], di[j], ei[j], OutDec));
580 ihaka 354 
	    }
2 r 355 
	}
580 ihaka 356 
	Rprintf("\n");
357 
	jmin = jmax;
358 
    }
2 r 359 
}
360 
 
38961 maechler 361 
static void printStringMatrix(SEXP sx, int offset, int r_pr, int r, int c,
4717 maechler 362 
			      int quote, int right, SEXP rl, SEXP cl,
41784 ripley 363 
			      const char *rn, const char *cn)
2 r 364 
{
38954 maechler 365 
    _PRINT_INIT_rl_rn;
58298 maechler 366 
    SEXP *x = STRING_PTR(sx)+offset;
2 r 367 
 
1858 ihaka 368 
    for (j = 0; j < c; j++) {
60241 ripley 369 
	formatString(&x[j * r], (R_xlen_t) r, &w[j], quote);
38954 maechler 370 
	_PRINT_SET_clabw;
1895 ihaka 371 
	if (w[j] < clabw)
372 
	    w[j] = clabw;
1820 ihaka 373 
    }
38954 maechler 374 
    _PRINT_DEAL_c_eq_0;
1858 ihaka 375 
    while (jmin < c) {
1820 ihaka 376 
	width = rlabw;
377 
	do {
4619 maechler 378 
	    width += w[jmax] + R_print.gap;
1820 ihaka 379 
	    jmax++;
1858 ihaka 380 
	}
4619 maechler 381 
	while (jmax < c && width + w[jmax] + R_print.gap < R_print.width);
4731 pd 382 
 
38954 maechler 383 
	_PRINT_ROW_LAB;
4731 pd 384 
 
1820 ihaka 385 
	if (right) {
1858 ihaka 386 
	    for (j = jmin; j < jmax ; j++)
1820 ihaka 387 
		RightMatrixColumnLabel(cl, j, w[j]);
2 r 388 
	}
1820 ihaka 389 
	else {
1858 ihaka 390 
	    for (j = jmin; j < jmax ; j++)
1820 ihaka 391 
		LeftMatrixColumnLabel(cl, j, w[j]);
392 
	}
38961 maechler 393 
	for (i = 0; i < r_pr; i++) {
4710 pd 394 
	    MatrixRowLabel(rl, i, rlabw, lbloff);
1820 ihaka 395 
	    for (j = jmin; j < jmax; j++) {
4619 maechler 396 
		Rprintf("%*s%s", R_print.gap, "",
29510 ripley 397 
			EncodeString(x[i + j * r], w[j], quote, right));
1820 ihaka 398 
	    }
399 
	}
400 
	Rprintf("\n");
401 
	jmin = jmax;
402 
    }
2 r 403 
}
404 
 
38961 maechler 405 
static void printRawMatrix(SEXP sx, int offset, int r_pr, int r, int c,
41784 ripley 406 
			   SEXP rl, SEXP cl, const char *rn, const char *cn)
34538 ripley 407 
{
38954 maechler 408 
    _PRINT_INIT_rl_rn;
58298 maechler 409 
    Rbyte *x = RAW(sx) + offset;
34538 ripley 410 
 
411 
    for (j = 0; j < c; j++) {
60241 ripley 412 
	formatRaw(&x[j * r], (R_xlen_t) r, &w[j]);
38954 maechler 413 
	_PRINT_SET_clabw;
34538 ripley 414 
	if (w[j] < clabw)
415 
	    w[j] = clabw;
416 
	w[j] += R_print.gap;
417 
    }
38954 maechler 418 
    _PRINT_DEAL_c_eq_0;
34538 ripley 419 
    while (jmin < c) {
420 
	width = rlabw;
421 
	do {
422 
	    width += w[jmax];
423 
	    jmax++;
424 
	}
425 
	while (jmax < c && width + w[jmax] < R_print.width);
426 
 
38954 maechler 427 
	_PRINT_ROW_LAB;
34538 ripley 428 
 
429 
	for (j = jmin; j < jmax ; j++)
430 
	    MatrixColumnLabel(cl, j, w[j]);
38961 maechler 431 
	for (i = 0; i < r_pr; i++) {
34538 ripley 432 
	    MatrixRowLabel(rl, i, rlabw, lbloff);
433 
	    for (j = jmin; j < jmax; j++)
63096 murdoch 434 
		Rprintf("%*s%s", w[j]-2, "", EncodeRaw(x[i + j * r], ""));
34538 ripley 435 
	}
436 
	Rprintf("\n");
437 
	jmin = jmax;
438 
    }
439 
}
440 
 
61776 ripley 441 
attribute_hidden
1858 ihaka 442 
void printMatrix(SEXP x, int offset, SEXP dim, int quote, int right,
41784 ripley 443 
		 SEXP rl, SEXP cl, const char *rn, const char *cn)
2 r 444 
{
38954 maechler 445 
/* 'rl' and 'cl' are dimnames(.)[[1]] and dimnames(.)[[2]]  whereas
446 
 * 'rn' and 'cn' are the  names(dimnames(.))
447 
 */
63155 luke 448 
    const void *vmax = vmaxget();
38980 maechler 449 
    int r = INTEGER(dim)[0];
450 
    int c = INTEGER(dim)[1], r_pr;
12976 pd 451 
    /* PR#850 */
38980 maechler 452 
    if ((rl != R_NilValue) && (r > length(rl)))
32871 ripley 453 
	error(_("too few row labels"));
38980 maechler 454 
    if ((cl != R_NilValue) && (c > length(cl)))
32871 ripley 455 
	error(_("too few column labels"));
20812 ripley 456 
    if (r == 0 && c == 0) {
457 
	Rprintf("<0 x 0 matrix>\n");
458 
	return;
459 
    }
38961 maechler 460 
    r_pr = r;
461 
    if(c > 0 && R_print.max / c < r) /* avoid integer overflow */
38980 maechler 462 
	/* using floor(), not ceil(), since 'c' could be huge: */
38961 maechler 463 
	r_pr = R_print.max / c;
1820 ihaka 464 
    switch (TYPEOF(x)) {
465 
    case LGLSXP:
38961 maechler 466 
	printLogicalMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
1820 ihaka 467 
	break;
468 
    case INTSXP:
38961 maechler 469 
	printIntegerMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
1820 ihaka 470 
	break;
471 
    case REALSXP:
38961 maechler 472 
	printRealMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn);
1820 ihaka 473 
	break;
474 
    case CPLXSXP:
38961 maechler 475 
	printComplexMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn);
1820 ihaka 476 
	break;
477 
    case STRSXP:
478 
	if (quote) quote = '"';
38961 maechler 479 
	printStringMatrix (x, offset, r_pr, r, c, quote, right, rl, cl, rn, cn);
1820 ihaka 480 
	break;
34538 ripley 481 
    case RAWSXP:
38961 maechler 482 
	printRawMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn);
34538 ripley 483 
	break;
34547 ripley 484 
    default:
485 
	UNIMPLEMENTED_TYPE("printMatrix", x);
1820 ihaka 486 
    }
39078 ripley 487 
#ifdef ENABLE_NLS
60801 ripley 488 
    if(r_pr < r) // number of formats must be consistent here
489 
	Rprintf(ngettext(" [ reached getOption(\"max.print\") -- omitted %d row ]\n",
58733 maechler 490 
			 " [ reached getOption(\"max.print\") -- omitted %d rows ]\n",
38980 maechler 491 
			 r - r_pr),
38961 maechler 492 
		r - r_pr);
39078 ripley 493 
#else
60801 ripley 494 
    if(r_pr < r)
58733 maechler 495 
	Rprintf(" [ reached getOption(\"max.print\") -- omitted %d rows ]\n",
39078 ripley 496 
		r - r_pr);
497 
#endif
63155 luke 498 
    vmaxset(vmax);
1820 ihaka 499 
}
500 
 
61776 ripley 501 
attribute_hidden
502 
void printArray(SEXP x, SEXP dim, int quote, int right, SEXP dimnames)
1820 ihaka 503 
{
3076 pd 504 
/* == printArray(.) */
63155 luke 505 
    const void *vmax = vmaxget();
38915 maechler 506 
    int ndim = LENGTH(dim);
41937 ripley 507 
    const char *rn = NULL, *cn = NULL;
1820 ihaka 508 
 
509 
    if (ndim == 1)
510 
	printVector(x, 1, quote);
511 
    else if (ndim == 2) {
512 
	SEXP rl, cl;
4710 pd 513 
	GetMatrixDimnames(x, &rl, &cl, &rn, &cn);
514 
	printMatrix(x, 0, dim, quote, 0, rl, cl, rn, cn);
1820 ihaka 515 
    }
38961 maechler 516 
    else { /* ndim >= 3 */
38915 maechler 517 
	SEXP dn, dnn, dn0, dn1;
38980 maechler 518 
	int i, j, has_dimnames, has_dnn, nb, nb_pr;
519 
	int nr = INTEGER(dim)[0], nr_last;
38915 maechler 520 
	int nc = INTEGER(dim)[1];
521 
	int b = nr * nc;
38980 maechler 522 
	Rboolean max_reached;
38961 maechler 523 
 
1858 ihaka 524 
	if (dimnames == R_NilValue) {
38915 maechler 525 
	    has_dimnames = 0;
526 
	    has_dnn = 0;
1858 ihaka 527 
	    dn0 = R_NilValue;
528 
	    dn1 = R_NilValue;
38915 maechler 529 
	    dnn = R_NilValue; /* -Wall */
1858 ihaka 530 
	}
531 
	else {
10172 luke 532 
	    dn0 = VECTOR_ELT(dimnames, 0);
533 
	    dn1 = VECTOR_ELT(dimnames, 1);
2462 hornik 534 
	    has_dimnames = 1;
4710 pd 535 
	    dnn = getAttrib(dimnames, R_NamesSymbol);
4717 maechler 536 
	    has_dnn = !isNull(dnn);
4710 pd 537 
	    if ( has_dnn ) {
41784 ripley 538 
		rn = (char *) translateChar(STRING_ELT(dnn, 0));
539 
		cn = (char *) translateChar(STRING_ELT(dnn, 1));
4710 pd 540 
	    }
1858 ihaka 541 
	}
38961 maechler 542 
	/* nb := #{entries} in a slice such as x[1,1,..] or equivalently,
543 
	 *       the number of matrix slices   x[ , , *, ..]  which
544 
	 *       are printed as matrices -- if options("max.print") allows */
545 
	for (i = 2, nb = 1; i < ndim; i++)
546 
	    nb *= INTEGER(dim)[i];
38980 maechler 547 
	max_reached = (b > 0 && R_print.max / b < nb);
548 
	if (max_reached) { /* i.e., also  b > 0, nr > 0, nc > 0, nb > 0 */
549 
	    /* nb_pr := the number of matrix slices to be printed */
550 
	    nb_pr = ceil_DIV(R_print.max, b);
551 
	    /* for the last, (nb_pr)th matrix slice, use only nr_last rows;
552 
	     *  using floor(), not ceil(), since 'nc' could be huge: */
553 
	    nr_last = (R_print.max - b * (nb_pr - 1)) / nc;
554 
	    if(nr_last == 0) { nb_pr--; nr_last = nr; }
555 
	} else {
556 
	    nb_pr = nb;
557 
	    nr_last = nr;
558 
	}
559 
	for (i = 0; i < nb_pr; i++) {
560 
	    int k = 1, use_nr = nr;
561 
	    if (i == nb_pr - 1) { /* for the last slice :*/
562 
		use_nr = nr_last;
563 
	    }
1820 ihaka 564 
	    Rprintf(", ");
1858 ihaka 565 
	    for (j = 2 ; j < ndim; j++) {
38915 maechler 566 
		int l = (i / k) % INTEGER(dim)[j] + 1;
2462 hornik 567 
		if (has_dimnames &&
10172 luke 568 
		    ((dn = VECTOR_ELT(dimnames, j)) != R_NilValue)) {
4710 pd 569 
		    if ( has_dnn )
4717 maechler 570 
			Rprintf(", %s = %s",
40705 ripley 571 
				translateChar(STRING_ELT(dnn, j)),
572 
				translateChar(STRING_ELT(dn, l - 1)));
4710 pd 573 
		    else
40705 ripley 574 
			Rprintf(", %s", translateChar(STRING_ELT(dn, l - 1)));
4717 maechler 575 
		} else
1820 ihaka 576 
		    Rprintf(", %d", l);
577 
		k = k * INTEGER(dim)[j];
578 
	    }
2254 pd 579 
	    Rprintf("\n\n");
1820 ihaka 580 
	    switch (TYPEOF(x)) {
581 
	    case LGLSXP:
38980 maechler 582 
		printLogicalMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
2 r 583 
		break;
1820 ihaka 584 
	    case INTSXP:
38980 maechler 585 
		printIntegerMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
2 r 586 
		break;
1820 ihaka 587 
	    case REALSXP:
38980 maechler 588 
		printRealMatrix   (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
2 r 589 
		break;
1820 ihaka 590 
	    case CPLXSXP:
38980 maechler 591 
		printComplexMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
2 r 592 
		break;
1820 ihaka 593 
	    case STRSXP:
2 r 594 
		if (quote) quote = '"';
38980 maechler 595 
		printStringMatrix (x, i * b, use_nr, nr, nc,
596 
				   quote, right, dn0, dn1, rn, cn);
2 r 597 
		break;
34538 ripley 598 
	    case RAWSXP:
38980 maechler 599 
		printRawMatrix    (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn);
34538 ripley 600 
		break;
1820 ihaka 601 
	    }
602 
	    Rprintf("\n");
2 r 603 
	}
38980 maechler 604 
 
605 
	if(max_reached && nb_pr < nb) {
606 
	    Rprintf(" [ reached getOption(\"max.print\") -- omitted");
607 
	    if(nr_last < nr) Rprintf(" %d row(s) and", nr - nr_last);
608 
	    Rprintf(" %d matrix slice(s) ]\n", nb - nb_pr);
609 
	}
1820 ihaka 610 
    }
63155 luke 611 
    vmaxset(vmax);
2 r 612 
}
613