首个和最后一个使用facet_wrap的ggplotly图像中的面板比中间的面板要大

Question

使用样本数据：

library(tidyverse)
library(plotly)

myplot <- diamonds %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, ncol = 8, scales = "free", strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

ggplotly(myplot)

返回类似这样的内容：

返回类似这样的东西：

里面的细节与第一个和最后一个相比严重缩放，而且有很多额外的填充。我试图从这些问题中找到一个解决方案：

当数量为facet较多时，ggplotly不正常工作

R：facet_wrap在Shiny应用程序中无法正确呈现ggplotly

通过反复试验，我在theme()中使用了panel.spacing.x = unit(-0.5, "line")，看起来好多了，很多额外的填充都消失了，但内部facet仍然明显较小。

此外，虽然不是很重要，但带标签的条纹是在ggplotly()调用中的顶部，当我将它们设置为底部时。似乎一直存在问题这里，有没有什么hacky的解决方法？

编辑：在我的真实数据集中，由于它们的刻度差异非常大，因此我需要每个facet的y轴标签，因此我保留了它们，并且这就是我需要facet_wrap的原因。 我真实数据集的截图如下：

- Nautica

Answer 1

更新的答案（2）：只需使用fixfacets()

我编写了一个函数fixfacets(fig, facets, domain_offset)用于将这个图表：

...通过以下方式处理：

f <- fixfacets(figure = fig, facets <- unique(df$clarity), domain_offset <- 0.06)

...变成这个：

现在，这个函数对于不同数量的分面应该都很灵活。

完整代码如下：

library(tidyverse)
library(plotly)

# YOUR SETUP:

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free', shrink = FALSE, ncol = 8, strip.position = "bottom", dir='h') +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())
fig <- ggplotly(myplot)

# Custom function that takes a ggplotly figure and its facets as arguments.
# The upper x-values for each domain is set programmatically, but you can adjust
# the look of the figure by adjusting the width of the facet domain and the 
# corresponding annotations labels through the domain_offset variable
fixfacets <- function(figure, facets, domain_offset){

  # split x ranges from 0 to 1 into
  # intervals corresponding to number of facets
  # xHi = highest x for shape
  xHi <- seq(0, 1, len = n_facets+1)
  xHi <- xHi[2:length(xHi)]

  xOs <- domain_offset

  # Shape manipulations, identified by dark grey backround: "rgba(217,217,217,1)"
  # structure: p$x$layout$shapes[[2]]$
  shp <- fig$x$layout$shapes
  j <- 1
  for (i in seq_along(shp)){
    if (shp[[i]]$fillcolor=="rgba(217,217,217,1)" & (!is.na(shp[[i]]$fillcolor))){
       #$x$layout$shapes[[i]]$fillcolor <- 'rgba(0,0,255,0.5)' # optionally change color for each label shape
       fig$x$layout$shapes[[i]]$x1 <- xHi[j]
       fig$x$layout$shapes[[i]]$x0 <- (xHi[j] - xOs)
       #fig$x$layout$shapes[[i]]$y <- -0.05
       j<-j+1
    }
  }

  # annotation manipulations, identified by label name
  # structure: p$x$layout$annotations[[2]]
  ann <- fig$x$layout$annotations
  annos <- facets
  j <- 1
  for (i in seq_along(ann)){
    if (ann[[i]]$text %in% annos){
       # but each annotation between high and low x,
       # and set adjustment to center
       fig$x$layout$annotations[[i]]$x <- (((xHi[j]-xOs)+xHi[j])/2)
       fig$x$layout$annotations[[i]]$xanchor <- 'center'
       #print(fig$x$layout$annotations[[i]]$y)
       #fig$x$layout$annotations[[i]]$y <- -0.05
       j<-j+1
    }
  }

  # domain manipulations
  # set high and low x for each facet domain
  xax <- names(fig$x$layout)
  j <- 1
  for (i in seq_along(xax)){
    if (!is.na(pmatch('xaxis', lot[i]))){
      #print(p[['x']][['layout']][[lot[i]]][['domain']][2])
      fig[['x']][['layout']][[xax[i]]][['domain']][2] <- xHi[j]
      fig[['x']][['layout']][[xax[i]]][['domain']][1] <- xHi[j] - xOs
      j<-j+1
    }
  }

  return(fig)
}

f <- fixfacets(figure = fig, facets <- unique(df$clarity), domain_offset <- 0.06)
f

更新的答案（1）：如何通过编程处理每个元素！

需要进行一些编辑以满足您对于维护每个分面的比例和修复奇怪布局方面需求的图形元素包括：

1. 通过 fig$x$layout$annotations 处理 x 轴标签注释，
2. 通过 fig$x$layout$shapes 处理 x 轴标签形状，以及
3. 通过 fig$x$layout$xaxis$domain 处理每个分面在 x 轴上的起始和结束位置。

唯一的真正挑战是引用正确的形状和注释，例如在众多形状和注释中引用正确的形状和注释。下面的代码片段将完全做到这一点，以生成以下图形：

针对每种情况，代码片段可能需要进行一些仔细的调整，包括分面名称和名称数量，但代码本身非常基本，因此您不应该有任何问题。我会在找到时间时进一步完善它。

完整代码：

ibrary(tidyverse)
library(plotly)

