The R Project SVN – R – Diff – /trunk/src/main/format.c



    *fieldwidth = 1;
    for(R_xlen_t i = 0 ; i < n; i++) {
	if (x[i] == NA_LOGICAL) {
	    if(*fieldwidth < R_print.na_width)
		*fieldwidth = R_print.na_width;
	} else if (x[i] != 0 && *fieldwidth < 4) { // 'TRUE'
	    *fieldwidth = 4;
	} else if (x[i] == 0 && *fieldwidth < 5 ) {// 'FALSE'
	    *fieldwidth = 5;
	    break;
	    // FIXME: Need to ensure that  na_width > 5  is not allowed (*and* document in ?print.default)
	    /* this is the widest it can be,  so stop */
	}
    }
}
 

        long double r_prec = r;
        /* use exact scaling factor in long double precision, if possible */
        if (abs(kp) <= KP_MAX) {
            if (kp > 0) r_prec /= tbl[kp]; else if (kp < 0) r_prec *= tbl[ -kp];
        }
#  ifdef HAVE_POWL
	// powl is C99 but only added to FreeBSD in 2017.
	else
            r_prec /= powl(10.0, (long double) kp);
#  else
        else if (kp <= R_dec_min_exponent)
            r_prec = (r_prec * 1e+303)/Rexp10((double)(kp+303));
        else
            r_prec /= Rexp10((double) kp);
#  endif
        if (r_prec < tbl[R_print.digits - 1]) {
            r_prec *= 10.0;
            kp--;
        }
        /* round alpha to integer, 10^(digits-1) <= alpha <= 10^digits

	    int sleft = neg_i + ((left <= 0) ? 1 : left); /* >= 1 */
	    int right = nsig - left; /* #{digits} right of '.' ( > 0 often)*/
	    if (neg_i) neg = 1;	 /* if any < 0, need extra space for sign */
 
	    /* Infinite precision "F" Format : */
	    if (right > rgt)  rgt = right;	/* max digits to right of . */
	    if (left  > mxl)  mxl = left;	/* max digits to  left of . */
	    if (left  < mnl)  mnl = left;	/* min digits to  left of . */
	    if (sleft > mxsl) mxsl = sleft;	/* max left including sign(s)*/
	    if (nsig  > mxns) mxns = nsig;	/* max sig digits */
	}
    }
     /* F Format: use "F" format WHENEVER we use not more space than  'E' + scipen
     *		and still satisfy 'R_print.digits' {but as if nsmall==0 !}
     *
     * E Format has the form   [S]X[.XXX]E+XX[X]
     *
     * This is indicated by setting *e to non-zero (usually 1)

     *	 AND in the	____ if(.) "F" else "E" ___   below: */
    if (R_print.digits == 0) rgt = 0;
    if (mxl < 0) mxsl = 1 + neg;  /* we use %#w.dg, so have leading zero */
 
    /* use nsmall only *after* comparing "F" vs "E": */
    if (rgt < 0) rgt = 0;// rgt != 0  <==> needs decimal point (OutDec) "."
    int wF = mxsl + rgt + (rgt != 0);	/* width for F format */
 
    /*-- 'see' how "E" Exponential format would be like : */
    *e = (mxl > 100 || mnl <= -99) ? 2 /* 3 digit exponent */ : 1;
    if (mxns != INT_MIN) {

	*e = 0;
    }
    if (naflag && *w < R_print.na_width)
	*w = R_print.na_width;
    if (nanflag && *w < 3) *w = 3;
    if (posinf  && *w < 3) *w = 3;
    if (neginf  && *w < 4) *w = 4;
}
 
attribute_hidden
void formatRealS(SEXP x, R_xlen_t n, int *w, int *d, int *e, int nsmall)
{

    *e = 0;
 
    ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, double, REAL, 0, n,
		      {
			  formatReal(px, nb, &tmpw, &tmpd, &tmpe, nsmall);
			  if( tmpw > *w ) *w = tmpw;
			  if(!*d && tmpd) *d = tmpd;
			  if( tmpe > *e ) *e = tmpe;
		      });
}
 
#ifdef formatComplex_tricky
#ifdef formatComplex_USING_signif

void z_prec_r(Rcomplex *r, const Rcomplex *x, double digits);
#endif
#endif
 
/* From R 2.2.0 to 4.3.z, the number of digits applied to real and imaginary parts
   together, not separately.  Since R 4.4.0, Re(.) and Im(.) are treated separately. */
