geom_bar() + 象形图，怎么做？

Question

（见帖子底部的更新）

首发，2014-07-29 11:43:38Z

我在the Economist's website 上看到了这个图形，想知道是否有可能制作一个嵌入这种说明性图标的geom_bar()？ （下面的虚拟数据）

虚拟数据，

require(ggplot2)

# Generate data
df3 <- data.frame(units = c(1.3, 1.8, 2.7, 4.2, 4.7, 6.7, 20), 
                   what = c('Wikipedia', 'London Olympic Park', 'Aircraft carrier', 
                            'The Great Pyramid', 'Stonehenge', 'Burj Khalifas', 
                            'Empire State Building'))

# make gs an ordered factor
df3$what <- factor(df3$what, levels = df3$what, ordered = TRUE)

    #plots
    ggplot(df3, aes(what, units)) + geom_bar(fill="white", colour="darkgreen", 
           alpha=0.5, stat="identity") + coord_flip() + scale_x_discrete() + 
           scale_y_continuous(breaks=seq(0, 20, 2)) + theme_bw() + 
           theme(axis.title.x  = element_blank(), axis.title.y  = element_blank())

更新 #1，2014-07-29 15:07:51Z

显然Robert Grant 已经开始构建一个 R 函数来生成带有象形图的条形图it can be found at Github。感谢Andrie 提供这些信息。我目前正在努力查看 Robert 的功能是否可以满足我的需求。

如果您对如何使用 Robert's function 回答我的问题有任何建议，请加入。

更新 #2，2014-08-02 12:35:19Z

这里是Grant's R-pictogram-function work的简单说明

# in case you don't alredy have RCurl
# install.packages("RCurl", dependencies = TRUE)
source_github <- function(u) {
  # load package
  require(RCurl)

  # read script lines from website and evaluate
  script <- getURL(u, ssl.verifypeer = FALSE)
  eval(parse(text = script),envir=.GlobalEnv)
}

得到这个脚本form this SO answer

source_github("https://raw.githubusercontent.com/robertgrant/pictogram/master/pictogram.R")

# install.packages("png", dependencies = TRUE)
  require(png)

img <- readPNG(system.file("img", "Rlogo.png", package="png"))
pictogram(icon = img, n = c( 12, 35, 7),
grouplabels=c("12 R logos","35 R logos","7 R logos"))

这给了你这样的情节

Answer 1

gridSVG 提供对 R 引擎无法使用的 svg 功能的支持，例如填充图案和任意剪裁。 This example 可以很容易地适应 ggplot2，

library(grid)
library(gridSVG)
require(ggplot2)

p <- ggplot(df3, aes(what, units)) + 
  geom_bar(colour="black", stat="identity") +
  coord_flip()

pattern <- pattern(circleGrob(r=.4, gp=gpar(fill="grey")),
                   width=.05, height=.05)
registerPatternFill("circles", pattern)
gridsvg("pattern.svg")
print(p)
grid.force()
grid.patternFill("geom_rect.rect", grep=TRUE, group=FALSE,
                 label=rep("circles", length(levels(df3$what))))
dev.off()

Answer 2

这是我根据this idea 得出的结论。 R logo 取自维基百科。

library(png)
fill_images <- function()
{
  l <- list()
  for (i in 1:nrow(df3)) 
  {
    for (j in 1:floor(df3$units[i]))
    {
      #seems redundant, but does not work if moved outside of the loop (why?)
      img <- readPNG("~/../Rlogo.png")
      g <- rasterGrob(img, interpolate=TRUE)
      l <- c(l, annotation_custom(g, xmin = i-1/2, xmax = i+1/2, ymin = j-1, ymax = j))
    }
  }
  l
}

p <- ggplot(df3, aes(what, units)) + 
  geom_bar(fill="white", colour="darkgreen", alpha=0.5, stat="identity") + 
  coord_flip() + 
  scale_y_continuous(breaks=seq(0, 20, 2)) + 
  scale_x_discrete() + 
  theme_bw() + 
  theme(axis.title.x  = element_blank(), axis.title.y  = element_blank()) + 
  fill_images()
p

我不太确定绘制部分图像的最佳方法是什么。

更新：

实际上，这比我预期的要容易。我通过在图像的一部分上绘制一个白色矩形来剪辑图像。请注意，geom_bar 应该在顶部，这样剪切矩形就不会影响它。网格线有一个小问题（它们被这些白色矩形部分隐藏），所以我不得不硬编码它们的位置并手动恢复它们。当然，这不是一个理想的解决方案，但我不知道如何以编程方式检索网格位置。无论如何，最终的情节完成了这项工作，而且看起来也很漂亮！

library(png)
fill_images <- function()
{
  l <- list()
  for (i in 1:nrow(df3)) 
  {
    for (j in 1:ceiling(df3$units[i]))
    {
      img <- readPNG("~/../Rlogo.png")
      g <- rasterGrob(img, interpolate=TRUE)
      l <- c(l, annotation_custom(g, xmin = i-1/2, xmax = i+1/2, ymin = j-1, ymax = j))
    }
  }
  l
}

clip_images <- function(restore_grid = TRUE)
{
  l <- list()
  for (i in 1:nrow(df3)) 
  {
    l <- c(l, geom_rect(xmin = i-1/2, xmax = i+1/2, 
                        ymin = df3$units[i], ymax = ceiling(df3$units[i]),
                        colour = "white", fill = "white"))
    if (restore_grid && ceiling(df3$units[i]) %in% major_grid) 
      l <- c(l, geom_segment(x = i-1, xend = i+1,
                             y = ceiling(df3$units[i]), 
                             yend = ceiling(df3$units[i]),
                             colour = grid_col, size = grid_size))
  }
  l
}

grid_col <- "grey50"
grid_size <- 0.6
major_grid <- 0:10 * 2
p <- ggplot(df3, aes(what, units)) + 
  fill_images() + 
  clip_images() +
  geom_bar(fill=NA, colour="darkgreen", size=1.2, alpha=0.5, stat="identity") + 
  coord_flip() + 
  scale_y_continuous(breaks=seq(0, 20, 2)) + 
  scale_x_discrete() + 
  theme_bw() + 
  theme(axis.title.x  = element_blank(), axis.title.y  = element_blank(),
        panel.grid.major.x = element_line(colour = grid_col, size = grid_size), 
        panel.grid.major.y = element_line(colour = NA)) 
p

为了保存 .svg 文件，请使用例如

ggsave(file="test.svg", plot=p, width=10, height=8)

如果您想将填充图像作为 .svg 文件，请查看 grImport package。看来您必须手动将 .svg 转换为 .ps（例如使用 imagemagick），然后按照指南进行操作。