在ggplot中绘制饼图

This may be a wish list thing, not sure (i.e. maybe there would need to be the creation of geom_pie for this to occur). I saw a map today (LINK) with pie graphs on it as seen here.

这可能是一个愿望列表，但不确定(例如，可能需要创建geom_pie来实现它)。我今天看到了一张地图(链接)上面有饼状图。

I don't want to debate the merits of a pie graph, this was more of an exercise of can I do this in ggplot?

我不想讨论饼图的优点，这更像是在ggplot中做的练习?

I have provided a data set below (loaded from my drop box) that has the mapping data to make a New York State map and some purely fabricated data on racial percentages by county. I have given this racial make up as a merge with the main data set and as a separate data set called key. I also think Bryan Goodrich's response to me in another post (HERE) on centering county names will be helpful to this concept.

我提供了下面的数据集(从我的下拉框中加载)，其中有绘制纽约州地图的地图的映射数据，以及一些完全虚构的各个县的种族百分比数据。我将这个种族组合作为与主数据集的合并，以及作为一个名为key的独立数据集。我还认为布莱恩·古德里奇(Bryan Goodrich)在另一个以县名为中心的帖子中对我的回应将有助于这个概念。

How can we make the map above with ggplot2?

如何用ggplot2制作上面的地图?

A data set and the map without the pie graphs:

没有饼状图的数据集和地图:

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

Thanks in advance for your ideas.

谢谢你的建议。

EDIT: I just saw another case at junkcharts that screams for this type of capability:

编辑:我刚刚在junkcharts看到另一个案例，它为这种能力尖叫:

5 个解决方案

#1

Three years later this is solved. I've put together a number of processes together and thanks to @Guangchuang Yu's excellent ggtree package this can be done fairly easily. Note that as of (9/3/2015) you need to have version 1.0.18 of ggtree installed but these will eventually trickle down to their respective repositories.

三年后，这个问题就解决了。我已经将一些过程组合在一起，多亏了@Guangchuang Yu的出色的ggtree包，这可以很容易地完成。注意到(9/3/2015)，您需要安装版本1.0.18的ggtree，但是这些最终将会逐渐扩展到它们各自的存储库。

I've used the following resources to make this (the links will give greater detail):

我使用了以下资源来做这个(链接将提供更详细的信息):

1. ggtree blog
2. ggtree博客
3. move ggplot legend
4. 移动ggplot传奇
5. correct ggtree version
6. 正确ggtree版本
7. centering things in polygons
8. 定心的多边形

Here's the code:

这是代码:

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)

#2

This functionality should be in ggplot, I think it is coming to ggplot soonish, but it is currently available in base plots. I thought I would post this just for comparison's sake.

这个功能应该在ggplot中，我认为它很快就会出现在ggplot soonish中，但它目前在base plot中可用。我想我还是把这个贴出来比较一下吧。

load(url("http://dl.dropbox.com/u/61803503/nycounty.RData"))

library(plotrix)
e=10^-5
myglyff=function(gi) {
floating.pie(mean(gi$long),
             mean(gi$lat),
             x=c(gi[1,"white"]+e,
                 gi[1,"black"]+e,
                 gi[1,"hispanic"]+e,
                 gi[1,"asian"]+e,
                 gi[1,"other"]+e),
              radius=.1) #insert size variable here
}

g1=ny[which(ny$group==1),]
plot(g1$long,
     g1$lat,
     type='l',
     xlim=c(-80,-71.5),
     ylim=c(40.5,45.1))

myglyff(g1)

for(i in 2:62)
  {gi=ny[which(ny$group==i),]
    lines(gi$long,gi$lat)
    myglyff(gi)
  }

Also, there may be (probably are) more elegant ways of doing this in the base graphics.

此外，在基本图形中可能有(可能是)更优雅的方法。

As, you can see, there are quite a few problems with this that need to be solved. A fill color for the counties. The pie charts tend to be too small or overlap. The lat and long do not take a projection so sizes of counties are distorted.

正如您所看到的，有很多问题需要解决。郡的填充色。饼图往往太小或重叠。lat和long没有投影，所以县的大小是扭曲的。

In any event, I am interested in what others can come up with.

无论如何，我对别人的想法很感兴趣。

#3

I've written some code to do this using grid graphics. There is an example here: https://qdrsite.wordpress.com/2016/06/26/pies-on-a-map/

我已经编写了一些代码来使用网格图形来实现这一点。这里有一个例子:https://qdrsite.wordpress.com/2016/06/26/pi -on-a-map/。

The goal here was to associate the pie charts with specific points on the map, and not necessarily regions. For this particular solution, it is necessary to convert the map coordinates (latitude and longitude) to a (0,1) scale so they can be plotted in the proper locations on the map. The grid package is used to print to the viewport that contains the plot panel.

这里的目标是将饼图与地图上的特定点联系起来，而不一定是区域。对于这个特殊的解决方案，需要将地图坐标(纬度和经度)转换成(0,1)的比例，以便在地图上的适当位置绘制它们。网格包用于打印到包含绘图面板的viewport。

Code:

代码:

# Pies On A Map
# Demonstration script
# By QDR