# YOUR SETUP:

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free', shrink = FALSE, ncol = 8, strip.position = "bottom", dir='h') +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())
#fig <- ggplotly(myplot)

# MY SUGGESTED SOLUTION:

# get info about facets
# through unique levels of clarity
facets <- unique(df$clarity)
n_facets <- length(facets)

# split x ranges from 0 to 1 into
# intervals corresponding to number of facets
# xHi = highest x for shape
xHi <- seq(0, 1, len = n_facets+1)
xHi <- xHi[2:length(xHi)]

# specify an offset from highest to lowest x for shapes
xOs <- 0.06

# Shape manipulations, identified by dark grey backround: "rgba(217,217,217,1)"
# structure: p$x$layout$shapes[[2]]$
shp <- fig$x$layout$shapes
j <- 1
for (i in seq_along(shp)){
  if (shp[[i]]$fillcolor=="rgba(217,217,217,1)" & (!is.na(shp[[i]]$fillcolor))){
     #fig$x$layout$shapes[[i]]$fillcolor <- 'rgba(0,0,255,0.5)' # optionally change color for each label shape
     fig$x$layout$shapes[[i]]$x1 <- xHi[j]
     fig$x$layout$shapes[[i]]$x0 <- (xHi[j] - xOs)
     j<-j+1
  }
}

# annotation manipulations, identified by label name
# structure: p$x$layout$annotations[[2]]
ann <- fig$x$layout$annotations
annos <- facets
j <- 1
for (i in seq_along(ann)){
  if (ann[[i]]$text %in% annos){
     # but each annotation between high and low x,
     # and set adjustment to center
     fig$x$layout$annotations[[i]]$x <- (((xHi[j]-xOs)+xHi[j])/2)
     fig$x$layout$annotations[[i]]$xanchor <- 'center'

     j<-j+1
  }
}

# domain manipulations
# set high and low x for each facet domain
lot <- names(fig$x$layout)
j <- 1
for (i in seq_along(lot)){
  if (!is.na(pmatch('xaxis', lot[i]))){
    #print(p[['x']][['layout']][[lot[i]]][['domain']][2])
    fig[['x']][['layout']][[lot[i]]][['domain']][2] <- xHi[j]
    fig[['x']][['layout']][[lot[i]]][['domain']][1] <- xHi[j] - xOs
    j<-j+1
  }
}

fig

基于内置功能的初始答案

---

由于许多变量具有非常不同的值，无论如何，您似乎都将得到具有挑战性的格式，这意味着要么

1. 单元格宽度会有所不同，或者
2. 标签将覆盖单元格或太小以无法阅读，或者
3. 图形将过宽而无法在没有滚动条的情况下显示。

因此，我建议您为每个唯一的清晰度和设置重新缩放您的price列，并设置scale='free_x'。我仍然希望有人能提出更好的答案。但以下是我的做法:

图1: 重新缩放的值和scale='free_x'

代码1:

#install.packages("scales")
library(tidyverse)
library(plotly)
library(scales)

library(data.table)
setDT(df)

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

# rescale price for each clarity
setDT(df)
clarities <- unique(df$clarity)
for (c in clarities){
  df[clarity == c, price := rescale(price)]
}

df$price <- rescale(df$price)

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free_x', shrink = FALSE, ncol = 8, strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

p <- ggplotly(myplot)
p

这当然只会提供每个类别内部分布的洞察力，因为数值已经重新缩放。如果您想显示原始价格数据并保持可读性，则建议通过设置足够大的width来为滚动条腾出空间。

图表2：scales='free'和足够大的宽度：

代码2：

library(tidyverse)
library(plotly)

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free', shrink = FALSE, ncol = 8, strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

p <- ggplotly(myplot, width = 1400)
p

当然，如果您的值在不同类别之间变化不太大，scales='free_x' 就可以正常工作。

图 3：scales='free_x'

代码 3：

library(tidyverse)
library(plotly)

df <- data.frame(diamonds)

df['price'][df$clarity == 'VS1', ] <- filter(df['price'], df['clarity']=='VS1')*2

myplot <- df %>% ggplot(aes(clarity, price)) +
  geom_boxplot() +
  facet_wrap(~ clarity, scales = 'free_x', shrink = FALSE, ncol = 8, strip.position = "bottom") +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

p <- ggplotly(myplot)
p

- vestland

---

我对这个答案的效果抱有很高的期望，因为自2017年以来，plotly似乎一直没有解决这个问题：https://github.com/plotly/plotly.R/issues/1099 我认为plotly的各个部分名称随着时间的推移发生了变化，导致出现错误，也没有实现预期的效果。我意识到这个评论毫无帮助，但是我还是留在这里给那些希望快速解决问题的人！看起来这是一个复杂的问题。 - Ashley Asmus

Answer 2

如果你对所选的图形有困难，考虑使用完全不同的图形可能会有帮助。这完全取决于你想要可视化的内容。有时箱线图有效，有时直方图有效，有时密度图有效。

以下是一个示例，说明如何使用密度图快速了解多个参数的数据分布情况。

library(tidyverse)
library(plotly)
myplot <- diamonds %>% ggplot(aes(price, colour = clarity)) +
  geom_density(aes(fill = clarity), alpha = 0.25) +
  theme(axis.ticks.x = element_blank(),
        axis.text.x = element_blank(),
        axis.title.x = element_blank())

- Paul van Oppen