| Line 1... |
Line 1... |
| 1 |
/*
|
1 |
/*
|
| 2 |
* R : A Computer Langage for Statistical Data Analysis
|
2 |
* R : A Computer Langage 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) 1998--2007 Robert Gentleman, Ross Ihaka and the
|
- |
|
| 5 |
* R Development Core Team
|
4 |
* Copyright (C) 1998--2011 The R Development Core Team
|
| 6 |
*
|
5 |
*
|
| 7 |
* 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
|
| 8 |
* 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
|
| 9 |
* the Free Software Foundation; either version 2 of the License, or
|
8 |
* the Free Software Foundation; either version 2 of the License, or
|
| 10 |
* (at your option) any later version.
|
9 |
* (at your option) any later version.
|
| Line 522... |
Line 521... |
| 522 |
tmp = VECTOR_ELT(DE->work, col - 1);
|
521 |
tmp = VECTOR_ELT(DE->work, col - 1);
|
| 523 |
if (isNull(tmp)) return fw;
|
522 |
if (isNull(tmp)) return fw;
|
| 524 |
/* don't use NA labels */
|
523 |
/* don't use NA labels */
|
| 525 |
lab = STRING_ELT(DE->names, col - 1);
|
524 |
lab = STRING_ELT(DE->names, col - 1);
|
| 526 |
if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;
|
525 |
if(lab != NA_STRING) w = strlen(CHAR(lab)); else w = fw;
|
| 527 |
PrintDefaults(R_NilValue);
|
526 |
PrintDefaults();
|
| 528 |
for (i = 0; i < INTEGER(DE->lens)[col - 1]; i++) {
|
527 |
for (i = 0; i < INTEGER(DE->lens)[col - 1]; i++) {
|
| 529 |
strp = EncodeElement(tmp, i, 0, '.');
|
528 |
strp = EncodeElement(tmp, i, 0, '.');
|
| 530 |
w1 = strlen(strp);
|
529 |
w1 = strlen(strp);
|
| 531 |
if (w1 > w) w = w1;
|
530 |
if (w1 > w) w = w1;
|
| 532 |
}
|
531 |
}
|
| Line 617... |
Line 616... |
| 617 |
vector. Caller must check. */
|
616 |
vector. Caller must check. */
|
| 618 |
|
617 |
|
| 619 |
static void printelt(DEstruct DE, SEXP invec, int vrow, int ssrow, int sscol)
|
618 |
static void printelt(DEstruct DE, SEXP invec, int vrow, int ssrow, int sscol)
|
| 620 |
{
|
619 |
{
|
| 621 |
const char *strp;
|
620 |
const char *strp;
|
| 622 |
PrintDefaults(R_NilValue);
|
621 |
PrintDefaults();
|
| 623 |
if (TYPEOF(invec) == REALSXP) {
|
622 |
if (TYPEOF(invec) == REALSXP) {
|
| 624 |
strp = EncodeElement(invec, vrow, 0, '.');
|
623 |
strp = EncodeElement(invec, vrow, 0, '.');
|
| 625 |
printstring(DE, strp, strlen(strp), ssrow, sscol, 0);
|
624 |
printstring(DE, strp, strlen(strp), ssrow, sscol, 0);
|
| 626 |
}
|
625 |
}
|
| 627 |
else if (TYPEOF(invec) == STRSXP) {
|
626 |
else if (TYPEOF(invec) == STRSXP) {
|
| Line 1210... |
Line 1209... |
| 1210 |
SEXP tvec;
|
1209 |
SEXP tvec;
|
| 1211 |
|
1210 |
|
| 1212 |
if (wcol <= DE->xmaxused) {
|
1211 |
if (wcol <= DE->xmaxused) {
|
| 1213 |
tvec = VECTOR_ELT(DE->work, wcol - 1);
|
1212 |
tvec = VECTOR_ELT(DE->work, wcol - 1);
|
| 1214 |
if (!isNull(tvec) && wrow < INTEGER(DE->lens)[wcol - 1]) {
|
1213 |
if (!isNull(tvec) && wrow < INTEGER(DE->lens)[wcol - 1]) {
|
| 1215 |
PrintDefaults(R_NilValue);
|
1214 |
PrintDefaults();
|
| 1216 |
if (TYPEOF(tvec) == REALSXP) {
|
1215 |
if (TYPEOF(tvec) == REALSXP) {
|
| 1217 |
prev = EncodeElement(tvec, wrow, 0, '.');
|
1216 |
prev = EncodeElement(tvec, wrow, 0, '.');
|
| 1218 |
} else if (TYPEOF(tvec) == STRSXP) {
|
1217 |
} else if (TYPEOF(tvec) == STRSXP) {
|
| 1219 |
if (STRING_ELT(tvec, wrow) != DE->ssNA_STRING)
|
1218 |
if (STRING_ELT(tvec, wrow) != DE->ssNA_STRING)
|
| 1220 |
prev = EncodeElement(tvec, wrow, 0, '.');
|
1219 |
prev = EncodeElement(tvec, wrow, 0, '.');
|
| Line 1407... |
Line 1406... |
| 1407 |
DE->de = newdataeditor(DE, title);
|
1406 |
DE->de = newdataeditor(DE, title);
|
| 1408 |
if(!DE->de) return TRUE;
|
1407 |
if(!DE->de) return TRUE;
|
| 1409 |
DE->oldWIDTH = DE->oldHEIGHT = 0;
|
1408 |
DE->oldWIDTH = DE->oldHEIGHT = 0;
|
| 1410 |
DE->nboxchars = 5;
|
1409 |
DE->nboxchars = 5;
|
| 1411 |
|
1410 |
|
| 1412 |
DE->nboxchars = asInteger(GetOption(install("de.cellwidth"), R_GlobalEnv));
|
1411 |
DE->nboxchars = asInteger(GetOption1(install("de.cellwidth")));
|
| 1413 |
if (DE->nboxchars == NA_INTEGER || DE->nboxchars < 0) DE->nboxchars = 0;
|
1412 |
if (DE->nboxchars == NA_INTEGER || DE->nboxchars < 0) DE->nboxchars = 0;
|
| 1414 |
if (DE->nboxchars > 0) check(DE->de_mvw);
|
1413 |
if (DE->nboxchars > 0) check(DE->de_mvw);
|
| 1415 |
DE->box_w = ((DE->nboxchars >0)?DE->nboxchars:FIELDWIDTH)*(DE->p->fw) + 8;
|
1414 |
DE->box_w = ((DE->nboxchars >0)?DE->nboxchars:FIELDWIDTH)*(DE->p->fw) + 8;
|
| 1416 |
/* this used to presume 4 chars sufficed for row numbering */
|
1415 |
/* this used to presume 4 chars sufficed for row numbering */
|
| 1417 |
labdigs = max(3, 1+floor(log10((double)DE->ymaxused)));
|
1416 |
labdigs = max(3, 1+floor(log10((double)DE->ymaxused)));
|