# Uses NLCD land cover data for different sites in the National Ecological Observatory Network.
# Each site consists of a number of different plots, and each plot has its own land cover classification.
# On a US map, plot a pie chart at the location of each site with the proportion of plots at that site within each land cover class.

# For this demo script, I've hard coded in the color scale, and included the data as a CSV linked from dropbox.

# Custom color scale (taken from the official NLCD legend)
nlcdcolors <- structure(c("#7F7F7F", "#FFB3CC", "#00B200", "#00FFFF", "#006600", "#E5CC99", "#00B2B2", "#FFFF00", "#B2B200", "#80FFCC"), .Names = c("unknown", "cultivatedCrops", "deciduousForest", "emergentHerbaceousWetlands", "evergreenForest", "grasslandHerbaceous", "mixedForest", "pastureHay", "shrubScrub", "woodyWetlands"))

# NLCD data for the NEON plots
nlcdtable_long <- read.csv(file='https://www.dropbox.com/s/x95p4dvoegfspax/demo_nlcdneon.csv?raw=1', row.names=NULL, stringsAsFactors=FALSE)

library(ggplot2)
library(plyr)
library(grid)

# Create a blank state map. The geom_tile() is included because it allows a legend for all the pie charts to be printed, although it does not
statemap <- ggplot(nlcdtable_long, aes(decimalLongitude,decimalLatitude,fill=nlcdClass)) +
geom_tile() +
borders('state', fill='beige') + coord_map() +
scale_x_continuous(limits=c(-125,-65), expand=c(0,0), name = 'Longitude') +
scale_y_continuous(limits=c(25, 50), expand=c(0,0), name = 'Latitude') +
scale_fill_manual(values = nlcdcolors, name = 'NLCD Classification')

# Create a list of ggplot objects. Each one is the pie chart for each site with all labels removed.
pies <- dlply(nlcdtable_long, .(siteID), function(z)
ggplot(z, aes(x=factor(1), y=prop_plots, fill=nlcdClass)) +
geom_bar(stat='identity', width=1) +
coord_polar(theta='y') +
scale_fill_manual(values = nlcdcolors) +
theme(axis.line=element_blank(),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks=element_blank(),
axis.title.x=element_blank(),
axis.title.y=element_blank(),
legend.position="none",
panel.background=element_blank(),
panel.border=element_blank(),
panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
plot.background=element_blank()))

# Use the latitude and longitude maxima and minima from the map to calculate the coordinates of each site location on a scale of 0 to 1, within the map panel.
piecoords <- ddply(nlcdtable_long, .(siteID), function(x) with(x, data.frame(
siteID = siteID[1],
x = (decimalLongitude[1]+125)/60,
y = (decimalLatitude[1]-25)/25
)))

# Print the state map.
statemap

# Use a function from the grid package to move into the viewport that contains the plot panel, so that we can plot the individual pies in their correct locations on the map.
downViewport('panel.3-4-3-4')

# Here is the fun part: loop through the pies list. At each iteration, print the ggplot object at the correct location on the viewport. The y coordinate is shifted by half the height of the pie (set at 10% of the height of the map) so that the pie will be centered at the correct coordinate.
for (i in 1:length(pies)) 
  print(pies[[i]], vp=dataViewport(xData=c(-125,-65), yData=c(25,50), clip='off',xscale = c(-125,-65), yscale=c(25,50), x=piecoords$x[i], y=piecoords$y[i]-.06, height=.12, width=.12))

The result looks like this:

结果是这样的:

#4

I stumbled upon what looks like a function to do this: "add.pie" in the "mapplots" package.

在“mapplot”包中，我偶然发现了这样一个函数:“add.pie”。

The example from the package is below.

该包中的示例如下。

plot(NA,NA, xlim=c(-1,1), ylim=c(-1,1) )
add.pie(z=rpois(6,10), x=-0.5, y=0.5, radius=0.5)
add.pie(z=rpois(4,10), x=0.5, y=-0.5, radius=0.3)

#5

A slight variation on the OP's original requirements, but this seems like an appropriate answer/update.

OP的原始需求略有变化，但这似乎是一个适当的回答/更新。

If you want an interactive Google Map, as of googleway v2.6.0 you can add charts inside info_windows of map layers.

如果您想要一个交互式的谷歌地图，如googleway v2.6.0，您可以在地图层的info_windows中添加图表。

see ?googleway::google_charts for documentation and examples

参见?googleway: google_charts获取文档和示例

library(googleway)

set_key("GOOGLE_MAP_KEY")

## create some dummy chart data
markerCharts <- data.frame(stop_id = rep(tram_stops$stop_id, each = 3))
markerCharts$variable <- c("yes", "no", "maybe")
markerCharts$value <- sample(1:10, size = nrow(markerCharts), replace = T)

chartList <- list(
  data = markerCharts
  , type = 'pie'
  , options = list(
    title = "my pie"
    , is3D = TRUE
    , height = 240
    , width = 240
    , colors = c('#440154', '#21908C', '#FDE725')
    )
  )

google_map() %>%
  add_markers(
    data = tram_stops
    , id = "stop_id"
    , info_window = chartList
  )