Make num() work with scales and ggplot2

[krlmlr]

Ideally, the labeling and formatting would be applied to the scales in ggplot2. From my experiments, this needs at least pretty(), seq(), a generic outer() (or a change to scales), and perhaps much more. Perhaps this can be solved in a much easier way?

library(tidyverse)

data <- tibble(
  x = num((1:10) / 100, fixed_exponent = -3, notation = "si"),
  y = num((1:10) / 100, scale = 100, label = "%")
)
data
#> # A tibble: 10 × 2
#>        x     y
#>     <si>     %
#>  1   10m     1
#>  2   20m     2
#>  3   30m     3
#>  4   40m     4
#>  5   50m     5
#>  6   60m     6
#>  7   70m     7
#>  8   80m     8
#>  9   90m     9
#> 10  100m    10

ggplot(data, aes(x, y)) +
  geom_point()
#> Don't know how to automatically pick scale for object of type pillar_num/pillar_vctr/vctrs_vctr/double. Defaulting to continuous.
#> Don't know how to automatically pick scale for object of type pillar_num/pillar_vctr/vctrs_vctr/double. Defaulting to continuous.

^{Created on 2021-12-25 by the reprex package (v2.0.1)}

[krlmlr]

It works with a lean subclass of ScaleContinuousPosition, modeled after ggforce::scale_x_unit() .

library(tidyverse)
library(scales)
#> 
#> Attaching package: 'scales'
#> The following object is masked from 'package:purrr':
#> 
#>     discard
#> The following object is masked from 'package:readr':
#> 
#>     col_factor

data <- tibble(
  x = num((1:10) / 100, fixed_exponent = -3, notation = "si"),
  y = num((1:10) / 100, scale = 100, label = "%")
)
data
#> # A tibble: 10 × 2
#>        x     y
#>     <si>     %
#>  1   10m     1
#>  2   20m     2
#>  3   30m     3
#>  4   40m     4
#>  5   50m     5
#>  6   60m     6
#>  7   70m     7
#>  8   80m     8
#>  9   90m     9
#> 10  100m    10


scale_x_num <- function(name = waiver(), breaks = waiver(), unit = NULL,
                        minor_breaks = waiver(), labels = waiver(),
                        limits = NULL, expand = waiver(), oob = censor,
                        na.value = NA_real_, trans = "identity",
                        position = "bottom", sec.axis = waiver()) {
  sc <- continuous_scale(
    c(
      "x", "xmin", "xmax", "xend", "xintercept", "xmin_final", "xmax_final",
      "xlower", "xmiddle", "xupper"
    ),
    "position_c", identity,
    name = name, breaks = breaks,
    minor_breaks = minor_breaks, labels = labels, limits = limits,
    expand = expand, oob = oob, na.value = na.value, trans = trans,
    guide = waiver(), position = position, super = ScaleContinuousPositionNum
  )
  if (!inherits(sec.axis, "waiver")) {
    if (inherits(sec.axis, "formula")) sec.axis <- sec_axis(sec.axis)
    if (!inherits(sec.axis, "AxisSecondary")) {
      stop("Secondary axes must be specified using 'sec_axis()'",
        call. = FALSE
      )
    }
    sc$secondary.axis <- sec.axis
  }
  sc
}

scale_y_num <- function(name = waiver(), breaks = waiver(),
                        minor_breaks = waiver(), labels = waiver(),
                        limits = NULL, expand = waiver(), oob = censor,
                        na.value = NA_real_, trans = "identity",
                        position = "left", sec.axis = waiver()) {
  sc <- continuous_scale(
    c(
      "y", "ymin", "ymax", "yend", "yintercept", "ymin_final", "ymax_final",
      "lower", "middle", "upper"
    ),
    "position_c", identity,
    name = name, breaks = breaks,
    minor_breaks = minor_breaks, labels = labels, limits = limits,
    expand = expand, oob = oob, na.value = na.value, trans = trans,
    guide = waiver(), position = position, super = ScaleContinuousPositionNum
  )
  if (!inherits(sec.axis, "waiver")) {
    if (inherits(sec.axis, "formula")) sec.axis <- sec_axis(sec.axis)
    if (!inherits(sec.axis, "AxisSecondary")) {
      stop("Secondary axes must be specified using 'sec_axis()'",
        call. = FALSE
      )
    }
    sc$secondary.axis <- sec.axis
  }
  sc
}

