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

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

我想将 ggplot2 facets 与 plotly 一起使用,但 运行 遇到了显示 yaxis 范围值而不是 ticktext 的 y 轴标签的问题。我可以在 plotly 对象中更改某些内容(使用 plotly_build)以使其正确呈现。我真的很想在 ggplots 上的闪亮应用程序中利用 plotly 的悬停功能。我在 plotly 中发现了一些与 facets 相关的其他问题,但大多数问题似乎将用户重定向为使用 plotly 子图而不是 ggplot。在我的例子中,facet 数据并没有消失,只是 yaxis 坏了。

参考问题:

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

如果我减少子图的数量,例如将 mtcars 数据集减少到只有几个模型,问题似乎就得到了解决。为什么子图的数量会影响 yaxis 刻度标签?看起来损坏的 facets/groups 只有 1 个项目(除非它是第一个 yaxis),具有超过 1 个项目的方面(至少在这个例子中)正在正确绘制 yaxis。我可以在 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 中的同一图已损坏 yaxis 标签:

这看起来像是从 ggplotPlotly 转换的一些奇怪的人工制品。 无论如何,您需要做的就是向 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

我对 ggplot 到 plotly conversion 有类似的问题,但想出了一个不同的解决方案。仍然不完美,但通过一些调整我相信你可以取得很好的结果:

#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))