Clusterización bebedores de agua

Segmentación de mercado

Una marca lider en el mercado de las Nabs tiene por interes entender el segmento de consumidores de Nabs bajas en calorias de entre 25 a 35 años. Para ello ha contratado un estudio de investigación de mercado para entender las características del target y segmentarlos para una comunicación y estategia de marketing más eficientes.

La encuestadora ha realizado 300 encuestas telefónicas en dónde se relevaron datos sobre consumos, usos y actitudes de los encuestados hacia las bebidas y aguas lights. El cuestionario incluyó 20 preguntas que se introdujeron con un fin exploratorio para segmentar el mercado. Las cuales son:

1. Me importa verme atractivo/a, sentirme bien conmigo/a mismo/a
1. Disfruto mi trabajo pero no soy esclavo de él
1. Disfruto mucho de hacer actividad física o deportes
1. Cuido mi peso y me gusta tener una buena figura
1. Priorizo un estilo de vida saludable, más que un estilo de cuerpo determinado
1. Me gusta llevar una vida social activa, mis amigos son mi cable a tierra
1. Me gusta estar al tanto de las nuevas tecnologías
1. Mi prioridad es mi vida personal y mi familia
1. Me gusta estar informado de lo que pasa en mi país
1. Uso mucho redes sociales como Facebook, Twitter, Instagram, Pinterest, etc.
1. Me gusta viajar y conocer nuevas culturas, te cambian la manera de ver y pensar
1. Me gustaría trabajar en un emprendimiento personal más que en una gran compañía, aunque resigne ingresos y seguridad
1. Mi trabajo es una fuente de ingresos pero mi prioridad es mi disfrute personal, no el trabajo
1. Uno de mis objetivos es constituir una familia y tener hijos pero pensé que iba a ser antes
1. Soy muy ambicioso y busco mi superación personal, pero no a cualquier precio
1. Somos una generación que ha vuelto a creer en la política como gestor de cambios
1. Me gusta comprometerme con causas sociales
1. Soy muy responsable y consciente respecto del cuidado del medio ambiente
1. Me siento ciudadano del mundo, mi identidad se construye en los viajes
1. Me gusta sentirme libre de elegir y no seguir mandatos de vida rígidos y estructurados
1. Pertenecer a una empresa me da contención y seguridad, me permite proyectar
1. Lo social hoy pasa más por una reunión y una charla con amigos que por una salida de boliche

Los cuales luego de un análisis de los objetivos de la empresa se decidió reducir a sólo 10 atributos que expresen el lado hedonista, social, saludable y familiar de los entrevistados. Siendo seleccionados.

1. Me importa verme atractivo/a, sentirme bien conmigo/a mismo/a
1. Priorizo un estilo de vida saludable, más que un estilo de cuerpo determinado
1. Me gusta llevar una vida social activa, mis amigos son mi cable a tierra
1. Mi prioridad es mi vida personal y mi familia
1. Me gusta viajar y conocer nuevas culturas, te cambian la manera de ver y pensar
1. Mi trabajo es una fuente de ingresos pero mi prioridad es mi disfrute personal, no el trabajo
1. Uno de mis objetivos es constituir una familia y tener hijos pero pensé que iba a ser antes
1. Soy muy ambicioso y busco mi superación personal, pero no a cualquier precio
1. Me gusta comprometerme con causas sociales
1. Pertenecer a una empresa me da contención y seguridad, me permite proyectar

Para segmentar utilizaremos un métodos combinado de entre jerárquico y no jerárquico. Nuestro análisis jerarquico aglomerativo mediante distancias euclidea utilizando el método de Ward al cuadrado se utilizará para determinar los agrupamientos y número de Cluster a utilizar. Para asegurarnos de la validez del método se realizarán análisis no jerárquicos de Kmedias para ajustar los resultados. Se comprobará así la validez del método y por último se interpretarán los segmentos creados.

Paso 1: Objetivos del Cluster analysis.

El objetivo es hallar una taxonomía de los objetos que permita segmentar a los consumidores de gaseosas y aguas lights de entre 25 y 25 años para aplicar una estrategia comunicativa efectiva. Desde el departamento de marketing se planteó la posibilidad de realizar una comunicación a públicos con distintas características las cuales van desde perfiles más hedonistas a aquellos más comunitarios.

