The R Project SVN R

Rev

Rev 80486 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 80486 Rev 80633
Line 40... Line 40...
40 
                     ../library/grDevices/src/axis_scales.c : */
 40 
                     ../library/grDevices/src/axis_scales.c : */
41 
// (usr = (min,max), n_inp, log) |--> (axp = (min, max), n_out) :
 41 
// (usr = (min,max), n_inp, log) |--> (axp = (min, max), n_out) :
42 
void GAxisPars(double *min, double *max, int *n, Rboolean log,
 42 
void GAxisPars(double *min, double *max, int *n, Rboolean log,
43 
	       int axis) // <- needed for warning() only
 43 
	       int axis) // <- needed for warning() only
44 
{
 44 
{
45 
#define EPS_FAC_2 100
 45 
#define EPS_FAC_2 16
- 
 
 46 
    //            -- was 100 (till R 4.1.0); 16 == EPS_FAC in ../library/graphics/src/graphics.c
46 
    Rboolean swap = *min > *max;
 47 
    Rboolean swap = *min > *max;
47 
    /* Feature: in R, something like  xlim = c(100,0)  just works */
 48 
    /* Feature: in R, something like  xlim = c(100,0)  just works */
48 
#define MAYBE_SWAP(_U,_V) do		\
 49 
#define MAYBE_SWAP(_U,_V) do		\
49 
    if(swap) {				\
 50 
    if(swap) {				\
50 
	double t = _U; _U = _V; _V = t;	\
 51 
	double t = _U; _U = _V; _V = t;	\
Line 52... Line 53...
52 
 
 53 
 
53 
    MAYBE_SWAP(*min, *max);
 54 
    MAYBE_SWAP(*min, *max);
54 
    /* save only for the extreme case (EPS_FAC_2): */
 55 
    /* save only for the extreme case (EPS_FAC_2): */
55 
    double min_o = *min, max_o = *max;
 56 
    double min_o = *min, max_o = *max;
56 
 
 57 
 
- 
 
 58 
#ifdef DEBUG_axis
- 
 
 59 
    REprintf("GAxisPars(%s): maybe_swap => (min=%g, max=%g); ",
- 
 
 60 
	     log ? "log=TRUE" : "", min_o, max_o);
- 
 
 61 
#endif
57 
    if(log) {
 62 
    if(log) {
58 
	/* Avoid infinities */
 63 
	/* Avoid infinities */
59 
	if(*max >  308) { *max =  308; if(*min > *max) *min = *max; }
 64 
	if(*max >  308) { *max =  308; if(*min > *max) *min = *max; }
60 
	if(*min < -307) { *min = -307; if(*max < *min) *max = *min; }
 65 
	if(*min < -307) { *min = -307; if(*max < *min) *max = *min; }
61 
	*min = Rexp10(*min);
 66 
	*min = Rexp10(*min);
62 
	*max = Rexp10(*max);
 67 
	*max = Rexp10(*max);
- 
 
 68 
#ifdef DEBUG_axis
- 
 
 69 
	REprintf("before GLPretty(min=%g, max=%g, n=%d):\n", *min, *max, *n);
- 
 
 70 
#endif
63 
	GLPretty(min, max, n);
 71 
	GLPretty(min, max, n);
64 
    }
 72 
    }
- 
 
 73 
    else {
- 
 
 74 
#ifdef DEBUG_axis
- 
 
 75 
	REprintf("before GEPretty(..):\n");
- 
 
 76 
#endif
65 
    else GEPretty(min, max, n);
 77 
	GEPretty(min, max, n);
- 
 
 78 
    }
- 
 
 79 
 
- 
 
 80 
#ifdef DEBUG_axis
- 
 
 81 
    REprintf(" [GAP]: then (min=%g, max=%g, n=%d)\n", *min, *max, *n);
- 
 
 82 
#endif
- 
 
 83 
 
- 
 
 84 
    double t_ = fmax2(fabs(*max), fabs(*min)),
- 
 
 85 
	tf = // careful to avoid overflow (and underflow) here:
- 
 
 86 
	    (t_ > 1)
- 
 
 87 
	    ? (t_ * DBL_EPSILON) * EPS_FAC_2
- 
 
 88 
	    : (t_ * EPS_FAC_2  ) * DBL_EPSILON;
- 
 
 89 
	if(tf == 0) tf = DBL_MIN;
66 
 
 90 
 
67 
    const double eps_2 = EPS_FAC_2 * DBL_EPSILON; /* << prevent overflow in product below */
 - 
 
68 
    double t_ = fmax2(fabs(*max), fabs(*min));
 - 
 
69 
    if(fabs(*max - *min) < t_ * eps_2) {
 91 
    if(fabs(*max - *min) <= tf) {
70 
	/* Treat this case somewhat similar to the (min ~= max) case above */
 92 
	/* Treat this case somewhat similar to the (min ~= max) case above */
71 
	/* Too much accuracy here just shows machine differences */
 93 
	/* Too much accuracy here just shows machine differences */
72 
	if(axis) // no warning with (axis = 0)
 94 
	if(axis) // no warning with (axis = 0)
73 
	warning(_("axis(%d, *): range of values (%5.2g) is small wrt |M| = %7.2g --> not pretty()")
 95 
	warning(_("axis(%d, *): range of values (%5.2g) is small wrt |M| = %7.2g --> not pretty()")
74 
		/*"to compute accurately"*/,
 96 
		/*"to compute accurately"*/,
Line 83... Line 105...
83 
	if(log) {
 105 
	if(log) {
84 
	    *min = Rexp10(*min);
 106 
	    *min = Rexp10(*min);
85 
	    *max = Rexp10(*max);
 107 
	    *max = Rexp10(*max);
86 
	}
 108 
	}
87 
	*n = 1;
 109 
	*n = 1;
- 
 
 110 
#ifdef DEBUG_axis
- 
 
 111 
	REprintf(" small range() --> axp[1:3]=(min,max, n=1) = (%g, %g, 1)\n", *min, *max);
- 
 
 112 
#endif
88 
    }
 113 
    }
89 
    MAYBE_SWAP(*min, *max);
 114 
    MAYBE_SWAP(*min, *max);
90 
}
 115 
}
91 
 
 116 
 
92 
#define LPR_SMALL  2
 117 
#define LPR_SMALL  2
Line 129... Line 154...
129 
    }
 154 
    }
130 
}
 155 
}
131 
 
 156 
 
132 
void GPretty(double *lo, double *up, int *ndiv)
 157 
void GPretty(double *lo, double *up, int *ndiv)
133 
{
 158 
{
134 
    GEPretty(lo, up, ndiv);
 159 
    GEPretty(lo, up, ndiv); // --> in ./engine.c , --> calling R_pretty()
135 
}
 160 
}