New Mothers: So much to do, so little sleep–HOW do they do it?!
Chris Abraham
2024-05-24
Overview
I split my Paternity Leave into two chunks, and am currently finishing up the second half. I have loved the time I get to spend with my wife and daughter, and wanted to share a project that addresses two main points:
- I have been hoping to create a data portfolio which shares some of my personal data projects.
- (More Importantly) I wanted to highlight just how much time and how little energy new moms experience. I don’t know how my wife does it! If you work with a new mom, please keep this in mind–they have a ton of added responsibilities, far less sleep, and the days remain 24 hours in length!
library(data.table)
library(dplyr)
library(ggplot2)
#Infile the Hatch Data
hatch_data=fread('E:/Hatch Project/HatchBabyExport (1).csv')
#Lets take a look at the data to understand what we are working with
glimpse(hatch_data)## Rows: 6,389
## Columns: 10
## $ `Baby Name` <chr> "Ava", "Ava", "Ava", "Ava", "Ava", "Ava", "Ava", "Ava", "…
## $ `Start Time` <chr> "07/14/2023 0:00 AM", "07/21/2023 0:47 AM", "07/21/2023 5…
## $ `End Time` <chr> "07/14/2023 0:00 AM", "07/21/2023 1:27 AM", "07/21/2023 6…
## $ Activity <chr> "Weight", "Feeding", "Feeding", "Feeding", "Feeding", "Fe…
## $ Amount <chr> "7.68750102052", "0", "0", "0", "0", "0", "Wet + Dirty", …
## $ Percentile <dbl> 0.70652, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, …
## $ Duration <dbl> NA, 40.000000, 36.000000, 25.000000, 33.000000, 32.000000…
## $ Info <chr> "", "Both", "Both", "Both", "Both", "Right", "", "", "", …
## $ Notes <chr> "", "", "", "", "", "", "", "", "", "", "", "", "", "", "…
## $ V10 <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…hatch_data %>% count(Activity)## Activity n
## 1: Diaper 1892
## 2: Feeding 2619
## 3: Length 6
## 4: Sleep 1850
## 5: Weight 22## Let's focus in on Sleep for now. Looks like we need to format the time columns
sleep_data=hatch_data %>% filter(Activity=='Sleep') %>%
mutate(start=as.POSIXct(`Start Time`, '%m/%d/%Y %H:%M %p', tz=Sys.timezone()),
end=as.POSIXct(`End Time`, '%m/%d/%Y %H:%M %p', tz=Sys.timezone()))
## Specifically, let's look at the AMOUNT OF SLEEP LOST
# Prior to the baby being born, my wife slept from 10:30PM to 6:30 AM
# If we can find the length of time between 10:30PM and 6:30 AM when the baby is AWAKE
# Then we can call that time lost sleep (bc my wife would have been sleeping otherwise)
## So we have a data set with all the intervals where the baby is ASLEEP
# let's use that to find the times where the baby is AWAKE
# by taking the end time of each row, paired with the start time of the next row
awake_table=sleep_data %>% arrange(start) %>%
mutate(next_sleep_starts=lead(start, 1)) %>%
mutate(Activity='AWAKE') %>%
rename(wake_window_start=end, wake_window_end=next_sleep_starts) %>%
select(Activity, wake_window_start, wake_window_end)
#Now that I created an AWAKE table, there is a problem of
# having a wake window that starts on one day and ends at the next
# So I will isolate the rows where the wake window spans multiple days,
# and cut them off at 11:59 on the start date, and re-start at 12:01 on the end date
awake_tbl_diffdays=awake_table %>%
filter(as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()) != as.Date(wake_window_end, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()) )
awake_tbl_diffdays_part1=awake_tbl_diffdays %>%
mutate(wake_window_end=as.POSIXct(paste(as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()), '23:59 PM'), '%Y-%m-%d %H:%M %p', tz=Sys.timezone()))
awake_tbl_diffdays_part2=awake_tbl_diffdays %>%
mutate(wake_window_start=as.POSIXct(paste(as.Date(wake_window_end, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()), '00:01 AM'), '%Y-%m-%d %H:%M %p', tz=Sys.timezone()))
awake_tbl_samedays=awake_table %>%
filter(as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()) == as.Date(wake_window_end, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()) )
awake_table2=rbind(awake_tbl_diffdays_part1, awake_tbl_diffdays_part2, awake_tbl_samedays) %>%
arrange(wake_window_start)
head(awake_table2)## Activity wake_window_start wake_window_end
## 1: AWAKE 2023-07-21 05:31:00 2023-07-21 06:08:00
## 2: AWAKE 2023-07-21 08:29:00 2023-07-21 10:12:00
## 3: AWAKE 2023-07-21 12:04:00 2023-07-21 12:48:00
## 4: AWAKE 2023-07-21 14:58:00 2023-07-21 15:57:00
## 5: AWAKE 2023-07-21 17:47:00 2023-07-21 18:51:00
## 6: AWAKE 2023-07-21 20:03:00 2023-07-21 22:05:00# this is tricky but fun
#Make each row into an "AWAKE INTERVAL"
#For each row, create a variable of "Should-be-sleeping" start and end times (12-630 AM, 10:30-11:59 PM)
#Make intervals for "should-be-sleeping" hours
# Find the intersection of AWAKE WINDOW and SHOULD-BE-SLEEPING
# That will tell us the times where Mom would normally be sleeping, but cannot b/c the baby is awake
awake_table3=awake_table2%>%
mutate(awake_interval=lubridate::as.interval(wake_window_start, wake_window_end)) %>%
mutate(am_start=as.POSIXct(paste(as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()), '0:01 AM'), tz=Sys.timezone()),
am_end=as.POSIXct(paste(as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()), '6:30 AM'), tz=Sys.timezone()),
pm_start=as.POSIXct(paste(as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone()), '22:30 PM'),tz=Sys.timezone()),
pm_end=as.POSIXct(paste(as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S',tz=Sys.timezone()), '23:59 PM'),tz=Sys.timezone())) %>%
mutate(wish_i_was_sleeping_interval_am=lubridate::as.interval(am_start, am_end),
wish_i_was_sleeping_interval_pm=lubridate::as.interval(pm_start, pm_end)) %>%
mutate(lost_sleep_am=lubridate::as.duration(intersect(awake_interval, wish_i_was_sleeping_interval_am)),
lost_sleep_pm=lubridate::as.duration(intersect(awake_interval, wish_i_was_sleeping_interval_pm)))
glimpse(awake_table3)## Rows: 1,894
## Columns: 12
## $ Activity <chr> "AWAKE", "AWAKE", "AWAKE", "AWAKE", "A…
## $ wake_window_start <dttm> 2023-07-21 05:31:00, 2023-07-21 08:29…
## $ wake_window_end <dttm> 2023-07-21 06:08:00, 2023-07-21 10:12…
## $ awake_interval <Interval> 2023-07-21 05:31:00 EDT--2023-07-…
## $ am_start <dttm> 2023-07-21 00:01:00, 2023-07-21 00:01…
## $ am_end <dttm> 2023-07-21 06:30:00, 2023-07-21 06:30…
## $ pm_start <dttm> 2023-07-21 22:30:00, 2023-07-21 22:30…
## $ pm_end <dttm> 2023-07-21 23:59:00, 2023-07-21 23:59…
## $ wish_i_was_sleeping_interval_am <Interval> 2023-07-21 00:01:00 EDT--2023-07-…
## $ wish_i_was_sleeping_interval_pm <Interval> 2023-07-21 22:30:00 EDT--2023-07-…
## $ lost_sleep_am <Duration> 2220s (~37 minutes), NA, NA, NA, …
## $ lost_sleep_pm <Duration> NA, NA, NA, NA, NA, NA, 2640s (~4…#last part, built in some time for lost sleep at each wake up--assuming Mom doesnt fall back asleep
# at the same time baby does!
lost_sleep_by_date=awake_table3 %>%
mutate(date=as.Date(wake_window_start, '%Y-%m-%d %H:%M:%S', tz=Sys.timezone())) %>%
mutate(wake_ups_during_sleephours=if_else(!is.na(lost_sleep_am)| !is.na(lost_sleep_pm), 1, 0)) %>%
group_by(date) %>%
summarise(lost_sleep_am=sum(lost_sleep_am, na.rm=T),
lost_sleep_pm=sum(lost_sleep_pm, na.rm=T),
wakeups_during_sleep_hours=sum(wake_ups_during_sleephours)) %>%
mutate(lost_sleep_total=lost_sleep_am+lost_sleep_pm+wakeups_during_sleep_hours*15*60) %>% #assume it takes mom 15 minutes (CONSERVATIVE) to get back to sleep
mutate(lost_minutes_am=lost_sleep_am/60,
lost_minutes_pm=lost_sleep_pm/60,
lost_minutes_total=lost_sleep_total/60)
#Note that there are a few days where lost sleep was negative
# this is likely due to an error in us entering sleep on the app, where we created overlapping sleep intervals
# the instances are few enough that I won't need to remove them
avg_daily_lostsleep=mean(lost_sleep_by_date$lost_minutes_total)
# Rather than make my x-axis dates, I will just make them the day number of our Daughter's life
sleep_plot=lost_sleep_by_date %>%
mutate(day_of_life=as.numeric(date-as.Date('7/14/2023', '%m/%d/%Y'))) %>%
arrange(day_of_life) %>%
mutate(rolling_7day_lostminutes=zoo::rollapply(lost_minutes_total,7,mean,align='center',fill=NA)) %>% #Smooth out some of the day-to-day volatility with a rolling average
mutate(rolling_7day_pct_oflostsleep=rolling_7day_lostminutes/480) %>%
mutate(fillcolor=if_else(rolling_7day_pct_oflostsleep > .2, "1",
if_else(rolling_7day_pct_oflostsleep < .1, "2", "3"))) %>% #make a color scale based on how badd the sleep deprivation is
ggplot(aes(x=day_of_life, y=rolling_7day_pct_oflostsleep))+
geom_bar(stat='identity', aes(fill=fillcolor))+
scale_fill_manual(values=c('darkorange', 'blue', 'darkgrey'), guide='none')+
geom_hline(yintercept=avg_daily_lostsleep/480, linetype='dotted')+
geom_text(aes(0,avg_daily_lostsleep/480,label = paste('Avg: ', round(100* avg_daily_lostsleep/480, 0), "%", sep=""), vjust = -0.5))+
scale_y_continuous(labels=scales::percent)+
labs(x="Day of Baby's Life", y= '% Of Sleep Mom Lost')+
annotate("text", x = 1, y = .1, label = "SURVIVAL\nNo time\nto enter data", size=3, fontface='bold.italic')+
annotate("text", x = 20, y = .29, label = "Newborn: Nobody Sleeps", size=3.5, fontface='italic')+
annotate("text", x = 100, y = .22, label = "Nice Stretch after 3 Months", size=3.5, fontface='italic')+
annotate("text", x = 144, y = .33, label = "Six Month Sleep\nRegression...lasts a while", size=3.5, fontface='italic')+
annotate("text", x = 300, y = .25, label = "Figuring things out\n for a moment?", size=3.5, fontface='italic')+
ggtitle("New Moms Lose 20% of their Normal Night Sleep Window!")+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
plot.title = element_text(size = 14, face = "bold")) #No Gridlines, Format the title
### Now lets do a second graph related to the time Mom spends feeding or changing the baby
# This should be much easier than the sleep data prep
feeding_table=hatch_data %>% filter(Activity=='Feeding') %>%
mutate(pump_duration=if_else(Info=='Bottle', 20, 0)) %>% #Estimate 20 minutes to pump a bottle
mutate(total_duration=pump_duration+Duration) %>%
select(`Start Time`, Activity, total_duration)
diaper_table=hatch_data %>% filter(Activity=='Diaper') %>%
mutate(total_duration=3) %>% #Assume 3 minutes for each diaper change
select(`Start Time`, Activity, total_duration)
feed_and_diaper=rbind(feeding_table, diaper_table) %>%
mutate(date=as.Date(`Start Time`, '%m/%d/%Y %H:%M %p', tz=Sys.timezone())) %>%
group_by(date, Activity) %>%
summarise(total_duration=sum(total_duration))
avg_hours_spent=feed_and_diaper %>% group_by(date) %>%
summarise(hours=sum(total_duration)/60) %>%
ungroup() %>%
summarise(avg_daily_hours=mean(hours))
avg_time=mean(avg_hours_spent$avg_daily_hours)
feed_diaper_plot=feed_and_diaper %>%
mutate(day_of_life=as.numeric(date-as.Date('7/14/2023', '%m/%d/%Y'))) %>%
group_by(Activity) %>%
arrange(Activity, day_of_life) %>%
mutate(rolling_7day_duration=zoo::rollapply(total_duration,7,mean,align='center',fill=NA)) %>%
mutate(rolling_7day_hours=rolling_7day_duration/60) %>%
ggplot(aes(x=day_of_life, y=rolling_7day_hours))+
geom_bar(stat='identity', aes(fill=Activity), position='stack')+
scale_fill_manual(values=c('darkorange', 'blue'))+
labs(fill="", x="Day of Baby's Life", y='Hours Spent')+
geom_hline(yintercept=avg_time, linetype='dashed')+
geom_text(aes(0,avg_time,label = paste('Avg: ', round(avg_time, 2), " Hours/Day", sep="")), x=250, y=avg_time+.2)+
ggtitle('10% of The Day is Spent Feeding/Pumping/Changing!')+
annotate("text", x = 60, y = 4.5, label = "Luckily newborns become more efficient eaters over time!", size=3, fontface='italic')+
theme(legend.position="bottom",
panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
panel.background = element_blank(), axis.line = element_line(colour = "black"),
plot.title = element_text(size = 14, face = "bold")) #No Gridlines, Format the titleIncluding Plots
My two plots from above:
