| /* |
| * R : A Computer Language for Statistical Data Analysis |
| * Copyright (C) 1997--2018 The R Core Team |
| * Copyright (C) 2002--2011 The R Foundation |
| * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka |
| * |
| * This program is free software; you can redistribute it and/or modify |
| * it under the terms of the GNU General Public License as published by |
| * the Free Software Foundation; either version 2 of the License, or |
| * (at your option) any later version. |
| * |
| * This program is distributed in the hope that it will be useful, |
| * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| * GNU General Public License for more details. |
| * |
| * You should have received a copy of the GNU General Public License |
| * along with this program; if not, a copy is available at |
| * https://www.R-project.org/Licenses/ |
| |
| |
| * This is an extensive reworking by Paul Murrell of an original |
| * quick hack by Ross Ihaka designed to give a superset of the |
| * functionality in the AT&T Bell Laboratories GRZ library. |
| */ |
| |
| #ifdef HAVE_CONFIG_H |
| #include <config.h> |
| #endif |
| |
| #include <Defn.h> |
| #include <float.h> /* for DBL_EPSILON etc */ |
| #include <Graphics.h> |
| // --> R_ext/GraphicsEngine.h + Rgraphics.h |
| #include <Rmath.h> /* eg. fmax2() */ |
| |
| static void GLPretty(double *ul, double *uh, int *n); |
| |
| /* used in GScale() (../library/graphics/src/graphics.c), but also in |
| ../library/grDevices/src/axis_scales.c : */ |
| // (usr, log, n_inp) |--> (axp = (min, max), n_out) : |
| void GAxisPars(double *min, double *max, int *n, Rboolean log, int axis) |
| { |
| #define EPS_FAC_2 100 |
| Rboolean swap = *min > *max; |
| double t_, min_o, max_o; |
| |
| if(swap) { /* Feature: in R, something like xlim = c(100,0) just works */ |
| t_ = *min; *min = *max; *max = t_; |
| } |
| /* save only for the extreme case (EPS_FAC_2): */ |
| min_o = *min; max_o = *max; |
| |
| if(log) { |
| /* Avoid infinities */ |
| if(*max > 308) { *max = 308; if(*min > *max) *min = *max; } |
| if(*min < -307) { *min = -307; if(*max < *min) *max = *min; } |
| *min = Rexp10(*min); |
| *max = Rexp10(*max); |
| GLPretty(min, max, n); |
| } |
| else GEPretty(min, max, n); |
| |
| double tmp2 = EPS_FAC_2 * DBL_EPSILON;/* << prevent overflow in product below */ |
| if(fabs(*max - *min) < (t_ = fmax2(fabs(*max), fabs(*min)))* tmp2) { |
| /* Treat this case somewhat similar to the (min ~= max) case above */ |
| /* Too much accuracy here just shows machine differences */ |
| warning(_("relative range of values (%4.0f * EPS) is small (axis %d)") |
| /*"to compute accurately"*/, |
| fabs(*max - *min) / (t_*DBL_EPSILON), axis); |
| |
| /* No pretty()ing anymore */ |
| *min = min_o; |
| *max = max_o; |
| double eps = .005 * fabs(*max - *min);/* .005: not to go to DBL_MIN/MAX */ |
| *min += eps; |
| *max -= eps; |
| if(log) { |
| *min = Rexp10(*min); |
| *max = Rexp10(*max); |
| } |
| *n = 1; |
| } |
| if(swap) { |
| t_ = *min; *min = *max; *max = t_; |
| } |
| } |
| |
| #define LPR_SMALL 2 |
| #define LPR_MEDIUM 3 |
| |
| static void GLPretty(double *ul, double *uh, int *n) |
| { |
| /* Generate pretty tick values -- LOGARITHMIC scale |
| * __ ul < uh __ |
| * This only does a very simple setup. |
| * The real work happens when the axis is drawn. */ |
| int p1, p2; |
| double dl = *ul, dh = *uh; |
| p1 = (int) ceil (log10(dl)); |
| p2 = (int) floor(log10(dh)); |
| if(p2 <= p1 && dh/dl > 10.0) { |
| p1 = (int) ceil (log10(dl) - 0.5); |
| p2 = (int) floor(log10(dh) + 0.5); |
| } |
| |
| if (p2 <= p1) { /* floor(log10(uh)) <= ceil(log10(ul)) |
| * <==> log10(uh) - log10(ul) < 2 |
| * <==> uh / ul < 100 */ |
| /* Very small range : Use tickmarks from a LINEAR scale |
| * Splus uses n = 9 here, but that is dumb */ |
| GPretty(ul, uh, n); |
| *n = -*n; |
| } |
| else { /* extra tickmarks --> CreateAtVector() in ./plot.c */ |
| /* round to nice "1e<N>" */ |
| *ul = Rexp10((double)p1); |
| *uh = Rexp10((double)p2); |
| if (p2 - p1 <= LPR_SMALL) |
| *n = 3; /* Small range : Use 1,2,5,10 times 10^k tickmarks */ |
| else if (p2 - p1 <= LPR_MEDIUM) |
| *n = 2; /* Medium range : Use 1,5 times 10^k tickmarks */ |
| else |
| *n = 1; /* Large range : Use 10^k tickmarks |
| * But decimate, when there are too many*/ |
| } |
| } |
| |
| void GPretty(double *lo, double *up, int *ndiv) |
| { |
| GEPretty(lo, up, ndiv); |
| } |