The R Project SVN R

Rev

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

Rev 87474 Rev 87761
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) 2000--2024	The R Core Team
 3 
 *  Copyright (C) 2000--2025	The R Core Team
4 
 *  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
 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
Line 407... Line 407...
407 
	printMatrix(x, 0, dim, quote, 0, rl, cl, rn, cn);
 407 
	printMatrix(x, 0, dim, quote, 0, rl, cl, rn, cn);
408 
    }
 408 
    }
409 
    else { /* ndim >= 3 */
 409 
    else { /* ndim >= 3 */
410 
	SEXP dn, dnn, dn0, dn1;
 410 
	SEXP dn, dnn, dn0, dn1;
411 
	const int *dims = INTEGER_RO(dim);
 411 
	const int *dims = INTEGER_RO(dim);
412 
	int i, j, nb, nb_pr, nr_last,
 412 
	int i, j, nb, nb_pr, ne_last, nc_last, nr_last,
413 
	    nr = dims[0], nc = dims[1],
 413 
	    nr = dims[0], nc = dims[1],
414 
	    b = nr * nc;
 414 
	    b = nr * nc;
415 
	Rboolean max_reached, has_dimnames = (dimnames != R_NilValue),
 415 
	Rboolean max_reached, has_dimnames = (dimnames != R_NilValue),
416 
	    has_dnn = has_dimnames;
 416 
	    has_dnn = has_dimnames;
417 
 
 417 
 
Line 441... Line 441...
441 
	if (max_reached) { /* i.e., also  b > 0, nr > 0, nc > 0, nb > 0 */
 441 
	if (max_reached) { /* i.e., also  b > 0, nr > 0, nc > 0, nb > 0 */
442 
	    /* nb_pr := the number of matrix slices to be printed */
 442 
	    /* nb_pr := the number of matrix slices to be printed */
443 
	    nb_pr = ceil_DIV(R_print.max, b);
 443 
	    nb_pr = ceil_DIV(R_print.max, b);
444 
	    /* for the last, (nb_pr)th matrix slice, use only nr_last rows;
 444 
	    /* for the last, (nb_pr)th matrix slice, use only nr_last rows;
445 
	     *  using floor(), not ceil(), since 'nc' could be huge: */
 445 
	     *  using floor(), not ceil(), since 'nc' could be huge: */
446 
	    nr_last = (R_print.max - b * (nb_pr - 1)) / nc;
 446 
	    ne_last = R_print.max - b * (nb_pr - 1);
- 
 
 447 
	    nc_last = (ne_last < nc) ? 0: nc;
- 
 
 448 
	    nr_last = (ne_last < nc) ? 0: ne_last / nc;
447 
	    if(nr_last == 0) { nb_pr--; nr_last = nr; }
 449 
	    if(nr_last == 0) { nb_pr--; nc_last = nc; nr_last = nr;}
448 
	} else {
 450 
	} else {
449 
	    nb_pr = (nb > 0) ? nb : 1; // do print *something* when dim = c(a,b,0)
 451 
	    nb_pr = (nb > 0) ? nb : 1; // do print *something* when dim = c(a,b,0)
- 
 
 452 
	    ne_last = b;
- 
 
 453 
	    nc_last = nc;
450 
	    nr_last = nr;
 454 
	    nr_last = nr;
451 
	}
 455 
	}
452 
	for (i = 0; i < nb_pr; i++) {
 456 
	for (i = 0; i < nb_pr; i++) {
453 
	    Rboolean do_ij = nb > 0,
 457 
	    Rboolean do_ij = nb > 0,
454 
		i_last = (i == nb_pr - 1); /* for the last slice */
 458 
		i_last = (i == nb_pr - 1); /* for the last slice */
455 
	    int use_nr = i_last ? nr_last : nr;
 459 
	    int	use_nc = i_last ? nc_last : nc,
- 
 
 460 
		use_nr = i_last ? nr_last : nr;
456 
	    if(do_ij) {
 461 
	    if(do_ij) {
457 
		int k = 1;
 462 
		int k = 1;
458 
		Rprintf(", ");
 463 
		Rprintf(", ");
459 
		for (j = 2 ; j < ndim; j++) {
 464 
		for (j = 2 ; j < ndim; j++) {
460 
		    int l = (i / k) % dims[j] + 1;
 465 
		    int l = (i / k) % dims[j] + 1;
Line 476... Line 481...
476 
		    Rprintf("%s%d", (i == 0) ? "<" : " x ", dims[i]);
 481 
		    Rprintf("%s%d", (i == 0) ? "<" : " x ", dims[i]);
477 
		Rprintf(" array of %s>\n", CHAR(type2str_nowarn(TYPEOF(x))));
 482 
		Rprintf(" array of %s>\n", CHAR(type2str_nowarn(TYPEOF(x))));
478 
	    }
 483 
	    }
479 
	    switch (TYPEOF(x)) {
 484 
	    switch (TYPEOF(x)) {
480 
	    case LGLSXP:
 485 
	    case LGLSXP:
481 
		printLogicalMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 486 
		printLogicalMatrix(x, i * b, use_nr, nr, use_nc, dn0, dn1, rn, cn, do_ij);
482 
		break;
 487 
		break;
483 
	    case INTSXP:
 488 
	    case INTSXP:
484 
		printIntegerMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 489 
		printIntegerMatrix(x, i * b, use_nr, nr, use_nc, dn0, dn1, rn, cn, do_ij);
485 
		break;
 490 
		break;
486 
	    case REALSXP:
 491 
	    case REALSXP:
487 
		printRealMatrix   (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 492 
		printRealMatrix   (x, i * b, use_nr, nr, use_nc, dn0, dn1, rn, cn, do_ij);
488 
		break;
 493 
		break;
489 
	    case CPLXSXP:
 494 
	    case CPLXSXP:
490 
		printComplexMatrix(x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 495 
		printComplexMatrix(x, i * b, use_nr, nr, use_nc, dn0, dn1, rn, cn, do_ij);
491 
		break;
 496 
		break;
492 
	    case STRSXP:
 497 
	    case STRSXP:
493 
		if (quote) quote = '"';
 498 
		if (quote) quote = '"';
494 
		printStringMatrix (x, i * b, use_nr, nr, nc,
 499 
		printStringMatrix (x, i * b, use_nr, nr, use_nc,
495 
				   quote, right, dn0, dn1, rn, cn, do_ij);
 500 
				   quote, right, dn0, dn1, rn, cn, do_ij);
496 
		break;
 501 
		break;
497 
	    case RAWSXP:
 502 
	    case RAWSXP:
498 
		printRawMatrix    (x, i * b, use_nr, nr, nc, dn0, dn1, rn, cn, do_ij);
 503 
		printRawMatrix    (x, i * b, use_nr, nr, use_nc, dn0, dn1, rn, cn, do_ij);
499 
		break;
 504 
		break;
500 
	    }
 505 
	    }
501 
	    Rprintf("\n");
 506 
	    Rprintf("\n");
502 
	}
 507 
	}
503 
 
 508 
 
504 
	if(max_reached && nb_pr < nb) {
 509 
	if (max_reached) {
505 
	    Rprintf(" [ reached 'max' / getOption(\"max.print\") -- omitted");
 510 
	    Rprintf(" [ reached 'max' / getOption(\"max.print\") -- omitted");
- 
 
 511 
	    if (nb_pr < nb)
- 
 
 512 
		Rprintf(ngettext(" %d slice", " %d slices", nb - nb_pr), nb - nb_pr);
- 
 
 513 
	    else if (nb_pr == nb) {
506 
	    if(nr_last < nr) Rprintf(" %d row(s) and", nr - nr_last);
 514 
		if(nr_last < nr) Rprintf(ngettext(" %d row",    " %d rows",    nr - nr_last), nr - nr_last);
- 
 
 515 
		if(nc_last < nc) Rprintf(ngettext(" %d column", " %d columns", nc - nc_last), nc - nc_last);
- 
 
 516 
/* == MM: replace the above with
- 
 
 517 
		if((nr -= nr_last) > 0) Rprintf(ngettext(" %d row",    " %d rows",    nr), nr);
- 
 
 518 
		if((nc -= nc_last) > 0) Rprintf(ngettext(" %d column", " %d columns", nc), nc);
- 
 
 519 
*/
- 
 
 520 
	    }
507 
	    Rprintf(" %d matrix slice(s) ]\n", nb - nb_pr);
 521 
	    Rprintf(" ] \n");
508 
	}
 522 
	}
509 
    }
 523 
    }
510 
    UNPROTECT(nprotect);
 524 
    UNPROTECT(nprotect);
511 
    vmaxset(vmax);
 525 
    vmaxset(vmax);
512 
}
 526 
}
513 
 
 -