ggplot - facet wrap - 调整比例以显示值之间的明显差异

Question

我有一个如下数据框:

text <- "
brand   a   b   c   d   e   f
nissan  99.21   99.78   6496    1.28    216 0.63
toyota  99.03   99.78   7652    1.39    205 0.60
"
df <- read.table(textConnection(text), sep="\t", header = T)

我试图将两组的所有变量绘制在一个ggplot中,使用face_wrap如下:

library(reshape2)
library(ggplot2)
library(ggthemes)
library(RColorBrewer)
ggplot(melt(df, id = "brand")) + 
  aes(brand, value, fill = brand) + 
  geom_bar(stat = "identity", position='dodge') +
  geom_text(data=melt(df, id = "brand"), angle = 0, 
               aes(brand, value,
                   label = ifelse(value > 100, round(value, 0), value) ) ) +
  facet_wrap(~ variable, scales = "free_y") + 
  scale_fill_brewer(palette = "Paired") + 
    theme(
      legend.position = "top",
      strip.text.y = element_text(angle = 0),
      axis.text.x = element_blank(),
      axis.text.y = element_blank(),
      axis.ticks = element_blank()
      )

除了一件事,它运作良好.变量值组之间的明显差异在视觉上并不是很好.例如,对于变量,a我希望条的高度能够以更容易的方式清晰显示哪个更高.如何使这些接近值之间的高度差更大？

Answer 1

我相信人们会高兴地告诉你如何破解ggplot2,这样你就可以让条形码以任意y值开始.但是,您需要注意结果将是无意义的垃圾图表,特别是如果您去除轴刻度的y轴.我建议阅读这篇关于比例墨水原理的博客文章.

您可以采用的一种解决方案是绘制代表两个变量比率的条形图,如下所示:

text <- "
brand   a   b   c   d   e   f
nissan  99.21   99.78   6496    1.28    216 0.63
toyota  99.03   99.78   7652    1.39    205 0.60
"

df_wide <- read.table(textConnection(text), sep="\t", header = T)

library(ggplot2)
library(tidyr)
library(dplyr)

df_long <- gather(df_wide, variable, value, -brand) %>%
  spread(brand, value) %>%
  mutate(ratio = nissan/toyota,
         label = paste(signif(nissan, 3), signif(toyota, 3), sep = " / "),
         vjust = ifelse(ratio >= 1, -.5, 1.5)) %>%
  mutate(ratio = ifelse(ratio == 1, 1.001, ratio))

ggplot(df_long, aes(variable, ratio, fill = (ratio>=1))) + 
  geom_col() +
  geom_text(aes(label = label, vjust = vjust)) +
  scale_y_log10(name = "ratio Nissan / Toyota",
                breaks = c(.85, .9, .95, 1, 1.05, 1.1),
                expand = c(.15, 0)) +
  scale_fill_brewer(palette = "Paired", guide = "none")

结果是每个配对只有一个条形,但条形高度准确地反映了两个变量的相对大小.而且你似乎对绝对量值不感兴趣,因为你在原始facet_wrap()命令中使用了自由y轴缩放.

Answer 2

编辑

(我不打算回到这里,因为我认为所有的答案都是在同一个方面.但它一直在我的饲料上突然出现,直到我终于想到了一个尚未提及的角度.)

我能想到在这方面,有些都不能证明使用酒吧的唯一方法是让它很清楚,酒吧的高度代表级别,而不是价值:

df2 <- melt(df, id = "brand") %>%
  group_by(variable) %>%
  mutate(rank = rank(value))

> df2
# A tibble: 12 x 4
# Groups: variable [6]
   brand  variable    value  rank
   <fctr> <fctr>      <dbl> <dbl>
 1 nissan a          99.2    2.00
 2 toyota a          99.0    1.00
 3 nissan b          99.8    1.50
 4 toyota b          99.8    1.50
 5 nissan c        6496      1.00
 6 toyota c        7652      2.00
 7 nissan d           1.28   1.00
 8 toyota d           1.39   2.00
 9 nissan e         216      2.00
10 toyota e         205      1.00
11 nissan f           0.630  2.00
12 toyota f           0.600  1.00

使用等级作为y值,其他所有内容都可以自然流动而不会引入geom_rect()等等:

ggplot(df2,
       aes(x = brand, y = rank, fill = brand,
           label = value)) +
  geom_col() +
  geom_text(vjust = 0) +
  facet_wrap(~variable) + 
  scale_fill_brewer(palette = "Paired") + 
  theme(
    legend.position="top",
    strip.text.y = element_text(angle = 0),
    axis.text=element_blank(),
    axis.ticks = element_blank()
  )

