• Publicado: 11 Oct 2016

  • Archivado en: datascience, curioso

Analizando un grupo típico de Whatsapp

Hace unos días surgió la curiosidad por confirmar algunas hipótesis que tenía sobre lo que se dice en uno de mis grupos más activos de WhatsApp. Entonces, decidí explorar con R estas preguntas, usando la exportación del chat a texto. Aquí están algunos resultados.

Limpia de datos

Primero, un poco sobre los datos. Hagamos la importación de la conversación:

d <- read.table(file = "venados.txt", 
                stringsAsFactors = FALSE, 
                sep = "\n", encoding = "UTF-8")

Hay algunos mensajes que empiezan con un “enter”, por ejemplo cuando se escribe en dos líneas dentro del mismo mensaje. Estos los tengo que quitar, para limpiar un poco la información. Si es la misma persona, pero manda el mensaje con enter, si aparece como dos mensajes (tú sabes quien eres).

En proporción, los mensajes que voy a quitar son pocos, solo 556 mensajes (3.1% del total):

library(dplyr)
library(magrittr)
library(knitr)
d %>% 
  mutate("Correcto" = ifelse(
    grepl(x = V1, 
          pattern = "^[0-9]{1,2}\\/[0-9]{1,2}\\/[0-9]{2}\\,"), 1, 0)) %>% 
  group_by(Correcto) %>% 
  summarise("Mensajes" = n()) %>% 
  kable()
Correcto Mensajes (%)
0 556 3.09%
1 17,426 96.9%

Ahora, para analizar bien el texto, hice la siguiente función que me parsea la hora, fecha, minuto, persona y mensaje en diferentes columas.

DividirTexto <- function(s){
  require(stringr)
  # patrones
  tiempo <- "^[0-9]{1,2}\\/[0-9]{1,2}\\/[0-9]{2}\\, [0-9]{1,2}\\:[0-9]{2} [AM|PM]{2} \\-"
  p <- "^[^\\:]+"
  b <- "^[0-9]{1,2}\\/[0-9]{1,2}\\/[0-9]{2}\\, [0-9]{1,2}\\:[0-9]{2} [AM|PM]{2} \\- [^\\:]+"
  k <- 2
  
  # Tiempo, Fecha y Hora
  TimeStamp <- unlist(
    str_extract_all(string = s, pattern = tiempo))
    # Fecha
  Fecha <- as.Date(
    str_extract(string = TimeStamp,
                pattern = "^[0-9]{1,2}\\/[0-9]{1,2}\\/[0-9]{2}"), 
    format = "%m/%d/%y")
  
  Hora <- as.numeric(
    gsub(x = str_extract(
      string = str_extract(
        string = TimeStamp, 
        pattern = "[0-9]{1,2}\\:[0-9]{2} [AM|PM]{2} \\-$"), 
      pattern = "^[0-9]{1,2}\\:"), 
      pattern = "\\:", 
      replacement = "") # eliminar el :
    ) # fin de hora
  
  Minutos <- as.numeric(
    gsub(x = str_extract(
      string = str_extract(
        string = TimeStamp, 
        pattern = "[0-9]{1,2}\\:[0-9]{2} [AM|PM]{2} \\-$"), 
      pattern = "\\:[0-9]{2,}"), # solo dos digitos despues de... 
      pattern = "\\:", 
      replacement = "") # eliminar el :
  )
    
  MitadDia <- str_extract(
    string = str_extract(
      string = TimeStamp, 
      pattern = "[0-9]{1,2}\\:[0-9]{2} [AM|PM]{2} \\-$"), 
    pattern = "[A|P]")
    
  
  Persona <- stri_split_regex(str = s, pattern = tiempo)
  Persona <- unlist(str_extract_all(pattern = p, string = unlist(Persona)[k]))
  
  msj <- gsub(pattern = "^:",
              x = unlist(str_split(string = s, pattern = b))[2], 
              replacement = "")
  
  df <- data.frame("TiempoWA" = TimeStamp, 
                   "Fecha" = Fecha, 
                   "Hora" = Hora, 
                   "Minutos" = Minutos, 
                   "MitadDia" = MitadDia, 
                   "Persona" = Persona, 
                   "Mensaje" = msj)
  return(df)
}

Entonces, pasemos los datos por esta función, para tener columnas que nos sirven para analizar…

