facet wrap 扭曲了 R 中的状态图

facet wrap distorts state maps in R

这个问题是我之前问过的一个问题的延伸,见。我想在地图中显示点,并按其值着色。我可以使用下面的代码让它工作,它会产生一个看起来不错的图,但我更喜欢 Mark Peterson 提供的 'sepStates' 输出的外观。

mn <- min(test$value); hist(test$value) 
mx <- max(test$value)
ggplot(map_data('state',region=states), aes(x=long,y=lat,group=group)) +
geom_polygon(colour='black',fill='white') + geom_point(data=test,aes
(x=Lon,   y=Lat, group=group, color=value),size=2.5, pch=16) +
facet_wrap(~region, scales = "free", ncol=3) + 
scale_colour_gradientn(limits = c(mn,mx),breaks=c
(2,3,4,5,6,7,8,9),colours=rev(rainbow(7)))

假设在提供的邮政编码数据标记中添加了一个温度列。

datatest <- structure(list(zip =c 
("5246", "85118", "85340", "34958", "33022", 
"32716", "49815", "48069", "48551", "58076", "58213", "58524", 
"73185", "74073", "73148", "98668", "98271", "98290"), 
city = c("Chandler","Gold Canyon", "Litchfield
Park", "JensenBeach", "Hollywood", "Altamonte
Springs", "Channing", "Pleasant Ridge", "Flint", "Wahpeton", 
"Ardoch", "Braddock", "Oklahoma City", "Sperry", "Oklahoma City", 
"Vancouver", "Marysville", "Snohomish"), state = c
("AZ", "AZ","AZ", "FL", "FL", "FL", "MI", "MI", "MI", "ND", "ND", "ND",
"OK","OK", "OK", "WA", "WA", "WA"), latitude = c(33.276539, 33.34,33.50835, 
27.242402, 26.013368, 28.744752, 46.186913, 42.472235, 
42.978995, 46.271839, 48.204374, 46.596608, 35.551409, 36.306323, 
35.551409, 45.801586, 48.093129, 47.930902), longitude = c(-112.18717,    
-111.42, -112.40523, -80.224613, -80.144217, -81.22328, -88.04546, 
-83.14051, -83.713124, -96.608142, -97.30774, -100.09497, -97.407537, 
-96.02081, -97.407537, -122.520347, -122.21614, -122.03976),
temperature = c(45,87,33,66,12,69,45,78,23,39,41,104,50,53,40,88,56,29)), 
.Names = c("zip", "city", "state", "latitude", "longitude","temperature"), 
row.names = c(NA, -18L), class = c("tbl_df", "tbl", "data.frame"))

如果我想按州分面显示它,右侧只有一个图例,就像上面的第一个代码生成的那样,我该怎么做?我当前的代码如下所示:

sepStates <- lapply(states, function(thisState){
ggplot(map_data('state',region=thisState), aes(x=long,y=lat,group=group)) +
geom_polygon(colour='black',fill='white') + geom_point(data=datatest
[datatest$region == tolower(thisState),],aes(x=long, y=lat, group=group,
color=temperature),size=2.5, pch=16) + ggtitle(thisState) + coord_map() +
theme_void() + theme(plot.title = element_text(hjust = 0.5))})

plot_grid(plotlist = sepStates)

使用 'cowplot' 包仍然会导致使用以下代码扭曲状态。任何帮助将不胜感激。

legend <- get_legend(ok_plot)
prow <- plot_grid(ok_plot + theme(legend.position="none"),
az_plot + theme(legend.position="none"),
mi_plot + theme(legend.position="right"),
nd_plot + theme(legend.position="none"),
fl_plot + theme(legend.position="none"),
wa_plot + theme(legend.position="right"),
align = 'vh',
hjust = -1,
nrow = 2)

谢谢!

您的方法看起来像是在正确的轨道上,但您似乎忘记了包括一些关键组件(例如,数据和创建 object 的位置 ok_plot 等.).

首先,我发现创建一个 object 来保存您想使用的任何色标是最简单的。我不确定您要使用 rainbow 调色板去哪里,因为中断似乎与您的数据范围不匹配。因此,相反,我将使用 viridis 制作一个(调色板非常适合顺序数据)。

library(viridis)
sharedScale <-
  scale_color_viridis(limits = range(datatest$temperature))

然后,像以前一样创建单独的地块。请注意,添加了颜色映射以及 sharedScale,并且我正在立即抑制图例。

sepStates <-
  lapply(states, function(thisState){
    ggplot(map_data('state',region=thisState)
           , aes(x=long,y=lat,group=group)) +
      geom_polygon(colour='black',fill='white') +
      geom_point(aes(color = temperature)
                 , data = datatest[datatest$region == tolower(thisState), ]
                 , size = 4
                 , show.legend = FALSE) +
      sharedScale +
      ggtitle(thisState) +
      coord_map() +
      theme_void() +
      theme(plot.title = element_text(hjust = 0.5))
  })

像以前一样绘制这个,将给出你想要的地图(现在有颜色)。然而,它不会有传奇。为此,我们希望提取一个图例以在所有地块中共享。当您这样做时,确保每个图中的值都相同(例如,您设置的限制)。

sharedLegend <-
  get_legend(
    ggplot(datatest
           , aes(x=long,y=lat,color = temperature)) +
      geom_point() +
      sharedScale +
      theme_void()
  )

现在,我们可以使用嵌套 plot_grid 将它们拼接在一起。在内部,我们生成与之前相同的布局(只有六个状态)。在外面,我们将其与传说相结合。您将不得不修改 rel_widths 以匹配您在最终产品中想要的纵横比(和标题)。

plot_grid(
  plot_grid(plotlist = sepStates)
  , sharedLegend
  , nrow = 1
  , rel_widths = c(6, 1)
)

给予

同样,您可能想玩玩图例 title/size(或考虑将其放在地图下方而不是旁边)。

flatLegend <-
  get_legend(
    ggplot(datatest
           , aes(x=long,y=lat,color = temperature)) +
      geom_point() +
      sharedScale +
      labs(color = "Temp") +
      theme_void() +
      theme(
        legend.title = element_text(size = 18, face = "bold")
        , legend.text = element_text(size = 12)
        , legend.key.size = unit(24, "points")
        , legend.position = "bottom")
  )

plot_grid(
  plot_grid(plotlist = sepStates)
  , flatLegend
  , ncol = 1
  , rel_heights = c(6, 1)
)

给予