---
title: "Controlling display of numbers"
output: html_vignette
vignette: >
  %\VignetteIndexEntry{Controlling display of numbers}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r numbers-1, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  cache = TRUE,
  comment = "#>"
)
```

Tibbles print numbers with three significant digits by default, switching to scientific notation if the available space is too small.
Underlines are used to highlight groups of three digits.
This display works for many, but not for all use cases.

```{r numbers-2}
library(pillar)
library(tibble)
```

## Per-column number formatting

The new `num()` constructor allows creating vectors that behave like numbers but allow customizing their display.

```{r numbers-5}
num(-1:3, notation = "sci")

tibble(
  x4 = num(8:12 * 100 + 0.5, digits = 4),
  x1 = num(8:12 * 100 + 0.5, digits = -1),
  usd = num(8:12 * 100 + 0.5, digits = 2, label = "USD"),
  percent = num(8:12 / 100 + 0.0005, label = "%", scale = 100),
  eng = num(10^(-3:1), notation = "eng", fixed_exponent = -Inf),
  si = num(10^(-3:1) * 123, notation = "si")
)
```


## Computing on `num`

Formatting numbers is useful for presentation of results.
If defined early on in the analysis, the formatting options survive most operations.
It is worth defining output options that suit your data once early on in the process, to benefit from the formatting throughout the analysis.
We are working on seamlessly applying this formatting to the final presentation (plots, tables, ...).


### Arithmetics

```{r numbers-13}
num(1) + 2
1 + num(2)
1L + num(2)
num(3.23456, sigfig = 4) - num(2)
num(4, sigfig = 2) * num(3, digits = 2)
num(3, digits = 2) * num(4, sigfig = 2)
-num(2)
```

### Mathematics

```{r numbers-15}
min(num(1:3, label = "$"))
mean(num(1:3, notation = "eng"))
sin(num(1:3, label = "%", scale = 100))
```

### Recovery

The `var()` function is one of the examples where the formatting is lost:

```{r numbers-16}
x <- num(c(1, 2, 4), notation = "eng")
var(x)
```

One way to recover is to apply `num()` to the result:

```{r numbers-16a}
num(var(x), notation = "eng")
```

For automatic recovery, we can also define our version of `var()`, or even overwrite the base implementation.
Note that this pattern is still experimental and may be subject to change:

```{r numbers-16b}
var_ <- function(x, ...) {
  out <- var(vctrs::vec_proxy(x), ...)
  vctrs::vec_restore(out, x)
}
var_(x)
```

This pattern can be applied to all functions that lose the formatting.
The `make_restore()` function defined below is a function factory that consumes a function and returns a derived function:

```{r numbers-16c}
make_restore <- function(fun) {
  force(fun)
  function(x, ...) {
    out <- fun(vctrs::vec_proxy(x), ...)
    vctrs::vec_restore(out, x)
  }
}

var_ <- make_restore(var)
sd_ <- make_restore(sd)

var_(x)
sd_(x)
```

`````{asis echo = FALSE}

## Integrating with other classes

### gt

- Consumption via new `fmt_auto()`?

FIXME

### units

```{r numbers-17}
library(units)

set_units.pillar_num <- function(x, ...) {
  unclassed <- x
  class(unclassed) <- NULL
  set_units(unclassed, ...)
}

m <- set_units(1:3, m)
km <- set_units(1:3, km)

tibble(
  sci_int = set_num_opts(m + km, notation = "sci"),
  digits_int = set_num_opts(km + m, digits = 4),
  sci_ext = set_units(num(1:3 + 0.001, notation = "sci"), km)
)

tibble(
  sci_int = set_num_opts(m, notation = "sci") + km,
  digits_int = set_num_opts(km, digits = 4) + m,
  sci_ext = set_units(num(1:3, notation = "sci"), m) + km
)
```

### formattable

```{r numbers-18, error = TRUE}
library(formattable)

pillar_shaft.formattable <- function(x, ...) {
  pillar::new_pillar_shaft_simple(format(x), align = "right")
}

pillar_shaft.formattable_currency <- function(x, ...) {
  formattable <- attr(x, "formattable", exact = TRUE)

  pillar_shaft(num(unclass(x), digits = formattable$digits))
}

pillar_shaft.formattable_percent <- function(x, ...) {
  formattable <- attr(x, "formattable", exact = TRUE)

  pillar_shaft(num(unclass(x), digits = formattable$digits, label = "%", scale = 100))
}

pillar_shaft.formattable_scientific <- function(x, ...) {
  pillar_shaft(num(unclass(x), notation = "sci"))
}

type_sum.formattable <- function(x) {
  formattable <- attr(x, "formattable", exact = TRUE)

  if (inherits(x, "formattable_currency")) {
    I(sub("^formattable_", "", class(x)[[1]]))
  } else if (inherits(x, "formattable_percent")) {
    I("%")
  } else {
    abbreviate(sub("^formattable_", "", class(x)[[1]]), 4)
  }
}

num_currency(1:3 * 100 + 0.1)
num_percent(1:3 * 0.1 + 0.001)
num_scientific(1:3 * 0.1 + 0.001)

tibble(
  currency = num_currency(1:3 * 100 + 0.1),
  percent = num_percent(1:3 * 0.1 + 0.001),
  scientific = num_scientific(1:3 * 0.1 + 0.001)
)
```

### scales

```{r numbers-scales, error = TRUE}
library(scales)

x <- num(1:10 / 100, label = "%", scale = 100)

scales::squish(x)

x < 0
x < 0L

scales::cscale(x, scales::rescale_pal())
```

### ggplot2

```{r numbers-19}
library(ggplot2)

scale_type.pillar_num <- function(x, ...) {
  "continuous"
}

data.frame(x = x, y = 1:10) %>%
  ggplot(aes(x = x, y = y)) %>%
  + geom_point()
```

## Rule-based decoration



```{r}
library(dplyr)

data_units <-
  palmerpenguins::penguins %>%
  mutate(across(ends_with("_mm"), set_units, "mm")) %>%
  mutate(across(ends_with("_g"), set_units, "g"))

data_units %>%
  mutate(bill_area = bill_length_mm * bill_depth_mm, .after = island)
```

```{r eval = FALSE}
data_decor <-
  data_units %>%
  decorate(year, digits = 0) %>%
  decorate(where(is.numeric), digits = 3)
```

```{r eval = FALSE}
data_decor %>%
  mutate(bill_area = bill_length_mm * bill_depth_mm, .after = island)
```

```{r echo = FALSE}
data_units %>%
  mutate(bill_area = bill_length_mm * bill_depth_mm, .after = island) %>%
  mutate(across(year, set_num_opts, digits = 0)) %>%
  mutate(across(where(is.numeric), set_num_opts, digits = 3))
```

`````
