I have some long-overdue news to share! I mentioned in this post last August that things had been going well with one of my OkCupid dates. They still are :). We’ve been in a relationship for over a year now, and I’m still crazy about him.

Recently, I exported all of our texts to .csv to see if I could find anything interesting. Here’s what I found. I’ll use the results to share a little more about our relationship.

Year Overview

As you can see from this graph, our relationship moved rather quickly. We moved in together less than four months after we started dating. The graph has two major peaks: one at the beginning, and one the week when we were moving in together, when we were figuring out all the necessary details. Not surprisingly, after we moved in together, we texted a lot less. Since then, we tend to exchange around 10 to 40 texts a week. I suspect this pattern will continue in the future.

Who texts the most?

Every month, I consistently sent fewer texts than he did. On average, he sent 26 texts per week, while I sent 22.

My texts, however, were generally longer. Mine were 53 characters long on average, while his were 50.

Most Common Phrases

From this you can see we miss each other frequently and I’m often on my way home, unsure or at the library. I find it amusing that “babe” was one of his most common words, when he would never call me that in person.

Smileys and Sad Faces

Number of texts containing a smiley or sad face

Number of texts containing multiple smiley or sad faces

We sent a fairly similar number of smiley faces, but he sent more than three times as many sad faces as I did. This was somewhat surprising to me because I think I’m gloomier than he is. I was much more likely to send multiple smiley faces in one text.

To conclude, his texts are smilier and more frequent. Mine are longer and more likely to contain multiple smileys. What does all this tell us about our relationship? Perhaps not a whole lot, but I at least enjoyed putting it together.

The Code

Here is the R code I used to create most of this analysis. I used Jihosoft to export my text messages as a csv and I used the text analyzer at online-utility.org to find the most common phrases.

library(ggplot2)
 library(plotly)
 packageVersion('plotly')

#Read in text data
 texts <- read.csv('C:/Users/Documents/Project Support/Blog/2017/07 July/sms_20170720.csv')

#Convert dates from factor to date
 texts$Date <- as.Date(texts$Date, format = "%d/%m/%Y")

#Get month and week of text
 texts$Month <- as.Date(cut(texts$Date, breaks="month"))
 texts$Week <- as.Date(cut(texts$Date,breaks="week",start.on.monday = FALSE))
 texts$Count <- 1

#Change in/out to him/me
 texts$Sender[texts$Type=="in"] <- "Him"
 texts$Sender[texts$Type=="out"] <- "Me"

### Graph count of texts ###
 #Get count of texts by month and week
 CountByMnthSender <- aggregate(Count~Month+Sender,texts,sum)
 CountByWeekSender <- aggregate(Count~Week+Sender,texts,sum)
 CountByWeek <- aggregate(Count~Week,texts,sum)

### Graph by Week
 green <- rgb(4,185,56,max=255)
 blue <- rgb(0,195,189,max=255)
 coral <- rgb(242,119,111,max=255)
 grey <- rgb(89,89,89,max=255)

##Color Bars
 CountByWeek$Color <- grey
 #First Sleepover
 CountByWeek$Color[CountByWeek$Week=="2016-08-07"]<-blue
 #Moved in Together
 CountByWeek$Color[CountByWeek$Week=="2016-10-16"]<-coral
 #Kaikoura Earthquake
 CountByWeek$Color[CountByWeek$Week=="2016-11-13"]<-green

##Change Hovertext
 CountByWeek$MyText <- ""
 #{Decide what to call first sleepover}
 #First Sleepover
 CountByWeek$MyText[CountByWeek$Week=="2016-08-07"]<-"First Sleepover"
 #Moved in Together
 CountByWeek$MyText[CountByWeek$Week=="2016-10-16"]<-"Moved in Together"
 #Kaikoura Earthquake
 CountByWeek$MyText[CountByWeek$Week=="2016-11-13"]<-"Kaikoura Earthquake"

p2 <- plot_ly(CountByWeek, x = ~Week, y= ~Count, type = 'bar',text=~MyText, marker = list(color = CountByWeek$Color) )%>%
 layout(title = "Texts Per Week")
 p2

##create legend
 #empty plot
 plot(1, type="n", axes=FALSE, xlab="", ylab="")

#legend
 legend("topleft",
 c("{First Sleepover}", "Moved In Together","Earthquake"),
 col=c(blue,coral,green), pch = c(15,15,15),
 inset = .02, bty = "n")

#Graph by month and year
 ggplot(CountByMnthSender,aes(Month,Count,fill=Sender)) +
 geom_bar(stat="identity",position='dodge') +
 ggtitle("Texts Per Month") +
 theme(plot.title = element_text(hjust = 0.5))

### Graph average length of texts ###

#Get text length
 texts$Length <- nchar(as.character(texts$Message))

#Get average text length per month
 LengthByMnth <- aggregate(Length~Month+Sender,texts,mean)

ggplot(LengthByMnth,aes(Month,Length,fill=Sender)) +
 geom_bar(stat="identity",position='dodge') +
 ggtitle("Average Length of Texts Per Month") +
 theme(plot.title = element_text(hjust = 0.5))

###Calculate number of texts per week per person
 TxtsPerWeek <- aggregate(Count~Sender,CountByWeekSender,mean)
 AvgTxtLength <- aggregate(Length~Sender,texts,mean)

###Count texts with :) and :(
texts$Smile <- grepl(":)",texts$Message,fixed=TRUE)
texts$Frown <- grepl(":(",texts$Message,fixed=TRUE)
SmileTxts <- aggregate(Smile~Sender,texts,sum)
FrownTxts <- aggregate(Frown~Sender,texts,sum)

##Count texts with multiple :) or :(
texts$SmileCount <- str_count(texts$Message,":[)]")
texts$MultiSmile <- texts$SmileCount > 1
texts$FrownCount <- str_count(texts$Message,":[(]")
texts$MultiFrown <- texts$FrownCount > 1
MultiSmile <- aggregate(MultiSmile~Sender,texts,sum)
MultiFrown <- aggregate(MultiFrown~Sender,texts,sum)