移动和重新调整阿拉斯加和夏威夷答案

【问题标题】：move and rescale alaska and hawaii移动和重新调整阿拉斯加和夏威夷
【发布时间】：2015-11-27 07:09:19
【问题描述】：

我正在关注this 教程来移动和重新缩放阿拉斯加和夏威夷。这是我正在运行的代码：

x = c("ggplot2", "rgdal", "maptools", "mapproj", "rgeos")
lapply(x, library, character.only = TRUE)

remove.territories = function(.df) {
  subset(.df, 
         .df$id != "AS" &
           .df$id != "MP" &
           .df$id != "GU" & 
           .df$id != "PR" &
           .df$id != "VI" 
  )
}

plain_theme = theme(axis.text=element_blank()) + 
  theme(panel.background = element_blank(), 
        panel.grid = element_blank(), 
        axis.ticks = element_blank())

no_ylab = ylab("") 
no_xlab = xlab("")

# From https://www.census.gov/geo/maps-data/data/cbf/cbf_state.html
us <- readOGR(dsn = "./cb_2014_us_state_5m.shp",
                  layer = "cb_2014_us_state_5m", verbose = FALSE)

# Transform geographical coordinates to Lambert Azimuth Equal Area projection
us_aea = spTransform(us, CRS("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs"))
us_aea@data$id = rownames(us_aea@data)

#Move Alaska (scaled down) and Hawaii
alaska = us_aea[us_aea$STATEFP=="02",]
alaska = elide(alaska, rotate=-50)
alaska = elide(alaska, scale=max(apply(bbox(alaska), 1, diff)) / 2.3)
alaska = elide(alaska, shift=c(-2100000, -2500000))
proj4string(alaska) = proj4string(us_aea)

hawaii = us_aea[us_aea$STATEFP=="15",]
hawaii = elide(hawaii, rotate=-35)
hawaii = elide(hawaii, shift=c(5400000, -1400000))
proj4string(hawaii) = proj4string(us_aea)

#Remove Alaska and Hawaii from base map and substitute transformed versions

us50 <- fortify(us_aea, region="STUSPS")
us50 = remove.territories(us50)

#plot 

p = ggplot(data=us50) + 
  geom_map(map=us50, aes(x=long, y=lat, map_id=id, group=group), ,fill="white", color="dark grey", size=0.15) + 
  no_ylab + 
  no_xlab + 
  plain_theme
p

我不确定我缺少什么我的地图看起来不像教程中的地图：

【问题讨论】：

不知道你有没有检查过this useful link。
Nathan Yau 在他的 ($) 订阅可视化系列中也有一个很好的基础图示例。
@hrbrmstr 我正在尝试与leaflet 一起工作。你知道某处有没有例子吗？
@Ignacio 它可能可以使用 Proj4Leaflet 插件：github.com/kartena/Proj4Leaflet 并且在 RStudio 传单 github 问题区域中存在/曾经有一些关于此的讨论，但预测不是传单的优势之一。您是否正在寻找将其转换为交互式 javascript 地图的方法或需要专门的传单？
我们的目标是学习如何把它变成一个交互式 javascript 地图。还有比leaflet更好的选择吗？

标签： r ggplot2 rgdal maptools

【解决方案1】：

此代码生成带有leaflet 的地图：

remove.territories = function(.df) {
  subset(.df, 
         .df$id != "AS" &
           .df$id != "MP" &
           .df$id != "GU" & 
           .df$id != "PR" &
           .df$id != "VI" 
  )
}

x = c("leaflet", "rgdal", "maptools", "mapproj", "rgeos")
lapply(x, library, character.only = TRUE)

# From https://www.census.gov/geo/maps-data/data/cbf/cbf_state.html
us <- readOGR(dsn = "./cb_2014_us_state_5m.shp",
              layer = "cb_2014_us_state_5m", verbose = FALSE)

# convert it to Albers equal area
us_aea <- spTransform(us, CRS("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs"))
us_aea@data$id <- rownames(us_aea@data)

# extract, then rotate, shrink & move alaska (and reset projection)
# need to use state IDs via # https://www.census.gov/geo/reference/ansi_statetables.html
alaska <- us_aea[us_aea$STATEFP=="02",]
alaska <- elide(alaska, rotate=-50)
alaska <- elide(alaska, scale=max(apply(bbox(alaska), 1, diff)) / 2.3)
alaska <- elide(alaska, shift=c(-2100000, -2500000))
proj4string(alaska) <- proj4string(us_aea)

