Skip to content

Multiple lengths of arrows for geom_segment is not working for 3.5.2.9002 #6594

@pwwang

Description

@pwwang

When testing my package with ggplot2 v4 (v3.5.2.9002, main branch), I found that providing multiple lengths of arrows for geom_segement is not working anymore:

packageVersion("ggplot2")

library(ggplot2)

segment_df <- data.frame(
    x = c(1, 2, 3),
    y = c(1, 2, 1),
    xend = c(2, 3, 4),
    yend = c(2, 1, 2),
    group = c("A", "B", "C"),
    arrow_length = c(0.1, 0.2, 0.3)
)
ggplot(segment_df) +
    geom_segment(
        aes(x = x, y = y, xend = xend, yend = yend, color = group),
        arrow = arrow(length = unit(segment_df$arrow_length, "inches"), type = "closed", angle = 30),
        linewidth = 1.5
    ) +
    theme_minimal()

[1] ‘3.5.2’

Image

With v3.5.2.9002:

[1] ‘3.5.2.9002’

ERROR while rich displaying an object: Error in vapply(glyph, get_attr, which = "width", default = 0, numeric(1)): values must be length 1,
 but FUN(X[[1]]) result is length 3

Traceback:
1. sapply(x, f, simplify = simplify)
2. lapply(X = X, FUN = FUN, ...)
3. FUN(X[[i]], ...)
4. tryCatch(withCallingHandlers({
 .     if (!mime %in% names(repr::mime2repr)) 
 .         stop("No repr_* for mimetype ", mime, " in repr::mime2repr")
 .     rpr <- repr::mime2repr[[mime]](obj)
 .     if (is.null(rpr)) 
 .         return(NULL)
 .     prepare_content(is.raw(rpr), rpr)
 . }, error = error_handler), error = outer_handler)
5. tryCatchList(expr, classes, parentenv, handlers)
6. tryCatchOne(expr, names, parentenv, handlers[[1L]])
7. doTryCatch(return(expr), name, parentenv, handler)
8. withCallingHandlers({
 .     if (!mime %in% names(repr::mime2repr)) 
 .         stop("No repr_* for mimetype ", mime, " in repr::mime2repr")
 .     rpr <- repr::mime2repr[[mime]](obj)
 .     if (is.null(rpr)) 
 .         return(NULL)
 .     prepare_content(is.raw(rpr), rpr)
 . }, error = error_handler)
9. repr::mime2repr[[mime]](obj)
10. repr_text.default(obj)
11. paste(capture.output(print(obj)), collapse = "\n")
12. capture.output(print(obj))
13. withVisible(...elt(i))
14. print(obj)
15. `print.ggplot2::ggplot`(obj)
16. ggplot_gtable(data)
17. `ggplot_gtable.ggplot2::ggplot_built`(data)
18. plot@guides$assemble(theme)
19. assemble(..., self = self)
20. self$draw(theme, positions, theme$legend.direction)
21. draw(..., self = self)
22. guides[[i]]$draw(theme = theme, position = positions[i], direction = directions[i], 
  .     params = params[[i]])
23. draw(..., self = self)
24. self$build_decor(params$decor, grobs, elems, params)
25. build_decor(...)
26. lapply(idx, function(i) {
  .     glyph <- lapply(decor, function(dec) {
  .         data <- vec_slice(dec$data, i)
  .         if (!(data$.draw %||% TRUE)) {
  .             return(zeroGrob())
  .         }
  .         key <- dec$draw_key(data, dec$params, key_size * 10)
  .         set_key_size(key, data$linewidth, data$size, key_size)
  .     })
  .     width <- vapply(glyph, get_attr, which = "width", default = 0, 
  .         numeric(1))
  .     width <- max(width, 0, key_size[1], na.rm = TRUE)
  .     height <- vapply(glyph, get_attr, which = "height", default = 0, 
  .         numeric(1))
  .     height <- max(height, 0, key_size[2], na.rm = TRUE)
  .     vp <- NULL
  .     if (!is.null(just)) {
  .         vp <- viewport(x = just[1], y = just[2], just = just, 
  .             width = unit(width, "cm"), height = unit(height, 
  .                 "cm"))
  .     }
  .     grob <- gTree(children = inject(gList(elements$key, !!!glyph)), 
  .         vp = vp)
  .     attr(grob, "width") <- width
  .     attr(grob, "height") <- height
  .     grob
  . })
27. FUN(X[[i]], ...)
28. vapply(glyph, get_attr, which = "width", default = 0, numeric(1))

pwwang/plotthis#19
pwwang/plotthis#22

Metadata

Metadata

Assignees

No one assigned

    Type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions