ggplot2带有引线的堆积条形图标签

时间:2015-01-08 01:02:29

标签: r charts ggplot2 geom-bar

我正在尝试创建一个标记的堆叠条形图,其中只有1个条形图。我的堆栈并不总是足够大以适应文本,所以我希望有一个引导线指向堆栈右侧的标签,用于无法放入堆栈的标签。或者,如果所有标签都在带有引导线的堆栈右侧,那也没关系。

我的data.frame看起来像这样:

Regional.District   Municipality Population.2010        mp
Metro               Bowen Island            3678    1839.0
Metro                  Coquitlam          126594   66975.0
Metro                      Delta          100000  180272.0
Metro               Langley City           25858  243201.0
Metro                Maple Ridge           76418  294339.0
Metro                   New West           66892  365994.0
Metro     North Vancouver (City)           50725  424802.5
Metro             Port Coquitlam           57431  478880.5
Metro                 Port Moody           33933  524562.5
Metro                     Surrey          462345  772701.5
Metro             West Vancouver           44058 1025903.0
Metro                 White Rock           19278 1057571.0
Metro                     Anmore            2203 1068311.5
Metro                   Belcarra             690 1069758.0
Metro                    Burnaby          227389 1183797.5
Metro             Langley (Town)          104697 1349840.5
Metro                  Lions Bay            1395 1402886.5
Metro      Metro Vancouver-uninc           24837 1416002.5
Metro North Vancouver (District)           88370 1472606.0
Metro               Pitt Meadows           18136 1525859.0
Metro                   Richmond          196858 1633356.0
Metro           Vancouver (City)          642843 2053206.5

这就是我目前的工作方式: current bar chart

这是我想要的工作: potential future bar chart

这是我的代码:

library(ggplot2)
ggplot(muns, aes(x = Regional.District, y = Population.2010, fill = Municipality)) +
    geom_bar(stat = 'identity', colour = 'gray32', width = 0.6, show_guide = FALSE) +
    geom_text(aes(y = muns$mp, label = muns$Municipality), colour = 'gray32')

这可以实现自动化吗?我没有使用ggplot2来实现这一点。 谢谢!

1 个答案:

答案 0 :(得分:4)

这是一种可能性。我认为这项工作确实需要一些手工工作,尽管你可以自动化一些流程。我最初调查哪些标签必须留在栏外。然后,我看到一些标签相互重叠。我的解决方案是移动栏左侧的一些标签。 Anmore是一个棘手的问题。我手动将其y位置移动一点,使其不与White Rock重叠。

gg1是基本图形。栏内有标签。创建gg2以获取应添加到栏右侧的标签。在dan中,我查看了ggplots使用和修改x值的数据(即x = 1.35)。我也在这里删除了三个地方。对emodan2中的三个位置进行了类似的处理。在gg3中,我添加了标签。最后的工作是添加细分。我创建了三个新的数据框来绘制细分。

library(dplyr) # I use the dev version (dplyr 0.4)
library(ggplot2)

# as_data_frame() is available in dplyr 0.4
mydf <- as_data_frame(list(Regional.District = rep("Metro", times = 22),
                           Municipality = c("Bowen Island", "Coquitlam", "Delta",
                                            "Langley City", "Maple Ridge", "New West",
                                            "North Vancouver (City)", "Port Coquitlam", "Port Moody",
                                            "Surrey", "West Vancouver", "White Rock",
                                            "Anmore", "Belcarra", "Burnaby", "Langley (Town)",
                                            "Lions Bay", "Metro Vancouver-uninc",
                                            "North Vancouver (District)", "Pitt Meadows",
                                            "Richmond", "Vancouver (City)"),
                           Population = c(3678, 126594, 100000, 25858, 76418, 66892, 50725,
                                          57431, 33933, 462345, 44058, 19278, 2203, 690,
                                          227389, 104697, 1395, 24837, 88370, 18136, 196858,
                                          642843),
                           mp = c(1839.0, 66975.0, 180272.0, 243201.0, 294339.0, 365994.0,
                                  424802.5, 478880.5, 524562.5, 772701.5, 1025903.0, 1057571.0,
                                  1068311.5, 1069758.0, 1183797.5, 1349840.5, 1402886.5, 1416002.5,
                                  1472606.0, 1525859.0, 1633356.0, 2053206.5)))


# Get label for places which has more than or less than 60,000 people

ana <- mutate(mydf, foo = ifelse(Population > 60000, Municipality, NA))
bob <- mutate(mydf, foo = ifelse(Population > 60000, NA, Municipality))


# Plot with places which have more than 60,000 people
gg1 <- ggplot(mydf, aes(x = Regional.District, y = Population, fill = Municipality)) +
       geom_bar(stat = "identity", colour = "gray32", width = 0.4, show_guide = FALSE) +
       geom_text(aes(y = ana$mp, label = ana$foo), colour = "gray32", size = 3)

# Plot with places which have less than 60,000 people
gg2 <- ggplot(mydf, aes(x = Regional.District, y = Population, fill = Municipality)) +
       geom_bar(stat = "identity", colour = "gray32", width = 0.4, show_guide = FALSE) +
       geom_text(aes(y = bob$mp, label = bob$foo), colour = "gray32")

# Label for right
dan <- na.omit(ggplot_build(gg2)$data[[2]]) %>%
       filter(!label %in% c("Belcarra", "Metro Vancouver-uninc", "Anmore")) %>%
       mutate(x = 1.35)

# Label for left
emo <- filter(ggplot_build(gg2)$data[[2]],
              label %in% c("Belcarra", "Metro Vancouver-uninc")) %>%
       mutate(x = 0.65)

# Special label for right
dan2 <- filter(ggplot_build(gg2)$data[[2]], label == "Anmore") %>%
        mutate(x = 1.35, y = 1098312)

# Add labels
gg3 <- gg1 +
       annotate("text", x = dan$x, y = dan$y, label = dan$label, colour = "gray32", size = 3) +
       annotate("text", x = emo$x, y = emo$y, label = emo$label, colour = "gray32", size = 3) +
       annotate("text", x = dan2$x, y = dan2$y, label = dan2$label, colour = "gray32", size = 3)


# Create data frames for segments
# right seg
r.seg <- data.frame(x = rep(1.2, times = 9),
                    xend = rep(1.25, times = 9),
                    y = dan$y,
                    yend = dan$y) 

# left seg
l.seg <- data.frame(x = rep(0.76, times = 2),
                    xend = rep(0.8, times = 2),
                    y = emo$y,
                    yend = emo$y)

# Anmore seg
a.seg <- data.frame(x = 1.2,
                    xend = 1.25,
                    y = 1068312,
                    yend = dan2$y)

# Draw the segments                                        
gg3 +
annotate("segment", x = r.seg$x, xend = r.seg$xend, y = r.seg$y, yend = r.seg$yend) +
annotate("segment", x = l.seg$x, xend = l.seg$xend, y = l.seg$y, yend = l.seg$yend) +
annotate("segment", x = a.seg$x, xend = a.seg$xend, y = a.seg$y, yend = a.seg$yend) 

enter image description here