# extract, then rotate & shift hawaii
hawaii <- us_aea[us_aea$STATEFP=="15",]
hawaii <- elide(hawaii, rotate=-35)
hawaii <- elide(hawaii, shift=c(5400000, -1400000))
proj4string(hawaii) <- proj4string(us_aea)

# remove old states and put new ones back in; note the different order
# we're also removing puerto rico in this example but you can move it
# between texas and florida via similar methods to the ones we just used
us_aea <- us_aea[!us_aea$STATEFP %in% c("02", "15", "72"),]
us_aea <- rbind(us_aea, alaska, hawaii)
# transform data again
us_aea2 <- spTransform(us_aea, proj4string(us))
#Leaflet
map <- leaflet(us_aea2) 
pal <- colorNumeric(
  palette = "YlGnBu",
  domain = us_aea2$ALAND)
map %>% 
  addPolygons(
    stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
    color = ~ pal(ALAND)
  ) %>% 
  setView(lng = -98.579394, lat = 37, zoom = 4)

我的猜测是有一种更有效的方法可以做到这一点。

【讨论】：

【解决方案2】：

这行得通：

remove.territories = function(.df) {
  subset(.df, 
         .df$id != "AS" &
           .df$id != "MP" &
           .df$id != "GU" & 
           .df$id != "PR" &
           .df$id != "VI" 
  )
}

x = c("ggplot2", "rgdal", "maptools", "mapproj", "rgeos")
lapply(x, library, character.only = TRUE)
plain_theme = theme(axis.text=element_blank()) + 
  theme(panel.background = element_blank(), 
        panel.grid = element_blank(), 
        axis.ticks = element_blank())

no_ylab = ylab("") 
no_xlab = xlab("")

us <- readOGR(dsn = "./cb_2014_us_state_5m.shp",
              layer = "cb_2014_us_state_5m", verbose = FALSE)

# convert it to Albers equal area
us_aea <- spTransform(us, CRS("+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs"))
us_aea@data$id <- rownames(us_aea@data)

# extract, then rotate, shrink & move alaska (and reset projection)
# need to use state IDs via # https://www.census.gov/geo/reference/ansi_statetables.html
alaska <- us_aea[us_aea$STATEFP=="02",]
alaska <- elide(alaska, rotate=-50)
alaska <- elide(alaska, scale=max(apply(bbox(alaska), 1, diff)) / 2.3)
alaska <- elide(alaska, shift=c(-2100000, -2500000))
proj4string(alaska) <- proj4string(us_aea)

# extract, then rotate & shift hawaii
hawaii <- us_aea[us_aea$STATEFP=="15",]
hawaii <- elide(hawaii, rotate=-35)
hawaii <- elide(hawaii, shift=c(5400000, -1400000))
proj4string(hawaii) <- proj4string(us_aea)

# remove old states and put new ones back in; note the different order
# we're also removing puerto rico in this example but you can move it
# between texas and florida via similar methods to the ones we just used
us_aea <- us_aea[!us_aea$STATEFP %in% c("02", "15", "72"),]
us_aea <- rbind(us_aea, alaska, hawaii)
us50 <- fortify(us_aea, region="STUSPS")
us50 = remove.territories(us50)


#plot 
p = ggplot(data=us50) + 
  geom_map(map=us50, aes(x=long, y=lat, map_id=id, group=group), ,fill="white", color="dark grey", size=0.15) + 
  no_ylab + 
  no_xlab + 
  plain_theme
p

来源：

【讨论】：

有趣的变量名选择@ignacio
@hrbrmstr 从几个不同的教程中复制和粘贴

【解决方案3】：

更新：您现在可以使用fiftystaterpackage（可通过CRAN 和GitHub 获得）来执行此操作。

这是包作者的快速教程：

library(ggplot2)
library(fiftystater)

data("fifty_states") # this line is optional due to lazy data loading

crimes <- data.frame(state = tolower(rownames(USArrests)), USArrests)

# map_id creates the aesthetic mapping to the state name column in your data
p <- ggplot(crimes, aes(map_id = state)) + 
  # map points to the fifty_states shape data
  geom_map(aes(fill = Assault), map = fifty_states) + 
  expand_limits(x = fifty_states$long, y = fifty_states$lat) +
  coord_map() +
  scale_x_continuous(breaks = NULL) + 
  scale_y_continuous(breaks = NULL) +
  labs(x = "", y = "") +
  theme(legend.position = "bottom", 
        panel.background = element_blank())

p

该代码将生成此等值线：

【讨论】：