ScaleContinuousPositionNum <- ggproto("ScaleContinuousPositionNum", ScaleContinuousPosition,
  ptype = NULL,
  train = function(self, x) {
    if (length(x) == 0) {
      return()
    }
    self$ptype <- vctrs::vec_ptype_common(x, self$ptype)
    self$range$train(x)
  },
  get_breaks = function(self, limits = self$get_limits()) {
    out <- ggproto_parent(ScaleContinuousPosition, self)$get_breaks(limits)
    vctrs::vec_cast(out, self$ptype)
  },
  get_labels = function(self, breaks = self$get_breaks()) {
    out <- ggproto_parent(ScaleContinuousPosition, self)$get_labels(breaks)
    fansi::strip_sgr(out)
  },
  make_title = function(self, title) {
    out <- ggproto_parent(ScaleContinuousPosition, self)$make_title(title)
    label <- attr(self$ptype, "pillar")$label
    if (!is.null(label)) {
      out <- paste0(out, " [", attr(self$ptype, "pillar")$label, "]")
    }
    out
  }
)

scale_type.pillar_num <- function(x) c("num", "continuous")

rescale.pillar_num <- function(x, to = c(0, 1), from = range(x, na.rm = TRUE, finite = TRUE),
                               ...) {
  out <- rescale(vctrs::vec_data(x), to, from, ...)
  vctrs::vec_cast(out, x)
}

ggplot(data, aes(x, y)) +
  geom_point()

^{Created on 2021-12-26 by the reprex package (v2.0.1)}

Session info

