| # File src/library/base/R/pretty.R |
| # Part of the R package, https://www.R-project.org |
| # |
| # Copyright (C) 1995-2018 The R Core Team |
| # |
| # 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. |
| # |
| # A copy of the GNU General Public License is available at |
| # https://www.R-project.org/Licenses/ |
| |
| pretty <- function(x, ...) UseMethod("pretty") |
| |
| |
| pretty.default <- |
| function(x, n = 5L, min.n = n %/% 3L, shrink.sml = 0.75, |
| high.u.bias = 1.5, u5.bias = .5 + 1.5*high.u.bias, |
| eps.correct = 0L, ...) |
| { |
| x <- x[is.finite(x <- as.numeric(x))] |
| if(!length(x)) return(x) |
| z <- .Internal(pretty(min(x), max(x), n, min.n, shrink.sml, |
| c(high.u.bias, u5.bias), eps.correct)) |
| s <- seq.int(z$l, z$u, length.out = z$n + 1L) |
| if(!eps.correct && z$n) { # maybe zap smalls from seq() rounding errors |
| ## better than zapsmall(s, digits = 14) : |
| delta <- diff(range(z$l, z$u)) / z$n # or abs(z$u - z$l) |
| if(any(small <- abs(s) < 1e-14 * delta)) s[small] <- 0 |
| } |
| s |
| } |