plot_ly刻面/网格面板标签和固定高度

Question

假设我有这个可爱的ggplot

library(plotly) 
library(tidyverse) 

mpg2=mpg%>% 
    filter(manufacturer%>%as.factor%>%as.numeric<6)%>% 
    group_by(manufacturer,model)%>% 
    summarize(hwy=mean(hwy))%>% 
    mutate(model=reorder(model,hwy)) 

myggplot=mpg2%>% 
    ggplot(aes(x=model,y=hwy))+ 
    geom_col()+ 
    coord_flip()+ 
    facet_grid(manufacturer~.,scales="free",space="free")+ 
    theme(legend.position="none", 
     axis.text.y=element_text(), 
     axis.title.y=element_blank(), 
     axis.text.x=element_text(size=12), 
     strip.text.y = element_text(angle = 0)) 

myggplot 

看起来不错，然后我尝试plotlify它，

ggplotly(myggplot) 

三个问题。

1. 带1条的小平面只有一个数字yaxis标签。
2. 横杠宽度在各个方面不相同（我的space =“free”参数丢失）。
3. 标签（y轴标签和facet标签均离开屏幕）。

那么，我该如何解决它？

我也试过本身做这件事，这是我迄今达成，

myplotly=mpg2%>% 
    nest(-manufacturer)%>% 
    mutate(plty=map(data,function(d){ 
    plot_ly(d,x=~hwy,y=~model,type="bar") %>% 
     layout(showlegend = FALSE) 
    }))%>% 
    select(plty)%>% 
    subplot(nrows=5,shareX=T,heights = table(mpg2$manufacturer)%>%prop.table%>%unname()) 

myplotly 

一个怎样完成的呢？

Answer 1

我尝试了一些手动更正ggplotly输出：

library(plotly) 
library(tidyverse) 

mpg2 <- mpg %>% 
    filter(manufacturer %>% as.factor %>% as.numeric<6) %>% 
    group_by(manufacturer,model) %>% summarize(hwy=mean(hwy)) %>% 
    mutate(model=reorder(model,hwy)) 

myggplot <- mpg2 %>% 
    ggplot(aes(x=model,y=hwy)) + geom_col() + 
    coord_flip() + facet_grid(manufacturer~.,scales="free",space="free") + 
    theme(legend.position="none", axis.text.y=element_text(), 
     axis.title.y=element_blank(), axis.text.x=element_text(size=12), 
     strip.text.y = element_text(angle = 0)) 

# Set dimensions and margins 
g <- ggplotly(myggplot, height=800, width=1200) %>% 
layout(autosize=F, margin=list(l=170,r=70,b=50,t=50,pad=10)) 

# Modify tick labels of Honda bar 
g$x$layout$yaxis5$tickvals <- 1:2 
g$x$layout$yaxis5$ticktext <- c("civic","") 

# Modify widths of Honda and Audi bars 
g$x$data[[5]]$width <- g$x$data[[5]]$width/4 
g$x$data[[1]]$width <- 3*g$x$data[[1]]$width/4 

# Modify positions of facet labels 
for (k in seq(2,10,2)) { 
    g$x$layout$shapes[[k]]$x1 <- 1.15 
} 
for (k in 1:6) { 
    g$x$layout$annotations[[k]]$xanchor <- "center" 
    g$x$layout$annotations[[k]]$x <- 1.0375 
} 

print(g) 

结果是比以前好，但并不完美。
希望它能帮助你。