ggplotly/plotly 中的长 facet_wrap 标签重叠 strip.background

Long facet_wrap labels in ggplotly / plotly overlap facet's strip.background

我有一个如下图所示的图,我需要在其中显示图标题和一些长边标签。在ggplot2,看起来还不错。

代表:

library(ggplot2)
library(stringr)
library(plotly)

iris$Species2 <- paste(iris$Species, "... some text to make the label really long and hard to put on a facet label")
iris$Species2 <- str_wrap(iris$Species2, 20)

g <- ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
  geom_point() +
  labs(title = "This title isn't helping anyone") + 
  facet_wrap(~Species2)

g

但是,转换为动态图并没有按预期工作...分面标签被截断并且 运行 进入标题:

gp <- ggplotly(g)
gp

有一个 previous SO question about this,但看起来 OP 没有尝试答案 - 没有人发现建议的答案没有按预期工作。

我对 plotly 在涉及方面时有奇怪的行为并不陌生 - 请参阅对话 here on github,但我对 plotly 的了解还不足以修改 object 到 强制它有更长的 strip.background.

希望有人能帮我修改objectgp解决

gp <- ggplotly(g)
# move facet labels down
gp[["x"]][["layout"]][["annotations"]][[3]][["y"]] <- 0.85 
gp[["x"]][["layout"]][["annotations"]][[4]][["y"]] <- 0.85
gp[["x"]][["layout"]][["annotations"]][[5]][["y"]] <- 0.85

# extend y axis to make room to move facet box down
gp[["x"]][["layout"]][["yaxis"]][["range"]] <- c(1.88,5.5) 
# extend facet boxes down
gp[["x"]][["layout"]][["shapes"]][[2]][["y0"]] <- - 100 
gp[["x"]][["layout"]][["shapes"]][[4]][["y0"]] <- - 100 
gp[["x"]][["layout"]][["shapes"]][[6]][["y0"]] <- - 100

gp

根据的回答,我写了一个简化过程的函数:

原创

facet_strip_bigger <- function(gp){

  # n_facets should be the number of facets x2
  n_facets <- c(1:length(gp[["x"]][["layout"]][["shapes"]]))
  
  for(i in n_facets){
    if(n_facets[i] %% 2 == 0){
      gp[["x"]][["layout"]][["shapes"]][[i]][["y0"]] <- + 80 # increase as needed
      gp[["x"]][["layout"]][["shapes"]][[i]][["y1"]] <- 0
    }
  }
  
  return(gp)
}

所以在这种特殊情况下:

iris$Species2 <- paste(iris$Species, "... some text to make the label really long and 
    hard to put on a facet label")
iris$Species2 <- str_wrap(iris$Species2, 20)

g <- ggplot(iris, aes(Sepal.Length, Sepal.Width, color = Species)) +
  geom_point() +
  labs(title = "This title isn't helping anyone") + 
  theme(axis.title.y = element_blank(),
        axis.title.x = element_blank())+
  facet_wrap(~Species2) 

g %>% 
  ggplotly() %>% 
  layout(title = list(y = 0.96,
                      yanchor = "top",
                      yef = "container"),
         margin = list(t = 110),
         yaxis = list(title = list(text = "Sepal width",
                                   standoff = 10L)),
         xaxis = list(title = list(text = "Sepal length"))
         ) %>%
  facet_strip_bigger()

编辑

我改进了函数,size 是一个参数,所以每次需要更改大小时都不需要编辑函数。

facet_strip_bigger <- function(gp, size){
  if(missing(gp)){
    print("this function needs a facet_wrap ggplotly object")
  }
  if(missing(size)){
    print("this function needs 'size' argument to be specified as integer. 80 will be introduced as default")
    size <- 80
  }
  
  n_facets <- c(1:length(gp[["x"]][["layout"]][["shapes"]]))
  
  for(i in n_facets){
    if(n_facets[i] %% 2 == 0){
      gp[["x"]][["layout"]][["shapes"]][[i]][["y0"]] <- + as.numeric(size)
      gp[["x"]][["layout"]][["shapes"]][[i]][["y1"]] <- 0
    }
  }
  
  return(gp)
}