22# '
33# ' Breaks a set of pretty breaks for changes.
44# ' @param n the number of breaks on either side of the reference
5+ # ' @param extra An optional vector of additional breaks.
6+ # ' The function always appends these breaks.
7+ # ' Use this option when you want to force this values to be a part of the
8+ # ' breaks.
59# ' @export
610# ' @importFrom assertthat assert_that is.count
711# ' @importFrom utils head tail
812# ' @family utils
9- change_breaks <- function (n = 2 ) {
13+ change_breaks <- function (n = 2 , extra = NULL ) {
1014 assert_that(is.count(n ))
1115 n_default <- n
12- function (x , n = n_default ) {
16+ extra_default <- extra
17+ function (x , n = n_default , extra = extra_default ) {
1318 if (length(x ) == 0 ) {
1419 return (numeric (0 ))
1520 }
21+ stopifnot(is.numeric(x ))
1622 abs(x ) | >
1723 max() | >
1824 exp() - > extreme
@@ -32,11 +38,22 @@ change_breaks <- function(n = 2) {
3238 rel_position <- log(candidate ) / max(log(candidate ))
3339 seq(0 , 1 , length = n + 1 ) | >
3440 outer(rel_position , " -" ) - > delta
35- selected <- candidate [apply(delta ^ 2 , 1 , which.min )]
41+ selected <- candidate [unique( apply(delta ^ 2 , 1 , which.min ) )]
3642 rev(1 / selected ) | >
3743 head(- 1 ) | >
3844 c(selected ) | >
39- log()
45+ log() - > breaks
46+ if (is.null(extra )) {
47+ return (breaks )
48+ }
49+ stopifnot(is.numeric(extra ))
50+ outer(breaks , extra , " -" ) | >
51+ abs() - > delta
52+ to_replace <- which(delta < min(diff(breaks )) / 5 , arr.ind = TRUE )
53+ breaks [to_replace [, " row" ]] <- extra [to_replace [, " col" ]]
54+ c(breaks , extra ) | >
55+ sort() | >
56+ unique()
4057 }
4158}
4259
0 commit comments