使用帶有 ggplotly 的 facet_wrap 的第一個和最后一個面大於中間面

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)

返回類似：

與第一個和最后一個相比，內部刻面的縮放比例非常驚人，並且有很多額外的填充。 我試圖從這些問題中找到解決方案：

當數量更多時，ggplotly無法正常工作

R：在 Shiny 應用程序中使用 ggplotly 無法正確渲染 facet_wrap

經過反復試驗，我在theme()中使用panel.spacing.x = unit(-0.5, "line") ，它看起來好多了，很多額外的填充消失了，但內部方面仍然明顯更小。

同樣作為一個額外的問題但不是那么重要，當我將條形標簽設置在底部時，條形標簽是ggplotly()調用中的頂部。 這里似乎是一個持續存在的問題，有沒有人有一個hacky解決方法？

編輯：在我的真實數據集中，我需要每個方面的 y 軸標簽，因為它們的比例非常不同，所以我將它們保留在示例中，這就是我需要facet_wrap的原因。 我的真實數據集的屏幕截圖以供解釋：

Answer 1

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

我整理了一個 function fixfacets(fig, facets, domain_offset) ，它變成了這樣：

...通過使用這個：

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

...進入這個：

這個 function 現在在方面的數量方面應該非常靈活。

完整代碼：

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. x label 注釋通過fig$x$layout$annotations ，
2. x label 形狀通過fig$x$layout$shapes ，和
3. position，其中每個方面通過fig$x$layout$xaxis$domain沿 x 軸開始和停止

例如，唯一真正的挑戰是在許多其他形狀和注釋中引用正確的形狀和注釋。 下面的代碼片段將執行此操作以生成以下 plot：

代碼片段可能需要對每個案例的方面名稱和名稱數量進行一些仔細的調整，但代碼本身是非常基本的，所以你不應該有任何問題。 當我有時間時，我會自己多打磨一下。

完整代碼：

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 。 我仍然希望有人能提出更好的答案。 但這是我要做的：

Plot 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設置得足夠大來為滾動條騰出空間。

Plot 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'就可以正常工作。

Plot 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

Answer 2

有時，如果您對所選的 plot 感到困惑，那么考慮完全不同的 plot 會有所幫助。 這一切都取決於您希望可視化的是什么。 有時箱形圖有效，有時直方圖有效，有時密度有效。 這是密度 plot 如何讓您快速了解許多參數的數據分布的示例。

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())