setwd("C:\\Users\\jonat\\OneDrive\\Escritorio\\Maestria generacion y analisis de informacion estadistica\\9. Estadistica aplicada a la investigacion de mercados\\3. Segmentacion de mercados\\TP clusters")

library(haven)

base<- read_sav(file="C:\\Users\\jonat\\OneDrive\\Escritorio\\Maestria generacion y analisis de informacion estadistica\\9. Estadistica aplicada a la investigacion de mercados\\3. Segmentacion de mercados\\TP clusters\\Target WE.sav")

head(base)

## # A tibble: 6 x 500
##   firstname lastname email language sent  remindersent remindercount usesleft
##   <chr>     <chr>    <chr> <chr>    <chr> <chr>        <chr>         <chr>   
## 1 ""        ""       ""    es       N     N            0             0       
## 2 ""        ""       ""    es       N     N            0             0       
## 3 ""        ""       ""    es       N     N            0             0       
## 4 ""        ""       ""    es       N     N            0             0       
## 5 ""        ""       ""    es       N     N            0             0       
## 6 ""        ""       ""    es       N     N            0             0       
## # ... with 492 more variables: id <dbl>, token <chr>, submitdate <dttm>,
## #   startlanguage <chr>, ipaddr <chr>, refurl <chr>, S1_1 <dbl+lbl>,
## #   S1_2 <dbl+lbl>, S1_3 <dbl+lbl>, S1_4 <dbl+lbl>, S1_5 <dbl+lbl>,
## #   S1_6 <dbl+lbl>, S1_7 <dbl+lbl>, S1eq <chr>, S1Filtro <dbl+lbl>,
## #   S2 <dbl+lbl>, S3 <dbl>, S3eq <chr>, S3Rango <dbl+lbl>, S4 <dbl+lbl>,
## #   S4eq <chr>, S3S4Cuota <dbl+lbl>, S5_1 <dbl+lbl>, S5_2 <dbl+lbl>,
## #   S5_3 <dbl+lbl>, S5_4 <dbl+lbl>, S5_5 <dbl+lbl>, S5_6 <dbl+lbl>, ...

Para este análisis descartaremos el resto de las variables que se incluyeron en el cuestionario con respecto a usos y consumos y solo nos enfocaremos en las variables actitudinales.

library(tidyverse)

#Reducimos la base

base<- column_to_rownames(base, var = "id")

base<- base[,c(87:108)]


base<- base[,c(1,5,6,8,11,13,14,15,17,21)]

PASO 2: Casos atípicos, estandarización y métodos.

Las preguntas actitudinales se realizaron a partir de una escala Likert en donde 5 significaba estar completamente de acuerdo y 1 completamente en desacuerdo. Debido a que la opción Ns.Nc se registró con el código 9 y la misma afectaría de manera sensible al modo en que la distancia entre los conglomerados se realizarían, se descartaron aquellos casos que hallan respondido Ns.Nc en alguna de las preguntas de segmentación.

#Revisamos la estructura de la base
summary(base)

##       P2_1            P2_5           P2_6           P2_8          P2_11      
##  Min.   :1.000   Min.   :1.00   Min.   :1.00   Min.   :1.00   Min.   :1.000  
##  1st Qu.:4.000   1st Qu.:3.00   1st Qu.:4.00   1st Qu.:4.00   1st Qu.:4.000  
##  Median :4.000   Median :4.00   Median :4.00   Median :5.00   Median :5.000  
##  Mean   :4.137   Mean   :4.03   Mean   :4.08   Mean   :4.47   Mean   :4.363  
##  3rd Qu.:5.000   3rd Qu.:5.00   3rd Qu.:5.00   3rd Qu.:5.00   3rd Qu.:5.000  
##  Max.   :9.000   Max.   :9.00   Max.   :9.00   Max.   :9.00   Max.   :9.000  
##      P2_13          P2_14           P2_15          P2_17           P2_21      
##  Min.   :1.00   Min.   :1.000   Min.   :1.00   Min.   :1.000   Min.   :1.000  
##  1st Qu.:3.00   1st Qu.:2.000   1st Qu.:3.00   1st Qu.:3.000   1st Qu.:3.000  
##  Median :4.00   Median :3.000   Median :4.00   Median :4.000   Median :4.000  
##  Mean   :4.01   Mean   :3.297   Mean   :3.94   Mean   :3.737   Mean   :3.857  
##  3rd Qu.:5.00   3rd Qu.:4.000   3rd Qu.:5.00   3rd Qu.:4.000   3rd Qu.:4.000  
##  Max.   :9.00   Max.   :9.000   Max.   :9.00   Max.   :9.000   Max.   :9.000

#Transformamos los Ns/Nc en missings
base[base==9] <- NA

#Excluimos aquellos casos que tienen Ns/Nc
base<- drop_na(base)

#Inspeccionamos

summary(base)

##       P2_1            P2_5            P2_6            P2_8      
##  Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:4.000   1st Qu.:3.000   1st Qu.:3.000   1st Qu.:4.000  
##  Median :4.000   Median :4.000   Median :4.000   Median :5.000  
##  Mean   :4.134   Mean   :4.034   Mean   :4.049   Mean   :4.451  
##  3rd Qu.:5.000   3rd Qu.:5.000   3rd Qu.:5.000   3rd Qu.:5.000  
##  Max.   :5.000   Max.   :5.000   Max.   :5.000   Max.   :5.000  
##      P2_11           P2_13           P2_14           P2_15      
##  Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
##  1st Qu.:4.000   1st Qu.:3.000   1st Qu.:2.000   1st Qu.:3.000  
##  Median :5.000   Median :4.000   Median :3.000   Median :4.000  
##  Mean   :4.328   Mean   :3.985   Mean   :3.198   Mean   :3.918  
##  3rd Qu.:5.000   3rd Qu.:5.000   3rd Qu.:4.000   3rd Qu.:5.000  
##  Max.   :5.000   Max.   :5.000   Max.   :5.000   Max.   :5.000  
##      P2_17           P2_21      
##  Min.   :1.000   Min.   :1.000  
##  1st Qu.:3.000   1st Qu.:3.000  
##  Median :4.000   Median :4.000  
##  Mean   :3.664   Mean   :3.582  
##  3rd Qu.:4.000   3rd Qu.:4.000  
##  Max.   :5.000   Max.   :5.000

Debemos identificar si existen casos atipicos, definir los metodos de asociación y estandarizar los datos. En este caso, no se normalizarán las variables debido a que se está utilizando preguntas cuya escala es la misma en todas las variables. A continuación se explora los datos para ver la distribución al interior de cada variable.

#Plot distribucion de frecuencias

library(ggplot2)
base %>% gather() %>% ggplot(aes(value)) + facet_wrap(~key, scales="fixed") + geom_density(aes(fill="red"))

Sería recomendable la estandarización por observación para eliminar los efecto de tipo respuesta. Asi nuestro cluster no nos agruparia a todos aquellos que marcan respuestas altas en todas las respuestas.

#Aca intente normalizar las observaciones pero el problema es que despues no puedo correr los clusters porque la media cero de cada observacion me la toma como na
#Aplicamos la estandarizacion a cada una de las variables. 


observaescala <- apply(base, 1, scale) %>% as.data.frame()


observaescala<- t(observaescala) %>% as.data.frame()

colnames_base<- colnames(base)

bases <- `colnames<-`(observaescala,colnames_base)

La medida de similitud que se utilizará serán medidas de distancia, en particular la distancia euclídea y el método de análisis será el método de Ward.

PASO 3: Supuestos del análisis Cluster

El análisis de Cluster supone los principios de representatividad y se espera que la multicolinealidad sea baja. La muestra obtenida de la población de consumidores de bebidas y aguas bajas en calorías de entre 25 y 35 años se asume representativa a partir de las características de selección durante el campo. En cuanto a la multicolinealidad, no se observan correlaciones fuertes entre las variables. Todos los coeficientes de correlación se hallan por debajo de 0.5.

#Correlacion entre las variables para identificar la multicolinealidad

correlaBase<- cor(base)

library(corrplot)

corrplot(correlaBase, method = "square", hclust.method = "ward.D2")

PASO4: Obtención de grupos y valoración del ajuste conjunto

