具有独立轴 R 的背靠背条形图答案

【问题标题】：back-to-back barplot with independent axes R具有独立轴 R 的背靠背条形图
【发布时间】：2021-04-25 06:26:05
【问题描述】：

我想绘制背靠背的条形图，但是每一边都在一个独立的轴上。我可以通过取一组负数来将它们背靠背地绘制出来，但这会使它们处于相同的访问权限，并且因为 pvalues 较小，它们的条形几乎没有被表示出来。

library(ggplot2)
df <-structure(list(Description = c("a", "b", "c", "d", "e", "f", 
    "g", "h", "a", "b", "c", "d", "e", "f", "g", "h"), test = c("size", 
    "size", "size", "size", "size", "size", "size", "size", "p", 
    "p", "p", "p", "p", "p", "p", "p"), value = c(0.1, 0.1, 0.125, 
    0.1, 0.075, 0.1, 0.075, 0.125, 0.000230705311441713, 0.000314488619269942, 
    0.00106639822095382, 0.00108290238851994, 0.00114723539549198, 
    0.00160204850890075, 0.0019276388745184, 0.00320371567547557)), .Names = c("Description", 
    "test", "value"), row.names = c(NA, -16L), class = "data.frame")

df$value[df$test == 'p'] <- -(df$value[df$test == 'p'])

ggplot(df, aes(x=Description, y= value, group=test, fill=test)) + geom_col() +coord_flip()

理想情况下，我希望每个组都在独立轴上，以便条形在零处相遇（在绘图区域的中间），但在此示例中处于不同的比例 ylim 类似于 ylim(0,0.13) 和 pvalue c(0, 0.0035)

【问题讨论】：

我会考虑这是否是表示数据的好方法。如果轴是独立的，是否应该将值绘制成可比较的？也许 p 与大小的散点图是传达信息的更好方式？
我在认真考虑，大小是我数据实际情况的糟糕描述。它基本上来自超几何测试的结果，如果 A-H 是子组，在这种情况下被过度表示，大小将是我的数据中找到的与每个子组匹配的项目与每个子组中的总数相比的比率。那有意义吗？我认为这两个图将很好地显示重要性以及项目的比例

标签： r ggplot2

【解决方案1】：

您可以通过使用构面来做到这一点，并调整以删除构面之间的间距：

ggplot(df, aes(x=Description, y= value, fill=test)) + 
    facet_wrap(~ test, scales = "free_x") + 
    geom_col() + 
    coord_flip() +
    scale_y_continuous(expand = c(0, 0)) +
    theme(panel.spacing.x = unit(0, "mm"))

它可能会产生一些轴标签问题，而且这些问题很难解决。在这种情况下，在刻面之间保留一些空间可能会更容易，但代价是条形不会在中间相交。

输出：

PS：您还可以使用以下内容删除负轴标签：

scale_y_continuous(
    expand = c(0, 0), 
    labels = function(x) signif(abs(x), 3)
)

【讨论】：

太好了，一个不错的解决方案。唯一的改进是绘图窗口是否略大于条形。我知道您可以使用expand_scale 独立调整 ggplot v3 中的 ylim，但由于必须反转一个图，因此这两个图的下限和上限是相反的。不过，我很乐意接受您的回答，谢谢。
是的，这很棘手，我认为您需要在每个方面设置不同的限制，我想不出该怎么做。

【解决方案2】：

我已经根据我的需要调整了this elegant solution。向张凌云致敬。

library(dplyr)
library(ggplot2)

set.seed(123)
ten_positive_rand_numbers <- abs(rnorm(10)) + 0.1
the_prob <- ten_positive_rand_numbers / sum(ten_positive_rand_numbers)

fk_data <- data.frame(job_type = sample(LETTERS[1:10], 1000, 
                                        replace = TRUE, prob = the_prob),
                      gender = sample(c("Male", "Female"), 1000, 
                                      replace = TRUE))

# prepare data for plotting
plotting_df <-
  fk_data %>% 
  group_by(job_type, gender) %>% 
  summarise(Freq = n()) %>% 
  # a trick!
  mutate(Freq = if_else(gender == "Male", -Freq, Freq))
## find the order
temp_df <-
  plotting_df %>% 
  filter(gender == "Female") %>% 
  arrange(Freq)
the_order <- temp_df$job_type

# plot
p <- 
  plotting_df %>% 
  ggplot(aes(x = job_type, y = Freq, group = gender, fill = gender)) +
  geom_bar(stat = "identity", width = 0.75) +
  coord_flip() +
  scale_x_discrete(limits = the_order) +
  # another trick!
  scale_y_continuous(breaks = seq(-150, 150, 50), 
                     labels = abs(seq(-150, 150, 50))) +
  labs(x = "Job type", y = "Count", title = "Back-to-back bar chart") +
  theme(legend.position = "bottom",
        legend.title = element_blank(),
        plot.title = element_text(hjust = 0.5),
        panel.background = element_rect(fill =  "grey90")) +
  # reverse the order of items in legend
  # guides(fill = guide_legend(reverse = TRUE)) +
  # change the default colors of bars
  scale_fill_manual(values = c("red", "blue"),
                    name = "",
                    breaks = c("Male", "Female"),
                    labels = c("Male", "Female")) 
print(p)

可以通过其他小细节进行改进，包括geom_hline(yintercept = 0, colour = "black")。

【讨论】：

【解决方案3】：

@Marius 解决方案比此解决方案更容易，但这允许独立控制每个图形。

我必须删除 p1 右侧和 p2 左侧的绘图边距。出于某种原因，左边距有填充，因此需要 -3.5pt 使其齐平，不确定这是否在所有地块中都是一致的。另一个手动操作是更改一个轴上的中断，因此 0 不会绘制在彼此之上。

我也不需要负 p 值，只需使用 scale_y_reverse

p1 <- ggplot(df[df$test == 'p',], aes(x=Description, y= value)) + geom_col(fill='red') + theme_minimal()+
  coord_flip() + scale_y_reverse(name= "axis1",expand = expand_scale(mult= c(c(0.05,0)))) +
  theme(panel.spacing.x = unit(0, "mm")) +theme(plot.margin = unit(c(5.5, 0, 5.5, 5.5), "pt"))

p2 <- ggplot(df[df$test != 'p',], aes(x=Description, y= value)) + geom_col(fill='blue') + 
  scale_y_continuous(name = "axis2", breaks = seq(0.025, 0.125, 0.025) ,expand = expand_scale(mult= c(c(0,0.05)))) +
  coord_flip() +
  theme(panel.spacing.x = unit(0, "mm"))+ theme_minimal() +
  theme(axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.line.y = element_blank(), axis.ticks.y=element_blank(),
        plot.margin = unit(c(5.5, 5.5, 5.5, -3.5), "pt"))

grid.newpage()
grid.draw(cbind(ggplotGrob(p1), ggplotGrob(p2), size = "last"))

我也使用过theme_minimal，但这只是出于我的审美偏好。

【讨论】：