The R Project SVN R

Rev

Rev 85535 | Rev 87167 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 85535 Rev 86902
Line 1... Line 1...
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
 - 
 
4 
 *  Copyright (C) 2000--2023	The R Core Team
 3 
 *  Copyright (C) 2000--2024	The R Core Team
5 
 *  Copyright (C) 2001--2012	The R Foundation
 4 
 *  Copyright (C) 2001--2012	The R Foundation
- 
 
 5 
 *  Copyright (C) 1995, 1996	Robert Gentleman and Ross Ihaka
6 
 *
 6 
 *
7 
 *  This program is free software; you can redistribute it and/or modify
 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
 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
 9 
 *  the Free Software Foundation; either version 2 of the License, or
10 
 *  (at your option) any later version.
 10 
 *  (at your option) any later version.
Line 215... Line 215...
215 
 
 215 
 
216 
    _COMPUTE_W_( formatLogical(&x[j * (R_xlen_t) r], (R_xlen_t) r, &w[j]) );
 216 
    _COMPUTE_W_( formatLogical(&x[j * (R_xlen_t) r], (R_xlen_t) r, &w[j]) );
217 
 
 217 
 
218 
    _PRINT_MATRIX_( , STD_ColumnLabels,
 218 
    _PRINT_MATRIX_( , STD_ColumnLabels,
219 
		   Rprintf("%s", EncodeLogical(x[i + j * (R_xlen_t) r], w[j])));
 219 
		   Rprintf("%s", EncodeLogical(x[i + j * (R_xlen_t) r], w[j])));
220 
 
 - 
 
221 
}
 220 
}
222 
 
 221 
 
223 
static void printIntegerMatrix(SEXP sx, int offset, int r_pr, int r, int c,
 222 
static void printIntegerMatrix(SEXP sx, int offset, int r_pr, int r, int c,
224 
			       SEXP rl, SEXP cl, const char *rn, const char *cn,
 223 
			       SEXP rl, SEXP cl, const char *rn, const char *cn,
225 
			       Rboolean print_ij)
 224 
			       Rboolean print_ij)
Line 241... Line 240...
241 
    const double *x = REAL_RO(sx) + offset;
 240 
    const double *x = REAL_RO(sx) + offset;
242 
    int *d = (int *) R_alloc(c, sizeof(int)),
 241 
    int *d = (int *) R_alloc(c, sizeof(int)),
243 
	*e = (int *) R_alloc(c, sizeof(int));
 242 
	*e = (int *) R_alloc(c, sizeof(int));
244 
 
 243 
 
245 
    _COMPUTE_W_( formatReal(&x[j * (R_xlen_t) r], (R_xlen_t) r, &w[j],
 244 
    _COMPUTE_W_( formatReal(&x[j * (R_xlen_t) r], (R_xlen_t) r, &w[j],
246 
                            &d[j], &e[j], 0) );
 245 
			    &d[j], &e[j], 0) );
247 
 
 246 
 
248 
    _PRINT_MATRIX_( , STD_ColumnLabels,
 247 
    _PRINT_MATRIX_( , STD_ColumnLabels,
249 
		   Rprintf("%s", EncodeReal0(x[i + j * (R_xlen_t) r],
 248 
		   Rprintf("%s", EncodeReal0(x[i + j * (R_xlen_t) r],
250 
                                             w[j], d[j], e[j], OutDec)) );
 249 
					     w[j], d[j], e[j], OutDec)) );
251 
}
 250 
}
252 
 
 251 
 
253 
static void printComplexMatrix(SEXP sx, int offset, int r_pr, int r, int c,
 252 
static void printComplexMatrix(SEXP sx, int offset, int r_pr, int r, int c,
254 
			       SEXP rl, SEXP cl, const char *rn, const char *cn,
 253 
			       SEXP rl, SEXP cl, const char *rn, const char *cn,
255 
			       Rboolean print_ij)
 254 
			       Rboolean print_ij)
Line 332... Line 331...
332 
 * 'rn' and 'cn' are the  names(dimnames(.))
 331 
 * 'rn' and 'cn' are the  names(dimnames(.))
333 
 */
 332 
 */
334 
    const void *vmax = vmaxget();
 333 
    const void *vmax = vmaxget();
335 
    const int *pdim = INTEGER_RO(dim);
 334 
    const int *pdim = INTEGER_RO(dim);
336 
    int r = pdim[0];
 335 
    int r = pdim[0];
337 
    int c = pdim[1], r_pr;
 336 
    int c = pdim[1];
338 
    /* PR#850 */
 337 
    /* PR#850 */
339 
    if ((rl != R_NilValue) && (r > length(rl)))
 338 
    if ((rl != R_NilValue) && (r > length(rl)))
340 
	error(_("too few row labels"));
 339 
	error(_("too few row labels"));
341 
    if ((cl != R_NilValue) && (c > length(cl)))
 340 
    if ((cl != R_NilValue) && (c > length(cl)))
342 
	error(_("too few column labels"));
 341 
	error(_("too few column labels"));
