r - 在ggplot中的 map 上绘制饼图

Question

这可能是一个愿望 list ，不确定(即可能需要创建geom_pie才能发生)。我今天看到了一张 map ( LINK )，上面有饼图，如下所示。

我不想争论饼图的优点，这更多的是我可以在 ggplot 中做到这一点吗？

我在下面提供了一个数据集(从我的投递箱加载)，其中包含用于制作纽约州 map 的 map 数据以及一些纯粹捏造的各县种族百分比数据。我将这个种族构成作为与主数据集的合并以及一个称为关键的单独数据集。我还认为 Bryan Goodrich 在另一篇文章 ( HERE ) 中对我关于以县名为中心的回复将对这一概念有所帮助。

我们如何用ggplot2制作上面的 map ？

没有饼图的数据集和 map :

load(url("http://dl.dropbox.com/u/61803503/nycounty.RData"))
head(ny); head(key)  #view the data set from my drop box
library(ggplot2)
ggplot(ny, aes(long, lat, group=group)) +  geom_polygon(colour='black', fill=NA)

#  Now how can we plot a pie chart of race on each county 
#  (sizing of the pie would also be controllable via a size 
#  parameter like other `geom_` functions).

预先感谢您的想法。

编辑:我刚刚在 junkcharts 看到了另一个案例这种能力令人尖叫:

Answer 1

三年后这个问题得到了解决。我已经将许多流程放在一起，并且感谢 @Guangchuang Yu 出色的 ggtree 包，这可以相当轻松地完成。请注意，截至(2015 年 9 月 3 日)您需要安装 1.0.18 版的 ggtree，但这些最终会渗透到各自的存储库中。

我使用了以下资源来实现此目的(链接将提供更多详细信息):

1. ggtree blog
2. move ggplot legend
3. correct ggtree version
4. centering things in polygons

代码如下:

load(url("http://dl.dropbox.com/u/61803503/nycounty.RData"))
head(ny); head(key)  #view the data set from my drop box

if (!require("pacman")) install.packages("pacman")
p_load(ggplot2, ggtree, dplyr, tidyr, sp, maps, pipeR, grid, XML, gtable)

getLabelPoint <- function(county) {Polygon(county[c('long', 'lat')])@labpt}

df <- map_data('county', 'new york')                 # NY region county data
centroids <- by(df, df$subregion, getLabelPoint)     # Returns list
centroids <- do.call("rbind.data.frame", centroids)  # Convert to Data Frame
names(centroids) <- c('long', 'lat')                 # Appropriate Header

pops <-  "http://data.newsday.com/long-island/data/census/county-population-estimates-2012/" %>%
     readHTMLTable(which=1) %>%
     tbl_df() %>%
     select(1:2) %>%
     setNames(c("region", "population")) %>%
     mutate(
         population = {as.numeric(gsub("\\D", "", population))},
         region = tolower(gsub("\\s+[Cc]ounty|\\.", "", region)),
         #weight = ((1 - (1/(1 + exp(population/sum(population)))))/11) 
         weight = exp(population/sum(population)),
         weight = sqrt(weight/sum(weight))/3
     )


race_data_long <- add_rownames(centroids, "region") %>>%
    left_join({distinct(select(ny, region:other))}) %>>%
    left_join(pops) %>>%
    (~ race_data) %>>%
    gather(race, prop, white:other) %>%
    split(., .$region)

pies <- setNames(lapply(1:length(race_data_long), function(i){
    ggplot(race_data_long[[i]], aes(x=1, prop, fill=race)) +
        geom_bar(stat="identity", width=1) + 
        coord_polar(theta="y") + 
        theme_tree() + 
        xlab(NULL) + 
        ylab(NULL) + 
        theme_transparent() +
        theme(plot.margin=unit(c(0,0,0,0),"mm"))
}), names(race_data_long))


e1 <- ggplot(race_data_long[[1]], aes(x=1, prop, fill=race)) +
        geom_bar(stat="identity", width=1) + 
        coord_polar(theta="y") 

leg1 <- gtable_filter(ggplot_gtable(ggplot_build(e1)), "guide-box") 


p <- ggplot(ny, aes(long, lat, group=group)) +  
    geom_polygon(colour='black', fill=NA) +
    theme_bw() +
    annotation_custom(grob = leg1, xmin = -77.5, xmax = -78.5, ymin = 44, ymax = 45) 



n <- length(pies)

for (i in 1:n) {

    nms <- names(pies)[i]
    dat <- race_data[which(race_data$region == nms)[1], ]
    p <- subview(p, pies[[i]], x=unlist(dat[["long"]])[1], y=unlist(dat[["lat"]])[1], dat[["weight"]], dat[["weight"]])

}

print(p)