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:
Download zip from here: now you have a iMessage-Export-master
folder. Put that wherever you want on your computer.
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.
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
- 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