在R中使用facet_grid进行Plotly和ggplot：如何让yaxis标签使用ticktext值而不是范围值？

Question

我想使用ggplot2 facets with plotly但是我遇到的问题是y轴标签显示yaxis范围值而不是ticktext。我可以在plotly对象（使用plotly_build）中改变它以使其正确呈现。我真的很想在ggplots的闪亮应用中利用剧情的悬浮功能。我已经在plotly中找到了一些与facet相关的其他问题，但是大多数问题似乎都会重定向用户使用plotly子图而不是ggplot。在我的情况下，facet数据不会消失，yaxis就会被破坏。

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

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

如果我减少子图的数量，例如将mtcars数据集减少到只有几个模型，则问题似乎得到解决。为什么子图的影响会影响yaxis刻度标签？它看起来像破碎的小平面/组只有1个项目（除非它是第一个yaxis），具有多个项目的小平面（至少在本例中）正在正确地绘制yaxis。我可以在plotly对象（使用plotly_build）中改变它以使其正确呈现。我真的很想在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情节：

图中相同的情节打破了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布局与其他布局相同，但不需要修复，因为它已经正确显示。

修复整个情节需要更多调整。我尽量做到尽可能通用，但转换会为每个情节打破不同的东西。

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有类似的问题，无法进行转换，但想出了一个不同的解决方案。仍然不是很完美，但是通过一些调整，我相信您可以取得很好的结果：

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