Question

我在ggplotly周围使用ggplot阻止y轴文本与刻度重叠时遇到问题。我怎样才能解决这个问题？我尝试过以下代码：

set.seed(395)
df1<- data.frame(CO2= c(cumsum(rnorm(1*36)), cumsum(rnorm(1*36))),
                  Group= rep(c("A","B"), each=36),
                  Segment=rep(seq(1,12),each=36))

plot<-ggplot(df1, aes(CO2, fill = Group)) +
           geom_density(alpha = 0.8)+
           facet_wrap(~ Segment)+
           theme_bw()+
           labs(x="CO2", y="density")
#Shouldn't the following work?
    pb <- plotly_build(plot)
    pb$layout$margin$l <- 200
    pb$layout$margin$b <- 100
    pb

Answer 1

让我们使用来自here的简单可重复示例。

library(gapminder)
library(plotly)
p <- ggplot(gapminder, aes(x=gdpPercap, y=lifeExp)) + geom_point() + scale_x_log10()
p <- p + aes(color=continent) + facet_wrap(~year)
gp <- ggplotly(p)

我们可以按照MLavoie的建议移动调整margins，但我们的轴图例也会移动。

gp %>% layout(margin = list(l = 75))

轴标签实际上不是标签而是注释，所以让我们先移动它。您可以在图gp中查询注释的结构：

# find the annotation you want to move
str(gp[['x']][['layout']][['annotations']]) 

List of 15
 $ :List of 13
  ..$ text          : chr "gdpPercap"
  ..$ x             : num 0.5
  ..$ y             : num -0.0294
  ..$ showarrow     : logi FALSE
  ..$ ax            : num 0
  ..$ ay            : num 0
  ..$ font          :List of 3
  .. ..$ color : chr "rgba(0,0,0,1)"
  .. ..$ family: chr ""
  .. ..$ size  : num 14.6
  ..$ xref          : chr "paper"
  ..$ yref          : chr "paper"
  ..$ textangle     : num 0
  ..$ xanchor       : chr "center"
  ..$ yanchor       : chr "top"
  ..$ annotationType: chr "axis"
 $ :List of 13
  ..$ text          : chr "lifeExp"
  ..$ x             : num -0.0346
  ..$ y             : num 0.5
.... <truncated>

好的，所以注释存储在15的列表中; ＆＃34; lifeExp＆＃34;是此列表的第二个（[[2]]）元素。＆＃34; x＆＃34; （[['x']]）和＆＃34; y＆＃34;值分别控制左右和上下移动。

# Check current x-location of x-axis label
gp[['x']][['layout']][['annotations']][[2]][['x']]
[1] -0.03459532

# Move the label further to the left
gp[['x']][['layout']][['annotations']][[2]][['x']] <- -0.1
gp %>% layout(margin = list(l = 75))

Answer 2

从Github中找到一个答案，可以很好地解决此问题。

layout_ggplotly <- function(gg, x = -0.02, y = -0.08){
  # The 1 and 2 goes into the list that contains the options for the x and y axis labels respectively
  gg[['x']][['layout']][['annotations']][[1]][['y']] <- x
  gg[['x']][['layout']][['annotations']][[2]][['x']] <- y
  gg
}
gp %>% layout_ggplotly

Answer 3

我发现以上两个答案都非常有用。但是，我注意到，上面给出的layout_ggplotly()函数仅在存在x和y轴标题时才能正常工作。如果缺少其中任何一个（例如，由于theme(axis.title.x = element_blank())导致的情况），则使用...[[1]]...和...[[2]]...的位置引用是指错误的标题/注释。

我在我的项目中编写了一个函数来解决这种局限性，我相信这是建立在先前答案的基础上的。

annotatify <- function(gg, x.y = -0.05, y.x = -0.05) {
  wip <- gg[['x']][['layout']][['annotations']] %>% 
    enframe() %>%
    mutate(value = map(value, as_tibble)) %>% 
    unnest(cols = c(value)) %>% 
    filter(!is.na(annotationType)) %>% 
    mutate(
      x = case_when(x == 0.5 ~ x, TRUE ~ x.y),
      y = case_when(y == 0.5 ~ y, TRUE ~ y.x)
    ) %>% 
    select(name, text, x, y) %>% 
    unique()

  if (nrow(wip) == 2) {
    for (i in 1:nrow(wip)) {
      if (wip$x[i] == 0.50) {
        gg[['x']][['layout']][['annotations']][[1]][['y']] <- wip$y[i]
      } else {
        gg[['x']][['layout']][['annotations']][[2]][['x']] <- wip$x[i]
      }
    }
  } else if (wip$y == 0.5) {
    gg[['x']][['layout']][['annotations']][[1]][['x']] <- wip$x
  } else {
    gg[['x']][['layout']][['annotations']][[1]][['y']] <- wip$y
  }

  gg
}

R：ggplot和plotly轴边距不会改变

3 个答案: