################################################################
# APRENDIZAJE DE MAQUINA
# Este documento contiene la manera de generar
# Clustering con el algoritmo K-means
# ##############################################################
# La data fue compilada de una red social
# y contiene los perfiles de 30.000 estudiantes
# de bachillerato residentes de los Estados Unidos
# la data fue recopilada durante los a?os escolares
# comprendidos desde el 2006 al 2009
# se uso un robot (ara?a)para obtener los perfiles
# de usuarios
# una herramienta para mineria de textos para filtrar
# 36 palabras claves de un total de 500 que aparecen
# en las paginas, estas incluyen: sexy, football,
# basketball,bible etc.

# Paso 1 - recopilando la data escoga el directorio de trabajo 
teens <- read.csv(file.choose())

#Paso 2 - explorando la data
summary(teens)
##     gradyear     gender           age             friends      
##  Min.   :2006   F   :22054   Min.   :  3.086   Min.   :  0.00  
##  1st Qu.:2007   M   : 5222   1st Qu.: 16.312   1st Qu.:  3.00  
##  Median :2008   NA's: 2724   Median : 17.287   Median : 20.00  
##  Mean   :2008                Mean   : 17.994   Mean   : 30.18  
##  3rd Qu.:2008                3rd Qu.: 18.259   3rd Qu.: 44.00  
##  Max.   :2009                Max.   :106.927   Max.   :830.00  
##                              NA's   :5086                      
##    basketball         football           soccer           softball      
##  Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.0000  
##  1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.0000  
##  Median : 0.0000   Median : 0.0000   Median : 0.0000   Median : 0.0000  
##  Mean   : 0.2673   Mean   : 0.2523   Mean   : 0.2228   Mean   : 0.1612  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000  
##  Max.   :24.0000   Max.   :15.0000   Max.   :27.0000   Max.   :17.0000  
##                                                                         
##    volleyball         swimming        cheerleading       baseball      
##  Min.   : 0.0000   Min.   : 0.0000   Min.   :0.0000   Min.   : 0.0000  
##  1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.:0.0000   1st Qu.: 0.0000  
##  Median : 0.0000   Median : 0.0000   Median :0.0000   Median : 0.0000  
##  Mean   : 0.1431   Mean   : 0.1344   Mean   :0.1066   Mean   : 0.1049  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.:0.0000   3rd Qu.: 0.0000  
##  Max.   :14.0000   Max.   :31.0000   Max.   :9.0000   Max.   :16.0000  
##                                                                        
##      tennis             sports           cute              sex          
##  Min.   : 0.00000   Min.   : 0.00   Min.   : 0.0000   Min.   :  0.0000  
##  1st Qu.: 0.00000   1st Qu.: 0.00   1st Qu.: 0.0000   1st Qu.:  0.0000  
##  Median : 0.00000   Median : 0.00   Median : 0.0000   Median :  0.0000  
##  Mean   : 0.08733   Mean   : 0.14   Mean   : 0.3229   Mean   :  0.2094  
##  3rd Qu.: 0.00000   3rd Qu.: 0.00   3rd Qu.: 0.0000   3rd Qu.:  0.0000  
##  Max.   :15.00000   Max.   :12.00   Max.   :18.0000   Max.   :114.0000  
##                                                                         
##       sexy              hot              kissed            dance        
##  Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.0000  
##  1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.0000  
##  Median : 0.0000   Median : 0.0000   Median : 0.0000   Median : 0.0000  
##  Mean   : 0.1412   Mean   : 0.1266   Mean   : 0.1032   Mean   : 0.4252  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000  
##  Max.   :18.0000   Max.   :10.0000   Max.   :26.0000   Max.   :30.0000  
##                                                                         
##       band            marching           music              rock        
##  Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.0000  
##  1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.0000  
##  Median : 0.0000   Median : 0.0000   Median : 0.0000   Median : 0.0000  
##  Mean   : 0.2996   Mean   : 0.0406   Mean   : 0.7378   Mean   : 0.2433  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 1.0000   3rd Qu.: 0.0000  
##  Max.   :66.0000   Max.   :11.0000   Max.   :64.0000   Max.   :21.0000  
##                                                                         
##       god              church            jesus             bible         
##  Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.0000   Min.   : 0.00000  
##  1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.: 0.00000  
##  Median : 0.0000   Median : 0.0000   Median : 0.0000   Median : 0.00000  
##  Mean   : 0.4653   Mean   : 0.2482   Mean   : 0.1121   Mean   : 0.02133  
##  3rd Qu.: 1.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.00000  
##  Max.   :79.0000   Max.   :44.0000   Max.   :30.0000   Max.   :11.00000  
##                                                                          
##       hair             dress           blonde              mall        
##  Min.   : 0.0000   Min.   :0.000   Min.   :  0.0000   Min.   : 0.0000  
##  1st Qu.: 0.0000   1st Qu.:0.000   1st Qu.:  0.0000   1st Qu.: 0.0000  
##  Median : 0.0000   Median :0.000   Median :  0.0000   Median : 0.0000  
##  Mean   : 0.4226   Mean   :0.111   Mean   :  0.0989   Mean   : 0.2574  
##  3rd Qu.: 0.0000   3rd Qu.:0.000   3rd Qu.:  0.0000   3rd Qu.: 0.0000  
##  Max.   :37.0000   Max.   :9.000   Max.   :327.0000   Max.   :12.0000  
##                                                                        
##     shopping         clothes         hollister        abercrombie     
##  Min.   : 0.000   Min.   :0.0000   Min.   :0.00000   Min.   :0.00000  
##  1st Qu.: 0.000   1st Qu.:0.0000   1st Qu.:0.00000   1st Qu.:0.00000  
##  Median : 0.000   Median :0.0000   Median :0.00000   Median :0.00000  
##  Mean   : 0.353   Mean   :0.1485   Mean   :0.06987   Mean   :0.05117  
##  3rd Qu.: 1.000   3rd Qu.:0.0000   3rd Qu.:0.00000   3rd Qu.:0.00000  
##  Max.   :11.000   Max.   :8.0000   Max.   :9.00000   Max.   :8.00000  
##                                                                       
##       die              death             drunk             drugs         
##  Min.   : 0.0000   Min.   : 0.0000   Min.   :0.00000   Min.   : 0.00000  
##  1st Qu.: 0.0000   1st Qu.: 0.0000   1st Qu.:0.00000   1st Qu.: 0.00000  
##  Median : 0.0000   Median : 0.0000   Median :0.00000   Median : 0.00000  
##  Mean   : 0.1841   Mean   : 0.1142   Mean   :0.08797   Mean   : 0.06043  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.:0.00000   3rd Qu.: 0.00000  
##  Max.   :22.0000   Max.   :14.0000   Max.   :8.00000   Max.   :16.00000  
## 
str(teens)
## 'data.frame':    30000 obs. of  40 variables:
##  $ gradyear    : int  2006 2006 2006 2006 2006 2006 2006 2006 2006 2006 ...
##  $ gender      : Factor w/ 2 levels "F","M": 2 1 2 1 NA 1 1 2 1 1 ...
##  $ age         : num  19 18.8 18.3 18.9 19 ...
##  $ friends     : int  7 0 69 0 10 142 72 17 52 39 ...
##  $ basketball  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ football    : int  0 1 1 0 0 0 0 0 0 0 ...
##  $ soccer      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ softball    : int  0 0 0 0 0 0 0 1 0 0 ...
##  $ volleyball  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ swimming    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ cheerleading: int  0 0 0 0 0 0 0 0 0 0 ...
##  $ baseball    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ tennis      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ sports      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ cute        : int  0 1 0 1 0 0 0 0 0 1 ...
##  $ sex         : int  0 0 0 0 1 1 0 2 0 0 ...
##  $ sexy        : int  0 0 0 0 0 0 0 1 0 0 ...
##  $ hot         : int  0 0 0 0 0 0 0 0 0 1 ...
##  $ kissed      : int  0 0 0 0 5 0 0 0 0 0 ...
##  $ dance       : int  1 0 0 0 1 0 0 0 0 0 ...
##  $ band        : int  0 0 2 0 1 0 1 0 0 0 ...
##  $ marching    : int  0 0 0 0 0 1 1 0 0 0 ...
##  $ music       : int  0 2 1 0 3 2 0 1 0 1 ...
##  $ rock        : int  0 2 0 1 0 0 0 1 0 1 ...
##  $ god         : int  0 1 0 0 1 0 0 0 0 6 ...
##  $ church      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ jesus       : int  0 0 0 0 0 0 0 0 0 2 ...
##  $ bible       : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hair        : int  0 6 0 0 1 0 0 0 0 1 ...
##  $ dress       : int  0 4 0 0 0 1 0 0 0 0 ...
##  $ blonde      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ mall        : int  0 1 0 0 0 0 2 0 0 0 ...
##  $ shopping    : int  0 0 0 0 2 1 0 0 0 1 ...
##  $ clothes     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hollister   : int  0 0 0 0 0 0 2 0 0 0 ...
##  $ abercrombie : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ die         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ death       : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ drunk       : int  0 0 0 0 1 1 0 0 0 0 ...
##  $ drugs       : int  0 0 0 0 1 0 0 0 0 0 ...
# Preparacion de la data - 
# uso de variables dummy para las variables faltantes
# para recodificar podemos utilizar la 
# funcion ifelse(), asignamos a teen$age el
# valor de teen$age si la edad es por lo menos 
# 13 a?os y menos de 20 a?os; de otra manera, la variable
# recibira el valor NA:
teens$age <- ifelse(teens$age>=13&teens$age<20,
                    teens$age,NA)
summary(teens$age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   13.03   16.30   17.26   17.25   18.22   20.00    5523
mean(teens$age,na.rm = TRUE)
## [1] 17.25243
# Tenemos que, si alguna persona no es
# femenina y no es de genero desconocido, entonces
# deben ser masculinos. Asi que, en este caso, necesitamos
# crear solamente variables dummy para 
# femenino y genero desconocido:
teens$female <- ifelse(teens$gender=="F"&
                         !is.na(teens$gender),1,0)
teens$no_gender <- ifelse(is.na(teens$gender),1,0)

# probamos los resultados
table(teens$gender,useNA = "ifany")
## 
##     F     M  <NA> 
## 22054  5222  2724
table(teens$female,useNA = "ifany")
## 
##     0     1 
##  7946 22054
table(teens$no_gender,useNA = "ifany")
## 
##     0     1 
## 27276  2724
#Imputacion
# Puedes pensar en una manera
# de utilizar esta data para tener una idea de la edad
# como podemos adivinar la edad de un adolecente?
# la respuesta podria ser el a?o de graduacion
# la funcion ave(), la cual devuelve un vector
# con el grupo de promedios
# repetidas de tal forma que es igual
# al tama?o del vector original:
ave_age <- ave(teens$age,teens$gradyear,
               FUN=function(x)mean(x,na.rm = TRUE))
teens$age <- ifelse(is.na(teens$age),
                          ave_age,teens$age)
summary(teens$age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   13.03   16.28   17.24   17.24   18.21   20.00
str(teens$age)
##  num [1:30000] 19 18.8 18.3 18.9 19 ...
str(teens)
## 'data.frame':    30000 obs. of  42 variables:
##  $ gradyear    : int  2006 2006 2006 2006 2006 2006 2006 2006 2006 2006 ...
##  $ gender      : Factor w/ 2 levels "F","M": 2 1 2 1 NA 1 1 2 1 1 ...
##  $ age         : num  19 18.8 18.3 18.9 19 ...
##  $ friends     : int  7 0 69 0 10 142 72 17 52 39 ...
##  $ basketball  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ football    : int  0 1 1 0 0 0 0 0 0 0 ...
##  $ soccer      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ softball    : int  0 0 0 0 0 0 0 1 0 0 ...
##  $ volleyball  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ swimming    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ cheerleading: int  0 0 0 0 0 0 0 0 0 0 ...
##  $ baseball    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ tennis      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ sports      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ cute        : int  0 1 0 1 0 0 0 0 0 1 ...
##  $ sex         : int  0 0 0 0 1 1 0 2 0 0 ...
##  $ sexy        : int  0 0 0 0 0 0 0 1 0 0 ...
##  $ hot         : int  0 0 0 0 0 0 0 0 0 1 ...
##  $ kissed      : int  0 0 0 0 5 0 0 0 0 0 ...
##  $ dance       : int  1 0 0 0 1 0 0 0 0 0 ...
##  $ band        : int  0 0 2 0 1 0 1 0 0 0 ...
##  $ marching    : int  0 0 0 0 0 1 1 0 0 0 ...
##  $ music       : int  0 2 1 0 3 2 0 1 0 1 ...
##  $ rock        : int  0 2 0 1 0 0 0 1 0 1 ...
##  $ god         : int  0 1 0 0 1 0 0 0 0 6 ...
##  $ church      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ jesus       : int  0 0 0 0 0 0 0 0 0 2 ...
##  $ bible       : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hair        : int  0 6 0 0 1 0 0 0 0 1 ...
##  $ dress       : int  0 4 0 0 0 1 0 0 0 0 ...
##  $ blonde      : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ mall        : int  0 1 0 0 0 0 2 0 0 0 ...
##  $ shopping    : int  0 0 0 0 2 1 0 0 0 1 ...
##  $ clothes     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ hollister   : int  0 0 0 0 0 0 2 0 0 0 ...
##  $ abercrombie : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ die         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ death       : int  0 0 1 0 0 0 0 0 0 0 ...
##  $ drunk       : int  0 0 0 0 1 1 0 0 0 0 ...
##  $ drugs       : int  0 0 0 0 1 0 0 0 0 0 ...
##  $ female      : num  0 1 0 1 0 1 1 0 1 1 ...
##  $ no_gender   : num  0 0 0 0 1 0 0 0 0 0 ...
# Paso 3 - entrenando el modelo en la data
# Comenzaremos el analisis de cluster con 36 variables
# solamente las 36 caracteristicas que representan
# el numero de veces que los diversos intereses aparecen 
# en el perfil de los adolecentes en SNS. 
# Por comodidad, hagamos una data frame conteniendo
# unicamente esas caracteristicas
interests <- teens[5:40]
# una practica comun empleada antes de cualquier analisis
# usando calculos de distancia es
# normalizar o estandarizar con z-score las caracteristicas 
# que cada una usa en el mismo rango
# El proceso de estandarizacion por z-score re-escala 
# las caracteristicas de tal forma que ellas tienen un
#  promedio igual a cero and y una desviacion estandar de uno
# Para aplicar la estandarizacion z-score 
# a la data frame de interese, podemos usar
# la funcion scales() con lapply() de la siguiente manera:
interests_z <- as.data.frame(lapply(interests, scale))
# los estereotipos utilizadosseran: a brain, an athlete,
# a basket case,a princess, and a criminal. 
#establecemos un punto de inicio o semilla para k.
set.seed(2345)
teens_clusters <- kmeans(interests_z,5)
# Paso 4 - evaluando el rendimiento del modelo
# Una de las maneras mas basicas de evaluar la utilidad
# de un conjunto de clusters es examinando
# el numero de ejemplos que caen en cada uno de los grupos.
# Si los grupos son muy grandes
# o demasiado peque?os,probablemente no seran muy utiles. 
# Para obtener el tama?o de los grupos(clusters) generados por kmeans()
#  usamos el comandoteen_clusters$size:
str(teens_clusters)
## List of 9
##  $ cluster     : int [1:30000] 5 3 5 5 4 5 1 5 5 3 ...
##  $ centers     : num [1:5, 1:36] 0.16 -0.092 0.528 0.341 -0.167 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:5] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:36] "basketball" "football" "soccer" "softball" ...
##  $ totss       : num 1079964
##  $ withinss    : num [1:5] 56114 36039 419433 181973 248881
##  $ tot.withinss: num 942439
##  $ betweenss   : num 137525
##  $ size        : int [1:5] 871 600 5981 1034 21514
##  $ iter        : int 5
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"
teens_clusters$size
## [1]   871   600  5981  1034 21514
# Para un examen mas detallado de los clusters, podemos 
# examinar los centroides
# usando el componente teen_clusters$centers
teens_clusters$centers
##    basketball   football      soccer    softball  volleyball    swimming
## 1  0.16001227  0.2364174  0.10385512  0.07232021  0.18897158  0.23970234
## 2 -0.09195886  0.0652625 -0.09932124 -0.01739428 -0.06219308  0.03339844
## 3  0.52755083  0.4873480  0.29778605  0.37178877  0.37986175  0.29628671
## 4  0.34081039  0.3593965  0.12722250  0.16384661  0.11032200  0.26943332
## 5 -0.16695523 -0.1641499 -0.09033520 -0.11367669 -0.11682181 -0.10595448
##   cheerleading    baseball      tennis      sports        cute
## 1    0.3931445  0.02993479  0.13532387  0.10257837  0.37884271
## 2   -0.1101103 -0.11487510  0.04062204 -0.09899231 -0.03265037
## 3    0.3303485  0.35231971  0.14057808  0.32967130  0.54442929
## 4    0.1856664  0.27527088  0.10980958  0.79711920  0.47866008
## 5   -0.1136077 -0.10918483 -0.05097057 -0.13135334 -0.18878627
##            sex        sexy         hot      kissed       dance        band
## 1  0.020042068  0.11740551  0.41389104  0.06787768  0.22780899 -0.10257102
## 2 -0.042486141 -0.04329091 -0.03812345 -0.04554933  0.04573186  4.06726666
## 3  0.002913623  0.24040196  0.38551819 -0.03356121  0.45662534 -0.02120728
## 4  2.028471066  0.51266080  0.31708549  2.97973077  0.45535061  0.38053621
## 5 -0.097928345 -0.09501817 -0.13810894 -0.13535855 -0.15932739 -0.12167214
##      marching      music        rock         god      church       jesus
## 1 -0.10942590  0.1378306  0.05905951  0.03651755 -0.00709374  0.01458533
## 2  5.25757242  0.4981238  0.15963917  0.09283620  0.06414651  0.04801941
## 3 -0.10880541  0.2844999  0.21436936  0.35014919  0.53739806  0.27843424
## 4 -0.02014608  1.1367885  1.21013948  0.41679142  0.16627797  0.12988313
## 5 -0.11098063 -0.1532006 -0.12460034 -0.12144246 -0.15889274 -0.08557822
##         bible        hair       dress      blonde        mall    shopping
## 1 -0.03692278  0.43807926  0.14905267  0.06137340  0.60368108  0.79806891
## 2  0.05863810 -0.04484083  0.07201611 -0.01146396 -0.08724304 -0.03865318
## 3  0.22990963  0.23612853  0.39407628  0.03471458  0.48318495  0.66327838
## 4  0.08478769  2.55623737  0.53852195  0.36134138  0.62256686  0.27101815
## 5 -0.06813159 -0.20498730 -0.14348036 -0.02918252 -0.18625656 -0.22865236
##         clothes  hollister abercrombie          die       death
## 1  0.5651537331  4.1521844  3.96493810  0.043475966  0.09857501
## 2 -0.0003526292 -0.1678300 -0.14129577  0.009447317  0.05135888
## 3  0.3759725120 -0.0553846 -0.07417839  0.037989066  0.11972190
## 4  1.2306917174  0.1610784  0.26324494  1.712181870  0.93631312
## 5 -0.1865419798 -0.1557662 -0.14861104 -0.094875180 -0.08370729
##          drunk       drugs
## 1  0.035614771  0.03443294
## 2 -0.086773220 -0.06878491
## 3 -0.009688746 -0.05973769
## 4  1.897388200  2.73326605
## 5 -0.087520105 -0.11423381
# las filas de salida (marcadas 1 to 5) refieren 
# a los cinco clusters, mientras que los numeros
# a lo largo de cada fila indica el valor promedio de cada cluster
# para el interes listado arriba
# de la columna. Como los valores han sido estandarizados por z-score,
# los valores positivos son los que estan por encima
# del valor promedio general y los valores negativos estan
# por debajo del valor promedio general.
# Por ejemplo, la tercera fila tiene el valor mas alto 
# en la columna basketball , lo cual 
# lo cual quiere decir que el cluster 3 tiene el valor promedio 
#  mas alto de interes en basketball entre todos los clusters


## Paso 5 - mejorando el rendimiento del modelo
# empezaremos por aplicar los clusters de vuelta
# a todo el conjunto de dataos. Elobjeto teen_clusters
# creado por la funcion kmeans()  incluye 
# un componente llamado cluster que
# contiene la asignacion del cluster para todos los
# 30,000 individuos en la muestra. Nosotros podemos a?adir
# esta como una columna a la data frame teens 
# con el siguiente comando:
teens$cluster <- teens_clusters$cluster
names(teens_clusters)
## [1] "cluster"      "centers"      "totss"        "withinss"    
## [5] "tot.withinss" "betweenss"    "size"         "iter"        
## [9] "ifault"
names(teens)
##  [1] "gradyear"     "gender"       "age"          "friends"     
##  [5] "basketball"   "football"     "soccer"       "softball"    
##  [9] "volleyball"   "swimming"     "cheerleading" "baseball"    
## [13] "tennis"       "sports"       "cute"         "sex"         
## [17] "sexy"         "hot"          "kissed"       "dance"       
## [21] "band"         "marching"     "music"        "rock"        
## [25] "god"          "church"       "jesus"        "bible"       
## [29] "hair"         "dress"        "blonde"       "mall"        
## [33] "shopping"     "clothes"      "hollister"    "abercrombie" 
## [37] "die"          "death"        "drunk"        "drugs"       
## [41] "female"       "no_gender"    "cluster"
# Dada esta nueva data, nosotros podemos comenzar a examinar
# como la asignacion del cluster se relaciona
# con las caracteristicas individuales.Poe ejemplo,
# tenemos la informacion de los primeros cinco individuos
#  en la data SNS:
teens[1:5,c("cluster","gender","age","friends")]
##   cluster gender    age friends
## 1       5      M 18.982       7
## 2       3      F 18.801       0
## 3       5      M 18.335      69
## 4       5      F 18.875       0
## 5       4   <NA> 18.995      10
# Utilizando la funcion aggregate(), podemos 
# observar las caracteristicas demograficas
# de los clusters. El promedio de edad no varia 
# demasiado por cluster, lo cual no es sorpresa:
aggregate(data=teens,age~cluster,mean)
##   cluster      age
## 1       1 16.86497
## 2       2 17.39037
## 3       3 17.07656
## 4       4 17.11957
## 5       5 17.29849
# Por otro lado, hay diferencia significativas
# en la  proporcion de
# mujeres por cluster. Esto es muy interesante
# ya que no utilizamos el genero
# en la creacion de los clusters, aun asi los clusters 
# son predictivos del genero:
aggregate(data=teens,female~cluster,mean)
##   cluster    female
## 1       1 0.8381171
## 2       2 0.7250000
## 3       3 0.8378198
## 4       4 0.8027079
## 5       5 0.6994515
# Dado nuestro exito prediciendo el genero, 
# podemos intuir que los clusters
# pueden predecir el numero de amigos 
# que los usuarios tienen. Esta hipotesis es
# apoyada por los resultados, los cuales son:
aggregate(data=teens,friends~cluster,mean)
##   cluster  friends
## 1       1 41.43054
## 2       2 32.57333
## 3       3 37.16185
## 4       4 30.50290
## 5       5 27.70052
# En promedio, Princesses tiene mas amigos
# (41.4), seguidos por atlhetes (37.2)
# y Brains (32.6). En lo mas bajo de la escala estan los Criminals
# (30.5) y Basket Cases (27.7). Como
# con genero, la conexion entre un adolecente (teen) 
# su numero de amigos y su prediccion de cluster
# es sorprendente, dado que no usamos
# numero de amigos en la data de entrada
# del algoritmo de clustering.