343 
    if (r == 0 && c == 0) { // FIXME?  names(dimnames(.)) :
 342 
    if (r == 0 && c == 0) { // FIXME?  names(dimnames(.)) :
344 
	Rprintf("<0 x 0 matrix>\n");
 343 
	Rprintf("<0 x 0 matrix>\n");
345 
	return;
 344 
	return;
346 
    }
 345 
    }
- 
 
 346 
 
347 
    r_pr = r;
 347 
    int r_pr = r,
- 
 
 348 
	/* Make sure we don't display more columns than max elements, see PR#15027 */
- 
 
 349 
	c_pr = c > R_print.max ? R_print.max : c;
- 
 
 350 
 
348 
    if(c > 0 && R_print.max / c < r) /* avoid integer overflow */
 351 
    if(c > 0 && R_print.max / c < r) /* avoid integer overflow */
349 
	/* using floor(), not ceil(), since 'c' could be huge: */
 352 
	/* using floor(), not ceil(), since 'c' could be huge: */
350 
	r_pr = R_print.max / c;
 353 
	r_pr = R_print.max / c;
- 
 
 354 
    /* Display at least one row in case of truncation */
- 
 
 355 
    if (c > c_pr && r_pr < 1 && r > 0)
- 
 
 356 
	r_pr = 1;
351 
    switch (TYPEOF(x)) {
 357 
    switch (TYPEOF(x)) {
352 
    case LGLSXP:
 358 
    case LGLSXP:
353 
	printLogicalMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 359 
	printLogicalMatrix(x, offset, r_pr, r, c_pr, rl, cl, rn, cn, TRUE);
354 
	break;
 360 
	break;
355 
    case INTSXP:
 361 
    case INTSXP:
356 
	printIntegerMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 362 
	printIntegerMatrix(x, offset, r_pr, r, c_pr, rl, cl, rn, cn, TRUE);
357 
	break;
 363 
	break;
358 
    case REALSXP:
 364 
    case REALSXP:
359 
	printRealMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 365 
	printRealMatrix	  (x, offset, r_pr, r, c_pr, rl, cl, rn, cn, TRUE);
360 
	break;
 366 
	break;
361 
    case CPLXSXP:
 367 
    case CPLXSXP:
362 
	printComplexMatrix(x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 368 
	printComplexMatrix(x, offset, r_pr, r, c_pr, rl, cl, rn, cn, TRUE);
363 
	break;
 369 
	break;
364 
    case STRSXP:
 370 
    case STRSXP:
365 
	if (quote) quote = '"';
 371 
	if (quote) quote = '"';
366 
	printStringMatrix (x, offset, r_pr, r, c, quote, right, rl, cl, rn, cn, TRUE);
 372 
	printStringMatrix (x, offset, r_pr, r, c_pr, quote, right, rl, cl, rn, cn, TRUE);
367 
	break;
 373 
	break;
368 
    case RAWSXP:
 374 
    case RAWSXP:
369 
	printRawMatrix	  (x, offset, r_pr, r, c, rl, cl, rn, cn, TRUE);
 375 
	printRawMatrix	  (x, offset, r_pr, r, c_pr, rl, cl, rn, cn, TRUE);
370 
	break;
 376 
	break;
371 
    default:
 377 
    default:
372 
	UNIMPLEMENTED_TYPE("printMatrix", x);
 378 
	UNIMPLEMENTED_TYPE("printMatrix", x);
373 
    }
 379 
    }
374 
#ifdef ENABLE_NLS
 - 
 
375 
    if(r_pr < r) // number of formats must be consistent here
 380 
    if (r_pr < r || c_pr < c) {
376 
	Rprintf(ngettext(" [ reached getOption(\"max.print\") -- omitted %d row ]\n",
 381 
	Rprintf(" [ reached getOption(\"max.print\") -- omitted");
377 
			 " [ reached getOption(\"max.print\") -- omitted %d rows ]\n",
 - 
 
378 
			 r - r_pr),
 382 
	if (r_pr < r) {
379 
		r - r_pr);
 383 
    	    Rprintf(ngettext(" %d row", " %d rows", r - r_pr), r - r_pr);
380 
#else
 384 
	}
381 
    if(r_pr < r)
 385 
	if (c_pr < c) {
- 
 
 386 
	    if (r_pr < r) Rprintf(_(" and"));
382 
	Rprintf(" [ reached getOption(\"max.print\") -- omitted %d rows ]\n",
 387 
	    Rprintf(ngettext(" %d column", " %d columns", c - c_pr), c - c_pr);
- 
 
 388 
	}
383 
		r - r_pr);
 389 
	Rprintf(" ]\n");
384 
#endif
 390 
    }
385 
    vmaxset(vmax);
 391 
    vmaxset(vmax);
386 
}
 392 
}
387 
 
 393 
 
388 
attribute_hidden
 394 
attribute_hidden
389 
void printArray(SEXP x, SEXP dim, int quote, int right, SEXP dimnames)
 395 
void printArray(SEXP x, SEXP dim, int quote, int right, SEXP dimnames)