En este paso seleccionamos los métodos para la creación de los cluster y determinamos su tamaño. Además observa la valoración del ajuste conjunto. Para crear los clusters procederemos con un análisis de clusters de distancias euclídeas y método de Ward. Luego mediante métodos de Sillhouete y de Elbow determinaremos el tamaño de los clusters a seleccionar. Para finalizar, correremos un cluster no jerárquico de Kmedias para la valoración del ajuste conjunto, así observaremos si nuestros clusters muestran patrones similares en ambos métodos.

library(cluster)

# Agglomerative Nesting (Hierarchical Clustering)
agnesagua<- agnes(base, metric = "euclidean",stand=TRUE, method =  "ward")


#Divisive nesting(Hierarchical Clustering)
dianagua<- diana(base, metric="euclidean", stand = TRUE)


#Drendrograma
library(factoextra)

#Aglomerativo
fviz_dend(agnesagua, cex = 0.2)

El método de Elbow nos muestra que a partir del 3 o 4 cluster la variacia explicada por nuevos segmentos es mucho más reducida.

#Metodo elbow

fviz_nbclust(base, kmeans, method = "wss") +
  geom_vline(xintercept =3 , linetype = 2)+
  labs(subtitle = "Elbow method")

El método Silhouette nos indica que el número de Clusters más adecuado es 3 ya que es el segmento con el mayor promedio del ancho de Silhouette.

#Metodo silhouette

fviz_nbclust(base, kmeans, method = "silhouette") +
  labs(subtitle = "Silhouette method")

#Metodo gap statistics
set.seed(111)
fviz_nbclust(base, kmeans, method = "gap_stat", nboot = 200) +
  labs(subtitle = "Gap statistics method")

Determinamos una solución de Cluster entre 2 y 3 segmentos

A partir de que determinamos los tamaños de los Clusters pasamos a observar las medias de las variables que se utilizaron para construir los segmentos y así poder explicarlos.

Solución 2 clusters jerarquicos

El conglomerado 1 presenta un mayor nivel de acuerdo con las frases actitudinales. Sin embargo, se muestra una diferencia significativa con respecto al conclomerado 2 en P2_14. Mientras que el conglomerado 2 uno prioriza de manera similar los valores hedonistas y tambien los sociales al igual que el conglomerado 1, se observa que el conglomerado 2 tiene un menor nivel de acuerdo con la idea de que tener una familia es uno de sus objetivos. Al mismo tiempo, en terminos comparativos muestra un menor grado de acuerdo en general con todas las variables. Esta tendencia se puede comprobar tanto en los cluster creados por el metodo jerarquico como por el no jerarquico.

#Matriz de distancia jerarquica

distancia<- dist(base,method = "euclidean")

#Clusterizamos los datos mediante Ward2
clusterjerData<- hclust(distancia, method = "ward.D2")

Cluster2 <- cutree(clusterjerData, k = 2)

table(Cluster2)

## Cluster2
##   1   2 
## 175  93

#Unimos los casos a la base
base<- cbind(base,Cluster2)

#Obtenemos las medias para los clusters

mediasclusterjerarquico2<- base %>% group_by(Cluster2) %>% summarise_all(mean)

#Transformamos los datos en un formato lago
perfilclusterjerquico2 <- pivot_longer(data=mediasclusterjerarquico2,
                                 -Cluster2,
                                 names_to="variable",
                                 values_to = "valor")

#Graficamos las medias segun Cluster
ggplot(perfilclusterjerquico2) + aes(x=variable,y=valor,color=as.factor(Cluster2)) + 
  geom_point() + 
  geom_line(aes(group = Cluster2)) +
  theme_bw() +
  theme(legend.position = "bottom",legend.title=element_blank()) +
  labs(title="Perfiles de Cluster por Variable",
       x="Variable",y="") + ylim(0,8)+
  scale_colour_discrete("Cluster2")

#Dendograma aglomerativo de dos grupos 
fviz_dend(agnesagua, k = 2)

Solución 2 clusters no jerarquicos

#Solucion con dos clusters no jerarquicos
set.seed(111)
segmentos2<- kmeans(base[,c(1:10)], 2)


