ggplot2 - Plotly and ggplot with facet_grid in R: How to to get yaxis labels to use ticktext value instead of range value?

Question

I would like to use ggplot2 facets with plotly but am running into issues with the y-axis labels showing the yaxis range values instead of the ticktext. Is there something I can alter in the plotly object (using plotly_build) to get it to render correctly. I'd really like to leverage the hover features of plotly in a shiny app on ggplots. I have found a few other questions that are related to facets in plotly but most appear to redirect users to use plotly subplots instead of ggplot. In my case the facet data isn't disappearing, the yaxis is just broken.

Reference Question: Error plotting chart with facet_wrap and scales = "free" in plotly

See example code below with mtcars dataset that shows the issues with facets. If you look at the ggplot object the labels are correct.

If I reduce the number of subplots like reduce the mtcars data set to only a few models the issue appears to be resolved. Why would # of subplots impact the yaxis tick labels? It also looks like the facets/groups that are broken only have 1 item (unless it is the first yaxis), the facets that have more than 1 item (at least in this example) are plotting the yaxis correctly. Is there something I can alter in the plotly object (using plotly_build) to get it to render correctly. I'd really like to leverage the hover features of plotly in a shiny app on ggplots.

library(plotly)
library(ggplot2)
library(data.table)
library(datasets)

#add fake model for use in facet
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]

#Optional toggle: pick a few models and issue seems to go away 
#Use data=dt[model %in% c("Mazda","Merc","Toyota","Honda","Hornet")]
ggplot.test<-ggplot(dt,aes(mpg,car.id))+geom_point()+facet_grid(model~.,scales="free_y",space="free",drop=TRUE)

#check ggplot in Plots
ggplot.test

#broken ggplotly object in Viewer
ggplotly(ggplot.test)

ggplot Plot:

Same plot in plotly that has broken yaxis labels:

Answer 1

This looks like some weird artifact from the ggplot to Plotly conversion. Anyways, all what you need to do is to add an empty string to ticktext and expand tickvals by 1.

for (i in 2:22) {
  tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1
  p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
  p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''
}

The first yaxis layout is identical to the rest but does not need fixing since it already already correctly shown.

---

---

Fixing the whole plot needs some more tweaking. I tried to make as generic as possible but probably the conversion will break something different for each plot.

library(plotly)
library(ggplot2)
library(data.table)
library(datasets)    

#add fake model for use in facet
dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]

#Optional toggle: pick a few models and issue seems to go away 
#Use data=dt[model %in% c("Mazda","Merc","Toyota","Honda","Hornet")]
ggplot.test<-ggplot(dt,aes(mpg,car.id))+geom_point()+facet_grid(model~.,scales="free_y",space="free",drop=TRUE)

p <- ggplotly(ggplot.test)
len <- length(unique(dt$model))

total <- 1
for (i in 2:len) {
  total <- total + length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']])
}

spacer <- 0.01 #space between the horizontal plots
total_length = total + len * spacer
end <- 1
start <- 1

for (i in c('', seq(2, len))) {
  tick_l <- length(p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']]) + 1

  #fix the y-axis
  p[['x']][['layout']][[paste('yaxis', i, sep='')]][['tickvals']] <- seq(1, tick_l)
  p[['x']][['layout']][[paste('yaxis', i, sep='')]][['ticktext']][[tick_l]] <- ''

  end <- start - spacer
  start <- start - (tick_l - 1) / total_length
  v <- c(start, end)
  #fix the size
  p[['x']][['layout']][[paste('yaxis', i, sep='')]]$domain <- v
}

#fix the first entry which has a different name than the rest
p[['x']][['layout']][['annotations']][[3]][['y']] <- (p[['x']][['layout']][['yaxis']]$domain[2] + p[['x']][['layout']][['yaxis']]$domain[1]) /2
p[['x']][['layout']][['shapes']][[2]][['y0']] <- p[['x']][['layout']][['yaxis']]$domain[1]
p[['x']][['layout']][['shapes']][[2]][['y1']] <- p[['x']][['layout']][['yaxis']]$domain[2]

#fix the annotations
for (i in 3:len + 1) {
  #fix the y position
  p[['x']][['layout']][['annotations']][[i]][['y']] <- (p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[1] + p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]]$domain[2]) /2
  #trim the text
  p[['x']][['layout']][['annotations']][[i]][['text']] <- substr(p[['x']][['layout']][['annotations']][[i]][['text']], 1, length(p[['x']][['layout']][[paste('yaxis', i - 2, sep='')]][['ticktext']]) * 3 - 3)
}

#fix the rectangle shapes in the background
for (i in seq(0,(len - 2) * 2, 2)) {
  p[['x']][['layout']][['shapes']][[i+4]][['y0']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[1]
  p[['x']][['layout']][['shapes']][[i+4]][['y1']] <- p[['x']][['layout']][[paste('yaxis', i /2 + 2, sep='')]]$domain[2]
}
p