r - 传单::映射错误的国家名称

Question

我很难弄清楚为什么我无法在 map 上绘制正确的国家/地区。我已经完成了所有代码，但我仍然不明白为什么不能正常工作。

如果您看到任何问题，请告诉我。我很欣赏。

这是数据集

      Country Total Code
1        China 34620  CHN
2        Japan    89  JPN
3    Singapore    40  SGP
4     Thailand    32  THA
5    Hong Kong    26  HKG
6     S. Korea    24  KOR
7       Taiwan    17  TWN
8     Malaysia    16  MYS
9    Australia    15  AUS
10     Germany    14  DEU
11     Vietnam    13  VNM
12         USA    12  USA
13      France    11  FRA
14       Macao    10  MAC
15      U.A.E.     7  ARE
16      Canada     7  CAN
17 Philippines     3  PHL
18       India     3  IND
19       Italy     3  ITA
20        U.K.     3  GBR
21      Russia     2  RUS
22     Finland     1  FIN
23   Sri Lanka     1  LKA
24      Sweden     1  SWE
25       Nepal     1  NPL
26    Cambodia     1  KHM
27       Spain     1  ESP
28     Belgium     1  BEL

library(leaflet)
library(maps)
library(maptools)

case <- read.csv("Cases_02072020_v1.csv",stringsAsFactors = FALSE)
Country = map("world", fill = TRUE, plot = FALSE, regions=iso.expand(case$Code,regex = TRUE))

IDs <- sapply(strsplit(Country$names, ":"), function(x) x[1])
Country <- map2SpatialPolygons(Country, 
                               IDs=IDs, 
                               proj4string=CRS("+proj=longlat +datum=WGS84"))


pal <- colorNumeric(
  palette = "Blues",
  domain = as.numeric(case$Total))

case$labels <- sprintf(
  "<strong>Country:%s</strong><br/>Total:%g",
  case$Country, case$Total)%>% lapply(htmltools::HTML) 


leaflet(Country) %>% addTiles() %>%
  addPolygons(fillOpacity = 0.6,  smoothFactor = 0.5, stroke = TRUE, weight = 1, 
              color = pal(as.numeric(case$Total)),
              label = case$labels)

Answer 1

您需要重复 case 的每一行数据框，以便国家/地区匹配 map 上的每个单独的多边形。这意味着确保您正确订购它们，并且您还需要将澳门和香港纳入中国(或更改您拆分 ID 的方式以在那里处理它们)。

这是一个完整的工作版本:

library(leaflet)
library(maps)
library(maptools)

case <- structure(list(Country = c("China", "Japan", "Singapore", "Thailand",
"Hong Kong", "S. Korea", "Taiwan", "Malaysia", "Australia", "Germany",
"Vietnam", "USA", "France", "Macao", "U.A.E.", "Canada", "Philippines",
"India", "Italy", "U.K.", "Russia", "Finland", "Sri Lanka", "Sweden",
"Nepal", "Cambodia", "Spain", "Belgium"), Total = c(34620, 89,
40, 32, 26, 24, 17, 16, 15, 14, 13, 12, 11, 10, 7, 7, 3, 3, 3,
3, 2, 1, 1, 1, 1, 1, 1, 1), Code = c("CHN", "JPN", "SGP", "THA",
"HKG", "KOR", "TWN", "MYS", "AUS", "DEU", "VNM", "USA", "FRA",
"MAC", "ARE", "CAN", "PHL", "IND", "ITA", "GBR", "RUS", "FIN",
"LKA", "SWE", "NPL", "KHM", "ESP", "BEL")), row.names = c(NA,
-28L), class = "data.frame")



case <- case[order(case$Country), ]
Country = map("world", fill = TRUE, plot = FALSE, regions = iso.expand(case$Code,regex = F))
IDs <- Country$names
Country <- map2SpatialPolygons(Country,
                               IDs=IDs,
                               proj4string=CRS("+proj=longlat +datum=WGS84"))

case[nrow(case) + 1, ] <- case[case$Code == "ESP",]
case$Country[nrow(case)] <- "Canary Islands"
case$Country[case$Country == "S. Korea"] <- "South Korea"
case$Country[case$Country == "U.K."] <- "UK"
case$Country[case$Country == "U.A.E."] <- "United Arab Emirates"
case$Total[case$Country == "China"] <- case$Total[case$Country == "China"] +
                                       case$Total[case$Country == "Hong Kong"] +
                                       case$Total[case$Country == "Macao"]

case <- case[-which(case$Country == "Hong Kong"), ]
case <- case[-which(case$Country == "Macao"), ]
case <- case[order(case$Country), ]

reps <- as.numeric(table(sapply(strsplit(IDs, ":"), function(x) x[1])))
case <- do.call(rbind, mapply(function(x, y){ x[rep(1,y),]},
                              split(case, case$Country),
                              reps,
                              SIMPLIFY = F))
pal <- colorNumeric(
  palette = "Blues",
  domain = as.numeric(case$Total))


case$labels <- sprintf(
  "<strong>Country:%s</strong><br/>Total:%g",
  case$Country, case$Total)%>% lapply(htmltools::HTML)


leaflet(Country) %>% addTiles() %>%
  addPolygons(fillOpacity = 0.6,  smoothFactor = 0.5, stroke = TRUE, weight = 1,
              color = pal(as.numeric(case$Total)),
              label = case$labels)

显然这只是一个快照，但你可以看到中国的颜色是正确的。