r - R : How to to get yaxis labels to use ticktext value instead of range value? 中带有 facet_grid 的 Plotly 和 ggplot

Question

我想将 ggplot2 facets 与 plotly 一起使用，但遇到了显示 yaxis 范围值而不是 ticktext 的 y 轴标签的问题。有什么我可以在 plotly 对象中改变的东西(使用 plotly_build)来让它正确渲染。我真的很想在 ggplots 上的 Shiny 应用程序中利用 plotly 的悬停功能。我发现了一些与 plotly 中的方面相关的其他问题，但大多数问题似乎将用户重定向到使用 plotly 子图而不是 ggplot。在我的情况下，facet 数据没有消失，yaxis 只是坏了。

引用问题:
Error plotting chart with facet_wrap and scales = "free" in plotly

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

如果我减少子图的数量，比如将 mtcars 数据集减少到只有几个模型，问题似乎得到了解决。为什么 # of subplots 会影响 yaxis 刻度标签？看起来被破坏的构面/组也只有 1 个项目(除非它是第一个 yaxis)，具有超过 1 个项目的构面(至少在本例中)正在正确绘制 yaxis。有什么我可以在 plotly 对象中改变的东西(使用 plotly_build)来让它正确渲染。我真的很想在 ggplots 上的 Shiny 应用程序中利用 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 :


plotly 中的相同图已损坏 yaxis 标签:

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 布局与其余部分相同，但不需要修复，因为它已经正确显示。



修复整个 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)

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