有多少总统在任何时候都活着?

Question

这是我在实际数据集中遇到的问题的简化示例。我想知道在1776年的任何一年里，有多少总统(现任，未来和过去(还活着。我有一个数据集，显示每位总统的出生年份和死亡年份(或NA(。这是代码。

library(tidyverse)
library(lubridate)
library(rvest)
site <- read_html("https://www.presidentsusa.net/birth.html")
site %>% 
html_table() %>% 
.[[1]] %>% 
as_tibble() %>% 
select(birthdate = `Birth Date`, deathdate = `Death Date`) %>% 
mutate(birthdate = year(mdy(birthdate)), deathdate = year(mdy(deathdate)))

如果网站更改并破坏了我的代码，这是我数据集的dput。

structure(list(birthdate = c(1732, 1735, 1743, 1751, 1758, 1767, 
1767, 1782, 1773, 1790, 1795, 1784, 1800, 1804, 1791, 1809, 1808, 
1822, 1822, 1831, 1829, 1837, 1833, 1843, 1858, 1857, 1856, 1865, 
1872, 1874, 1882, 1884, 1890, 1917, 1908, 1913, 1913, 1924, 1911, 
1924, 1946, 1946, 1961, 1946), deathdate = c(1799, 1826, 1826, 
1836, 1831, 1848, 1845, 1862, 1841, 1862, 1849, 1850, 1874, 1869, 
1868, 1865, 1875, 1885, 1893, 1881, 1886, 1908, 1901, 1901, 1919, 
1930, 1924, 1923, 1933, 1964, 1945, 1972, 1969, 1963, 1973, 1994, 
2006, NA, 2004, 2018, NA, NA, NA, NA)), class = c("tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -44L))

我想创建一个两列的 tibble，其中一列代表年份，第二列显示全年有多少总统还活着(不包括任何在这一年中死亡的人(。这是我所需输出的前几行。

tibble(year = 1776:1779, alive = c(8,8,8,7))

我将不胜感激这里的任何指导。这在 Python 中是一个类似的问题，但我在将其适应 R 时遇到了麻烦。这是我到目前为止尝试过的。它有效，但似乎应该有一种更有效的方法，不涉及每年对整个数据集运行两个filter()操作。

filter <- dplyr::filter
df <- mutate(df, deathdate = replace_na(deathdate, 9999))
count_living <- function(year) {
df %>%
filter(birthdate < year, deathdate >= year) %>%
nrow()
}
tibble(year = 1776:2020,
alive = map_int(1776:2020, count_living))

Answer 1

在将NA替换为当前year并count遇到year的次数后，您可以在birthdate和deathdate之间创建一个序列。

library(dplyr)
library(lubridate)
df %>%
mutate(deathdate = replace(deathdate, is.na(deathdate), year(Sys.Date())), 
year = purrr::map2(birthdate, deathdate, seq)) %>%
tidyr::unnest(year) %>%
count(year, name = 'alive')

# A tibble: 289 x 2
#    year alive
#   <int> <int>
# 1  1732     1
# 2  1733     1
# 3  1734     1
# 4  1735     2
# 5  1736     2
# 6  1737     2
# 7  1738     2
# 8  1739     2
# 9  1740     2
#10  1741     2
# … with 279 more rows

---

在基本 R 中使用相同的逻辑：

df$deathdate[is.na(df$deathdate)] <- as.integer(format(Sys.Date(), "%Y"))
stack(table(unlist(Map(seq, df$birthdate, df$deathdate))))

Answer 2

这是使用IRanges的方法，它针对此问题进行了高度优化：

library(IRanges)
data$deathdate[is.na(data$deathdate)] <- 3000
Presidents <- IRanges(start = data$birthdate,end = data$deathdate)    
QueryYears <- IRanges(start = 1732:2020, width = 1)
Hits <- countOverlaps(QueryYears,Presidents)
Result <- data.frame(Year = 1732:2020, Count = Hits)
Result[order(Result$Count,decreasing = TRUE),]
#    Year Count
#91  1822    18
#92  1823    18
#93  1824    18
#94  1825    18
#95  1826    18
#100 1831    18
#102 1833    18
#103 1834    18
#104 1835    18
#105 1836    18
#106 1837    18
#...

我尽量不使用另一个包来回答问题，但IRanges是 R 工具包中的绝佳工具。它可以将此类问题的解决方案的性能提高几个数量级。