Motivation

I downloaded iMessage data to make a text mining Valentine for my LDR SO in February. I’ve recently been wondering how frequent our texts are when we are apart vs. together. I figured I could visualize this by plotting daily counts of messages and shading time intervals when we were in the same city.

How to get a csv of iMessage data!

Here are the steps:

  1. Download zip from here: now you have a iMessage-Export-master folder. Put that wherever you want on your computer.

  2. On your mac: Finder>Go>Go To Folder. Type in ~/Library/Messages. Copy the chat.db file into the iMessage-Export-master folder you got from step 1.

  3. Create a contacts.txt file featuring contact numbers you want to identify with names. E.g., for the purposes of this work, this is just my and Jesse’s numbers. The text file just contains the following (numbers partially X’d for privacy reasons #dataethics):

+1917XXXXXXX Alex

+1262XXXXXXX Jesse

  1. Go to Terminal. Navigate to wherever your iMessage-Export-master folder lives (via cd command). Run php contacts.php >> contacts.txt. Then run php export-csv.php.

You should now have a folder messages in iMessage-Export-master. Within that folder is a messages.csv file. Names that you identified in contacts.txt will be coded in. TA DA!

Load and shape data

Pull in the csv.

#fix time and date
# make all messages lowercase
messages<-read.csv('iMessage-Export-master/messages/messages.csv')
messages$Message<-as.character(messages$Message)
messages$Message<-tolower(messages$Message)

Subset to messages between me and Jesse.

messagesja <- messages[ which(messages$To.Name=='Jesse' | messages$From.Name=='Jesse'), ]
nrow(messagesja)
[1] 57608

This time period (5-3-17 to 4-26-18) includes 57,608 text messages! (That includes reactions to messages as well.)

messagesja<-messagesja[,c("Date", "Message")]
messagesja$Date <- as.Date(messagesja$Date)
# calculate how many messages per day and plot that over the year! 
library(dplyr)
#calculate total messages by day
jatot<-messagesja %>% 
  group_by(Date) %>% 
  summarise(n = n())
#some days have 0 and we want these to show up as 0
#so we create a dataframe of all days 5-3-17 to 4-26-18 and merge that with jatot
df <- data.frame(Date=seq(as.Date("2017/5/3"), as.Date("2018/4/26"), "days")) 
jatot<-merge(jatot,df,by="Date", all=T)
jatot$n[is.na(jatot$n)] <- 0
#save this csv so I can then add data about when together and when not together manually out of R
write.csv(jatot, "jatot.csv", row.names = F)

Let’s graph

Use my regular theme.

library(ggplot2);library(ggrepel); library(extrafont); library(ggthemes);library(reshape);library(grid);
library(scales);library(RColorBrewer);library(gridExtra);
my_theme <- function() {
  # Define colors for the chart
  palette <- brewer.pal("Greys", n=9)
  color.background = palette[2]
  color.grid.major = palette[4]
  color.panel = palette[3]
  color.axis.text = palette[9]
  color.axis.title = palette[9]
  color.title = palette[9]
  # Create basic construction of chart
  theme_bw(base_size=9, base_family="Palatino") + 
  # Set the entire chart region to a light gray color
  theme(panel.background=element_rect(fill=color.panel, color=color.background)) +
  theme(plot.background=element_rect(fill=color.background, color=color.background)) +
  theme(panel.border=element_rect(color=color.background)) +
  # Format grid
  theme(panel.grid.major=element_line(color=color.grid.major,size=.25)) +
  theme(panel.grid.minor=element_blank()) +
  theme(axis.ticks=element_blank()) +
  # Format legend
  theme(legend.position="bottom") +
  theme(legend.background = element_rect(fill=color.background)) +
  theme(legend.text = element_text(size=8,color=color.axis.title)) + 
  theme(legend.title = element_blank()) + 
  
  #Format facet labels
  theme(strip.text.x = element_text(size = 8, face="bold"))+
  # Format title and axes labels these and tick marks
  theme(plot.title=element_text(color=color.title, size=28)) +
  theme(axis.text.x=element_text(size=8)) +
  theme(axis.text.y=element_text(size=8)) +
  theme(axis.title.x=element_text(size=8)) +
  theme(axis.title.y=element_text(size=8)) +
  #Format title and facet_wrap title
  theme(strip.text = element_text(size=8), plot.title = element_text(size = 16, colour = "black", vjust = 1, hjust=0))+
    
  # Plot margins
  theme(plot.margin = unit(c(.2, .2, .2, .2), "cm"))
}

I added in data about whether we were together or not in jatot_together.csv. Let’s pull this in.

jaall<-read.csv('jatot_together.csv')
jaall$Date<-as.Date(jaall$Date, "%m/%d/%y")
nrow(subset(jaall, together==1))
[1] 184

We were together 184 days out of the year!! I didn’t know that stat until now (thus the !!). Now, we plot!

ggplot(jaall,aes(x=Date,y=n, group =1)) + geom_point(size=1)+ 
  geom_line(size=.6)+
  my_theme()+ 
  ggtitle("Text Me Back: A Year of LDR Communication", subtitle="Daily Count of iMessages between Alex and Jesse [5/3/17 - 4/26/18]") + 
  scale_x_date(labels = date_format("%b %Y"), date_breaks = "1 month")+
  scale_y_continuous(breaks = seq(0,1000,100), lim = c(0, 1000))+
  geom_rect(data = subset(jaall, jaall$together == 1), 
            aes(ymin = -Inf, ymax = Inf, xmin = Date-0.5, xmax = Date+0.5), alpha = 0.2, fill="mediumseagreen")+
  labs(y = NULL, x=NULL, caption="\nShaded green areas mark time periods when Alex and Jesse were physically in the same city!\nAlex and Jesse spent 184 days together despite living in Cambridge/SF, respectively. Graph via Alex Albright [thelittledataset.com].") 
  ggsave("LDR_year.png", width = 9, height = 5, dpi = 800)

Hypothesis confirmed!

LS0tCnRpdGxlOiAnVGV4dCBNZSBCYWNrOiBBIFllYXIgb2YgTERSIENvbW11bmljYXRpb24nCmF1dGhvcjogIkFsZXggQWxicmlnaHQiCmRhdGU6ICJgciBmb3JtYXQoU3lzLnRpbWUoKSwgJyVCICVkLCAlWScpYCIKb3V0cHV0OgogIGh0bWxfbm90ZWJvb2s6IGRlZmF1bHQKLS0tCgojIE1vdGl2YXRpb24KCkkgZG93bmxvYWRlZCBpTWVzc2FnZSBkYXRhIHRvIG1ha2UgYSB0ZXh0IG1pbmluZyBWYWxlbnRpbmUgZm9yIG15IExEUiBTTyBpbiBGZWJydWFyeS4gSSd2ZSByZWNlbnRseSBiZWVuIHdvbmRlcmluZyBob3cgZnJlcXVlbnQgb3VyIHRleHRzIGFyZSB3aGVuIHdlIGFyZSBhcGFydCB2cy4gdG9nZXRoZXIuIEkgZmlndXJlZCBJIGNvdWxkIHZpc3VhbGl6ZSB0aGlzIGJ5ICoqcGxvdHRpbmcgZGFpbHkgY291bnRzIG9mIG1lc3NhZ2VzIGFuZCBzaGFkaW5nIHRpbWUgaW50ZXJ2YWxzIHdoZW4gd2Ugd2VyZSBpbiB0aGUgc2FtZSBjaXR5LioqICAKCiMgSG93IHRvIGdldCBhIGBjc3ZgIG9mIGlNZXNzYWdlIGRhdGEhCgpIZXJlIGFyZSB0aGUgc3RlcHM6CgoxLiBEb3dubG9hZCB6aXAgZnJvbSBbaGVyZV0oaHR0cHM6Ly9naXRodWIuY29tL2Fhcm9ucGsvaU1lc3NhZ2UtRXhwb3J0KTogbm93IHlvdSBoYXZlIGEgYGlNZXNzYWdlLUV4cG9ydC1tYXN0ZXJgIGZvbGRlci4gUHV0IHRoYXQgd2hlcmV2ZXIgeW91IHdhbnQgb24geW91ciBjb21wdXRlci4gCgoyLiBPbiB5b3VyIG1hYzogYEZpbmRlcj5Hbz5HbyBUbyBGb2xkZXJgLiBUeXBlIGluIGB+L0xpYnJhcnkvTWVzc2FnZXNgLiBDb3B5IHRoZSBgY2hhdC5kYmAgZmlsZSBpbnRvIHRoZSBgaU1lc3NhZ2UtRXhwb3J0LW1hc3RlcmAgZm9sZGVyIHlvdSBnb3QgZnJvbSBzdGVwIDEuCgozLiBDcmVhdGUgYSBgY29udGFjdHMudHh0YCBmaWxlIGZlYXR1cmluZyBjb250YWN0IG51bWJlcnMgeW91IHdhbnQgdG8gaWRlbnRpZnkgd2l0aCBuYW1lcy4gRS5nLiwgZm9yIHRoZSBwdXJwb3NlcyBvZiB0aGlzIHdvcmssIHRoaXMgaXMganVzdCBteSBhbmQgSmVzc2UncyBudW1iZXJzLiBUaGUgdGV4dCBmaWxlIGp1c3QgY29udGFpbnMgdGhlIGZvbGxvd2luZyAobnVtYmVycyBwYXJ0aWFsbHkgYFhgJ2QgZm9yIHByaXZhY3kgcmVhc29ucyAjZGF0YWV0aGljcyk6CgorMTkxN1hYWFhYWFggQWxleAoKKzEyNjJYWFhYWFhYIEplc3NlCgo0LiBHbyB0byBUZXJtaW5hbC4gTmF2aWdhdGUgdG8gd2hlcmV2ZXIgeW91ciBgaU1lc3NhZ2UtRXhwb3J0LW1hc3RlcmAgZm9sZGVyIGxpdmVzICh2aWEgYGNkYCBjb21tYW5kKS4gUnVuIGBwaHAgY29udGFjdHMucGhwID4+IGNvbnRhY3RzLnR4dGAuIFRoZW4gcnVuIGBwaHAgZXhwb3J0LWNzdi5waHBgLiAKCllvdSBzaG91bGQgbm93IGhhdmUgYSBmb2xkZXIgYG1lc3NhZ2VzYCBpbiBgaU1lc3NhZ2UtRXhwb3J0LW1hc3RlcmAuIFdpdGhpbiB0aGF0IGZvbGRlciBpcyBhIGBtZXNzYWdlcy5jc3ZgIGZpbGUuIE5hbWVzIHRoYXQgeW91IGlkZW50aWZpZWQgaW4gYGNvbnRhY3RzLnR4dGAgd2lsbCBiZSBjb2RlZCBpbi4gKipUQSBEQSEqKgoKIyBMb2FkIGFuZCBzaGFwZSBkYXRhCgpQdWxsIGluIHRoZSBjc3YuIAoKYGBge3IsIGVjaG89VFJVRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KI2ZpeCB0aW1lIGFuZCBkYXRlCiMgbWFrZSBhbGwgbWVzc2FnZXMgbG93ZXJjYXNlCm1lc3NhZ2VzPC1yZWFkLmNzdignaU1lc3NhZ2UtRXhwb3J0LW1hc3Rlci9tZXNzYWdlcy9tZXNzYWdlcy5jc3YnKQptZXNzYWdlcyRNZXNzYWdlPC1hcy5jaGFyYWN0ZXIobWVzc2FnZXMkTWVzc2FnZSkKbWVzc2FnZXMkTWVzc2FnZTwtdG9sb3dlcihtZXNzYWdlcyRNZXNzYWdlKQpgYGAKClN1YnNldCB0byBtZXNzYWdlcyBiZXR3ZWVuIG1lIGFuZCBKZXNzZS4KCmBgYHtyLCBlY2hvPVRSVUUsIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9Cm1lc3NhZ2VzamEgPC0gbWVzc2FnZXNbIHdoaWNoKG1lc3NhZ2VzJFRvLk5hbWU9PSdKZXNzZScgfCBtZXNzYWdlcyRGcm9tLk5hbWU9PSdKZXNzZScpLCBdCm5yb3cobWVzc2FnZXNqYSkKYGBgClRoaXMgdGltZSBwZXJpb2QgKDUtMy0xNyB0byA0LTI2LTE4KSBpbmNsdWRlcyA1Nyw2MDggdGV4dCBtZXNzYWdlcyEgKFRoYXQgaW5jbHVkZXMgcmVhY3Rpb25zIHRvIG1lc3NhZ2VzIGFzIHdlbGwuKQoKYGBge3IsIGVjaG89VFJVRSwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KbWVzc2FnZXNqYTwtbWVzc2FnZXNqYVssYygiRGF0ZSIsICJNZXNzYWdlIildCm1lc3NhZ2VzamEkRGF0ZSA8LSBhcy5EYXRlKG1lc3NhZ2VzamEkRGF0ZSkKIyBjYWxjdWxhdGUgaG93IG1hbnkgbWVzc2FnZXMgcGVyIGRheSBhbmQgcGxvdCB0aGF0IG92ZXIgdGhlIHllYXIhIAoKbGlicmFyeShkcGx5cikKI2NhbGN1bGF0ZSB0b3RhbCBtZXNzYWdlcyBieSBkYXkKamF0b3Q8LW1lc3NhZ2VzamEgJT4lIAogIGdyb3VwX2J5KERhdGUpICU+JSAKICBzdW1tYXJpc2UobiA9IG4oKSkKCiNzb21lIGRheXMgaGF2ZSAwIGFuZCB3ZSB3YW50IHRoZXNlIHRvIHNob3cgdXAgYXMgMAojc28gd2UgY3JlYXRlIGEgZGF0YWZyYW1lIG9mIGFsbCBkYXlzIDUtMy0xNyB0byA0LTI2LTE4IGFuZCBtZXJnZSB0aGF0IHdpdGggamF0b3QKZGYgPC0gZGF0YS5mcmFtZShEYXRlPXNlcShhcy5EYXRlKCIyMDE3LzUvMyIpLCBhcy5EYXRlKCIyMDE4LzQvMjYiKSwgImRheXMiKSkgCmphdG90PC1tZXJnZShqYXRvdCxkZixieT0iRGF0ZSIsIGFsbD1UKQpqYXRvdCRuW2lzLm5hKGphdG90JG4pXSA8LSAwCgojc2F2ZSB0aGlzIGNzdiBzbyBJIGNhbiB0aGVuIGFkZCBkYXRhIGFib3V0IHdoZW4gdG9nZXRoZXIgYW5kIHdoZW4gbm90IHRvZ2V0aGVyIG1hbnVhbGx5IG91dCBvZiBSCndyaXRlLmNzdihqYXRvdCwgImphdG90LmNzdiIsIHJvdy5uYW1lcyA9IEYpCmBgYAoKIyBMZXQncyBncmFwaAoKVXNlIG15IHJlZ3VsYXIgdGhlbWUuCmBgYHtyLCBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQpsaWJyYXJ5KGdncGxvdDIpO2xpYnJhcnkoZ2dyZXBlbCk7IGxpYnJhcnkoZXh0cmFmb250KTsgbGlicmFyeShnZ3RoZW1lcyk7bGlicmFyeShyZXNoYXBlKTtsaWJyYXJ5KGdyaWQpOwpsaWJyYXJ5KHNjYWxlcyk7bGlicmFyeShSQ29sb3JCcmV3ZXIpO2xpYnJhcnkoZ3JpZEV4dHJhKTsKCm15X3RoZW1lIDwtIGZ1bmN0aW9uKCkgewoKICAjIERlZmluZSBjb2xvcnMgZm9yIHRoZSBjaGFydAogIHBhbGV0dGUgPC0gYnJld2VyLnBhbCgiR3JleXMiLCBuPTkpCiAgY29sb3IuYmFja2dyb3VuZCA9IHBhbGV0dGVbMl0KICBjb2xvci5ncmlkLm1ham9yID0gcGFsZXR0ZVs0XQogIGNvbG9yLnBhbmVsID0gcGFsZXR0ZVszXQogIGNvbG9yLmF4aXMudGV4dCA9IHBhbGV0dGVbOV0KICBjb2xvci5heGlzLnRpdGxlID0gcGFsZXR0ZVs5XQogIGNvbG9yLnRpdGxlID0gcGFsZXR0ZVs5XQoKICAjIENyZWF0ZSBiYXNpYyBjb25zdHJ1Y3Rpb24gb2YgY2hhcnQKICB0aGVtZV9idyhiYXNlX3NpemU9OSwgYmFzZV9mYW1pbHk9IlBhbGF0aW5vIikgKyAKCiAgIyBTZXQgdGhlIGVudGlyZSBjaGFydCByZWdpb24gdG8gYSBsaWdodCBncmF5IGNvbG9yCiAgdGhlbWUocGFuZWwuYmFja2dyb3VuZD1lbGVtZW50X3JlY3QoZmlsbD1jb2xvci5wYW5lbCwgY29sb3I9Y29sb3IuYmFja2dyb3VuZCkpICsKICB0aGVtZShwbG90LmJhY2tncm91bmQ9ZWxlbWVudF9yZWN0KGZpbGw9Y29sb3IuYmFja2dyb3VuZCwgY29sb3I9Y29sb3IuYmFja2dyb3VuZCkpICsKICB0aGVtZShwYW5lbC5ib3JkZXI9ZWxlbWVudF9yZWN0KGNvbG9yPWNvbG9yLmJhY2tncm91bmQpKSArCgogICMgRm9ybWF0IGdyaWQKICB0aGVtZShwYW5lbC5ncmlkLm1ham9yPWVsZW1lbnRfbGluZShjb2xvcj1jb2xvci5ncmlkLm1ham9yLHNpemU9LjI1KSkgKwogIHRoZW1lKHBhbmVsLmdyaWQubWlub3I9ZWxlbWVudF9ibGFuaygpKSArCiAgdGhlbWUoYXhpcy50aWNrcz1lbGVtZW50X2JsYW5rKCkpICsKCiAgIyBGb3JtYXQgbGVnZW5kCiAgdGhlbWUobGVnZW5kLnBvc2l0aW9uPSJib3R0b20iKSArCiAgdGhlbWUobGVnZW5kLmJhY2tncm91bmQgPSBlbGVtZW50X3JlY3QoZmlsbD1jb2xvci5iYWNrZ3JvdW5kKSkgKwogIHRoZW1lKGxlZ2VuZC50ZXh0ID0gZWxlbWVudF90ZXh0KHNpemU9OCxjb2xvcj1jb2xvci5heGlzLnRpdGxlKSkgKyAKICB0aGVtZShsZWdlbmQudGl0bGUgPSBlbGVtZW50X2JsYW5rKCkpICsgCiAgCiAgI0Zvcm1hdCBmYWNldCBsYWJlbHMKICB0aGVtZShzdHJpcC50ZXh0LnggPSBlbGVtZW50X3RleHQoc2l6ZSA9IDgsIGZhY2U9ImJvbGQiKSkrCgogICMgRm9ybWF0IHRpdGxlIGFuZCBheGVzIGxhYmVscyB0aGVzZSBhbmQgdGljayBtYXJrcwogIHRoZW1lKHBsb3QudGl0bGU9ZWxlbWVudF90ZXh0KGNvbG9yPWNvbG9yLnRpdGxlLCBzaXplPTI4KSkgKwogIHRoZW1lKGF4aXMudGV4dC54PWVsZW1lbnRfdGV4dChzaXplPTgpKSArCiAgdGhlbWUoYXhpcy50ZXh0Lnk9ZWxlbWVudF90ZXh0KHNpemU9OCkpICsKICB0aGVtZShheGlzLnRpdGxlLng9ZWxlbWVudF90ZXh0KHNpemU9OCkpICsKICB0aGVtZShheGlzLnRpdGxlLnk9ZWxlbWVudF90ZXh0KHNpemU9OCkpICsKCiAgI0Zvcm1hdCB0aXRsZSBhbmQgZmFjZXRfd3JhcCB0aXRsZQogIHRoZW1lKHN0cmlwLnRleHQgPSBlbGVtZW50X3RleHQoc2l6ZT04KSwgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplID0gMTYsIGNvbG91ciA9ICJibGFjayIsIHZqdXN0ID0gMSwgaGp1c3Q9MCkpKwogICAgCiAgIyBQbG90IG1hcmdpbnMKICB0aGVtZShwbG90Lm1hcmdpbiA9IHVuaXQoYyguMiwgLjIsIC4yLCAuMiksICJjbSIpKQp9CmBgYAoKSSBhZGRlZCBpbiBkYXRhIGFib3V0IHdoZXRoZXIgd2Ugd2VyZSB0b2dldGhlciBvciBub3QgaW4gYGphdG90X3RvZ2V0aGVyLmNzdmAuIExldCdzIHB1bGwgdGhpcyBpbi4KYGBge3J9CmphYWxsPC1yZWFkLmNzdignamF0b3RfdG9nZXRoZXIuY3N2JykKamFhbGwkRGF0ZTwtYXMuRGF0ZShqYWFsbCREYXRlLCAiJW0vJWQvJXkiKQoKbnJvdyhzdWJzZXQoamFhbGwsIHRvZ2V0aGVyPT0xKSkKYGBgCldlIHdlcmUgdG9nZXRoZXIgMTg0IGRheXMgb3V0IG9mIHRoZSB5ZWFyISEgSSBkaWRuJ3Qga25vdyB0aGF0IHN0YXQgdW50aWwgbm93ICh0aHVzIHRoZSAhISkuCk5vdywgd2UgcGxvdCEKYGBge3J9CmdncGxvdChqYWFsbCxhZXMoeD1EYXRlLHk9biwgZ3JvdXAgPTEpKSArIGdlb21fcG9pbnQoc2l6ZT0xKSsgCiAgZ2VvbV9saW5lKHNpemU9LjYpKwogIG15X3RoZW1lKCkrIAogIGdndGl0bGUoIlRleHQgTWUgQmFjazogQSBZZWFyIG9mIExEUiBDb21tdW5pY2F0aW9uIiwgc3VidGl0bGU9IkRhaWx5IENvdW50IG9mIGlNZXNzYWdlcyBiZXR3ZWVuIEFsZXggYW5kIEplc3NlIFs1LzMvMTcgLSA0LzI2LzE4XSIpICsgCiAgc2NhbGVfeF9kYXRlKGxhYmVscyA9IGRhdGVfZm9ybWF0KCIlYiAlWSIpLCBkYXRlX2JyZWFrcyA9ICIxIG1vbnRoIikrCiAgc2NhbGVfeV9jb250aW51b3VzKGJyZWFrcyA9IHNlcSgwLDEwMDAsMTAwKSwgbGltID0gYygwLCAxMDAwKSkrCiAgZ2VvbV9yZWN0KGRhdGEgPSBzdWJzZXQoamFhbGwsIGphYWxsJHRvZ2V0aGVyID09IDEpLCAKICAgICAgICAgICAgYWVzKHltaW4gPSAtSW5mLCB5bWF4ID0gSW5mLCB4bWluID0gRGF0ZS0wLjUsIHhtYXggPSBEYXRlKzAuNSksIGFscGhhID0gMC4yLCBmaWxsPSJtZWRpdW1zZWFncmVlbiIpKwogIGxhYnMoeSA9IE5VTEwsIHg9TlVMTCwgY2FwdGlvbj0iXG5TaGFkZWQgZ3JlZW4gYXJlYXMgbWFyayB0aW1lIHBlcmlvZHMgd2hlbiBBbGV4IGFuZCBKZXNzZSB3ZXJlIHBoeXNpY2FsbHkgaW4gdGhlIHNhbWUgY2l0eSFcbkFsZXggYW5kIEplc3NlIHNwZW50IDE4NCBkYXlzIHRvZ2V0aGVyIGRlc3BpdGUgbGl2aW5nIGluIENhbWJyaWRnZS9TRiwgcmVzcGVjdGl2ZWx5LiBHcmFwaCB2aWEgQWxleCBBbGJyaWdodCBbdGhlbGl0dGxlZGF0YXNldC5jb21dLiIpIAogIGdnc2F2ZSgiTERSX3llYXIucG5nIiwgd2lkdGggPSA5LCBoZWlnaHQgPSA1LCBkcGkgPSA4MDApCmBgYAoKIyMgSHlwb3RoZXNpcyBjb25maXJtZWQh