The R Project SVN R

Rev

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

Rev 24179 Rev 25249
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
 3 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
4 
 *  Copyright (C) 1997-2003   The R Development Core Team.
 4 
 *  Copyright (C) 1997--2003  The R Development Core Team.
- 
 
 5 
 *  Copyright (C) 2003        The R Foundation
5 
 *
 6 
 *
6 
 *  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
7 
 *  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
8 
 *  the Free Software Foundation; either version 2 of the License, or
 9 
 *  the Free Software Foundation; either version 2 of the License, or
9 
 *  (at your option) any later version.
 10 
 *  (at your option) any later version.
Line 149... Line 150...
149 
static const double tbl[] =
 150 
static const double tbl[] =
150 
{
 151 
{
151 
    0.e0, 1.e0, 1.e1, 1.e2, 1.e3, 1.e4, 1.e5, 1.e6, 1.e7, 1.e8, 1.e9
 152 
    0.e0, 1.e0, 1.e1, 1.e2, 1.e3, 1.e4, 1.e5, 1.e6, 1.e7, 1.e8, 1.e9
152 
};
 153 
};
153 
 
 154 
 
154 
#if 0
 - 
 
155 
static double eps;/* = 10^{- R_print.digits};
 - 
 
156 
			set in formatReal/Complex,  used in scientific() */
 - 
 
157 
#endif
 - 
 
158 
 
 - 
 
159 
static void scientific(double *x, int *sgn, int *kpower, int *nsig, double eps)
 155 
static void scientific(double *x, int *sgn, int *kpower, int *nsig, double eps)
160 
{
 156 
{
161 
    /* for 1 number	 x , return
 157 
    /* for a number x , determine
162 
     *	sgn    = 1_{x < 0}  {0/1}
 158 
     *	sgn    = 1_{x < 0}  {0/1}
163 
     *	kpower = Exponent of 10;
 159 
     *	kpower = Exponent of 10;
164 
     *	nsig   = min(R_print.digits, #{significant digits of alpha}
 160 
     *	nsig   = min(R_print.digits, #{significant digits of alpha})
165 
     *
 161 
     *
166 
     * where  |x| = alpha * 10^kpower	and	 1 <= alpha < 10
 162 
     * where  |x| = alpha * 10^kpower	and	 1 <= alpha < 10
167 
     */
 163 
     */
168 
    register double alpha;
 164 
    register double alpha;
169 
    register double r;
 165 
    register double r;
Line 193... Line 189...
193 
	   and makes the reasonable assumption that R_dec_min_exponent+30
 189 
	   and makes the reasonable assumption that R_dec_min_exponent+30
194 
	   is in range.
 190 
	   is in range.
195 
	 */
 191 
	 */
196 
	else if (kp <= R_dec_min_exponent) {
 192 
	else if (kp <= R_dec_min_exponent) {
197 
	    alpha = (r * 1e+30)/pow(10.0, (double)(kp+30));
 193 
	    alpha = (r * 1e+30)/pow(10.0, (double)(kp+30));
198 
	}
194 
	}
199 
	else
195 
	else
200 
	    alpha = r / pow(10.0, (double)kp);
 196 
	    alpha = r / pow(10.0, (double)kp);
201 
 
 197 
 
202 
	/* make sure that alpha is in [1,10) AFTER rounding */
 198 
	/* make sure that alpha is in [1,10) AFTER rounding */
203 
 
 199 
 
204 
	if (10.0 - alpha < eps*alpha) {
 200 
	if (10.0 - alpha < eps*alpha) {
Line 257... Line 253...
257 
	    if (left < mnl)  mnl = left;	/* min digits to  left of . */
 253 
	    if (left < mnl)  mnl = left;	/* min digits to  left of . */
258 
	    if (sleft> mxsl) mxsl = sleft;	/* max left including sign(s)*/
 254 
	    if (sleft> mxsl) mxsl = sleft;	/* max left including sign(s)*/
259 
	    if (nsig > mxns) mxns = nsig;	/* max sig digits */
 255 
	    if (nsig > mxns) mxns = nsig;	/* max sig digits */
260 
	}
 256 
	}
261 
    }
 257 
    }
262 
    /* F Format (NEW):	use "F" format
 - 
 
263 
     *	    WHENEVER we use not more space than 'E'
 258 
    /* F Format: use "F" format WHENEVER we use not more space than 'E'
264 
     *		and still satisfy 'R_print.digits'
 259 
     *		and still satisfy 'R_print.digits' {but as if nsmall==0 !}
265 
     *
 260 
     *
266 
     * E Format has the form   [S]X[.XXX]E+XX[X]
 261 
     * E Format has the form   [S]X[.XXX]E+XX[X]
267 
     *
 262 
     *
268 
     * This is indicated by setting *e to non-zero (usually 1)
 263 
     * This is indicated by setting *e to non-zero (usually 1)
269 
     * If the additional exponent digit is required *e is set to 2
 264 
     * If the additional exponent digit is required *e is set to 2
270 
     */
 265 
     */
271 
 
 266 
 
272 
    /*-- These	'mxsl' & 'rgt'  are used in F Format
 267 
    /*-- These	'mxsl' & 'rgt'	are used in F Format
273 
     *	 AND in the	____ if(.) "F" else "E" ___   below: */
 268 
     *	 AND in the	____ if(.) "F" else "E" ___   below: */
274 
    if (mxl < 0) mxsl = 1 + neg;
 269 
    if (mxl < 0) mxsl = 1 + neg;
- 
 
 270 
 
275 
    /*old: if (mxl != mnl && mxl + rgt > R_print.digits) rgt = R_print.digits - mxl;*/
 271 
    /* use nsmall only *after* comparing "F" vs "E": */
