--- title: "obsplot Gallery : marks" author: "Julien Barnier" date: "`r Sys.Date()`" output: rmarkdown::html_vignette: fig_width: 7 fig_height: 4.5 toc: true vignette: > %\VignetteIndexEntry{obsplot Gallery : marks} %\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. ## Area mark ```{r} data(aapl) obsplot(aapl) |> mark_areaY(x = Date, y = Close, fill = "#ccc") |> mark_lineY(x = Date, y = Close) |> mark_ruleY(y = 0) |> scale_y(grid = TRUE) ``` ```{r} data(sftemp) obsplot(sftemp) |> mark_ruleY(y = 32) |> mark_areaY( transform_windowY( x = date, y1 = low, y2 = high, fill = "#ccc", k = 14 ) ) |> mark_line( transform_windowY( x = date, y = JS("d => (d.low + d.high) / 2"), k = 14 ) ) |> scale_y(grid = TRUE, label = "↑ Temperature (°F)") ``` ```{r} data(bls) obsplot(bls) |> mark_areaY(x = date, y2 = unemployed, z = industry, fillOpacity = 0.1) |> mark_lineY(x = date, y = unemployed, z = industry, strokeWidth = 1) ``` ```{r} obsplot(bls) |> mark_areaY(x = date, y = unemployed, fill = industry) |> mark_ruleY(y = 0) ``` ```{r} normY <- transform_normalizeY(basis = "median", x = date, y = unemployed) obsplot(bls, height = 600) |> mark_areaY(normY, fillOpacity = 0.2) |> mark_lineY(normY, strokeWidth = 1) |> facet(y = industry, marginRight = 140) |> scale_y(axis = NULL) |> scale_fy(axis = "right", label = NULL) ``` ## Bar mark ```{r} data(civilizations) obsplot(civilizations, height = nrow(civilizations) * 12) |> mark_barX(x1 = start, x2 = end, y = civilization) |> mark_text( x = start, y = civilization, text = civilization, textAnchor = "end", dx = -6 ) |> opts(marginLeft = 140) |> scale_x(axis = "top", grid = TRUE) |> scale_y(axis = NULL, domain = civilizations$civilization[order(civilizations$start)]) ``` ```{r} data(popchange) popchange$diff <- (popchange$`2019` - popchange$`2010`) / popchange$`2010` * 100 popchange$up <- popchange$diff >= 0 obsplot(popchange, height = 780) |> mark_barX(y = State, x = diff, fill = up) |> mark_ruleX(x = 0) |> opts(marginLeft = 110, grid = TRUE) |> scale_x( axis = "top", round = TRUE, label = "← decrease · Change in population, 2010–2019 (%) · increase →", labelAnchor = "center", tickFormat = "+" ) |> scale_y(label = NULL, domain = popchange$State[order(popchange$diff)], reverse = TRUE) |> scale_color(range = c("#e15759", "#4e79a7")) ``` ```{r} data(alphabet) obsplot(alphabet, height = 60) |> mark_ruleX(c(0,1)) |> mark_barX( transform_stackX(order = letter, x = frequency, fill = "#ccc", insetLeft = 1) ) |> mark_textX( transform_stackX(order = letter, x = frequency, text = "letter", insetLeft = 1) ) |> scale_x(label = "Frequency (%)", transform = JS("d => d * 100")) ``` ```{r message=FALSE} data(stateage) # Precompute state names order library(dplyr) states <- stateage |> group_by(name) |> summarize(total = sum(population)) |> arrange(desc(total)) |> slice(1:6) |> pull(name) obsplot(stateage) |> mark_barY(x = age, y = population, fill = age, title = age) |> mark_ruleY(y = 0) |> facet(x = name) |> scale_x(axis = NULL, domain = unique(stateage$age)) |> scale_fx(domain = states, label = NULL, tickSize = 6) |> scale_y(grid = TRUE, tickFormat = "s") |> scale_color(domain = unique(stateage$age), scheme = "spectral") ``` ## Cell mark ```{r} obsplot(simpsons, height = 600) |> mark_cell(x = season, y = number_in_season, fill = imdb_rating) |> mark_text(x = season, y = number_in_season, text = imdb_rating, title = title) |> scale_x(axis = "top", label = "Season") |> scale_y(label = "Episode") |> scale_color(scheme = "PiYg") |> opts(padding = 0.05, grid = TRUE) ``` ```{r message = FALSE} data(dji) # precompute variables dji <- dji |> mutate( variation = (Close - lag(Close)) / lag(Close), title = round(variation * 100, 1) ) obsplot(dji, height = 1300) |> mark_cell( x = JS("d => d3.utcWeek.count(d3.utcYear(d.Date), d.Date)"), y = JS("d => d.Date.getUTCDay()"), fill = variation, title = title, inset = 0.5 ) |> facet(y = JS("d => d.Date.getUTCFullYear()")) |> scale_x(axis = NULL, padding = 0) |> scale_y( padding = 0, tickSize = 0, tickFormat = JS('Plot.formatWeekday("en", "narrow")') ) |> scale_fy(reverse = TRUE, label = NULL) |> scale_color(type = "diverging", scheme = "PiYg") ``` ```{r} data(seattle) obsplot(seattle, height = 300) |> mark_cell( transform_group( list(fill = "max"), x = JS("d => d.date.getUTCDate()"), y = JS("d => d.date.getUTCMonth()"), fill = temp_max, inset = 0.5 ) ) |> scale_y( tickFormat = JS('Plot.formatMonth("en", "short")') ) |> opts(padding = 0) ``` ```{r} df <- simpsons |> mutate(tick = season * 100 + number_in_season - 1) obsplot(df, height = 60) |> mark_cell(x = tick, fill = imdb_rating) |> scale_x( ticks = df |> filter(number_in_season == 1) |> pull(tick), tickFormat = JS("d => d / 100"), round = FALSE, label = "Season →", labelAnchor = "right" ) |> scale_color(scheme = "PiYg") ``` ## Dot mark ```{r} data(gistemp) obsplot(gistemp) |> mark_ruleY(y = 0) |> mark_dot(x = Date, y = Anomaly, stroke = Anomaly) |> scale_y(tickFormat = "+f", grid = TRUE) |> scale_color(type = "diverging", scheme = "BuRd") ``` ```{r} data(aapl) obsplot(aapl) |> mark_ruleX(0) |> mark_dot( x = JS("d => (d.Close - d.Open) / d.Open"), y = Volume, r = Volume ) |> scale_x( label = "Daily change (%) →", tickFormat = "+f", transform = JS("d => d * 100") ) |> scale_y( label = "↑ Daily trading volume", type = "log", tickFormat = "~s" ) |> opts(grid = TRUE) ``` ```{r} data(diamonds_obs) obsplot(diamonds_obs, height = 480) |> mark_dot( transform_bin(r = "count", x = carat, y = price, thresholds = 100) ) |> scale_x(label = "Carats →") |> scale_y(label = "↑ Price ($)") |> scale_r(range = c(0, 20)) |> opts(grid = TRUE) ``` ```{r} data(driving) # filter out highlighted data beforehand driv5 <- driving |> filter(year %% 5 == 0) obsplot(driving) |> mark_line(x = miles, y = gas, curve = "catmull-rom") |> mark_dot(x = miles, y = gas, fill = "currentColor") |> mark_text(driv5, x = miles, y = gas, text = year, dy = -8) |> opts(grid = TRUE) ``` ```{r} data(alphabet) obsplot(alphabet) |> mark_ruleY(y = 0) |> mark_ruleX(x = letter, y = frequency) |> mark_dot(x = letter, y = frequency, fill = "black", r = 4) |> scale_x(label = NULL, tickSize = 0) |> scale_y(transform = JS("d => d * 100"), label = "↑ Frequency (%)") ``` ```{r} data(stateage) xy <- transform_normalizeY(basis = "sum", z = "name", x = "age", y = "population") obsplot(stateage) |> mark_ruleY(y = 0) |> mark_line(xy, strokeWidth = 1, stroke = "#ccc") |> mark_dot(xy) |> scale_x(domain = unique(stateage$age), labelAnchor = "right") |> scale_y(transform = JS("d => d*100")) |> opts(grid = TRUE) ``` ```{r} 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(axis = NULL) |> scale_color(scheme = "spectral", domain = unique(stateage$age)) |> opts(grid = TRUE) ``` ## Link mark ```{r} data(metros) # Compute the difference first metros$diff1580 <- metros$R90_10_2015 - metros$R90_10_1980 obsplot(metros) |> mark_link( x1 = POP_1980, y1 = R90_10_1980, x2 = POP_2015, y2 = R90_10_2015, stroke = diff1580 ) |> mark_dot(x = POP_2015, y = R90_10_2015, r = 1) |> mark_text( x = POP_2015, y = R90_10_2015, filter = highlight, text = nyt_display, dy = -6 ) |> scale_x(type = "log", tickFormat = "~s") |> scale_color(type = "diverging", reverse = TRUE) |> opts(grid = TRUE) ``` ```{r} data(income) # Compute min and max values first imin <- min(c(income$m, income$f), na.rm = TRUE) imax <- max(c(income$m, income$f), na.rm = TRUE) qs <- c(.6, .7, .8, .9, 1) obsplot(height = 600) |> mark_link(x1 = imin, y1 = imin, x2 = imax, y2 = imax) |> mark_link( x1 = imin, y1 = imin * qs, x2 = imax, y2 = imax * qs, strokeOpacity = ifelse(qs == 1, 1, 0.2) ) |> mark_text( x = imax, y = qs * imax, textAnchor = "start", dx = 6, text = ifelse(qs == 1, "Equal", qs) ) |> mark_dot(income, x = m, y = f, title = paste(income$type, income$age)) |> opts(marginRight = 40) |> scale_x( label = "Median annual income (men, thousands) →", tickFormat = JS("d => d / 1000") ) |> scale_y( label = "↑ Median annual income (women, thousands)", tickFormat = JS("d => d / 1000") ) ``` ## Line mark ```{r} data(aapl) obsplot(aapl) |> mark_line(x = Date, y = Close) |> scale_y(grid = TRUE) ``` ```{r} obsplot() |> mark_lineY(JS("d3.cumsum({length: 300}, d3.randomNormal())")) |> scale_x(axis = NULL) ``` ```{r} data(bls_unemployment) obsplot(bls_unemployment) |> mark_ruleY(y = 0) |> mark_line(x = date, y = unemployment, z = division) |> scale_y(grid = TRUE, label = "↑ Unemployment (%)") ``` ```{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)") ) |> style(overflow = "visible") ``` ```{r} data(bls_unemployment) obsplot(bls_unemployment) |> mark_ruleY(0) |> mark_line( x = date, y = unemployment, z = division, stroke = unemployment ) |> scale_y(grid = TRUE, label = "↑ Unemployment (%)") ``` ```{r} data(bls_unemployment) bls_unemployment$highlight <- grepl(", MI ", bls_unemployment$division) obsplot(bls_unemployment) |> mark_ruleY(0) |> mark_line( x = date, y = unemployment, z = division, stroke = highlight, sort = highlight ) |> scale_y(grid = TRUE, label = "↑ Unemployment (%)") |> scale_color(domain = c(FALSE, TRUE), range = c("#CCC", "red")) ``` ```{r} data(sftemp) obsplot(sftemp) |> mark_line( transform_windowY(k = 14, x = date, y = low, stroke = "#4e79a7") ) |> mark_line( transform_windowY(k = 14, x = date, y = high, stroke = "#e15759") ) |> mark_ruleY(32) |> scale_y(grid = TRUE, label = "↑ Temperature (°F)") ``` ## Rect mark ```{r} data(aapl) obsplot(aapl) |> mark_rectY( transform_binX( y = "count", x = JS("d => Math.log10(d.Volume)"), normalize = TRUE ) ) |> mark_ruleY(0) |> scale_x(round = TRUE, label = "Trade volume (log₁₀) →") |> scale_y(grid = TRUE) ``` ```{r} data(povcalnet) obsplot(povcalnet) |> mark_rectY( transform_stackX( filter = JS("d => ['N', 'A'].includes(d.CoverageType)"), x = ReqYearPopulation, order = HeadCount, reverse = TRUE, y2 = HeadCount, title = JS("d => `${d.CountryName}\n${(d.HeadCount * 100).toFixed(1)}%`"), insetLeft = 0.2, insetRight = 0.2 ) ) |> scale_x(label = "Population (millions) →") |> scale_y( label = "↑ Proportion living on less than $30 per day (%)", transform = JS("d => d * 100"), grid = TRUE ) ``` ```{r} data(diamonds_obs) obsplot(diamonds_obs, height = 640) |> mark_rect( transform_bin( fill = "count", x = carat, y = price, thresholds = 100, inset = 0 ) ) |> opts(round = TRUE) |> scale_color(scheme = "bupu", type = "symlog") ``` ```{r} data(aapl) obsplot(aapl) |> mark_rectY( transform_binX( y = "count", rx = 8, x = JS("d => Math.log10(d.Volume)"), normalize = TRUE ) ) |> mark_ruleY(0) |> scale_x(round = TRUE, label = "Trade volume (log₁₀) →") |> scale_y(grid = TRUE) ``` ## Rule mark ```{r} obsplot(height = 60) |> mark_ruleX(data = list(length = 500), x = JS("d3.randomNormal()"), strokeOpacity = 0.2) |> scale_x(domain = c(-4, 4)) ``` ```{r} data(seattle) obsplot(seattle) |> mark_ruleY(0) |> mark_ruleX(x = date, y1 = temp_min, y2 = temp_max, stroke = temp_max) |> scale_color(scheme = "BuRd") |> scale_y( grid = TRUE, label = "↑ Temperature (°F)", transform = JS("d => d * 9 / 5 + 32") ) ``` ```{r} data(aapl) aapl120 <- tail(aapl, 120) obsplot(aapl120) |> mark_ruleX(x = Date, strokeOpacity = 0.1) |> mark_ruleX(x = Date, y1 = Low, y2 = High) |> mark_ruleX( x = Date, y1 = Open, y2 = Close, stroke = JS("d => Math.sign(d.Close - d.Open)"), strokeWidth = 4, strokeLinecap = "round" ) |> scale_x(label = NULL) |> scale_y(grid = TRUE, label = "↑ Stock price ($)") |> scale_color(range = c("#e41a1c", "#000000", "#4daf4a")) |> opts(inset = 6) ``` ```{r} data(simpsons) obsplot(simpsons) |> mark_ruleX( transform_groupX( list(y1 = "min", y2 = "max"), x = season, y = imdb_rating ) ) |> mark_line( transform_groupX( y = "median", x = season, y = imdb_rating, stroke = "red" ) ) |> mark_dot(x = season, y = imdb_rating) |> scale_x(type = "point", label = "Season →", labelAnchor = "right") |> scale_y(label = "↑ IMDb rating") ``` ## Text mark ```{r} data(alphabet) obsplot(alphabet) |> mark_barY(x = letter, y = frequency) |> mark_text( x = letter, y = frequency, text = JS("d => (d.frequency * 100).toFixed(1)"), dy = -5 ) |> mark_ruleY(0) |> scale_x(label = NULL) |> scale_y(grid = TRUE, label = "↑ Frequency (%)", transform = JS("d => d * 100")) ``` In the following example, the `text` channels passed to `mark_text` are not data column names but explicit values. In Observable Plot this is done by setting to an array (`text: ["2019"]`). In `obsplot`, we use the helper function `as_data` to achieve the same goal. ```{r} data(travelers) last_traveler <- head(travelers, 1) obsplot(travelers) |> mark_ruleY(0) |> mark_line(x = date, y = previous, stroke = "#bab0ab") |> mark_line(x = date, y = current) |> mark_text( last_traveler, x = date, y = previous, fill = "#8a817c", text = as_data("2019"), dy = "-0.5em" ) |> mark_text( last_traveler, x = date, y = current, text = as_data("2020"), dy = "1.2em" ) |> scale_y( grid = TRUE, nice = TRUE, label = "↑ Travelers per day (millions)", transform = JS("d => d / 1e6") ) ``` ```{r} library(stringr) data(caltrain) north <- subset(caltrain, orientation == "N") south <- subset(caltrain, orientation == "S") obsplot(caltrain, height = 480, width = 240) |> mark_text(x = 1, y = 3, text = as_data("Northbound"), textAnchor = "start") |> mark_text(x = -1, y = 3, text = as_data("Southbound"), textAnchor = "end") |> mark_text( unique(caltrain$hours), x = 0, y = JS("d => d"), text = JS('d => `${(d - 1) % 12 + 1}${(d % 24) >= 12 ? "p": "a"}`') ) |> mark_text( north, transform_stackX2( x = 1, y = hours, text = str_pad(north$minutes, 2, side = "left", pad = 0), title = paste(north$time, north$line), fill = type, textAnchor = "start" ) ) |> mark_text( south, transform_stackX2( x = -1, y = hours, text = str_pad(south$minutes, 2, side = "left", pad = 0), title = paste(north$time, north$line), fill = type, textAnchor = "end" ) ) |> mark_ruleX(c(-.5, .5)) |> scale_x(axis = NULL) |> scale_y(domain = 3:26, axis = NULL) |> scale_color(domain = "NLB", range = c("currentColor", "peru", "brown")) ``` ## Tick mark ```{r} data(stateage) obsplot(stateage, height = 300) |> mark_ruleX(0) |> mark_tickX( transform_normalizeX(basis = "sum", z = name, x = population, y = age) ) |> scale_x(axis = "top", label = "Percent (%) →", transform = JS("d => d*100")) |> scale_y(domain = unique(stateage$age), label = "Age") |> opts(marginLeft = 50, grid = TRUE) ``` ```{r} obsplot(height = 60) |> mark_tickX(list(length = 500), x = JS("d3.randomNormal()"), strokeOpacity = 0.2) |> scale_x(domain = c(-4, 4)) ``` ```{r} data(morley) obsplot(morley, height = 150) |> mark_ruleY( transform_groupY( list( x1 = JS('V => Math.max(d3.min(V), d3.quantile(V, 0.25) * 2.5 - d3.quantile(V, 0.75) * 1.5)'), x2 = JS('V => Math.min(d3.max(V), d3.quantile(V, 0.75) * 2.5 - d3.quantile(V, 0.25) * 1.5)') ), x = Speed, y = Expt ) ) |> mark_barX( transform_groupY( list( x1 = JS('V => d3.quantile(V, 0.25)'), x2 = JS('V => d3.quantile(V, 0.75)') ), x = Speed, y = Expt, fill = "#ccc" ) ) |> mark_tickX( transform_groupY( list(x = JS('d3.median')), x = Speed, y = Expt, strokeWidth = 2 ) ) |> scale_x(grid = TRUE, inset = 6) ```