library(foreign)
library(psych)
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggpubr)
library(egg)
library(survey)
library(forcats)
library(egg)
library(lubridate)

Let’s take a quick look at our data. We have ATUS data from 2019 to 2021. ATUS, initiated in 2003, employs a computer-assisted telephone interview method to collect information from a nationally representative sample of the U.S. noninstitutionalized population. One individual aged at least 15 years old in each selected household retrospectively reported daily activities and corresponding time intervals throughout the 24 hours. Data contain basic demographic information and time (in minutes) spent on each of the following activities:

  1. volunteer activities
  2. religious and spiritual activities
  3. civic obligations and education-related activities
  4. social, relaxing, and leisure activities
  5. telephone calls
ATUS<-read.dta("/Users/jiaoyu/Documents/Ph.D/projects/ATUS/data/atus_R.dta",convert.factors = F)
head(ATUS)
##   year      caseid region statefip county hh_numkids month age engage engage_n
## 1 2019 2.01901e+13      3       48  48000          0     1  85      0        0
## 2 2019 2.01901e+13      2       26  26000          1     1  25      0        0
## 3 2019 2.01901e+13      1       36  36047          0     1  20      0        0
## 4 2019 2.01901e+13      1       36  36005          0     1  61      0        0
## 5 2019 2.01901e+13      1       50  50000          1     1  34     55       55
## 6 2019 2.01901e+13      1       25  25017          0     1  53    192      192
##   volunteer_h2 volunteer_nh2 religion_h2 religion_nh2 civic_h2 civic_nh2
## 1            0             0           0          240        0         0
## 2            0             0           0            0        0         0
## 3            0             0           0            0        0         0
## 4            0             0           0            0        0         0
## 5            0             0           0            0        0         0
## 6           90            20           0            0        0         0
##   social_leisure_nh2 social_leisure_h2 education_nh2 education_h2 phone_h2
## 1                  0                 0             0            0        0
## 2                  0                 0             0            0        0
## 3                  0                 0             0            0        0
## 4                  0                 0             0            0        0
## 5                 35                 0             0            0        0
## 6                  0                40             0            0       60
##   phone_nh2 engage_h_not engage_nh_not tv volunteer_h1 volunteer_nh1
## 1         0            0           240 NA            0             0
## 2         0            0             0 NA            0             0
## 3         0            0             0 NA            0             0
## 4         0            0             0 NA            0             0
## 5         0            0            35 NA            0             0
## 6         0          190            20 NA           90           102
##   religion_h1 religion_nh1 civic_h1 civic_nh1 social_leisure_nh1
## 1           0          300        0         0                  0
## 2           0            0        0         0                  0
## 3           0            0        0         0                  0
## 4           0            0        0         0                  0
## 5           0            0        0         0                 55
## 6           0            0        0         0                  0
##   social_leisure_h1 education_nh1 education_h1 phone_h1 phone_nh1 engage_h
## 1                 0             0            0        0         0        0
## 2                 0             0            0        0         0        0
## 3                 0             0            0        0         0        0
## 4                 0             0            0        0         0        0
## 5                 0             0            0        0         0        0
## 6                40             0            0       60         0      190
##   engage_nh weekday season female mar foreignborn edu4 employ spouse race4
## 1       300       0      4      1   0           0    3      2      0     2
## 2         0       1      4      1   0           0    1      1      1     3
## 3         0       1      4      1   0           0    3      1      0     3
## 4         0       1      4      1   1           0    3      2      1     3
## 5        55       0      4      0   1           0    4      1      1     1
## 6       102       1      4      1   0           0    4      1      1     1
##     weight      wtn weight_inter     ym civic_edu_h civic_edu_nh diffany age3
## 1  2286292  2041308      2286292 2019.1           0            0       2    3
## 2 53729032 47103356     53729032 2019.1           0            0       1   25
## 3 23789098 20895104     23789098 2019.1           0            0       1   20
## 4 22241500 28980104     22241500 2019.1           0            0       1    1
## 5  2599756  2955964      2599756 2019.1           0            0       1   34
## 6 17223160 17129340     17223160 2019.1           0            0       1   53
##        p_h     p_nh
## 1 56.76189 76.43527
## 2 24.11634 28.87053
## 3 18.66152 38.83329
## 4 36.93901 66.17111
## 5 16.37354 54.14193
## 6 27.95344 44.00770

Alluvium plots

