r - 如何在 R 中创建参议院点名投票地图

Question

我希望最终在 Leaflet 中呈现一张地图，显示参议院特定投票的唱名投票结果。这显然涉及根据参议员的党派关系和他们的投票方式（每个州 2 名参议员）的独特组合为州多边形着色。我遇到的问题是以这种方式开发一个工作流程来对一个州进行颜色编码（这里我使用的是美国各州的简单 sf 数据框）。这个想法是根据参议员的党派和投票类型，用两种不同的颜色“条纹”该州。

下面是一个已经创建的工作流程，用于查看国会选区的唱名投票结果（不是我想要的，我想为参议院投票这样做），但我认为这将是希望创建一个起点或基线参议院唱名表决的类似地图。此代码可在https://www.r-bloggers.com/2020/09/mapping-congressional-roll-calls/找到。唯一不同的是，我提供了一个我在另一个网站上找到的功能，可以直接从 UCLA 政治科学系提供的网站上读取国会选区 shapefile：

# Workflow for mapping congressional district roll call voting results
library(Rvoteview)
library(tidyverse)
devtools::install_github("jaytimm/wnomadds")
library(wnomadds)
library(sf)
library(tigris)

# Function to download a shapefile for any congressional district of your choice.
get_congress_map <- function(cong=113) {
  tmp_file <- tempfile()
  tmp_dir  <- tempdir()
  zp <- sprintf("http://cdmaps.polisci.ucla.edu/shp/districts%03i.zip",cong)
  download.file(zp, tmp_file)
  unzip(zipfile = tmp_file, exdir = tmp_dir)
  fpath <- paste(tmp_dir, sprintf("districtShapes/districts%03i.shp",cong), sep = "/")
  st_read(fpath)
}

# Get the shapefile for the 89th congress
cd89 <- get_congress_map(cong = 89)

options(tigris_use_cache = TRUE, tigris_class = "sf")
# List the FIPS for US territories (and Alaska and Hawaii) that we won't include in maps.
nonx <- c('78', '69', '66', '72', '60', '15', '02')

# Create a simple states dataframe
states <- tigris::states(cb = TRUE) %>%
  data.frame() %>%
  select(STATEFP, STUSPS) %>%
  rename(state_abbrev = STUSPS)

# Join the congressional districts shapefile with the simple states dataframe we
# created above.
  cd_sf <- cd89 %>%
  mutate(STATEFP = substr(ID, 2, 3),
         district_code = as.numeric(substr(ID, 11, 12))) %>%
  left_join(states, by = "STATEFP") %>%
  filter(!STATEFP %in% nonx) %>%
  select(STATEFP, state_abbrev, district_code) 
  
