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