plotly/plotly.R

Bug with configurable annotations: when repositioning annotation via click and drag, annotation gets duplicated. Seems to be an issue with specifying font attributes.

ellenbouchard opened this issue · 1 comments

Hello,

I ran into what appears to be a bug with configurable annotations in R. Briefly, if just one annotation label is displayed on the plot, and I reposition the label by clicking and dragging, the annotation gets duplicated; one label is repositioned, and the other remains in its original position. If more than one annotation label is displayed, this does not happen.

After some investigating, I realized that this only happens if the "font" argument within "add_annotations" is a list of more than one element. So if I don't specify any "font" attributes, or specify only one font attribute (such as color or size), the bug does not occur. As soon as I specify multiple font attributes, the bug happens. I realize this may be a version thing but wanted to put it out there regardless.

Example here, code slightly modified from Text and Annotations in R :
This code has a bug; the annotation label will be duplicated when repositioned

library(plotly)

data <- mtcars[which(mtcars$am == 1 & mtcars$gear == 4),]
annot_data <- data[1,]

fig <- plot_ly(data, x = ~wt, y = ~mpg, type = 'scatter', mode = 'markers',
               marker = list(size = 10)) %>% 
              config(editable = TRUE)

fig <- fig %>% add_annotations(x = annot_data$wt,
                               y = annot_data$mpg,
                               text = rownames(annot_data),
                               xref = "x",
                               yref = "y",
                               showarrow = TRUE,
                               arrowhead = 4,
                               arrowsize = .5,
                               ax = 20,
                               ay = -40,
                               # Styling annotation text:
                               font = list(family = 'sans serif',
                                           size = 14))

fig

This code, in which 'font' only has one element, does NOT have the bug; the annotation label will be repositioned normally

library(plotly)

data <- mtcars[which(mtcars$am == 1 & mtcars$gear == 4),]
annot_data <- data[1,]

fig <- plot_ly(data, x = ~wt, y = ~mpg, type = 'scatter', mode = 'markers',
               marker = list(size = 10)) %>% 
              config(editable = TRUE)

fig <- fig %>% add_annotations(x = annot_data$wt,
                               y = annot_data$mpg,
                               text = rownames(annot_data),
                               xref = "x",
                               yref = "y",
                               showarrow = TRUE,
                               arrowhead = 4,
                               arrowsize = .5,
                               ax = 20,
                               ay = -40,
                               # Styling annotation text:
                               font = list(size = 14))

fig

Session info:

R version 4.3.2 (2023-10-31)
Platform: x86_64-apple-darwin20 (64-bit)
Running under: macOS Monterey 12.7.6

Matrix products: default
BLAS:   /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib 
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

time zone: America/Los_Angeles
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] plotly_4.10.4 ggplot2_3.5.0

Update: I figured it out; it has to do with how annotations are dealt with in plotly_build.

Relevant snippet from plotly_build:

layouts <- Map(function(x, y) {
    
    d <- plotly_data(p, y)
    x <- rapply(x, eval_attr, data = d, how = "list")
    
    # if an annotation attribute is an array, expand into multiple annotations
    nAnnotations <- max(lengths(x$annotations) %||% 0)
    if (!is.null(names(x$annotations))) {
      # font is the only list object, so store it, and attach after transposing
      font <- x$annotations[["font"]]
      x$annotations <- purrr::transpose(lapply(x$annotations, function(x) {
        as.list(rep(x, length.out = nAnnotations))
      }))
      for (i in seq_len(nAnnotations)) {
        x$annotations[[i]][["font"]] <- font
      }
    }
    
    x[lengths(x) > 0]
    
  }, p$x$layoutAttrs, names2(p$x$layoutAttrs))

The problematic line is nAnnotations <- max(lengths(x$annotations) %||% 0).
If "font" contains multiple elements, it is a list of length > 1. Thus, even when only one annotation is present, lengths(x$annotations) is >1 and thus nAnnotations is > 1.

Because nAnnotations is >1, the line x$annotations <- purrr::transpose(lapply(x$annotations, function(x) { as.list(rep(x, length.out = nAnnotations)) repeats the annotation multiple times, and you end up with multiple repeated annotations that appear on the figure.

I'm working on a fix that will hopefully be able to discern between an irrelevent 'font' attribute and an attribute that is useful for counting annotations.

Update: One fix that seems to work is to make a subset of x$annotations that removes any elements that are of class "list" (which I believe should only apply to the 'font' attribute), and calculate nAnnotations based on this subset; code below:

  layouts <- Map(function(x,y) {
    d <- plotly_data(p, y)
    x <- rapply(x, eval_attr, data = d, how = "list")
    
    # if an annotation attribute is an array, expand into multiple annotations
    
    # Remove any elements from x$annotations that are of class 'list'
    # this will remove the 'font' attribute list while retaining relevent attributes
    x_annotations_subset <- Filter(function(x) !inherits(x, "list"), x$annotations)
    nAnnotations_fixed <- max(lengths(x_annotations_subset) %||% 0)
    
    if(!is.null(names(x$annotations))) {
      # font is the only list object, so store it, and attach after transposing
      font <- x$annotations[["font"]]
      x$annotations <- purrr::transpose(lapply(x$annotations, function(x) {
        as.list(rep(x, length.out = nAnnotations_fixed))
      }))
      print(paste0("transposed annotations: ", x$annotations))
      for(i in seq_len(nAnnotations_fixed)) {
        x$annotations[[i]][["font"]] <- font
      }
    }
    x[lengths(x) > 0]
  }, p$x$layoutAttrs, names2(p$x$layoutAttrs))