Creating a census table based on multiple variables

Question

I have a relatively big data table that essentially includes -people -where they live -what they do -move-in dates -move-out dates. My goal is to derive a running weekly census table with each week as a row, and a column for each occupation and city, populated with the headcount at that time.

#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
}}

score 1 · Accepted Answer · answered Oct 28 '21 at 00:50

Here's a possible solution using some tidyverse verbs, since you loaded that package. We loop over the weeks you're interested in using the map_dfr function, and for each week we collect a subset of the people who are there using your logic statement above. Then, we can use group_by to skip the double outer loop and count them directly. Finally, we mutate a new column for week to keep them straight after they're bound together. Outside of the loop, we then pivot_wider to get the one-column-per-occupation and one-row-per-week format that you're looking for.

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)

which returns

# 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

It looks like you're getting errors due to a couple typos. You're using the filter verb to ask for the cities column, but data only has a city column in the sample data set. Same for occupations vs occupation. Good to keep in mind for the future, but great first effort and nicely provided example!

score 1 · Answer 2 · answered Oct 28 '21 at 01:01

I used data.table. lubridate isn't needed, I used Sys.Date().
I made census a data.table also, instead of a matrix.
data.table::CJ is pretty much the same as expand.grid.
Then used mapply instead of for loops.
Finally, re-organized from long to wide, as I think that's what you wanted.
I left in all the city_occupation combinations - not sure if that was the intent.

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')

Gives:

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

Creating a census table based on multiple variables

2 Answers2