obsplot Gallery : marks

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)

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)")

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)

obsplot(bls) |>
    mark_areaY(x = date, y = unemployed, fill = industry) |>
    mark_ruleY(y = 0)

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)

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)])

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"))

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"))

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")

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)

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")

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)

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")

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")

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)

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)

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)

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 (%)")

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)

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)

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)

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")
    )

data(aapl)

obsplot(aapl) |>
    mark_line(x = Date, y = Close) |>
    scale_y(grid = TRUE)

obsplot() |>
    mark_lineY(JS("d3.cumsum({length: 300}, d3.randomNormal())")) |>
    scale_x(axis = NULL)

data(bls_unemployment)

obsplot(bls_unemployment) |>
    mark_ruleY(y = 0) |>
    mark_line(x = date, y = unemployment, z = division) |>
    scale_y(grid = TRUE, label = "↑ Unemployment (%)")

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")

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 (%)")

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"))

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)")

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)

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
    )

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")

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)

obsplot(height = 60) |>
    mark_ruleX(data = list(length = 500), x = JS("d3.randomNormal()"), strokeOpacity = 0.2) |>
    scale_x(domain = c(-4, 4))

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")
    )

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)

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")

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"))

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")
    )

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"))

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)

obsplot(height = 60) |>
    mark_tickX(list(length = 500), x = JS("d3.randomNormal()"), strokeOpacity = 0.2) |>
    scale_x(domain = c(-4, 4))

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)