---
title: "obsplot Gallery : facets and transforms"
author: "Julien Barnier"
date: "`r Sys.Date()`"
output:
  rmarkdown::html_vignette:
    fig_width: 7
    fig_height: 4.5
    toc: true
vignette: >
  %\VignetteIndexEntry{obsplot Gallery : facets and transforms}
  %\VignetteEncoding{UTF-8}
  %\VignetteEngine{knitr::rmarkdown}
editor_options:
  chunk_output_type: console
---

```{r, include=FALSE}
library(obsplot)
library(htmlwidgets)
knitr::opts_chunk$set(
  screenshot.force = FALSE,
  echo = TRUE
)
```

This document is an attempt to reproduce some of the charts shown in [Observable Plot documentation notebooks](https://observablehq.com/@observablehq/plot).

As always, there are several ways to do things, in particular data manipulation could be done either in R before plotting, or in JavaScript via transforms and `JS()` calls. Each example below is one way to achieve a given result, not necessarily the best one or the most elegant.

## Facets

```{r}
data(anscombe_obs)

obsplot(anscombe_obs, height = 240) |>
    mark_frame() |>
    mark_dot(x = x, y = y) |>
    facet(x = series) |>
    opts(grid = TRUE, inset = 10)
```

```{r}
data(barley)

obsplot(barley, height = 800) |>
    mark_frame() |>
    mark_dot(
        x = yield, y = variety, stroke = year,
        sort = list(fy = "x", y = "x", reduce = "median", reverse = TRUE)
    ) |>
    facet(y = site, marginRight = 90) |>
    scale_color(type = "categorical") |>
    opts(marginLeft = 110, grid = TRUE)
```

```{r message = FALSE}
library(palmerpenguins)
data(penguins)

obsplot(penguins, height = 600) |>
    mark_frame() |>
    mark_dot(penguins, x = bill_depth_mm, y = bill_length_mm, r = 2, fill = "#ddd") |>
    mark_dot(x = bill_depth_mm, y = bill_length_mm) |>
    facet(x = sex, y = species, marginRight = 80) |>
    opts(grid = TRUE)
```


## Group transform

```{r}
data(penguins)

obsplot(penguins) |>
    mark_barY(
        transform_groupX(y = "count", x = species)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
species_domain <- names(sort(table(penguins$species)))

obsplot(penguins) |>
    mark_barY(
        transform_groupX(y = "count", x = species)
    ) |>
    mark_ruleY(0) |>
    scale_x(domain = species_domain, reverse = TRUE) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(penguins) |>
    mark_barY(
        transform_groupX(y = "proportion", x = species)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE, percent = TRUE)
```

```{r}
penguins$body_mass_kg <- penguins$body_mass_g / 1000

obsplot(penguins) |>
    mark_barY(
        transform_groupX(y = "sum", x = species, y = body_mass_kg)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE, label = "↑ Total mass (kg)")
```

```{r}
obsplot(penguins, height = 170) |>
    mark_dot(y = species, x = body_mass_g) |>
    mark_ruleY(
        transform_groupY(
            list(x1 = "min", x2 = "max"), 
            y = species, x = body_mass_g
        )
    ) |>
    mark_tickX(
        transform_groupY(
            list(x = "median"), 
            y = species, x = body_mass_g, stroke = "red"
        )
    ) |>
    scale_x(inset = 6) |>
    scale_y(label = NULL) |>
    opts(marginLeft = 60)
```

```{r}
data(mobydick1)

obsplot(mobydick1) |>
    mark_barY(
        transform_groupX(y = "count")
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(mobydick1) |>
    mark_barY(
        transform_groupX(y = "proportion", filter = JS('d => /[AEIOUY]/.test(d)'))
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE, percent = TRUE)
```

```{r}
data(penguins)

obsplot(penguins) |>
    mark_barY(
        transform_groupX(y = "count", x = sex)
    ) |>
    mark_ruleY(0) |>
    facet(x = species) |>
    scale_x(tickFormat = JS('d => d === null ? "N/A" : d')) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(penguins) |>
    mark_barY(
        transform_groupX(y = "proportion-facet", x = sex)
    ) |>
    mark_ruleY(0) |>
    facet(x = species) |>
    scale_x(tickFormat = JS('d => d === null ? "N/A" : d')) |>
    scale_y(grid = TRUE, percent = TRUE)
```

```{r}
obsplot(penguins) |>
    mark_barY(
        transform_groupX(y = "count", x = species, fill = sex)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(penguins, height = 60) |>
    mark_barX(
        transform_stackX(
            transform_groupZ(x = "proportion", fill = sex)
        )
    ) |>
    mark_text(
        transform_stackX(
            transform_groupZ(
                list(x = "proportion", text = "first"),
                z = sex, text = sex)
        )
    ) |>
    mark_ruleX(c(0, 1)) |>
    scale_x(percent = TRUE)
```

```{r}
obsplot(penguins) |>
    mark_barY(
        transform_groupZ(y = "proportion-facet", fill = sex)
    ) |>
    mark_ruleY(c(0, 1)) |>
    facet(x = species) |>
    scale_y(grid = TRUE, percent = TRUE)
```

```{r}
data(seattle)

obsplot(seattle, height = 300) |>
    mark_cell(
        transform_group(
            fill = "max",
            x = JS('d => d.date.getUTCDate()'),
            y = JS('d => d.date.getUTCMonth()'),
            fill = temp_max,
            inset = 0.5
        )
    ) |>
    scale_color(scheme = "BuRd") |>
    scale_y(tickFormat = JS('Plot.formatMonth()')) |>
    opts(padding = 0)
```


## Bin transform

```{r}
data(athletes)
# Only keep used variables
athletes <- athletes[, c("weight", "height", "sex", "sport")]

obsplot(athletes) |>
    mark_rectY(
        transform_binX(y = "count", x = weight)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_rectY(
        transform_binX(y = "count", x = weight, inset = 0)
    ) |>
    mark_ruleY(0) |>
    scale_x(round = TRUE) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_areaY(
        transform_binX(y = "count", x = weight, fill = "#ccc")
    ) |>
    mark_lineY(
        transform_binX(y = "count", x = weight)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_rectY(
        transform_binX(y = "count", x = weight, thresholds = "sturges")
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_rectY(
        transform_binX(y = "count", x = weight, cumulative = TRUE)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_rectY(
        transform_binX(
            y2 = "count", 
            x = weight, fill = sex, mixBlendMode = "multiply"
        )
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_rectY(
        transform_binX(y = "count", x = weight, fill = sex)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(athletes, height = 60) |>
    mark_barX(
        transform_binX(fill = "count", x = weight)
    ) |>
    scale_x(round = TRUE) |>
    scale_color(scheme = "YlGnBu")
```

```{r}
obsplot(athletes) |>
    mark_rect(
        transform_bin(fill = "count", x = weight, y = height, inset = 0)
    ) |>
    scale_color(scheme = "YlGnBu") |>
    opts(round = TRUE, grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_rect(
        transform_bin(
            fillOpacity = "count", 
            x = weight, y = height, fill = sex, inset = 0
        )
    ) |>
    opts(round = TRUE, grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_dot(
        transform_bin(r = "count", x = weight, y = height)
    ) |>
    scale_r(range = c(0, 10)) |>
    opts(round = TRUE, grid = TRUE)
```

```{r}
obsplot(athletes) |>
    mark_dot(
        transform_bin(r = "count", x = weight, y = height, stroke = sex)
    ) |>
    scale_r(range = c(0, 10)) |>
    opts(round = TRUE, grid = TRUE)
```

```{r}
obsplot(athletes, height = 60) |>
    mark_dot(
        transform_binX(r = "count", x = weight)
    ) |>
    scale_r(range = c(0, 14))
```

```{r}
sports_by_weight <- levels(reorder(athletes$sport, athletes$weight, median, na.rm = TRUE))

obsplot(athletes, height = 600) |>
    mark_barX(
        transform_binX(fill = "proportion-facet", x = weight, inset = 0.5)
    ) |>
    facet(marginLeft = 100, y = sport) |>
    scale_color(scheme = "YlGnBu") |>
    scale_x(round = TRUE, grid = TRUE) |>
    scale_fy(domain = sports_by_weight, label = NULL) |>
    opts(marginLeft = 100, padding = 0)
```


## Stack transform

```{r}
data(crimea)

obsplot(crimea) |>
    mark_lineY(x = date, y = deaths, stroke = cause) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(crimea) |>
    mark_areaY(x = date, y2 = deaths, fill = cause, mixBlendMode = "multiply") |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(crimea) |>
    mark_areaY(x = date, y = deaths, fill = cause) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE)
```

```{r}
obsplot(crimea) |>
    mark_barY(x = date, y = deaths, fill = cause) |>
    mark_ruleY(0) |>
    scale_x(label = NULL, tickFormat = JS('d => d.toLocaleString("en", {month: "narrow"})'))
```

```{r}
data(unemployment)

obsplot(unemployment) |>
    mark_areaY(
        transform_stackY(x = date, y = unemployed, fill = industry, title = industry)
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE, label = '↑ Unemployed (thousands)')
```

```{r}
obsplot(unemployment) |>
    mark_areaY(
        transform_stackY(offset = "silhouette", x = date, y = unemployed, fill = industry)
    ) |>
    scale_y(grid = TRUE, label = '↑ Unemployed (thousands)')
```

```{r}
obsplot(unemployment) |>
    mark_areaY(
        transform_stackY(offset = "wiggle", x = date, y = unemployed, fill = industry)
    ) |>
    scale_y(grid = TRUE, label = '↑ Unemployed (thousands)')
```

```{r}
obsplot(unemployment) |>
    mark_areaY(
        transform_stackY(
            curve = "catmull-rom", 
            x = date, y = unemployed, fill = industry, order = value
        )
    ) |>
    mark_ruleY(0) |>
    scale_y(grid = TRUE, label = '↑ Unemployed (thousands)')
```

```{r}
data(riaa)

xy <- list(x = "year", y = "revenue", z = "format", order = "appearance", reverse = TRUE)
obsplot(riaa) |>
    mark_areaY(
        transform_stackY(
            append(
                xy,
                list(fill = "group", title = JS('d => `${d.format}\n${d.group}`'))
            )
        )
    ) |>
    mark_lineY(
        transform_stackY1(
            append(
                xy,
                list(stroke = "white", strokeWidth = 1)
            )
        )
    ) |>
    mark_ruleY(0) |>
    scale_y(
        grid = TRUE, label = "↑ Annual revenue (billions, adj.)", 
        transform = JS('d => d / 1000')
    )
```

```{r}
xy <- list(
    x = "year", y = "revenue", z = "format", 
    order = "appearance", reverse = TRUE, offset = "expand"
)
obsplot(riaa) |>
    mark_areaY(
        transform_stackY(
            append(
                xy,
                list(fill = "group", title = JS('d => `${d.format}\n${d.group}`'))
            )
        )
    ) |>
    mark_lineY(
        transform_stackY1(
            append(
                xy,
                list(stroke = "white", strokeWidth = 1)
            )
        )
    ) |>
    mark_ruleY(c(0, 1)) |>
    scale_y(
        grid = TRUE, label = "↑ Annual revenue (billions, adj.)", 
        transform = JS('d => d / 1000')
    )
```

```{r}
data(congress)

obsplot(congress, height = 300) |>
    mark_dot(
        transform_stackY2(
            x = JS('d => 2021 - d.birth'),
            y = JS('d => d.gender === "M" ? 1 : d.gender === "F" ? -1 : 0'),
            fill = gender
        )
    ) |>
    mark_ruleY(0) |>
    scale_x(label = "Age →", nice = TRUE) |>
    scale_y(
        grid = TRUE, label = "← Women · Men →",
        labelAnchor =  "center",
        tickFormat = JS('Math.abs')
    )
```

```{r}
obsplot(congress, height = 280) |>
    mark_barX(
        transform_stackX(
            transform_groupZ(x = "proportion-facet", fill = gender)
        )
    ) |>
    mark_text(
        transform_stackX(
            transform_groupZ(
                list(x = "proportion-facet", text = "first"),
                z = gender,
                text = JS('d => d.gender === "F" ? "Women" : d.gender === "M" ? "Men" : null')
            )
        )
    ) |>
    mark_ruleX(c(0, 1)) |>
    facet(y = JS('d => Math.floor((2021 - d.birth) / 10) * 10')) |>
    scale_x(percent = TRUE)
```

```{r}
data(iowa)

obsplot(iowa) |>
    mark_areaY(
        transform_stackY(x = year, y = net_generation, fill = source, title = source)
    ) |>
    mark_ruleY(0) |>
    scale_y(
        grid = TRUE,  label = "↑ Net generation (million MWh)", 
        transform = JS('d => d / 1000')
    )
```


## Select transform

```{r}
data(stocks)

obsplot(stocks) |>
    mark_line(x = Date, y = Close, stroke = Symbol) |>
    mark_text(
        transform_selectLast(
            x = Date, y = Close, stroke = Symbol,
            text = Symbol, textAnchor = "start", dx = 3
        )
    ) |>
    scale_y(grid = TRUE, label = "↑ Price ($)") |>
    opts(marginRight = 40)
```


## Map transform

```{r}
values <- rnorm(500)

obsplot(values, height = 200) |>
    mark_lineY(transform_map(list(y = "cumsum"), y = values))
```

```{r}
obsplot(values, height = 200) |>
    mark_lineY(transform_mapY("cumsum", y = values))
```

```{r}
data(sftemp)

obsplot(sftemp) |>
    mark_areaY(x = date, y1 = low, y2 = high, curve = "step", fill = "#ccc") |>
    mark_line(
        transform_windowY(x = date, y = low, k = 7, curve = "step", stroke = "blue")
    ) |>
    mark_line(
        transform_windowY(x = date, y = high, k = 7, curve = "step", stroke = "red")
    ) |>
    scale_y(grid = TRUE, label = "↑ Daily temperature range (°F)")
```

```{r}
data(stocks)

obsplot(stocks) |>
    mark_ruleY(1) |>
    mark_line(transform_normalizeY(x = Date, y = Close, stroke = Symbol)) |>
    mark_text(
        transform_selectLast(
            transform_normalizeY(
                x = Date, y = Close, stroke = Symbol,
                text = Symbol, textAnchor = "start", dx = 3
            )
        )
    ) |>
    scale_y(
        type = "log", grid = TRUE, label = "↑ Change in price (%)",
        tickFormat = JS("x => d3.format('+d')((x - 1) * 100)")
    ) |>
    opts(marginRight = 40)
```

```{r message = FALSE, warning = FALSE}
data(stateage)

# Get states order by proportion of >=80
library(dplyr)
state_order <- stateage |>
    group_by(name) |>
    mutate(
        total_pop = sum(population),
        prop = population / total_pop
    ) |>
    filter(age == "≥80") |>
    arrange(desc(prop))

xy <- transform_normalizeX(basis = "sum", z = name, x = population, y = name)

obsplot(stateage, height = 660) |>
    mark_ruleX(x = 0) |>
    mark_ruleY(
        transform_groupY(list(x1 = "min", x2 = "max"), xy)
    ) |>
    mark_dot(xy, fill = age, title = age) |>
    mark_text(
        transform_selectMinX(xy), textAnchor = "end", dx = -6, text = name
    ) |>
    scale_x(axis = "top",   label =  "Percent (%) →", transform = JS("d => d * 100")) |>
    scale_y(
        domain = state_order$name,
        axis = NULL
    ) |>
    scale_color(scheme = "spectral", domain = unique(stateage$age)) |>
    opts(grid = TRUE)
```