276 
    if (rgt < nsmall) rgt = nsmall;
 272 
    if (rgt < 0) rgt = 0;
277 
    /* NO! else if (rgt > R_print.digits) rgt = R_print.digits; */
 - 
 
278 
    mF = mxsl + rgt + (rgt != 0);	/* width m for F  format */
 273 
    mF = mxsl + rgt + (rgt != 0);	/* width m for F  format */
279 
 
 274 
 
280 
    /*-- 'see' how "E" Exponential format would be like : */
 275 
    /*-- 'see' how "E" Exponential format would be like : */
281 
    if (mxl > 100 || mnl < -99) *e = 2;/* 3 digit exponent */
 276 
    if (mxl > 100 || mnl < -99) *e = 2;/* 3 digit exponent */
282 
    else *e = 1;
 277 
    else *e = 1;
283 
    *n = mxns - 1;
 278 
    *n = mxns - 1;
284 
    *m = neg + (*n > 0) + *n + 4 + *e; /* width m for E	 format */
 279 
    *m = neg + (*n > 0) + *n + 4 + *e; /* width m for E	 format */
285 
 
 280 
 
286 
    if (mF <= *m  + R_print.scipen) { /* Fixpoint if it needs less space */
 281 
    if (mF <= *m  + R_print.scipen) { /* Fixpoint if it needs less space */
287 
	*e = 0;
 282 
	*e = 0;
- 
 
 283 
	if (nsmall > rgt) {
- 
 
 284 
	    rgt = nsmall;
- 
 
 285 
	    mF = mxsl + rgt + (rgt != 0);
- 
 
 286 
	}
288 
	*n = rgt;
 287 
	*n = rgt;
289 
	*m = mF;
 288 
	*m = mF;
290 
    } /* else : "E" Exponential format -- all done above */
 289 
    } /* else : "E" Exponential format -- all done above */
291 
    if (naflag && *m < R_print.na_width)
 290 
    if (naflag && *m < R_print.na_width)
292 
	*m = R_print.na_width;
 291 
	*m = R_print.na_width;
Line 383... Line 382...
383 
 
 382 
 
384 
    /* overall format for real part	*/
 383 
    /* overall format for real part	*/
385 
 
 384 
 
386 
    if (mxl != INT_MIN) {
 385 
    if (mxl != INT_MIN) {
387 
	if (mxl < 0) mxsl = 1 + neg;
 386 
	if (mxl < 0) mxsl = 1 + neg;
388 
	if (rt < nsmall) rt = nsmall;
 387 
	if (rt < 0) rt = 0;
389 
	mF = mxsl + rt + (rt != 0);
 388 
	mF = mxsl + rt + (rt != 0);
390 
 
 389 
 
391 
	if (mxl > 100 || mnl < -99) *er = 2;
 390 
	if (mxl > 100 || mnl < -99) *er = 2;
392 
	else *er = 1;
 391 
	else *er = 1;
393 
	*nr = mxns - 1;
 392 
	*nr = mxns - 1;
394 
	*mr = neg + (*nr > 0) + *nr + 4 + *er;
 393 
	*mr = neg + (*nr > 0) + *nr + 4 + *er;
395 
        if (mF <= *mr + R_print.scipen) { /* Fixpoint if it needs less space */
 394 
        if (mF <= *mr + R_print.scipen) { /* Fixpoint if it needs less space */
396 
	    *er = 0;
 395 
	    *er = 0;
- 
 
 396 
	    if (nsmall > rt) {
- 
 
 397 
		rt = nsmall;
- 
 
 398 
		mF = mxsl + rt + (rt != 0);
- 
 
 399 
	    }
397 
	    *nr = rt;
 400 
	    *nr = rt;
398 
	    *mr = mF;
 401 
	    *mr = mF;
399 
	}
 402 
	}
400 
    }
 403 
    }
401 
    else {
 404 
    else {
Line 409... Line 412...
409 
 
 412 
 
410 
    /* overall format for imaginary part */
 413 
    /* overall format for imaginary part */
411 
 
 414 
 
412 
    if (i_mxl != INT_MIN) {
 415 
    if (i_mxl != INT_MIN) {
413 
	if (i_mxl < 0) i_mxsl = 1;
 416 
	if (i_mxl < 0) i_mxsl = 1;
414 
	if (i_rt < nsmall) i_rt = nsmall;
 417 
	if (i_rt < 0) i_rt = 0;
415 
	mF = i_mxsl + i_rt + (i_rt != 0);
 418 
	mF = i_mxsl + i_rt + (i_rt != 0);
416 
 
 419 
 
417 
	if (i_mxl > 100 || i_mnl < -99) *ei = 2;
 420 
	if (i_mxl > 100 || i_mnl < -99) *ei = 2;
418 
	else *ei = 1;
 421 
	else *ei = 1;
419 
	*ni = i_mxns - 1;
 422 
	*ni = i_mxns - 1;
420 
	*mi = (*ni > 0) + *ni + 4 + *ei;
 423 
	*mi = (*ni > 0) + *ni + 4 + *ei;
421 
        if (mF <= *mi + R_print.scipen) { /* Fixpoint if it needs less space */
 424 
        if (mF <= *mi + R_print.scipen) { /* Fixpoint if it needs less space */
422 
	    *ei = 0;
 425 
	    *ei = 0;
- 
 
 426 
	    if (nsmall > i_rt) {
- 
 
 427 
		i_rt = nsmall;
- 
 
 428 
		mF = mxsl + i_rt + (i_rt != 0);
- 
 
 429 
	    }
423 
	    *ni = i_rt;
 430 
	    *ni = i_rt;
424 
	    *mi = mF;
 431 
	    *mi = mF;
425 
	}
 432 
	}
426 
    }
 433 
    }
427 
    else {
 434 
    else {