mediasclusterNOjerarquico2<- segmentos2[["centers"]] %>% as.data.frame() %>% rownames_to_column(var="Cluster")



perfilclusterNOjerquico2 <- pivot_longer(data=mediasclusterNOjerarquico2,
                                 -Cluster,
                                 names_to="variable",
                                 values_to = "valor")


ggplot(perfilclusterNOjerquico2) + aes(x=variable,y=valor,color=as.factor(Cluster)) + 
  geom_point() + 
  geom_line(aes(group = Cluster)) +
  theme_bw() +
  theme(legend.position = "bottom",legend.title=element_blank()) +
  labs(title="Perfiles de Cluster por Variable",
       x="Variable",y="") + ylim(0,8)+
  scale_colour_discrete("Cluster")

fviz_cluster(segmentos2, base, labelsize = 0 )

Solucion 3 clusters jerarquicos

#Matriz de distancia jerarquica

#Clusterizamos los datos mediante Ward2
Cluster3 <- cutree(clusterjerData, k = 3)

table(Cluster3)

## Cluster3
##   1   2   3 
## 175  51  42

#Unimos los casos a la base
base<- cbind(base,Cluster3)

#Obtenemos las medias para los clusters
mediasclusterjerarquico3<- base %>% group_by(Cluster3) %>% summarise_all(mean)

#Transformamos los datos en un formato largo
perfilclusterjerquico3 <- pivot_longer(data=mediasclusterjerarquico3,
                                 -Cluster3,
                                 names_to="variable",
                                 values_to = "valor")

#Graficamos las medias segun Cluster

ggplot(perfilclusterjerquico3) + aes(x=variable,y=valor,color=as.factor(Cluster3)) + 
  geom_point() + 
  geom_line(aes(group = Cluster3)) +
  theme_bw() +
  theme(legend.position = "bottom",legend.title=element_blank()) +
  labs(title="Perfiles de Cluster por Variable",
       x="Variable",y="") + ylim(0,8)+
  scale_colour_discrete("Cluster3")

#Aglomerativo
fviz_dend(agnesagua, k = 3)

Solución 3 clusters no jerarquicos

Siguiendo el analisis que se observa en la salida con dos conglomerados, podemos oberservar que el conglomerado 2 tienen una marcada diferencia en comparacion con el conglomerado 1 y 3 sobre el grado de acuerdo de formar una familia. Si bien las tendencias entre los conglomerados 1 y 3 son similares, el conglomerado 1 muestra un mayor grado de acuerdo hacia las frases actitudinales que el conglomerado 3.

#Solucion con 3 clusters
set.seed(111)
segmentos3<- kmeans(base[,c(1:10)], 3)


mediasclusterNOjerarquico3<- segmentos3[["centers"]] %>% as.data.frame()  %>% rownames_to_column(var="Cluster")

#Transformamos los datos en un formato lago
perfilclusterNOjerquico3 <- pivot_longer(data=mediasclusterNOjerarquico3,
                                 -Cluster,
                                 names_to="variable",
                                 values_to = "valor")

#Graficamos las medias segun Cluster
ggplot(perfilclusterNOjerquico3) + aes(x=variable,y=valor,color=as.factor(Cluster)) + 
  geom_point() + 
  geom_line(aes(group = Cluster)) +
  theme_bw() +
  theme(legend.position = "bottom",legend.title=element_blank()) +
  labs(title="Perfiles de Cluster por Variable",
       x="Variable",y="") + ylim(0,8)+
  scale_colour_discrete("Cluster")

fviz_cluster(segmentos3, base, labelsize = 0)

Paso 5: Interpretación de los conglomerados y su efecto de segmentación sobre otras variables.

Se calcula la media para cada conglomerado para identificar las dimensiones de las variables que están altamente intercorrelacionadas y así poder interpretar los conglomerados generados.

Para identificar el efecto de la segmentación sobre otras variables se tomaron las preguntas sobre frecuencia de consumo de bebidas de P1, en donde en una escala del 1 al 9 el encuestado debía responder qué tan frecuentemente consumía esa bebidad. Escala en donde 1 es varias veces al día y 9 es nunca.

Solución de dos conglomerados