A summary of in-home and out-of-home social engagement time across three years (2019-2021).

library(ggalluvial)
df<-ATUS%>%filter(age>59)%>%select("engage_h","engage_nh", "year", "race4", "weight", "month", "caseid")

library(survey)
sydata<-svydesign(id=~caseid, weights=~weight, data=df)
datal<-svyby(~engage_h + engage_nh, ~year,   sydata, svymean,  keep.var=TRUE)

names(datal)<-c("year", "engage.1", "engage.2", "se.1","se.2")

al<-reshape(datal,
        direction = "long",
        idvar = "year",       # i
        timevar = "group",  # j
        varying = c("engage.1", "engage.2", "se.1","se.2"))
al$group<-factor(al$group, levels=c(1,2), labels=c("At home", "Outside home"))
ggplot(al, aes(axis1 = year, axis2 = group, y = engage)) +
   geom_alluvium(aes(fill =group)) +
  geom_stratum( alpha = .5) +
scale_x_discrete(expand = c(.1, .1)) +
  scale_fill_viridis_d() +
  theme_minimal() +
 geom_text(stat = "stratum",
            aes(label = after_stat(stratum))) +
  scale_x_discrete(limits = c("year", "group"),
                   expand = c(0.15, 0.05)) +
  theme_void()+
   geom_text(aes(label = paste0(round(engage, 0), "min")), stat = "flow", nudge_x = -.25, alpha=0.7, size=3.5) + 
  labs(title = "",
      # subtitle = "",
       x = NULL,
       fill = NULL,
       y = "")  # the \n adds a line break

Line plots

Here we present a line plot to show how older adults use their time before and over the course of the pandemic. Note, due to the impact of the pandemic, data collection was paused from March 18, 2020, to May 9, 2020. We actually have a missing month for April 2020. Time spent outside home plummeted since the national lockdown.

df<-ATUS%>%filter(age>59)%>%select("engage_h","engage_nh", "year", "race4", "weight", "month", "caseid", "female", "edu4" )%>%mutate(ym=format(lubridate::ym(paste0(year,month)), "%Y.%m"), eg=engage_h+engage_nh)
df$ym<-as.factor(df$ym)

library(survey)
sydata<-svydesign(id=~caseid, weights=~weight, data=df)

datline<-svyby(~engage_h + engage_nh+eg, ~ym,   sydata,svymean,  keep.var=TRUE)
names(datline)<-c("ym", "engage.1", "engage.2","engage.3", "se.1","se.2", "se.3")

line<-reshape(datline,
        direction = "long",
        idvar = "ym",       # i
        timevar = "group",  # j
        varying = c("engage.1", "engage.2", "engage.3","se.1","se.2","se.3"))
line$group<-factor(line$group, levels=c(1,2,3), labels=c("In home", "Out-of-home", "Total"))

line$upper<-line$engage+1.96*line$se
line$lower<-line$engage-1.96*line$se
line$time<-seq(1,nrow(line), 1)
lplot<-ggplot(data=line, aes(x = ym, y = engage, color= group, group= group)) +
  #geom_rect(aes(xmin='2019.01',
                 # xmax = '2019.12',
                 # ymin = -Inf,
                #   ymax = Inf),  fill = "grey85",  alpha = 0.03) +
    #geom_rect(aes(xmin='2021.01',
               # xmax = '2021.12',
               #   ymin = -Inf,
               #   ymax = Inf),  fill = "grey85",  alpha = 0.03) +
  geom_line( size=0.5) +
  geom_point(  size = 1.5)+
 #geom_ribbon(aes(ymin=lower, ymax=upper), linetype=2, alpha=0.01)+
  
  geom_vline(xintercept = "2020.05",
               colour = "grey40",
               linetype = 2)+ # vertical line
 # geom_vline(xintercept = "2021.08",
              # colour = "grey40",
               #linetype = 2)+ # vertical line
  labs( x= "Month" , y= 'Time (min)',title= "", color="", type="", size=8)+
  hrbrthemes::theme_ipsum()+
  theme(axis.text.x = element_text(angle = 90, vjust=0.5, hjust=1, size=5), legend.title = element_blank(),legend.text = element_text(size=8))+
  scale_color_manual(values = c("#D16103", "#293352","#9999CC")) +
  coord_cartesian(ylim = c(0,100))

Here gganimate gives us a nice animation plot.

library(gganimate)


lplot+geom_point() +
  transition_reveal(time)