# Download rollcall data from the Voteview database. Here for the Voting
# Rights Act of 1965
  vra <- Rvoteview::voteview_search('("VOTING RIGHTS ACT OF 1965") AND (congress:89) 
                                  AND (chamber:house)') %>%
         filter( date == '1965-07-09') %>%
         janitor::clean_names()
  votes <- Rvoteview::voteview_download(vra$id)
  names(votes) <- gsub('\\.', '_', names(votes))
  
# Restructure the roll call voting data stored in votes
  big_votes <- votes$legis_long_dynamic %>%
    left_join(votes$votes_long, by = c("id", "icpsr")) %>%
    filter(!grepl('POTUS', cqlabel)) %>%
    group_by(state_abbrev) %>%
    mutate(n = length(district_code)) %>%
    ungroup() %>%
    mutate(avote = case_when(vote %in% c(1:3) ~ 'Yea',
                             vote %in% c(4:6) ~ 'Nay',
                             vote %in% c(7:9) ~ 'Not Voting'),
           
           party_code = case_when(party_code == 100 ~ 'Dem',
                                  party_code == 200 ~ 'Rep' ), 
           Party_Member_Vote = paste0(party_code, ': ', avote),
           
           ## fix at-large -- 
           district_code = ifelse(district_code %in% c(98, 99), 0, district_code),
           district_code = ifelse(n == 1 & district_code == 1, 0, district_code),
           district_code = as.integer(district_code)) %>%
    select(-n)
  #Members who represent historical “at-large” districts are 
  ##assigned 99, 98, or 1 in various circumstances. Per VoteView.
  
  # Make the Party_Member_Vote variable a factor and change the order of its levels.
  big_votes$Party_Member_Vote <- factor(big_votes$Party_Member_Vote)
  big_votes$Party_Member_Vote <- 
    factor(big_votes$Party_Member_Vote, 
           levels(big_votes$Party_Member_Vote)[c(3,6,1,4,2,5)])
  
  # Join the roll call voting data with the shapefile and plot.
  cd_sf_w_rolls <- cd_sf %>% 
    left_join(big_votes, by = c("state_abbrev", "district_code")) 
  
  main1 <- cd_sf_w_rolls %>%
    ggplot() + 
    geom_sf(aes(fill = Party_Member_Vote), 
            color = 'white',
            size = .25) + 
    wnomadds::scale_fill_rollcall() +
    theme_minimal() +
    theme(axis.title.x=element_blank(),
          axis.text.x=element_blank(),
          axis.title.y=element_blank(),
          axis.text.y=element_blank(),
          legend.position = 'none') # +
  main1 + ggtitle(vra$short_description)

这对于根据众议院的唱名投票绘制国会选区是很好的。我正试图找出一种方法来重现类似的参议院唱名投票地图。因此，我从相同的工作流程开始，不确定如何进一步进行，或者是否可能：

# Now I want to make a similar map for the senators of each state, not
# the representatives.
  
# I want to include Hawaii and Alaska in my Senate maps, so remove those FIPS
# from the vector.
non_states <- c('78', '69', '66', '72', '60', '11')
  
# No congressional district shapefile is therefore needed. So, here I just make 
# a simple sf dataframe for the US States. Set the coordinate reference system to 
# 4326 (World Geodetic System 1984) because I want to render the map in Leaflet
# and that's the reference system Leaflet uses.
states_Senate <- tigris::states(cb = TRUE) %>%
  st_as_sf(crs = 4326) %>%
  select(STATEFP, STUSPS, geometry) %>%
  filter(!STATEFP %in% non_states) %>%
  rename(state_abbrev = STUSPS)

# Query a roll call vote in the Voteview database. Any vote will work, here
# a vote related to marketing of non-prescription drugs in the 116th congress in the
# Senate now, not the House.
vra2 <- Rvoteview::voteview_search('("A bill to amend the Federal Food, Drug, and Cosmetic Act") 
                                  AND (congress:116) AND (chamber:senate)') %>%
       janitor::clean_names()

votes2 <- Rvoteview::voteview_download(vra2$id)
names(votes2) <- gsub('\\.', '_', names(votes2))

# Restructure the roll call voting data stored in votes2
big_votes2 <- votes2$legis_long_dynamic %>%
  left_join(votes2$votes_long, by = c("id", "icpsr")) %>%
  filter(!grepl('POTUS', cqlabel)) %>%
  mutate(avote = case_when(vote %in% c(1:3) ~ 'Yea',
                           vote %in% c(4:6) ~ 'Nay',
                           vote %in% c(7:9) ~ 'Not Voting'),
         
         party_code = case_when(party_code == 100 ~ 'Dem',
                                party_code == 200 ~ 'Rep' ), 
         Party_Member_Vote = paste0(party_code, ': ', avote))

# Now I have a dataframe, big_votes2 that has 2 rows for each state. I need to figure
# out how to color the polygons for each state based on the unique combination of 
# party affiliation and vote cast.

# Make Party_Member_Vote a factor like the congressional district workflow above,
# join big_votes2 with states_Senate sf dataframe, and plot........finishing this
# workflow and making a Senate map is essentially my question.

我希望制作一张看起来与以下类似的最终地图（可在https://voteview.com/rollcall/RS1160389找到），这是我在创建工作流脚本中提供的示例查询的结果点名投票正上方的参议院地图（关于非处方药的唱名投票）。这可能是在 Javascript 中完成的，也许是 D3，但我正在开发一个 R Shiny 应用程序来查看点名投票，所以我严格希望在 R 中做到这一点。

在这里，州多边形被参议员所在的政党及其投票方式“条纹化”。如果一个州的参议员都是一个政党并且一致投票，则该州是反映这一点的纯色。调色板基于包装中voteview_pal提供的。wnomadds此调色板中的颜色不包括认为自己独立的参议员，但如果有在状态多边形内创建条纹图案的解决方案，我可以更新调色板。在我使用 RI 时，我想不出一种方法来实现这一点，因为颜色填充是基于因子变量的唯一级别，在这里我们必须为每个状态设置行，因为数据框是在这个工作流程中创建的。此外，我从未见过图案或条纹填充ggplot即使数据帧以每个状态只有 1 行/观察的方式排列，也可以实现这一点。如果这是可能的，我想在 Leaflet 中呈现它，但如果可以通过在其中绘制 sf 对象来完成基本概念，ggplot我很乐意从那里开始。任何帮助将不胜感激。

标签： rggplot2mapssfr-leaflet