我是 R 的新手，并且真的在為一個感覺很簡單的問題而苦苦掙扎（我一直無法找到答案）。
我有一個相對較大的資料表，其中主要包括 - 人們 - 他們住在哪里 - 他們做什么 - 搬入日期 - 搬出日期。我的目標是生成一個每周運行的人口普查表，每周作為一行，每個職業和城市都有一個列，填充當時的人數。
#MRE
library(tidyverse)
library(lubridate)
data <- data.frame(
first_names = c("joe", "sally", "bob", "frank", "susy"),
move_in = as.Date(c("2020-01-01", "2021-01-04", "2020-04-01", "2018-12-20", "2019-10-12")),
move_out = as.Date(c("2021-01-01", NA, "2021-10-01", NA, NA)),
city = c("Denver", "Phoenix", "Austin", "Denver", "Seattle"),
occupation = c("doctor", "doctor", "architect", "teacher", "teacher"))
#what I've tried :
cities = unique(data$city)[!is.na(unique(data$city))]
occupations = unique(data$occupation)[!is.na(unique(data$occupation))]
weeks <- (date = seq(from = as.Date("2020-12-27"), to = as.Date(today()), by="1 week"))
census <- matrix(data=NA, nrows=44, ncols=12)
for (i in seq(cities)){
for (j in seq(occupations)){
count <- data %>%
filter(cities == i) %>%
filter(occupations == j) %>%
sapply(weeks, function(x)
sum(
((as.Date(data$move_in)) <= as.Date(x) &
(as.Date(data$move_out)) > as.Date(x))|
((as.Date(data$move_in)) <= as.Date(x) &
is.na(data$move_out))))
census[j,x] <- count
}}
任何幫助是極大的贊賞！
uj5u.com熱心網友回復：
這是使用一些 tidyverse 動詞的可能解決方案，因為您加載了該包。我們會在您有興趣使用該map_dfr函式的幾周內回圈，并且每周我們都會使用您的上述邏輯陳述句收集在場人員的一個子集。然后，我們可以使用group_by跳過雙外回圈和count它們直接。最后，我們mutate為一周開設了一個新專欄，以便在將它們系結在一起后使它們保持直立。在回圈之外，我們然后pivot_wider獲得您正在尋找的每職業一列和每周一行的格式。
library(tidyverse)
data <- data.frame(
first_names = c("joe", "sally", "bob", "frank", "susy"),
move_in = as.Date(c("2020-01-01", "2021-01-04", "2020-04-01", "2018-12-20", "2019-10-12")),
move_out = as.Date(c("2021-01-01", NA, "2021-10-01", NA, NA)),
city = c("Denver", "Phoenix", "Austin", "Denver", "Seattle"),
occupation = c("doctor", "doctor", "architect", "teacher", "teacher"))
# Avoid needing to load lubridate by using Sys.Date() instead of today()
weeks <- (date = seq(from = as.Date("2020-12-27"), to = as.Date(Sys.Date()), by="1 week"))
map_dfr(weeks, function(week_i){
data %>%
filter(move_in<week_i & move_out > week_i | move_in < week_i & is.na(move_out)) %>%
group_by(city, occupation) %>%
count() %>%
mutate(week=week_i)
}) %>%
pivot_wider(values_from = n, names_from = occupation, values_fill = 0)
回傳
# A tibble: 170 x 5
# Groups: city [4]
city week architect doctor teacher
<chr> <date> <int> <int> <int>
1 Austin 2020-12-27 1 0 0
2 Denver 2020-12-27 0 1 1
3 Seattle 2020-12-27 0 0 1
4 Austin 2021-01-03 1 0 0
5 Denver 2021-01-03 0 0 1
6 Seattle 2021-01-03 0 0 1
7 Austin 2021-01-10 1 0 0
8 Denver 2021-01-10 0 0 1
9 Phoenix 2021-01-10 0 1 0
10 Seattle 2021-01-10 0 0 1
# ... with 160 more rows
由于幾個錯別字，您似乎遇到了錯誤。您正在使用filter動詞請求cities列，但資料city在示例資料集中只有一列。occupationsvs相同occupation。很高興為未來記住，但偉大的第一次努力和很好的例子！
uj5u.com熱心網友回復：
我使用了資料表。 lubridate不需要，我使用了 Sys.Date()。
我也將人口普查設為 data.table，而不是矩陣。
data.table::CJ 與 expand.grid 幾乎相同。
然后使用 mapply 而不是 for 回圈。
最后，從長到寬重新組織，因為我認為這就是您想要的。
我留下了所有 city_occupation 組合 - 不確定這是否是意圖。
library(data.table)
library(magrittr)
data <- data.frame(
first_names = c("joe", "sally", "bob", "frank", "susy"),
move_in = as.Date(c("2020-01-01", "2021-01-04", "2020-04-01", "2018-12-20", "2019-10-12")),
move_out = as.Date(c("2021-01-01", NA, "2021-10-01", NA, NA)),
city = c("Denver", "Phoenix", "Austin", "Denver", "Seattle"),
occupation = c("doctor", "doctor", "architect", "teacher", "teacher"))
cities <- unique(data$city)[!is.na(unique(data$city))]
occupations <- unique(data$occupation)[!is.na(unique(data$occupation))]
weeks <- (date = seq(from = as.Date("2020-12-27"), to = Sys.Date(), by="1 week"))
data %>% setDT()
census <- CJ(week = weeks, city = cities, occupation = occupations) %>%
.[, count := mapply(function(wk, cty, occ) {
data[city == cty & occupation == occ,
sum(move_in <= wk & (move_out > wk | is.na(move_out)))]
}, week, city, occupation)]
census %<>% dcast(week ~ city occupation, value.var = 'count')
給出：
census
week Austin_architect Austin_doctor Austin_teacher Denver_architect
1: 2020-12-27 1 0 0 0
2: 2021-01-03 1 0 0 0
3: 2021-01-10 1 0 0 0
4: 2021-01-17 1 0 0 0
5: 2021-01-24 1 0 0 0
6: 2021-01-31 1 0 0 0
7: 2021-02-07 1 0 0 0
8: 2021-02-14 1 0 0 0
9: 2021-02-21 1 0 0 0
10: 2021-02-28 1 0 0 0
11: 2021-03-07 1 0 0 0
12: 2021-03-14 1 0 0 0
13: 2021-03-21 1 0 0 0
14: 2021-03-28 1 0 0 0
15: 2021-04-04 1 0 0 0
16: 2021-04-11 1 0 0 0
17: 2021-04-18 1 0 0 0
18: 2021-04-25 1 0 0 0
19: 2021-05-02 1 0 0 0
20: 2021-05-09 1 0 0 0
21: 2021-05-16 1 0 0 0
22: 2021-05-23 1 0 0 0
23: 2021-05-30 1 0 0 0
24: 2021-06-06 1 0 0 0
25: 2021-06-13 1 0 0 0
26: 2021-06-20 1 0 0 0
27: 2021-06-27 1 0 0 0
28: 2021-07-04 1 0 0 0
29: 2021-07-11 1 0 0 0
30: 2021-07-18 1 0 0 0
31: 2021-07-25 1 0 0 0
32: 2021-08-01 1 0 0 0
33: 2021-08-08 1 0 0 0
34: 2021-08-15 1 0 0 0
35: 2021-08-22 1 0 0 0
36: 2021-08-29 1 0 0 0
37: 2021-09-05 1 0 0 0
38: 2021-09-12 1 0 0 0
39: 2021-09-19 1 0 0 0
40: 2021-09-26 1 0 0 0
41: 2021-10-03 0 0 0 0
42: 2021-10-10 0 0 0 0
43: 2021-10-17 0 0 0 0
44: 2021-10-24 0 0 0 0
week Austin_architect Austin_doctor Austin_teacher Denver_architect
Denver_doctor Denver_teacher Phoenix_architect Phoenix_doctor
1: 1 1 0 0
2: 0 1 0 0
3: 0 1 0 1
4: 0 1 0 1
5: 0 1 0 1
6: 0 1 0 1
7: 0 1 0 1
8: 0 1 0 1
9: 0 1 0 1
10: 0 1 0 1
11: 0 1 0 1
12: 0 1 0 1
13: 0 1 0 1
14: 0 1 0 1
15: 0 1 0 1
16: 0 1 0 1
17: 0 1 0 1
18: 0 1 0 1
19: 0 1 0 1
20: 0 1 0 1
21: 0 1 0 1
22: 0 1 0 1
23: 0 1 0 1
24: 0 1 0 1
25: 0 1 0 1
26: 0 1 0 1
27: 0 1 0 1
28: 0 1 0 1
29: 0 1 0 1
30: 0 1 0 1
31: 0 1 0 1
32: 0 1 0 1
33: 0 1 0 1
34: 0 1 0 1
35: 0 1 0 1
36: 0 1 0 1
37: 0 1 0 1
38: 0 1 0 1
39: 0 1 0 1
40: 0 1 0 1
41: 0 1 0 1
42: 0 1 0 1
43: 0 1 0 1
44: 0 1 0 1
Denver_doctor Denver_teacher Phoenix_architect Phoenix_doctor
Phoenix_teacher Seattle_architect Seattle_doctor Seattle_teacher
1: 0 0 0 1
2: 0 0 0 1
3: 0 0 0 1
4: 0 0 0 1
5: 0 0 0 1
6: 0 0 0 1
7: 0 0 0 1
8: 0 0 0 1
9: 0 0 0 1
10: 0 0 0 1
11: 0 0 0 1
12: 0 0 0 1
13: 0 0 0 1
14: 0 0 0 1
15: 0 0 0 1
16: 0 0 0 1
17: 0 0 0 1
18: 0 0 0 1
19: 0 0 0 1
20: 0 0 0 1
21: 0 0 0 1
22: 0 0 0 1
23: 0 0 0 1
24: 0 0 0 1
25: 0 0 0 1
26: 0 0 0 1
27: 0 0 0 1
28: 0 0 0 1
29: 0 0 0 1
30: 0 0 0 1
31: 0 0 0 1
32: 0 0 0 1
33: 0 0 0 1
34: 0 0 0 1
35: 0 0 0 1
36: 0 0 0 1
37: 0 0 0 1
38: 0 0 0 1
39: 0 0 0 1
40: 0 0 0 1
41: 0 0 0 1
42: 0 0 0 1
43: 0 0 0 1
44: 0 0 0 1
Phoenix_teacher Seattle_architect Seattle_doctor Seattle_teacher
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/340978.html