R中带有facet_grid的Plotly和ggplot：如何获取yaxis标签以使用ticktext值而不是范围值？

Question

我想在 plotly 中使用 ggplot2 构面，但遇到了 y 轴标签显示 y 轴范围值而不是刻度文本的问题。我可以在 plotly 对象中更改某些内容（使用 plotly_build）以使其正确渲染。我真的很想在 ggplots 上的闪亮应用程序中利用 plotly 的悬停功能。我发现了一些与情节相关的其他问题，但大多数似乎将用户重定向到使用情节子图而不是 ggplot。在我的情况下，构面数据并没有消失，y轴只是坏了。

参考问题： Error plotting chart with facet_wrap and scales = "free" in plotly

请参阅下面的示例代码，其中包含显示方面问题的 mtcars 数据集。如果您查看 ggplot 对象，则标签是正确的。

如果我减少子图的数量，例如将 mtcars 数据集减少到仅几个模型，则问题似乎得到了解决。为什么 # of subplots 会影响 yaxis 刻度标签？看起来被破坏的构面/组只有 1 个项目（除非它是第一个 y 轴），具有 1 个以上项目的构面（至少在此示例中）正确绘制 y 轴。我可以在 plotly 对象中更改什么（使用 plotly_build）以使其正确渲染。我真的很想在 ggplots 上的闪亮应用中利用 plotly 的悬停功能。

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 情节：

plotly 中的相同图已损坏 y 轴标签：

Answer 1

这看起来像是从ggplot 到Plotly 转换的一些奇怪的工件。 无论如何，您需要做的就是向ticktext 添加一个空字符串并将tickvals 扩展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]] <- ''
}

第一个 yaxis 布局与其他布局相同，但不需要修复，因为它已经正确显示。

---

---

修复整个情节需要更多调整。我试图使尽可能通用，但转换可能会破坏每个情节的不同之处。

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

Answer 2

我在 ggplot 到 plotly 转换时遇到了类似的问题，但我想出了一个不同的解决方案。仍然不完美，但通过一些调整我相信你可以取得非常好的结果：

#Using your original dt dataframe

dt<-data.table(mtcars)
dt[,car.id:=rownames(mtcars)]
dt[,model:=substr(car.id,1,regexpr(" ",car.id)-1)][model=="",model:=car.id]



#define plot xaxis limits (+/- 10%)

limits <- dt %>%
  summarise(max = ceiling(max(mpg*1.1)),
            min = floor(min(mpg*0.9)))


#define height of subplots by finding the number of cars in each "facet"

plot_height<- dt %>%
  group_by(model) %>%
  count() %>%
  ungroup() %>%
  mutate(height_pct = n/sum(n))


#define a list of ggplots and feed it in the subplot function with the calculated limits

dt %>%
  split(.$model) %>%
  map(function(x) {
    ggplot(data=x,aes(mpg,car.id)) + geom_point()+
      facet_grid(model~.) + xlim(c(limits$min,limits$max))
  }) %>%
  subplot(margin = 0.005, shareX = T,heights = plot_height$height_pct,nrows = nrow(plot_height))