(不包括绘制图像.它基本上与下面的图表相同,除了y轴标题现在是"等级".)

结果还是垃圾吗？我会说是的,但如果你非得表现出任意酒吧给别人,告诉他们高度是根据等级,并应作出一点更有意义.

原答案如下

如果您确实需要使用条形图,则可以使用geom_rect&为每个方面手动定义不同的ymin.

修改数据框:

library(dplyr)

df2 <- melt(df, id = "brand") %>%
  group_by(variable) %>%
  mutate(ymax = value, 
         ymin = ifelse(diff(value) == 0, 0,
                       min(value) - (max(value) - min(value)) / 2),
         yblank = ifelse(diff(value) == 0, value * 2,
                         max(value) + (max(value) - min(value)) / 2),
         x = as.integer(brand),
         xmin = x - 0.4,
         xmax = x + 0.4,
         label = ifelse(value > 100, round(value, 0), value)) %>%
  ungroup()

> df2
# A tibble: 12 x 10
   brand  variable    value     ymax     ymin   yblank     x  xmin  xmax    label
   <fctr> <fctr>      <dbl>    <dbl>    <dbl>    <dbl> <int> <dbl> <dbl>    <dbl>
 1 nissan a          99.2     99.2     98.9     99.3       1 0.600  1.40   99.2  
 2 toyota a          99.0     99.0     98.9     99.3       2 1.60   2.40   99.0  
 3 nissan b          99.8     99.8      0      200         1 0.600  1.40   99.8  
 4 toyota b          99.8     99.8      0      200         2 1.60   2.40   99.8  
 5 nissan c        6496     6496     5918     8230         1 0.600  1.40 6496    
 6 toyota c        7652     7652     5918     8230         2 1.60   2.40 7652    
 7 nissan d           1.28     1.28     1.23     1.44      1 0.600  1.40    1.28 
 8 toyota d           1.39     1.39     1.23     1.44      2 1.60   2.40    1.39 
 9 nissan e         216      216      200      222         1 0.600  1.40  216    
10 toyota e         205      205      200      222         2 1.60   2.40  205    
11 nissan f           0.630    0.630    0.585    0.645     1 0.600  1.40    0.630
12 toyota f           0.600    0.600    0.585    0.645     2 1.60   2.40    0.600

这样就形成了条形,使得每个小平面中的较短条占据小平面高度的四分之一,而较高的条占据四分之三.如果两个杆的高度完全相同,则它们都占据了刻面高度的一半.如果要调整外观,只需更改ymin/yblank即可.

情节:

ggplot(df2,
       aes(x = x, y = ymax, fill = brand)) + 
  geom_rect(aes(xmin = xmin, xmax = xmax,
                ymin = ymin, ymax = ymax)) +
  geom_text(aes(label = label), 
            vjust = -1) + # position labels slightly above top of each bar
  geom_blank(aes(y = yblank)) +
  facet_wrap(~ variable, scales = "free_y") + 
  scale_fill_brewer(palette = "Paired") + 
  theme(
    legend.position="top",
    strip.text.y = element_text(angle = 0),
    axis.text=element_blank(),
    axis.ticks = element_blank()
  )

Answer 3

我同意答案和评论,操纵相对条形长度并不是一个好主意.如果您只想显示当前绘图中哪个条形较高,则可以使用另一个美学来突出显示它,例如将较高的条形图放在如下图所示的框中.

library(reshape2)
library(ggplot2)
library(ggthemes)
library(RColorBrewer)

library(data.table)
library(magrittr)


# add a winner column to mark the winner in red
aaa <- melt(df, id = "brand") %>%
    setDT() %>%
    .[, winner := ifelse(value > mean(value), "red", "NA"), by = variable]

# plot and show the higher bar in read box
ggplot(aaa, aes(brand, value, fill = brand)) + 
    geom_bar(aes(color = winner), stat = "identity", position='dodge') +
    geom_text(data=melt(df, id = "brand"), angle = 0, 
              aes(brand, value,
                  label = ifelse(value > 100, round(value, 0), value) ) ) +
    facet_wrap(~ variable, scales = "free_y") + 
    scale_fill_brewer(palette = "Paired") + 
    scale_color_identity() +
    theme(
        legend.position = "top",
        strip.text.y = element_text(angle = 0),
        axis.text.x = element_blank(),
        axis.text.y = element_blank(),
        axis.ticks = element_blank()
    )