El conglomerado 1 consume mucho más frecuente todo tipo de aguas embotelladas aunque el consumo de gaseosas común es casi idéntico para los dos conglomerados.

#Combinamos el resultado de los cluster no jerarquicos con el resto de la base para identificar su efecto sobre la segmentacion

#Levantamos la base original

basefinal<- read_sav(file="C:\\Users\\jonat\\OneDrive\\Escritorio\\Maestria generacion y analisis de informacion estadistica\\9. Estadistica aplicada a la investigacion de mercados\\3. Segmentacion de mercados\\TP clusters\\Target WE.sav") %>% as.data.frame()

basefinal$id<- as.character(basefinal$id)

clustersegmentos2<- as.data.frame(segmentos2$cluster) %>% rownames_to_column(var="id") 

basefinal<- right_join(basefinal,clustersegmentos2, by="id")

#Cruzamos los clusters por variables que sirvan para entender la segmentacion

library(crosstable)
  

media_consumo<- basefinal[,c(76:87,501)] %>% group_by(`segmentos2$cluster`) %>% summarise_all(mean)

variablesname<- c("CLUSTER", "AGUASINGAS", "AGUACONGAS","AGUACANILLA","AGUASABORIZADALIGHT","GASEOSACOMUN","GASEOSALIGHT","JUGOSPOLVO","JUGOSPOLVOLIGHT","JUGOSLISTOS","JUGOSCONCENTRADOS","ISOTONICAS","HERBALES")

media_consumo<- `colnames<-`(media_consumo,variablesname )


media_consumo<- pivot_longer(data=media_consumo,
                -CLUSTER, 
                names_to = "variables", 
                values_to="valor")

ggplot(media_consumo) + aes(x=variables,y=valor,color=as.factor(CLUSTER)) + 
  geom_point() + 
  geom_line(aes(group = CLUSTER)) +
  theme_bw() +
  theme(legend.position = "bottom",legend.title=element_blank()) +
  labs(title="Perfiles de Cluster por Variable",
       x="Variable",y="") + ylim(0,8)+
  scale_colour_discrete("CLUSTER")

Solución de tres conglomerados

El conglomerado 2 consume con mayor frecuencia bebidas gasificadas, ya sea agua con gas o gaseosas tradicionales. En cambio, el conglomerado 3 casi nunca consume bebidas con gas especialmente gaseosas.

#Combinamos el resultado de los cluster no jerarquicos con el resto de la base para identificar su efecto sobre la segmentacion

#Levantamos la base original

basefinal<- read_sav(file="C:\\Users\\jonat\\OneDrive\\Escritorio\\Maestria generacion y analisis de informacion estadistica\\9. Estadistica aplicada a la investigacion de mercados\\3. Segmentacion de mercados\\TP clusters\\Target WE.sav") %>% as.data.frame()

basefinal$id<- as.character(basefinal$id)

clustersegmentos3<- as.data.frame(segmentos3$cluster) %>% rownames_to_column(var="id") 

basefinal<- right_join(basefinal,clustersegmentos3, by="id")

#Cruzamos los clusters por variables que sirvan para entender la segmentacion


media_consumo<- basefinal[,c(76:87,501)] %>% group_by(`segmentos3$cluster`) %>% summarise_all(mean)

variablesname<- c("CLUSTER", "AGUASINGAS", "AGUACONGAS","AGUACANILLA","AGUASABORIZADALIGHT","GASEOSACOMUN","GASEOSALIGHT","JUGOSPOLVO","JUGOSPOLVOLIGHT","JUGOSLISTOS","JUGOSCONCENTRADOS","ISOTONICAS","HERBALES")

media_consumo<- `colnames<-`(media_consumo,variablesname )


media_consumo<- pivot_longer(data=media_consumo,
                -CLUSTER, 
                names_to = "variables", 
                values_to="valor")

ggplot(media_consumo) + aes(x=variables,y=valor,color=as.factor(CLUSTER)) + 
  geom_point() + 
  geom_line(aes(group = CLUSTER)) +
  theme_bw() +
  theme(legend.position = "bottom",legend.title=element_blank()) +
  labs(title="Perfiles de Cluster por Variable",
       x="Variable",y="") + ylim(0,8)+
  scale_colour_discrete("CLUSTER")