Search code examples
rshinyplotly

R Plotly is showing extra random arrows while using subplot


I wrote a function to generate multiple graphs in plotly. In each of those graph, I am only adding annotations for last data point.

To plot all those graphs at once, I am using subplot function. This however shows some extra arrows on the graph. I'm not sure what I am doing wrong, where they are coming from, or how do I turn them off. (Turning them white wouldn't be a solution as they are also problamatic in the sense that their position stays relatively constant if eg Y axis is formatted as %- they just dwarf everything)

enter image description here

Really appreciate some assistance with this.

library(plotly)
library(tibble)
library(dplyr)


# A function to generate plots in the required format
plotbundlefunction<-function(data1,ttitle){
  mypalette <- c("#4E79A7","#F28E2B","#E15759","#76B7B2","#59A14F","#EDC948","#B07AA1","#FF9DA7","#9C755F","BAB0AC") %>% head(ncol(data1)-1)
  lineannot<-c()
  for(i in 2:ncol(data1)){  
    lineannot[[i]]<-list(x = tail(na.omit(data1 %>% select('ID',i)),n=1L)[['ID']], y = tail(na.omit(data1[[i]]),n=1L), text = tail(na.omit(data1[[i]]),n=1L),
                         font=list(color=mypalette[i-1]),xanchor = "left", bgcolor="#D4D8DF", showarrow = F)
  }
  
  p <- plot_ly()
  for(i in 2:ncol(data1)){
    p<-add_trace(p,x=data1[['ID']],y=data1[[i]],name=colnames(data1)[i], type='scatter', mode='lines')
  }
  p %>% layout(colorway=mypalette, annotations = lineannot) %>% return()
}

# Numerous dataframe representing snapshot at a point in time for same data characteristics
dflist<-list(
  KPI1 = data.frame(ID=c(1,2,3,4,5), Japan=c(100,98,97,95,94), Korea = c(100,97,94,91,87) , Laos=c(100,97,94,90,84)),
  KPI2 = data.frame(ID=c(1,2,3,4,5), Japan=c(5,7,8,9,3)      , Korea = c(6,8,7,9,5)       , Laos=c(7,5,5,2,1)),
  KPI3 = data.frame(ID=c(1,2,3,4,5), Japan=c(78,89,56,48,92) , Korea = c(42,49,85,99,72)  , Laos=c(78,58,88,87,68))
)

#Iterate over a function that generates a separate graph for each columns across dataframes 
mainplotset<-lapply(1:length(dflist),function(s){
  plotbundlefunction(dflist[[names(dflist)[s]]],names(dflist)[s])
})

#Do a subplot to show all results 
subplot(mainplotset,nrows = 1,margin=0.05)

Solution

  • Update based on your comment

    As I pointed out in my comment after I already posted this answer, the actual solution is the revise the for statement that creates the annnotations. Instead of

    for(i in 2:ncol(data1)){  
      lineannot[[i]] <- ...
    

    It should be

    for(i in 2:ncol(data1)){  
      lineannot[[i - 1]] <- ...
    

    On to how I found the arrows...

    I meant to include how I came up with the annotations traces, sorry about leaving that out!

    I can't think of any way an arrow can get into a plot without annotations, so I knew where to start. So first, I set the subplot to an object and looked at whether showarrow was set to TRUE or FALSE.

    plt <- subplot(mainplotset,nrows = 1,margin=0.05)
    
    invisible(lapply(
      1:length(plt$x$layout$annotations),
      function(k) {
        res <- plt$x$layout$annotations[[k]]$showarrow
        message("arrow? ", k, " ", res)
      }
    ))
    

    The default for annotations is showarrow = TRUE, so that's why your plots were returned with arrows.

    Original answer

    Such an odd error! I'm not sure how to prevent this error. (I'm still trying to figure that out.) In the meantime, I thought I could give you a way to fix it.

    I used lapply to find out what traces were creating these arrows.

    plt <- subplot(mainplotset, nrows = 1, margin = 0.05)
    
    # arrow? 1 
    # arrow? 2 FALSE
    # arrow? 3 FALSE
    # arrow? 4 FALSE
    # arrow? 5 
    # arrow? 6 FALSE
    # arrow? 7 FALSE
    # arrow? 8 FALSE
    # arrow? 9 
    # arrow? 10 FALSE
    # arrow? 11 FALSE
    # arrow? 12 FALSE
    

    When I looked at the traces that didn't indicate true or false, there was nothing in the traces except xref and yref.

    To remove them:

    plt$x$layout$annotations <- plt$x$layout$annotations[c(-1, -5, -9)]
    plt
    

    enter image description here