# quitando los datos "malos"
d %<>%
  mutate("Correcto" = ifelse
         (grepl(x = V1, 
                pattern = "^[0-9]{1,2}\\/[0-9]{1,2}\\/[0-9]{2}\\,"), 1, 0)) %>%
  filter(Correcto == 1) %>%
  select(-Correcto)
  
# dividiendo columnas
library(stringi)
d_limpio <- lapply(d$V1, DividirTexto)

Tenemos una lista así (estoy escondiendo el nombre real):

kable(d_limpio[[7110]])
TiempoWA Fecha Hora Mins Mitad Persona Mensaje
10/4/16, 1:39 PM - 2016-10-04 1 39 P Nombre Estaba en iglesia.

Por obvias razones, voy a “anonimizar” los nombres de mis amigos, sustituyendo por el nombre de una ciudad cada uno. Después, convertimos a un data.frame (esto lo esconderé).

Ya que tenemos los datos limpios, podemos probar algunas de estas hipótesis…

Mensajes por miembros

a1 <- d_limpio %>% 
  mutate("Palabras_Total" = str_count(Mensaje, 
                                      pattern = "\\S+")) %>%
  group_by(Ciudad) %>% 
  summarise("PalabraxMsj" = round(mean(Palabras_Total),2), 
            "Palabras" = sum(Palabras_Total), 
            "Mensajes" = n()) %>% 
  mutate("(% Msj)" = paste0(round(Mensajes/17415*100,1),"%"),
         "(% Palabras)" = paste0(round(Palabras/90579*100,1),"%")) %>%
  arrange(desc(Palabras))
kable(a1)
Ciudad PalabraxMsj Palabras Mensajes (% Msj) (% Palabras)
Madrid 4.17 16250 3893 22.4% 17.9%
Mexico 5.38 10279 1911 11% 11.3%
Boston 6.45 7186 1114 6.4% 7.9%
Oslo 6.01 6984 1162 6.7% 7.7%
Cairo 4.15 5973 1438 8.3% 6.6%
Monterrey 6.54 5768 882 5.1% 6.4%
Beijing 6.00 5765 961 5.5% 6.4%
Bogota 5.53 4803 869 5% 5.3%
Paris 6.17 4587 744 4.3% 5.1%
Cancun 4.27 3590 841 4.8% 4%
Roma 4.24 3310 781 4.5% 3.7%
Milan 5.94 2968 500 2.9% 3.3%
Seoul 5.76 2846 494 2.8% 3.1%
Taipei 5.21 2393 459 2.6% 2.6%
Lima 6.05 1543 255 1.5% 1.7%
Londres 5.46 1419 260 1.5% 1.6%
Houston 8.60 1350 157 0.9% 1.5%
Caracas 4.90 1180 241 1.4% 1.3%
Chicago 4.49 889 198 1.1% 1%
Vienna 4.49 830 185 1.1% 0.9%
Morelia 9.51 666 70 0.4% 0.7%

En un grupo de 21 personas, uno de los miembros manda el 22.4% de los mensajes (el esperado sería de 1/21)!

El encanto del “enviar”

Desde la tabla pasada, se puede ver un poco esto, pero hagamos una gráfica sencilla para ilustrar…

library(ggplot2)
library(eem)
ggplot(data = a1, 
       aes(x = Mensajes, 
           y = PalabraxMsj))+
  geom_point(colour=eem_colors[1])+
  theme_eem()+
  ggrepel::geom_label_repel(aes(label = Ciudad))+
  labs(x="Mensajes", y ="Palabras por Mensaje", 
       title = "Distribución de Mensajes en Grupo")

Distribución de Mensajes en Grupo de Whatsapp

Entonces, Madrid es fan del “enter”.

Mensajes de multimedia

Para probar esta hipótesis, extraemos un indicador por mensaje que nos dice si contiene multimedia. Ojo que Whatsapp no exporta el tipo de media, sino solamente una leyenda que dice “", por lo que pueden ser también voicenotes o fotos.

a2 <- d_limpio %>% 
  mutate("Media" = stri_count_regex(str = Mensaje, 
                                    pattern = "<Media omitted>")) %>%
  group_by(Ciudad) %>%
  summarise("Media" = sum(Media), "Mensajes" = n()) %>%
  mutate("Msj/Media" = Mensajes/Media) %>%
  mutate("(% Media)" = paste0(round(Media/1200*100,2),"%")) %>%
  arrange(desc(Media))
kable(a2)
Ciudad Media Mensajes Msj/Media (% Media)
Mexico 229 1911 8.344978 19.08%
Madrid 184 3893 21.157609 15.33%
Paris 104 744 7.153846 8.67%
Monterrey 86 882 10.255814 7.17%
Milan 65 500 7.692308 5.42%
Boston 64 1114 17.406250 5.33%
Cairo 64 1438 22.468750 5.33%
Oslo 57 1162 20.385965 4.75%
Cancun 56 841 15.017857 4.67%
Bogota 52 869 16.711538 4.33%
Roma 49 781 15.938776 4.08%
Seoul 49 494 10.081633 4.08%
Beijing 48 961 20.020833 4%
Lima 32 255 7.968750 2.67%
Londres 17 260 15.294118 1.42%
Taipei 17 459 27.000000 1.42%
Chicago 13 198 15.230769 1.08%
Caracas 6 241 40.166667 0.5%
Vienna 4 185 46.250000 0.33%
Houston 3 157 52.333333 0.25%
Morelia 1 70 70.000000 0.08%

Mexico manda cada 8 mensajes en promedio un mensaje de multimedia y acumula el 19% de todos los que se han enviado, mientras que el que menos manda es Morelia (ha mandado 1 solamente).

Dado esto, y la cantidad de mensajes que llegan al día, podemos calcular la probabilidad de manera muy arbitraria que un día cualquiera nos llegue multimedia por cada persona:

# mensajes por día
msj_x_dia <- nrow(d_limpio)/length(unique(d_limpio$Fecha))

a3 <- a2 %>% 
  inner_join(., a1, by = c("Ciudad")) %>%
  mutate("ProbabilidadMedia" = paste0(round(
    ((Mensajes.y/17415)*`Msj/Media`)/msj_x_dia*100,2),"%")) %>%
  arrange(desc(ProbabilidadMedia)) %>%
  select(c(Ciudad, ProbabilidadMedia)) 
kable(a3)
Ciudad ProbabilidadMedia
Madrid 5.13%
Cairo 2.01%
Oslo 1.48%
Boston 1.21%
Beijing 1.2%
Mexico 0.99%
Bogota 0.91%
Cancun 0.79%
Roma 0.78%
Taipei 0.77%
Caracas 0.6%
Monterrey 0.56%
Vienna 0.53%
Houston 0.51%
Paris 0.33%
Seoul 0.31%
Morelia 0.31%
Londres 0.25%
Milan 0.24%
Chicago 0.19%
Lima 0.13%

Variación de horas por persona

En este caso, parece que no hay tendencia muy establecida por persona, aunque en total es obvio que hay diferencias por hora. Un cuarto de los mensajes (23.9%) se mandan en las horas de trabajo (10 y 11 am) o a las 5 pm. Aquí les va una gráfica:

a4 <- d_limpio %>% 
  group_by(Ciudad, Hora, MitadDia) %>% 
  summarise("Mensajes" = n())

ggplot(a4, 
       aes(x = as.factor(Hora), 
           y = Mensajes)) + 
  geom_bar(stat = "identity", 
           aes(fill= Ciudad)) + 
  facet_wrap( ~ MitadDia) + 
  theme_eem() + 
  scale_fill_manual(c(eem_colors,"#B0034F", "e72712"))

Mensajes por hora

Conversacion entre personas

Finalmente, estaría interesante ver quienes son los que más se responden entre sí. Obviamente lo más común es un mensaje de Madrid seguido por otro de Madrid, pero aquí filtraré los mensajes que son de la misma persona. Es decir, son combinaciones de mensaje-respuesta entre dos participantes del grupo.

a5 <- d_limpio %>% 
  mutate("Respuesta" = paste0(Ciudad,"-",lag(Ciudad)), 
         "Igual" = ifelse(Ciudad==lag(Ciudad),1,0)) %>% 
  filter(Igual<1) %>% 
  group_by(Respuesta) %>% 
  summarise("Conteo" = n()) %>% 
  arrange(desc(Conteo))

Aquí está en top 10 de combinaciones:

kable(a5 %>% head(., n = 10))
Respuesta Conteo
Mexico-Madrid 255
Madrid-Mexico 234
Boston-Madrid 188
Madrid-Oslo 178
Madrid-Boston 177
Madrid-Beijing 165
Beijing-Madrid 164
Oslo-Madrid 155
Cancun-Madrid 154
Madrid-Cancun 154

Para aquel que está acostumbrado a estas cosas, esto no es necesariamente relevante, por que Madrid, Mexico y Boston están relativamente sobre-representados en la muestra. Lo conveniente sería tratar a esta canasta de respuestas con un procedimiento bayesiano simple para encontrar las relaciones que probabilísticamente no ocurrirían de manera independiente.

Esto se reduce a simplemente a seguir el teorema de Bayes: P(A|B) = P(A)P(B) y comparar contra lo observado (la hipótesis nula es que no son independientes). Hagamos una función para esto.

ObtenerIndependiente <- function(d, p){
  tm <- length(d$Mensaje)
  a <- d %>% 
    filter(Ciudad == p)
  pa <- length(a$Mensaje)
  pa <- pa/tm
  
  n <- unique(d$Ciudad)
  v <- NULL
  k <- NULL
  for(i in 1:length(n)){
    b <- d %>% 
      filter(Ciudad == as.character(n[i]))
    pb <- length(b$Mensaje)
    pb <- pb/tm
    v[i] <- (pa*pb*tm)
    k[i] <- as.character(n[i])
  }
  df <- data.frame("Ciudad" = rep(p, times = length(n)),
                   "Ciudad2" = k, 
                   "P_Independiente" = v)
  return(df)
}

Ahora voy a generar indicadores para cada “país”:

associacion <- NULL
for(i in 1:21){
  tmp <- ObtenerIndependiente(d_limpio, unique(d_limpio$Ciudad)[i])
  associacion <- rbind.data.frame(associacion, tmp)
}

Obtenemos un data.frame así:

kable(head(associacion))
Ciudad Ciudad2 P_Independiente
Londres Londres 3.881711
Londres Paris 11.107666
Londres Monterrey 13.167959
Londres Mexico 28.530577
Londres Cancun 12.555843
Londres Houston 2.343956

Esto básicamente quiere decir que, si realmente existiese independencia estadística, deberíamos de encontrar casi 4 (3.88) mensajes con en dónde Londres manda un mensaje antes o después de si mismo.

Dado que vamos a comparar solamente contra lo observado después de un mensaje particular, vamos a dividir estas probabilidades entre dos (el supuesto fuerte aquí es que asumimos que no hay diferencia entre mandar antes o después un mensaje…).

Finalmente, comparamos contra lo observado.

a6 <- associacion %>% 
  mutate("Combinacion" = paste0(Ciudad, "-", Ciudad2), 
         "P_Independiente" = P_Independiente/2) %>%
  inner_join(., a5, by = c("Combinacion" = "Respuesta")) %>%
  mutate("Asociacion" = Conteo/P_Independiente) %>%
  arrange(desc(Asociacion)) %>%
  head(., n = 20) %>%
  select(c(Combinacion, Asociacion))
kable(a6)
Combinacion Asociacion
Morelia-Caracas 8.258447
Houston-Caracas 6.443693
Chicago-Morelia 5.025974
Vienna-Taipei 4.922099
Cairo-Morelia 4.498212
Morelia-Cairo 4.498212
Houston-Taipei 4.349944
Chicago-Lima 4.139037
Lima-Chicago 4.139037
Morelia-Lima 3.902521
Houston-Bogota 3.829352
Morelia-Londres 3.827472
Vienna-Cancun 3.805701
Cancun-Lima 3.735469
Caracas-Houston 3.682110
Londres-Vienna 3.620582
Chicago-Seoul 3.560913
Taipei-Londres 3.502262
Lima-Cancun 3.248234
Caracas-Seoul 3.218119

La tabla de arriba se lee básicamente así: Morelia tiende a responder estadísticamente ocho veces más después de Caracas que lo esperado. A pesar de que no son los que más escriben, estas relaciones son las más fuertes.

Se me acaba el tiempo, pero tal vez en un futuro cercano valga la pena hacer algo de sentiment analysis sobre lo que se dice, o explorar el grado de diferencia entre palabras usadas…

referencia 1 de 2