custom-marks.R
In glyph: A Grammar of Interactive Graphics

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup, message = FALSE---------------------------------------------------
library(glyph)

## ----echo = FALSE, out.width = "100%", fig.alt = "A lollipop chart of fruit sold: stems rise from zero to 12, 7 and 9 for apple, fig and kiwi, and one hangs down to -3 for pear."----
knitr::include_graphics("custom-marks-lollipop.png")

## ----eval = FALSE-------------------------------------------------------------
# #' Add a lollipop mark
# #'
# #' Draws a stem from zero to each value, with a dot at the end.
# #' @inheritParams mark_point
# #' @return Modified \code{glyph_spec} object with the lollipop mark added
# #' @export
# #'
# #' @examples
# #' df <- data.frame(fruit = c("apple", "fig", "kiwi"), sold = c(12, 7, 9))
# #' glyph(df, x = fruit, y = sold) |> mark_lollipop()
# mark_lollipop <- function(spec, ..., data = NULL, style = list()) {
#   add_mark(spec, "lollipop", rlang::enquos(...), data, style,
#            defaults = list(size = 5, stroke_width = 1.5, opacity = 0.9))
# }

## -----------------------------------------------------------------------------
sales <- data.frame(
  fruit = c("apple", "fig", "kiwi", "pear"),
  sold = c(12, 7, 9, -3)
)
p <- glyph(sales, x = fruit, y = sold * 2) |> mark_point()
str(p$marks[[1]][c("type", "style", "id", "stat")])

## -----------------------------------------------------------------------------
compiled <- compile(p)
str(compiled$spec$marks[[1]]$encoding)

## -----------------------------------------------------------------------------
str(compiled$spec$data)

## -----------------------------------------------------------------------------
str(compiled$spec$marks[[1]]$data)

## ----eval = FALSE-------------------------------------------------------------
# sales <- data.frame(fruit = c("apple", "fig", "kiwi", "pear"), sold = c(12, 7, 9, -3))
# 
# test_that("mark_lollipop() adds a lollipop layer", {
#   spec <- glyph(sales, x = fruit, y = sold) |> mark_lollipop()
#   mark <- spec$marks[[1]]
#   expect_equal(mark$type, "lollipop")
#   expect_equal(mark$style$size, 5)
#   compiled <- compile(spec)$spec$marks[[1]]
#   expect_equal(compiled$encoding$y$field, "sold")
#   expect_equal(compiled$encoding$x$type, "nominal")
# })

## ----eval = FALSE-------------------------------------------------------------
# test_that("lollipops are drawn from zero to their value", {
#   skip_if_no_browser()
#   s <- open_page(save_page(
#     glyph(sales, x = fruit, y = sold) |> mark_lollipop() |> interact(tooltip = TRUE, brush = TRUE)
#   ))
#   js(s, AXIS_JS)
#   drawn <- js(s, "(() => { const y = axisMap('y');
#     return [...document.querySelectorAll('.glyph-lollipop')].map(p => ({
#       base: y(+p.querySelector('line').getAttribute('y1')),
#       tip: y(+p.querySelector('line').getAttribute('y2')),
#       dot: y(+p.querySelector('circle').getAttribute('cy')) })); })()")
#   expect_length(drawn, 4)
#   expect_equal(vapply(drawn, `[[`, numeric(1), "base"), rep(0, 4), tolerance = 0.05)
#   expect_equal(vapply(drawn, `[[`, numeric(1), "tip"), sales$sold, tolerance = 0.05)
#   expect_equal(vapply(drawn, `[[`, numeric(1), "dot"), sales$sold, tolerance = 0.05)
#   expect_length(page_errors(s), 0)
# })

## ----eval = FALSE-------------------------------------------------------------
# devtools::load_all()
# glyph(sales, x = fruit, y = sold) |>
#   mark_lollipop(color = sold > 0) |>
#   interact(tooltip = TRUE, hover = "enlarge", brush = TRUE, zoom = TRUE)