Создание карты Choropleth с данными уровня округа США

Question

Я пытаюсь составить краткую карту данных на уровне округов по инфекциям COVID-19 с использованием R. Я относительный новичок ie к R, так что ...

Я сделал некоторые довольно простые c вещи с ggmap для построения пространственных данных, но никогда ничего подобного. Обычно у меня просто есть интересные объекты, которые мне нужно наложить на карту, чтобы я мог использовать geom_point и их широту / долготу. В этом случае мне нужно построить базовую карту, а затем заполнить регионы, и я изо всех сил пытаюсь сделать это в мире ggplot.

Я следил за некоторыми примерами онлайн, которые я нашел, чтобы добраться до этого :

library(ggplot2)
library(broom)
library(geojsonio)

#get a county level map geoJSON file
counties <- geojson_read("https://eric.clst.org/assets/wiki/uploads/Stuff/gz_2010_us_050_00_500k.json", what = "sp")

#filter our alaska and Hawaii
lower48 <- counties[(counties@data$STATE != "02" & counties@data$STATE != "15") ,]

#turn it into a dataframe for ggmap
new_counties <- tidy(lower48)

# Plot it
print(ggplot() +
  geom_polygon(data = new_counties, aes( x = long, y = lat, group = group), fill="#69b3a2", color="white") +
  theme_void() +
  coord_map())

Который производит этот участок:

Пока все хорошо. Но мой информационный фрейм new_counties теперь выглядит следующим образом:

head(new_counties)
# A tibble: 6 x 7
   long   lat order hole  piece group id  
  <dbl> <dbl> <int> <lgl> <chr> <chr> <chr>
1 -85.4  33.9     1 FALSE 1     0.1   0    
2 -85.4  33.9     2 FALSE 1     0.1   0    
3 -85.4  33.9     3 FALSE 1     0.1   0    
4 -85.4  33.9     4 FALSE 1     0.1   0    
5 -85.4  33.9     5 FALSE 1     0.1   0    
6 -85.4  33.8     6 FALSE 1     0.1   0 

Так что я потерял все, что смогу получить ie к своим данным об инфекциях на уровне округа.

Мой данные имеют 5-ди git код FIPS для каждого округа. Первые две цифры - штат, а последние три - округ. Мой файл geo JSON содержит гораздо более подробный код FIPS. Я попытался получить только первые 5 и создать свой собственный элемент данных, который я мог отобразить обратно на

library(ggplot2)
library(broom)
library(geojsonio)

#get a county level map geoJSON file
counties <- geojson_read("https://eric.clst.org/assets/wiki/uploads/Stuff/gz_2010_us_050_00_500k.json", what = "sp")

#filter our alaska and Hawaii
lower48 <- counties[(counties@data$STATE != "02" & counties@data$STATE != "15") ,]

#add my own FIPS code
lower48@data$myFIPS <- substr(as.character(lower48@data$GEO_ID),1,5)  

#turn it into a dataframe for ggmap
new_counties <- tidy(lower48, region = "myFIPS")


# Plot it
print(ggplot() +
  geom_polygon(data = new_counties, aes( x = long, y = lat, group = group), fill="#69b3a2", color="white") +
  theme_void() +
  coord_map())

Но это приводит к этому графику

И я должен сказать, что я недостаточно знаком с метлой :: приборкой, чтобы точно знать, почему. По мере ввода текста я также замечаю, что мне нужно отфильтровать Пуэрто-Рико!

Если кто-нибудь может указать мне полезное направление ... Я не привержен нынешнему подходу, хотя хотел бы придерживаться ggplot2 или ggmap. Мой босс в конечном итоге хочет, чтобы я наложил определенные функции. В конечном итоге цель состоит в том, чтобы последовать примеру здесь и создать анимированную карту, показывающую данные с течением времени, но я, очевидно, далек от этого.

Answer 1

Есть много способов сделать это, но концепция в основном та же: найти карту, содержащую коды FIPS на уровне страны, и использовать их для связи с источником данных, также содержащим те же коды FIPS, а также переменную для построения графиков ( здесь число случаев covid-19 в день).

#devtools::install_github("UrbanInstitute/urbnmapr")
library(urbnmapr) # For map
library(ggplot2)  # For map
library(dplyr)    # For summarizing
library(tidyr)    # For reshaping
library(stringr)  # For padding leading zeros

---

# Get COVID cases, available from:
url <- "https://static.usafacts.org/public/data/covid-19/covid_confirmed_usafacts.csv
             ?_ga=2.162130428.136323622.1585096338-408005114.1585096338"

COV <- read.csv(url, stringsAsFactors = FALSE)
names(COV)[1] <- "countyFIPS"  # Fix the name of first column. Why!?

Данные хранятся в широком формате с разбивкой по дням в каждом округе по столбцам. Это нужно собрать до слияния с картой. Даты должны быть преобразованы в правильные даты. Коды FIPS хранятся в виде целых чисел, поэтому их необходимо преобразовать в символ с начальными 0, чтобы объединить данные карты. Я использую пакет urbnmap для данных карты.

Covid <- pivot_longer(COV, cols=starts_with("X"), 
                     values_to="cases",
                     names_to=c("X","date_infected"),
                     names_sep="X") %>%                
  mutate(date_infected = as.Date(date_infected, format="%m.%d.%Y"),
         countyFIPS = str_pad(as.character(countyFIPS), 5, pad="0"))

# Obtain map data for counties (to link with covid data) and states (for showing borders)
states_sf <- get_urbn_map(map = "states", sf = TRUE)
counties_sf <- get_urbn_map(map = "counties", sf = TRUE)

# Merge county map with total cases of cov
counties_cov <- inner_join(counties_sf, group_by(Covid, countyFIPS) %>%
       summarise(cases=sum(cases)), by=c("county_fips"="countyFIPS"))

counties_cov %>%
  ggplot() +
  geom_sf(mapping = aes(fill = cases), color = NA) +
  geom_sf(data = states_sf, fill = NA, color = "black", size = 0.25) +
  coord_sf(datum = NA) +   
  scale_fill_gradient(name = "Cases", trans = "log", low='pink', high='navyblue', 
                      na.value="white", breaks=c(1, max(counties_cov$cases))) +
  theme_bw() + theme(legend.position="bottom", panel.border = element_blank())

---

---

Для анимации вы можете использовать пакет gganimate и переходить через дни. Команды аналогичны приведенным выше, за исключением того, что скрытые данные не должны суммироваться.

library(gganimate)

counties_cov <- inner_join(counties_sf, Covid, by=c("county_fips"="countyFIPS"))

p <- ggplot(counties_cov) + ... # as above

p <- p + transition_time(date_infected) +
  labs(title = 'Date: {frame_time}')

animate(p, end_pause=30)

---