sessioninfo::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#>  setting  value
#>  version  R version 4.1.2 (2021-11-01)
#>  os       macOS Big Sur 11.6.1
#>  system   aarch64, darwin20
#>  ui       X11
#>  language (EN)
#>  collate  en_US.UTF-8
#>  ctype    en_US.UTF-8
#>  tz       Europe/Zurich
#>  date     2021-12-26
#>  pandoc   2.13 @ /usr/local/bin/ (via rmarkdown)
#> 
#> ─ Packages ───────────────────────────────────────────────────────────────────
#>  package     * version date (UTC) lib source
#>  assertthat    0.2.1   2019-03-21 [1] CRAN (R 4.1.0)
#>  backports     1.4.1   2021-12-13 [1] CRAN (R 4.1.1)
#>  broom         0.7.10  2021-10-31 [1] CRAN (R 4.1.1)
#>  cellranger    1.1.0   2016-07-27 [1] CRAN (R 4.1.0)
#>  cli           3.1.0   2021-10-27 [1] CRAN (R 4.1.1)
#>  colorspace    2.0-2   2021-06-24 [1] CRAN (R 4.1.1)
#>  crayon        1.4.2   2021-10-29 [1] CRAN (R 4.1.1)
#>  curl          4.3.2   2021-06-23 [1] CRAN (R 4.1.0)
#>  DBI           1.1.1   2021-01-15 [1] CRAN (R 4.1.0)
#>  dbplyr        2.1.1   2021-04-06 [1] CRAN (R 4.1.0)
#>  digest        0.6.29  2021-12-01 [1] CRAN (R 4.1.1)
#>  dplyr       * 1.0.7   2021-06-18 [1] CRAN (R 4.1.0)
#>  ellipsis      0.3.2   2021-04-29 [1] CRAN (R 4.1.0)
#>  evaluate      0.14    2019-05-28 [1] CRAN (R 4.1.0)
#>  fansi         0.5.0   2021-05-25 [1] CRAN (R 4.1.0)
#>  farver        2.1.0   2021-02-28 [1] CRAN (R 4.1.0)
#>  fastmap       1.1.0   2021-01-25 [1] CRAN (R 4.1.0)
#>  forcats     * 0.5.1   2021-01-27 [1] CRAN (R 4.1.1)
#>  fs            1.5.2   2021-12-08 [1] CRAN (R 4.1.1)
#>  generics      0.1.1   2021-10-25 [1] CRAN (R 4.1.1)
#>  ggplot2     * 3.3.5   2021-06-25 [1] CRAN (R 4.1.1)
#>  glue          1.6.0   2021-12-17 [1] CRAN (R 4.1.1)
#>  gtable        0.3.0   2019-03-25 [1] CRAN (R 4.1.1)
#>  haven         2.4.3   2021-08-04 [1] CRAN (R 4.1.1)
#>  highr         0.9     2021-04-16 [1] CRAN (R 4.1.0)
#>  hms           1.1.1   2021-09-26 [1] CRAN (R 4.1.1)
#>  htmltools     0.5.2   2021-08-25 [1] CRAN (R 4.1.1)
#>  httr          1.4.2   2020-07-20 [1] CRAN (R 4.1.0)
#>  jsonlite      1.7.2   2020-12-09 [1] CRAN (R 4.1.0)
#>  knitr         1.37    2021-12-16 [1] CRAN (R 4.1.1)
#>  labeling      0.4.2   2020-10-20 [1] CRAN (R 4.1.0)
#>  lifecycle     1.0.1   2021-09-24 [1] CRAN (R 4.1.1)
#>  lubridate     1.8.0   2021-10-07 [1] CRAN (R 4.1.1)
#>  magrittr      2.0.1   2020-11-17 [1] CRAN (R 4.1.0)
#>  mime          0.12    2021-09-28 [1] CRAN (R 4.1.1)
#>  modelr        0.1.8   2020-05-19 [1] CRAN (R 4.1.0)
#>  munsell       0.5.0   2018-06-12 [1] CRAN (R 4.1.0)
#>  pillar        1.6.4   2021-10-18 [1] CRAN (R 4.1.1)
#>  pkgconfig     2.0.3   2019-09-22 [1] CRAN (R 4.1.0)
#>  purrr       * 0.3.4   2020-04-17 [1] CRAN (R 4.1.0)
#>  R.cache       0.15.0  2021-04-30 [1] CRAN (R 4.1.0)
#>  R.methodsS3   1.8.1   2020-08-26 [1] CRAN (R 4.1.0)
#>  R.oo          1.24.0  2020-08-26 [1] CRAN (R 4.1.0)
#>  R.utils       2.11.0  2021-09-26 [1] CRAN (R 4.1.1)
#>  R6            2.5.1   2021-08-19 [1] CRAN (R 4.1.1)
#>  Rcpp          1.0.7   2021-07-07 [1] CRAN (R 4.1.0)
#>  readr       * 2.1.1   2021-11-30 [1] CRAN (R 4.1.1)
#>  readxl        1.3.1   2019-03-13 [1] CRAN (R 4.1.0)
#>  reprex        2.0.1   2021-08-05 [1] CRAN (R 4.1.1)
#>  rlang         0.4.12  2021-10-18 [1] CRAN (R 4.1.1)
#>  rmarkdown     2.11    2021-09-14 [1] CRAN (R 4.1.1)
#>  rstudioapi    0.13    2020-11-12 [1] CRAN (R 4.1.0)
#>  rvest         1.0.2   2021-10-16 [1] CRAN (R 4.1.1)
#>  scales      * 1.1.1   2020-05-11 [1] CRAN (R 4.1.0)
#>  sessioninfo   1.2.2   2021-12-06 [1] CRAN (R 4.1.1)
#>  stringi       1.7.6   2021-11-29 [1] CRAN (R 4.1.1)
#>  stringr     * 1.4.0   2019-02-10 [1] CRAN (R 4.1.1)
#>  styler        1.6.2   2021-09-23 [1] CRAN (R 4.1.1)
#>  tibble      * 3.1.6   2021-11-07 [1] CRAN (R 4.1.1)
#>  tidyr       * 1.1.4   2021-09-27 [1] CRAN (R 4.1.1)
#>  tidyselect    1.1.1   2021-04-30 [1] CRAN (R 4.1.0)
#>  tidyverse   * 1.3.1   2021-04-15 [1] CRAN (R 4.1.0)
#>  tzdb          0.2.0   2021-10-27 [1] CRAN (R 4.1.1)
#>  utf8          1.2.2   2021-07-24 [1] CRAN (R 4.1.0)
#>  vctrs         0.3.8   2021-04-29 [1] CRAN (R 4.1.0)
#>  withr         2.4.3   2021-11-30 [1] CRAN (R 4.1.1)
#>  xfun          0.29    2021-12-14 [1] CRAN (R 4.1.1)
#>  xml2          1.3.3   2021-11-30 [1] CRAN (R 4.1.1)
#>  yaml          2.2.1   2020-02-01 [1] CRAN (R 4.1.0)
#> 
#>  [1] /Users/kirill/Library/R/arm64/4.1/library
#>  [2] /Library/Frameworks/R.framework/Versions/4.1-arm64/Resources/library
#> 
#> ──────────────────────────────────────────────────────────────────────────────

[krlmlr]

Related issues:

• Enhance Supporting Nonstandard Classes in train_continuous scales#166
• Cannot Use ggplot2 with units r-quantities/units#164
• Support ptype argument for scale() functions tidyverse/ggplot2#4065

[github-actions]

This old thread has been automatically locked. If you think you have found something related to this, please open a new issue and link to this old issue if necessary.