Plotly doesn't render the plot correctly

Question

I am trying to make a plot created with the trace_explorer function from buraR package interactive using the ggplotly function but the resulting plot is not the expected.

Here is the code :

library(ggplot2)
library(bupaR)

patients <- eventdataR::patients # dataset from bupaR

df <- eventlog(patients,
               case_id = "patient",
               activity_id = "handling",
               activity_instance_id = "handling_id",
               lifecycle_id = "registration_type",
               timestamp = "time",
               resource_id = "employee")




tr <- df %>% processmapR::trace_explorer(type = "frequent", coverage = 1.0)

# tr # print the ggplot to see the expected output!
ggplotly(tr)

and the resulting plot

I tried to use the theme option in ggplot2 and then the layout function but the result is still the same without the legend.

ggtrace <- trace_explorer(df,
                          type = "frequent", 
                          coverage = 1.0)

ggtrace <- ggtrace + 
  theme (legend.position="none") +
  theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank()
  )

plotly_trace <- ggplotly(ggtrace)

layout(plotly_trace, 
                    margin=list(l=50, b=50), 
                    legend=list(x=1.05)
)

The expected out should be a like the original ggplot but with interactive options coming from plotly.

Note I am using previous version of the packages and want to keep these versions.

> packageVersion('ggplot2')
[1] ‘3.3.0’
> packageVersion('bupaR')
[1] ‘0.5.2’

Answer 1

It's been a while since you asked, but I just came across your question. Lots of odd things happened in the conversion from ggplot to plotly here.

I have written a UDF to address the 3 primary issues that are presented: annotations, shapes, and the y-axis grid.

The annotations:

This is the text in the gray boxes on the right side. In the ggplotly object, this became "xx.x%<br />xxx<br />xx.x%" which is odd! The first two annotations are actually the axis titles, which is also a bit strange. I left the axis labels as is. The remaining annotations are those found in the gray boxes. That's why you'll see from 3:length(plt$x$layout$annotations) in the first call for lapply. Within these fixes, I obtain each annotation, split the string of values ("xx.x%<br />xxx<br />xx.x%"), and create an annotation for each value. I changed the text to be centered, instead of left justified. Lastly, I change the text position to increment based on the number of strings (so that the numbers are not on top of each other).

The shapes:

These are the gray backgrounds of the shapes and the rectangles around each horizontal row. The shapes alternate: rectangle, gray block, rectangle and so on. So to capture the shapes that are necessary for modification, the if function looks for even index values between one and the number of shapes in the plot. If even, the shape size is changed to a dynamic, instead of fixed size (so it grows or shrinks if your plot does), the text is centered, and the start positions are increased between the 3 blocks so they aren't on top of each other. Lastly, the widths are set to .19 (19% of the plot size) from their start position. (This .19 is selected due to the .20 I used to increment the block positions by, leaving .1 of which is the white line between blocks.)

The grid for the y-axis:

The reason you have this mess of lines about each of the rows of data is that the y-axis grid is used, whether you designate this or not in ggplot. So the last step of the UDF is to change each y-axis (one for each row in your plot) to showgrid = F.

This uses the object plotly_trace as presented in your question. (The layout arguments you provided aren't utilized.) There are comments within the code to help explain what is happening. It could be consolidated a bit more, but I think it might be easier to follow as it's written.

I've included your code as it was used in my answer.

library(tidyverse)
library(bupaR)
library(plotly)

patients <- eventdataR::patients # dataset from bupaR

df <- eventlog(patients,
               case_id = "patient",
               activity_id = "handling",
               activity_instance_id = "handling_id",
               lifecycle_id = "registration_type",
               timestamp = "time",
               resource_id = "employee")

tr <- df %>% processmapR::trace_explorer(type = "frequent", coverage = 1.0)

# tr # print the ggplot to see the expected output!
ggplotly(tr)

ggtrace <- trace_explorer(df,
                          type = "frequent", 
                          coverage = 1.0)

(ggtrace <- ggtrace + 
  theme (legend.position="none") +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank()
  ))

plotly_trace <- ggplotly(ggtrace)

buParFix <- function(plt) {
  # annotations 1 & 2 are actually the axis labels (odd)
  repAnn <- invisible(lapply(3:length(plt$x$layout$annotations), function(k) {
    # get text, create separate annot for each text
    tx <- plt$x$layout$annotations[[k]]$text
    trs <- strsplit(tx, "<br />")[[1]] %>% imap(., function(i, j) {
      otr <- plt$x$layout$annotations[[k]]         # collect & copy annot
      otr$text <- i
      otr$xanchor <- "center"                      # horizontal alignment
      otr$x <- 1.1 + ((j - 1) * .2)                # move to the right each iter
      otr
    }) 
    trs
  })) %>% unlist(recursive = F)                    # remove one list of lists level
                                                   # fix text in end caps
  plt$x$layout$annotations <- append(plt$x$layout$annotations[1:2], repAnn)  
  
  shps <- invisible(lapply(1:length(plotly_trace$x$layout$shapes), function(q) {
    if(q %% 2 == 0) {
      tr <- plotly_trace$x$layout$shapes[[q]]      # collect & copy shape
      tr$xsizemode = "scaled"                      # make width dynamic
      tr$xref = "paper"                            # use paper space
      trts <- map(1:3, function(k) {               # three columns to the right
        tr$x0 <- 1 + ((k - 1) * .2)                # set x0 and x1
        tr$x1 <- tr$x0 + .19                       # move to the right each iter
        tr
      })
      return(append(plotly_trace$x$layout$shapes[q - 1], trts)) # return updated shapes
    }
  })) %>% unlist(recursive = F)                    # remove one list of lists level
  
  plt$x$layout$shapes <- shps                      # fix gray background end caps
  
  # fix grid for y-axes
  ys <- length(which(startsWith(names(plt$x$layout), "yaxi"))) # count of y-axes
  lapply(paste0("yaxis", c("", 2:ys)), function(i) {     # hide grid for each
    plt$x$layout[[i]]$showgrid <<- F
  })
  plt %>% layout(margin = list(r = 200))                 # return modified plot
}
buParFix(plotly_trace)