некоторые полигоны SF отсутствуют при построении в ggplot2 - PullRequest
1 голос
/ 08 мая 2020

Я пытаюсь построить данные на уровне округов США, но не могу понять, почему некоторые округа не отображаются. В этом игрушечном примере я сосредоточен только на округах Калифорнии и оставляю все ежедневные данные до конца, пока не отфильтрую вызов ggplot() (мой фактический вариант использования включает gganimate, поэтому мне нужны ежедневные данные).

enter image description here

library(tidyverse)
library(sf)
library(viridis)
library("rio")

# get county geometry
  url <- "https://gist.githubusercontent.com/ericpgreen/717596c37478ef894c14b250477fae92/raw/c2cf4b273a2c7f0677f22a37b5e9f7e893204e3b/cali.R"
  cali <- rio::import(url)

# get covid data
  covid <- read.csv("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv", 
                    stringsAsFactors = FALSE)

# prep covid data
  covidPrepped <-
  covid %>%
    filter(state=="California") %>%
    select(date, fips, cases, deaths) %>%
    mutate(date = lubridate::ymd(date)) %>%
    mutate(fips = stringr::str_pad(fips, width=5, pad="0")) %>%
    mutate(month = lubridate::month(date, 
                                    label=TRUE, 
                                    abbr=TRUE),
           day = lubridate::day(date),
           monthDay = paste(month, day, sep=" "))

# make sure every county has a row for every day
  complete <- 
  cali %>%
    left_join(covidPrepped, by = c("GEOID" = "fips")) %>%
    complete(date, GEOID, fill = list(cases = 0)) %>%
    select(date, GEOID, cases, monthDay)

# join back to geometry and construct casesPop
  pData <- 
  complete %>%
    left_join(select(cali, GEOID, NAME, estimate, geometry),
              by = "GEOID") %>%
    st_as_sf() %>%
    mutate(casesPop = (cases/estimate)*100000) %>%
    mutate(casesPop = ifelse(is.na(casesPop), 0, casesPop)) %>%
    mutate(group = cut(casesPop, 
                       breaks = c(0, 1, 3, 10, 30, 100, 
                                  300, 1000, 3000, 10000, 
                                  Inf),
                       labels = c(0, 1, 3, 10, 30, 100, 
                                  300, 1000, 3000, 10000),
                       include.lowest = TRUE)
    ) %>%
    select(GEOID, geometry, group, monthDay) 

# plot
  ggplot(pData %>% filter(monthDay=="May 5")) +
    geom_sf(aes(fill = group), color = "white", size=.1) +
    scale_fill_viridis_d(option = "magma", drop=FALSE) +
    coord_sf(crs = 102003) +
    theme_minimal() + 
    theme(legend.position = "top",
          legend.box = "horizontal",
          legend.title = element_blank(),
          legend.justification='left') +
    guides(fill = guide_legend(nrow = 1))

Отсутствующие округа:

missing <- pData %>% filter(monthDay=="May 5")
cali$GEOID[!(cali$GEOID %in% test$GEOID)]
#[1] "06035" "06049" "06091" "06105"

В этих округах нет данных covid на 5 мая, но Я думал, что это будет решено по телефону complete().

complete(date, GEOID, fill = list(cases = 0))

1 Ответ

0 голосов
/ 08 мая 2020

Я понял, что complete() оставляет дыры в monthDay, которые я использовал на более позднем этапе для фильтрации. Эти NA теряли при построении.

complete(date, GEOID, fill = list(cases = 0)) %>%
select(date, GEOID, cases, monthDay)

Поэтому я немного реорганизовал, чтобы создать monthDay после объединения полных данных с геометрическими данными.

library(tidyverse)
library(sf)
library(viridis)
library("rio")

# get county geometry
url <- "https://gist.githubusercontent.com/ericpgreen/717596c37478ef894c14b250477fae92/raw/c2cf4b273a2c7f0677f22a37b5e9f7e893204e3b/cali.R"
cali <- rio::import(url)

# get covid data
covid <- read.csv("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-counties.csv", 
                  stringsAsFactors = FALSE)

# prep covid data
covidPrepped <-
  covid %>%
  filter(state=="California") %>%
  select(date, fips, cases, deaths) %>%
  mutate(date = lubridate::ymd(date)) %>%
  mutate(fips = stringr::str_pad(fips, width=5, pad="0")) 

# make sure every county has a row for every day
complete <- 
  cali %>%
  left_join(covidPrepped, by = c("GEOID" = "fips")) %>%
  complete(GEOID, date, fill = list(cases = 0)) %>%
  select(date, GEOID, cases)

# join back to geometry and construct casesPop
pData <- 
  complete %>%
  left_join(select(cali, GEOID, NAME, estimate, geometry),
            by = "GEOID") %>%
  st_as_sf() %>%
  mutate(casesPop = (cases/estimate)*100000) %>%
  mutate(casesPop = ifelse(is.na(casesPop), 0, casesPop)) %>%
  mutate(group = cut(casesPop, 
                     breaks = c(0, 1, 3, 10, 30, 100, 
                                300, 1000, 3000, 10000, 
                                Inf),
                     labels = c(0, 1, 3, 10, 30, 100, 
                                300, 1000, 3000, 10000),
                     include.lowest = TRUE)
  ) %>%
  mutate(month = lubridate::month(date, 
                                  label=TRUE, 
                                  abbr=TRUE),
         day = lubridate::day(date),
         monthDay = paste(month, day, sep=" ")) %>%
  select(GEOID, geometry, group, monthDay) 

# plot
ggplot(pData %>% filter(monthDay=="May 5")) +
  geom_sf(aes(fill = group), color = "white", size=.1) +
  scale_fill_viridis_d(option = "magma", drop=FALSE) +
  coord_sf(crs = 102003) +
  theme_minimal() + 
  theme(legend.position = "top",
        legend.box = "horizontal",
        legend.title = element_blank(),
        legend.justification='left') +
  guides(fill = guide_legend(nrow = 1))
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...