plot_ly faceting/trellis panel label and fixed height

Question

Suppose I have this lovely 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

looks good, then I try to plotlify it,

ggplotly(myggplot)

three problems.

1. the facet with 1 bar only has a numeric yaxis label.
2. the bar width is not identical across facets (my space="free" argument is lost).
3. the labels (both y axis labels and facet labels go off-screen).

So, how do I fix it?

I also tried doing it natively, and this is what I have reached so far,

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

How would one finish it?

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)

结果比以前好，但不完美 希望它可以帮到你。

Answer 2

我遇到了类似的问题，并进一步回答了马可的问题。我希望这会帮助其他人。谢谢。

library(ggplot2)
library(plotly, warn.conflicts=FALSE)
mtcars<-head(mtcars, n=2L)
mtcars$name<-rownames(mtcars)

p<-ggplot(data=mtcars,aes(wt,cyl))+geom_point()+facet_grid(name~carb)+
   theme(strip.text.y=element_text(angle=0, size=7),
         axis.text = element_text(size=7))
p
q <- ggplotly(p, height=700)

#Find the maximal x1 value of q's shapes. These shapes are the rectangles of the right-side facet labels.
x1<-vector()
for (k in 1:length(q$x$layout$shapes)){
  x1 <- c(x1,q$x$layout$shapes[[k]]$x1)
}
x1_to_change <- max(x1)

#Change all those maximal x1 values to something yuge:
for (k in 1:length(q$x$layout$shapes)){
  if(q$x$layout$shapes[[k]]$x1==x1_to_change){
     q$x$layout$shapes[[k]]$x1 <- 1000
  }
}

required_right_margin <- 5*max(nchar(mtcars$name))  #a tentative guesstimate

#Enlarge right margin to make space for right-side facet labels: 
q %>% layout(autosize=FALSE, margin=list(r=required_right_margin))