void formatComplex(const Rcomplex *x, R_xlen_t n,
		   int *wr, int *dr, int *er, // (w,d,e) for Re(.)
		   int *wi, int *di, int *ei, // (w,d,e) for Im(.)
		   int nsmall)
{

Rev 87894	Rev 90097
Line 108...	Line 108...
108	`*fieldwidth = 1;`	108	`*fieldwidth = 1;`
109	`for(R_xlen_t i = 0 ; i < n; i++) {`	109	`for(R_xlen_t i = 0 ; i < n; i++) {`
110	`if (x[i] == NA_LOGICAL) {`	110	`if (x[i] == NA_LOGICAL) {`
111	`if(*fieldwidth < R_print.na_width)`	111	`if(*fieldwidth < R_print.na_width)`
112	`*fieldwidth = R_print.na_width;`	112	`*fieldwidth = R_print.na_width;`
113	`} else if (x[i] != 0 && *fieldwidth < 4) {`	113	`} else if (x[i] != 0 && *fieldwidth < 4) { // 'TRUE'`
114	`*fieldwidth = 4;`	114	`*fieldwidth = 4;`
115	`} else if (x[i] == 0 && *fieldwidth < 5 ) {`	115	`} else if (x[i] == 0 && *fieldwidth < 5 ) {// 'FALSE'`
116	`*fieldwidth = 5;`	116	`*fieldwidth = 5;`
117	`break;`	117	`break;`
-		118	`// FIXME: Need to ensure that na_width > 5 is not allowed (and document in ?print.default)`
118	`/* this is the widest it can be, so stop */`	119	`/* this is the widest it can be, so stop */`
119	`}`	120	`}`
120	`}`	121	`}`
121	`}`	122	`}`
122		123
Line 346...	Line 347...
346	`long double r_prec = r;`	347	`long double r_prec = r;`
347	`/* use exact scaling factor in long double precision, if possible */`	348	`/* use exact scaling factor in long double precision, if possible */`
348	`if (abs(kp) <= KP_MAX) {`	349	`if (abs(kp) <= KP_MAX) {`
349	`if (kp > 0) r_prec /= tbl[kp]; else if (kp < 0) r_prec *= tbl[ -kp];`	350	`if (kp > 0) r_prec /= tbl[kp]; else if (kp < 0) r_prec *= tbl[ -kp];`
350	`}`	351	`}`
351	`#ifdef HAVE_POWL`	352	`# ifdef HAVE_POWL`
352	`// powl is C99 but only added to FreeBSD in 2017.`	353	`// powl is C99 but only added to FreeBSD in 2017.`
353	`else`	354	`else`
354	`r_prec /= powl(10.0, (long double) kp);`	355	`r_prec /= powl(10.0, (long double) kp);`
355	`#else`	356	`# else`
356	`else if (kp <= R_dec_min_exponent)`	357	`else if (kp <= R_dec_min_exponent)`
357	`r_prec = (r_prec * 1e+303)/Rexp10((double)(kp+303));`	358	`r_prec = (r_prec * 1e+303)/Rexp10((double)(kp+303));`
358	`else`	359	`else`
359	`r_prec /= Rexp10((double) kp);`	360	`r_prec /= Rexp10((double) kp);`
360	`#endif`	361	`# endif`
361	`if (r_prec < tbl[R_print.digits - 1]) {`	362	`if (r_prec < tbl[R_print.digits - 1]) {`
362	`r_prec *= 10.0;`	363	`r_prec *= 10.0;`
363	`kp--;`	364	`kp--;`
364	`}`	365	`}`
365	`/* round alpha to integer, 10^(digits-1) <= alpha <= 10^digits`	366	`/* round alpha to integer, 10^(digits-1) <= alpha <= 10^digits`
Line 458...	Line 459...
458	`int sleft = neg_i + ((left <= 0) ? 1 : left); /* >= 1 */`	459	`int sleft = neg_i + ((left <= 0) ? 1 : left); /* >= 1 */`
459	`int right = nsig - left; /* #{digits} right of '.' ( > 0 often)*/`	460	`int right = nsig - left; /* #{digits} right of '.' ( > 0 often)*/`
460	`if (neg_i) neg = 1; /* if any < 0, need extra space for sign */`	461	`if (neg_i) neg = 1; /* if any < 0, need extra space for sign */`
461		462
462	`/* Infinite precision "F" Format : */`	463	`/* Infinite precision "F" Format : */`
463	`if (right > rgt) rgt = right; /* max digits to right of . */`	464	`if (right > rgt) rgt = right; /* max digits to right of . */`
464	`if (left > mxl) mxl = left; /* max digits to left of . */`	465	`if (left > mxl) mxl = left; /* max digits to left of . */`
465	`if (left < mnl) mnl = left; /* min digits to left of . */`	466	`if (left < mnl) mnl = left; /* min digits to left of . */`
466	`if (sleft> mxsl) mxsl = sleft; /* max left including sign(s)*/`	467	`if (sleft > mxsl) mxsl = sleft; /* max left including sign(s)*/`
467	`if (nsig > mxns) mxns = nsig; /* max sig digits */`	468	`if (nsig > mxns) mxns = nsig; /* max sig digits */`
468	`}`	469	`}`
469	`}`	470	`}`
470	`/* F Format: use "F" format WHENEVER we use not more space than 'E'`	471	`/* F Format: use "F" format WHENEVER we use not more space than 'E' + scipen`
471	`* and still satisfy 'R_print.digits' {but as if nsmall==0 !}`	472	`* and still satisfy 'R_print.digits' {but as if nsmall==0 !}`
472	`*`	473	`*`
473	`* E Format has the form [S]X[.XXX]E+XX[X]`	474	`* E Format has the form [S]X[.XXX]E+XX[X]`
474	`*`	475	`*`
475	`* This is indicated by setting *e to non-zero (usually 1)`	476	`* This is indicated by setting *e to non-zero (usually 1)`
Line 480...	Line 481...
480	`* AND in the ____ if(.) "F" else "E" ___ below: */`	481	`* AND in the ____ if(.) "F" else "E" ___ below: */`
481	`if (R_print.digits == 0) rgt = 0;`	482	`if (R_print.digits == 0) rgt = 0;`
482	`if (mxl < 0) mxsl = 1 + neg; /* we use %#w.dg, so have leading zero */`	483	`if (mxl < 0) mxsl = 1 + neg; /* we use %#w.dg, so have leading zero */`
483		484
484	`/* use nsmall only after comparing "F" vs "E": */`	485	`/* use nsmall only after comparing "F" vs "E": */`
485	`if (rgt < 0) rgt = 0;`	486	`if (rgt < 0) rgt = 0;// rgt != 0 <==> needs decimal point (OutDec) "."`
486	`int wF = mxsl + rgt + (rgt != 0); /* width for F format */`	487	`int wF = mxsl + rgt + (rgt != 0); /* width for F format */`
487		488
488	`/-- 'see' how "E" Exponential format would be like : /`	489	`/-- 'see' how "E" Exponential format would be like : /`
489	`e = (mxl > 100 \|\| mnl <= -99) ? 2 / 3 digit exponent */ : 1;`	490	`e = (mxl > 100 \|\| mnl <= -99) ? 2 / 3 digit exponent */ : 1;`
490	`if (mxns != INT_MIN) {`	491	`if (mxns != INT_MIN) {`
Line 506...	Line 507...
506	`*e = 0;`	507	`*e = 0;`
507	`}`	508	`}`
508	`if (naflag && *w < R_print.na_width)`	509	`if (naflag && *w < R_print.na_width)`
509	`*w = R_print.na_width;`	510	`*w = R_print.na_width;`
510	`if (nanflag && w < 3) w = 3;`	511	`if (nanflag && w < 3) w = 3;`
511	`if (posinf && w < 3) w = 3;`	512	`if (posinf && w < 3) w = 3;`
512	`if (neginf && w < 4) w = 4;`	513	`if (neginf && w < 4) w = 4;`
513	`}`	514	`}`
514		515
515	`attribute_hidden`	516	`attribute_hidden`
516	`void formatRealS(SEXP x, R_xlen_t n, int w, int d, int *e, int nsmall)`	517	`void formatRealS(SEXP x, R_xlen_t n, int w, int d, int *e, int nsmall)`
517	`{`	518	`{`
Line 526...	Line 527...
526	`*e = 0;`	527	`*e = 0;`
527		528
528	`ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, double, REAL, 0, n,`	529	`ITERATE_BY_REGION_PARTIAL(x, px, idx, nb, double, REAL, 0, n,`
529	`{`	530	`{`
530	`formatReal(px, nb, &tmpw, &tmpd, &tmpe, nsmall);`	531	`formatReal(px, nb, &tmpw, &tmpd, &tmpe, nsmall);`
531	`if(tmpw > w) w = tmpw;`	532	`if( tmpw > w ) w = tmpw;`
532	`if(!d && tmpd) d = tmpd;`	533	`if(!d && tmpd) d = tmpd;`
533	`if(tmpe > e) e = tmpe;`	534	`if( tmpe > e ) e = tmpe;`
534	`});`	535	`});`
535	`}`	536	`}`
536		537
537	`#ifdef formatComplex_tricky`	538	`#ifdef formatComplex_tricky`
538	`#ifdef formatComplex_USING_signif`	539	`#ifdef formatComplex_USING_signif`
Line 540...	Line 541...
540	`void z_prec_r(Rcomplex r, const Rcomplex x, double digits);`	541	`void z_prec_r(Rcomplex r, const Rcomplex x, double digits);`
541	`#endif`	542	`#endif`
542	`#endif`	543	`#endif`
543		544
544	`/* From R 2.2.0 to 4.3.z, the number of digits applied to real and imaginary parts`	545	`/* From R 2.2.0 to 4.3.z, the number of digits applied to real and imaginary parts`
545	`together, not separately. Since R 4.4.0, Re(.) and Im(.) are treated seperately. */`	546	`together, not separately. Since R 4.4.0, Re(.) and Im(.) are treated separately. */`
546	`void formatComplex(const Rcomplex *x, R_xlen_t n,`	547	`void formatComplex(const Rcomplex *x, R_xlen_t n,`
547	`int wr, int dr, int *er, // (w,d,e) for Re(.)`	548	`int wr, int dr, int *er, // (w,d,e) for Re(.)`
548	`int wi, int di, int *ei, // (w,d,e) for Im(.)`	549	`int wi, int di, int *ei, // (w,d,e) for Im(.)`
549	`int nsmall)`	550	`int nsmall)`
550	`{`	551	`{`

The R Project SVN R

(root)/trunk/src/main/format.c @ 77458 – Rev 87894 → 90097