R ggplot-镶嵌面包裹-调整比例以显示值之间的明显差异

我有一个如下所示的数据帧：

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)

除了一件事，它工作得很好。两组变量值之间的明显差异在视觉上表现得不是很好。例如，对于变量

a

，我希望条形图的高度能够清楚地显示哪个更高，哪个更容易。如何使这些接近值之间的高度差变大

编辑

（我不打算回到这个话题上来，因为我认为所有的答案都是一致的。但它一直出现在我的提要上，直到我最终想到了一个尚未提及的角度。）

我认为在这种情况下使用条形图有一定道理的唯一方法是非常清楚地表明条形图的高度表示等级，而不是值：

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

&手动为每个面定义不同的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

---

我相信人们会很乐意告诉你如何破解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")

text=1，-.5,1.5））%>%
突变（比率=ifelse（比率=1,1.001，比率））
ggplot（df_long，aes（变量、比率、填充=（比率>=1））+
geom_col（）+
几何图形文本（aes（标签=标签，vjust=vjust））+
比例10（name=“日产/丰田比例”，
断裂=c（.85、.9、.95、1、1.05、1.1），
展开=c（.15，0））+
缩放填充酿酒器（调色板=“成对”，指南=“无”）

---

结果是每个配对只有一根杆，但杆的高度准确地反映了两个变量的相对大小。而且您似乎对绝对大小并不感兴趣，因为您在原始的

facet\u wrap（）

命令中使用了自由y轴缩放。

我同意答案和评论，即操纵相对条长度不是一个好主意。如果您只想显示当前绘图中哪个条较高，可以使用另一种美学方法将其高亮显示，例如，将较高的条放在下面的绘图框中

library（重塑2）
图书馆（GG2）
图书馆（主题）
图书馆（RColorBrewer）
库（数据表）
图书馆（magrittr）
#添加“赢家”列以红色标记赢家
aaa%
setDT（）%>%
[，获胜者：=ifelse（值>平均值），“红色”，“NA”），by=变量]
#在“读取”框中打印并显示较高的条形图
ggplot（aaa、aes（品牌、价值、填充=品牌））+
几何图形栏（aes（颜色=获胜者），stat=“identity”，position=“dodge”）+
几何图形文字（数据=熔体（df，id=“品牌”），角度=0，
aes（品牌、价值、，
label=ifelse（值>100，四舍五入（值，0，值）））+
镶嵌面包裹（~variable，scales=“free_y”）+
缩放填充酿酒器（调色板=“成对”）+
比例\颜色\标识（）+
主题(
legend.position=“top”，
strip.text.y=元素\文本（角度=0），
axis.text.x=元素_blank（），
axis.text.y=元素_blank（），
axis.ticks=元素_blank（）
)

这篇文章中的许多人指出，以任意y值开始缩放是错误的

一个尚未考虑的答案是使用

scale\u y\u log10（）

将标尺置于对数标尺上，并与

geom\u text

标签结合以显示刻面组之间的差异

数据

---

您确定需要使用条形图吗？默认情况下，这些从原点开始，因此大数字之间的差异变得相对难以区分。如果目的是为了说明差异（因为您使用的是免费的y标尺），为什么不取消这些横杆并在日产和丰田之间的每个方面画一条线？我需要使用横杆图-有没有办法指定根据y值动态调整原点？我投了赞成票，因为它确实回答了提出的问题，但我讨厌这个结果。酒吧不应该以任意的y值开始。@ClausWilke我欣赏这种区别，我同意。这也不是我最喜欢的可视化类型。正如Z.Lin和@Clause Wilke非常清楚地指出的那样，调整条形图中列的起点不是一种好的做法，因为条形图的相对长度不再与绘制的值成比例，成对比较变得毫无意义。那些读过它的人将很难调和酒吧的视觉印象和标注的数字。这可能被认为是一种故意带有偏见和误导性的表现形式——正如克劳斯在他的解决方案中明确指出的那样，这充其量只是一种图表垃圾。

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

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

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

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

df <- data_frame(
  pair = letters[1:6] %>% rep(2),
  brand = c("nissan", "toyota") %>% rep(each = 6),
  value = c(99.21, 99.78, 6496, 1.28, 216, 0.63, 
            99.03, 99.78, 7652, 1.39, 205, 0.60)
)

df %>% 
  ggplot(aes(x = brand, y = value)) +
  geom_col(aes(fill = brand)) +
  geom_text(aes(label = value), vjust = -1) +
  scale_y_log10() +
  facet_wrap(~pair) +
  theme_bw()