Mercado Têxtil - Unsupervised Machine Learning

Segmentação do Perfil de Compra

Sobre

Este projeto foi criado pela necessidade de uma empresa do setor têxtil, que precisava de uma ação de marketing e inteligência, para venda de uma grande variedade de produtos, que estavam em estoque e já não constavam mais em seu portfólio. A idéia central era criar algumas campanhas baseadas no perfil de compra dos clientes, que já obtiveram esses produtos antes. Para isso, foi utilizado uma combinação de duas técnicas primordiais no aprendizado não-supervisionado, a clusterização (K-means e Cluster Hierárquico) e a análise de redução de dimensionalidade com o PCA!

Para fins de reprodução e direitos da empresa vamos omitir o valor real gasto pelos clientes que foi utilizado na análise. Só mostrarei o dataset depois que ele for tratado.

Vamos ao Dataset

Para nossa análise, retiramos do banco de dados da empresa, o histórico de compra dos clientes. Fizemos alguns tratamentos primários. Filtramos somente o histórico a partir de 2017 para chegarmos a um perfil mais próximo possível do atual de consumo. Filtramos também, somente os clientes ativos da nossa base. E para o primeiro projeto por decisão estratégica da empresa focamos somente nos clientes do estado do Rio de Janeiro.

library(readxl)
library(tidyverse)
library(lubridate)
#caminho dos arquivos
path1<-file.path("C:\\Users\\lferreira\\Desktop\\Planejamento\\Dados\\FaturamentosItens.csv")
path2<-file.path("C:\\Users\\lferreira\\Desktop\\Planejamento\\Dados\\Faturamentos.csv")
path3<-file.path("C:\\Users\\lferreira\\Desktop\\Planejamento\\LISTA ESTOQUE PARADO.xlsx")
#Importação
itens <- read.csv(path1,header = FALSE,stringsAsFactors = FALSE,sep = ";",col.names = c("num_nf" ,"data","num_pedido","produto","derivacao","qtd faturada ","qtd devolvida","vlr liquido","preco unitario","vlr bruto","vlr desconto","vlr desconto 1","vlr desconto 2","vlr desconto 3","vlr descont 4","vlr financeiro","vazio"))
fat<-read.csv(path2,header=FALSE,stringsAsFactors = FALSE,sep=";",col.names = c("num_nf","cod_cliente", "data emissao","Representante","Situacao","vazio"),colClasses = c("numeric","character","character","character","character","character"))
lista<-read_xlsx(path3)
#Juntando datasets e filtrando somente os produtos que precisamos com estoque e fora do portfólio
#Essa lista de produtos está em "lista"
base_fat<-left_join(itens,fat[,1:2],by="num_nf")
base_fat<-base_fat%>%
  mutate(PROD_DER = str_c(produto,derivacao,sep=""))

base_fat<-base_fat%>%
  filter(PROD_DER%in%as.list(lista$`PROD/DER`))
base_fat$data<-as.Date.character(base_fat$data,format = "%d/%m/%Y")
#Passando o valor gasto para o sistema de notação americana com "."
base_fat$vlr.liquido<-gsub("\\.","",base_fat$vlr.liquido)
base_fat$vlr.liquido<-gsub(",",".",base_fat$vlr.liquido)
base_fat$vlr.liquido<-as.numeric(base_fat$vlr.liquido)
#Filtrando para somente 2017 em diante
base_fat<-base_fat%>%mutate(
  ano = year(data)
)%>%
  filter(ano>=2017)
#Vamos agora filtrar somente os clientes do estado RJ
base_fat2<-base_fat%>%
  group_by(cod_cliente,produto)%>%
  summarise(valor_RS = sum(vlr.liquido))
path8<-file.path("C:\\Users\\lferreira\\Desktop\\Planejamento\\Dados\\Clientes.csv")

estado_clientes<-read.csv(path8,header=FALSE,stringsAsFactors = FALSE,sep=";",col.names = c("cod_cliente","fantasia", "cidade","estado","cnpj","vazio"),colClasses = c("character","character","character","character","character","character") )
estado_clientes<-estado_clientes[,c(1,4)]
base_fat2<-left_join(base_fat2,estado_clientes,by="cod_cliente")
base_fat2<-base_fat2%>%
  filter(estado=="RJ")
base_fat2<-base_fat2[,-4]
#Filtrando Também somente clientes ativos "A"
path5<-file.path("C:\\Users\\lferreira\\Desktop\\Planejamento\\sit clientes.XLSX")

sit_clientes<-read_xlsx(path5,col_types = c("text","text"))
base_fat2$cod_cliente<-gsub("\\.","",base_fat2$cod_cliente)
base_fat2<-left_join(base_fat2,sit_clientes,by="cod_cliente")

base_fat2<-base_fat2%>%
  filter(sit_cliente=="A")
base_fat2<-base_fat2[,-4]

#Agora vamos para nossa análise agrupar os produtos em família de produtos
path7<-file.path("C:\\Users\\lferreira\\Desktop\\Planejamento\\fam_est_parado.xlsx")
familia<-read_xlsx(path7)
familia$fam<-str_to_lower(familia$fam)
base_fat2<-left_join(base_fat2,familia,by="produto")

base_fat2<-base_fat2%>%
  group_by(cod_cliente,fam)%>%
  summarise(Valor_RS=sum(valor_RS))
#agora irei separar as famílias "fam" em colunas com spread:
base_fat_spread<-base_fat2%>%
  spread(fam,Valor_RS,fill=0)
glimpse(base_fat_spread)

## Observations: 235
## Variables: 16
## Groups: cod_cliente [235]
## $ cod_cliente           <chr> "10071", "10082", "10098", "101", "10107...
## $ `cadarços (sarjado)`  <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00...
## $ `cintos elásticos`    <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1080, 0...
## $ cordões               <dbl> 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00...
## $ `elásticos crochet`   <dbl> 0.00, 21.42, 0.00, 18106.59, 32.06, 4667...
## $ `elásticos tear`      <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
## $ `elásticos trançados` <dbl> 0.00, 0.00, 0.00, 0.00, 205.98, 0.00, 0....
## $ franja                <dbl> 0.00, 0.00, 0.00, 0.00, 92.60, 0.00, 0.0...
## $ galões                <dbl> 0.00, 0.00, 0.00, 0.00, 103.81, 0.00, 0....
## $ `passa fita`          <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
## $ pom                   <dbl> 145.80, 0.00, 410.27, 0.00, 0.00, 0.00, ...
## $ `ponto palito`        <dbl> 51.97, 0.00, 0.00, 0.00, 0.00, 0.00, 0.0...
## $ rendas                <dbl> 0.00, 76.95, 0.00, 2475.18, 462.19, 4535...
## $ sianinha              <dbl> 0.00, 0.00, 0.00, 0.00, 103.84, 0.00, 0....
## $ soutache              <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...
## $ vira                  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...

Usando Log e Scale para pré-processamento

A base de dados foi transformada usando a função log() afim de evitarmos alguns outiliers no dataset. Melhorando assim, o processo de clusterização.

names<-base_fat_spread$cod_cliente

faturamento_hak_parado<-base_fat_spread[,-1]
#Passando os clientes para indexador de linhas
row.names(faturamento_hak_parado)<-names
#transformação logarítmica, adicionei 1 aos elementos da matriz, já que essa base de dados possui muitos zeros.
faturamento_hak_parado<-faturamento_hak_parado + 1

faturamento_hak_parado<-log(faturamento_hak_parado)

head(faturamento_hak_parado)

##       cadarços (sarjado) cintos elásticos cordões elásticos crochet
## 10071                  0                0       0          0.000000
## 10082                  0                0       0          3.109953
## 10098                  0                0       0          0.000000
## 101                    0                0       0          9.804086
## 10107                  0                0       0          3.498324
## 10118                  0                0       0          8.448696
##       elásticos tear elásticos trançados  franja   galões passa fita
## 10071              0            0.000000 0.00000 0.000000          0
## 10082              0            0.000000 0.00000 0.000000          0
## 10098              0            0.000000 0.00000 0.000000          0
## 101                0            0.000000 0.00000 0.000000          0
## 10107              0            5.332622 4.53903 4.652149          0
## 10118              0            0.000000 0.00000 0.000000          0
##            pom ponto palito   rendas sianinha soutache vira
## 10071 4.989071     3.969726 0.000000 0.000000        0    0
## 10082 0.000000     0.000000 4.356068 0.000000        0    0
## 10098 6.019250     0.000000 0.000000 0.000000        0    0
## 101   0.000000     0.000000 7.814472 0.000000        0    0
## 10107 0.000000     0.000000 6.138137 4.652435        0    0
## 10118 0.000000     0.000000 8.419843 0.000000        0    0

Embora cada variável (família) use a mesma medida, (faturamento líquido) é necessário olharmos se tanto a média quanto o desvio padrão de cada variável apresenta uma distribuição normal centrada, ou uma distribuição assimétrica. Em outras palavras, procuramos saber se tanto a média como o desvio padrão de cada variável estão próximos entre si ou temos variáveis com valores muito distantes da mediana dos valores.

means<-colMeans(faturamento_hak_parado)
hist(means)

sdev<-apply(faturamento_hak_parado,2,sd)
hist(sdev)

Bem, embora o desvio padrão esteja mais centrado, a média não está (Padrão Cauda Longa). Por via das dúvidas, vamos de scale()!

library(knitr)
faturamento_hak_parado2<-scale(faturamento_hak_parado,center = TRUE,scale = FALSE)

head(faturamento_hak_parado2)%>%
  kable()

	cadarços (sarjado)	cintos elásticos	cordões	elásticos crochet	elásticos tear	elásticos trançados	franja	galões	passa fita	pom	ponto palito	rendas	sianinha	soutache	vira
10071	-0.5045204	-0.1201778	-1.798427	-4.0821980	-0.2005836	-1.731280	-0.9424351	-2.693407	-0.2701208	4.082693	3.4691450	-1.620245	-0.829144	-0.3249097	-0.022749
10082	-0.5045204	-0.1201778	-1.798427	-0.9722446	-0.2005836	-1.731280	-0.9424351	-2.693407	-0.2701208	-0.906378	-0.5005808	2.735822	-0.829144	-0.3249097	-0.022749
10098	-0.5045204	-0.1201778	-1.798427	-4.0821980	-0.2005836	-1.731280	-0.9424351	-2.693407	-0.2701208	5.112872	-0.5005808	-1.620245	-0.829144	-0.3249097	-0.022749
101	-0.5045204	-0.1201778	-1.798427	5.7218884	-0.2005836	-1.731280	-0.9424351	-2.693407	-0.2701208	-0.906378	-0.5005808	6.194227	-0.829144	-0.3249097	-0.022749
10107	-0.5045204	-0.1201778	-1.798427	-0.5838739	-0.2005836	3.601342	3.5965953	1.958743	-0.2701208	-0.906378	-0.5005808	4.517892	3.823291	-0.3249097	-0.022749
10118	-0.5045204	-0.1201778	-1.798427	4.3664979	-0.2005836	-1.731280	-0.9424351	-2.693407	-0.2701208	-0.906378	-0.5005808	6.799597	-0.829144	-0.3249097	-0.022749

Principal Component Analysis (PCA)

Nossa análise é composta por 235 clientes e 15 variáveis que são as seguintes famílias de produtos:

##  [1] "cadarços (sarjado)"  "cintos elásticos"    "cordões"            
##  [4] "elásticos crochet"   "elásticos tear"      "elásticos trançados"
##  [7] "franja"              "galões"              "passa fita"         
## [10] "pom"                 "ponto palito"        "rendas"             
## [13] "sianinha"            "soutache"            "vira"

A empresa produz peças têxteis, que servem de matéria-prima para diversas outras indústrias de transformação como: vestuário, cama, mesa e banho, festas tradicionais regionais (carnaval, festa do boi etc).

Não é intuito desse artigo falar afundo sobre cada família. Para mais detalhes acesse: HAK Soluções Têxteis

Vamos tentar reduzir o numero de variáveis através da redução da dimensionalidade, usando o PCA, resumindo a análise de PCA usa um conjunto de combinações lineares em cada variável em busca de multicolinearidade. Criando assim, componentes que possuem pesos de cada variável. Assim, podemos trabalhar com apenas poucos componentes que explicam boa parte da variação dos dados ao invés de usarmos todas.

Para mais detalhes recomendo muito o artigo de Luke Hayden na pagina do DataCamp e o vídeo de Josh Starmer no famoso canal StatQuest with Josh Starmer!

fat_hak_pca<-prcomp(faturamento_hak_parado2)

pr.var<-fat_hak_pca$sdev^2
pve<-pr.var/sum(pr.var)

plot(pve, xlab = "Componente Principal", 
     ylab = "Proporção de Variação Explicada", 
     ylim = c(0, 1), type = "b")

plot(cumsum(pve), xlab = "Componente Principal", 
     ylab = "Proporção de Variação  Acumulada Explicada", 
     ylim = c(0, 1), type = "b")

summary(fat_hak_pca)

## Importance of components:
##                          PC1    PC2     PC3    PC4     PC5     PC6     PC7
## Standard deviation     4.973 3.9095 2.68364 2.5335 2.03456 1.76795 1.66372
## Proportion of Variance 0.336 0.2077 0.09785 0.0872 0.05624 0.04247 0.03761
## Cumulative Proportion  0.336 0.5437 0.64152 0.7287 0.78497 0.82743 0.86504
##                            PC8     PC9    PC10   PC11   PC12    PC13
## Standard deviation     1.52394 1.41635 1.32478 1.1020 1.0613 0.91784
## Proportion of Variance 0.03155 0.02725 0.02384 0.0165 0.0153 0.01145
## Cumulative Proportion  0.89659 0.92384 0.94769 0.9642 0.9795 0.99093
##                           PC14    PC15
## Standard deviation     0.75079 0.32191
## Proportion of Variance 0.00766 0.00141
## Cumulative Proportion  0.99859 1.00000

Essa é a mágica do PCA, com apenas 6 componentes conseguimos explicar cerca de 82,7% da variação dos dados. Desse momento em diante, vamos usá-los para análise.

Outro fator importante é o peso que cada variável tem em cada um dos seis principais componentes que escolhemos usar.

É importantíssimo analisarmos cada peso dos seis componentes para entendermos o que podemos extrair de informação de cada um deles!

fat_hak_pca$rotation[,1:6]%>%
  kable()

	PC1	PC2	PC3	PC4	PC5	PC6
cadarços (sarjado)	0.1714545	-0.0771075	0.0778450	-0.1456412	-0.1005456	0.1434591
cintos elásticos	0.0157902	-0.0185673	0.0085563	0.0437537	0.0725420	0.0317553
cordões	0.4568899	-0.0995462	-0.1280048	-0.3583833	0.1667411	0.7150495
elásticos crochet	-0.1121696	-0.9674770	0.1573408	0.0183238	-0.0876964	-0.0470224
elásticos tear	0.0263448	-0.0146726	0.0109943	0.0222209	0.0078217	0.0085937
elásticos trançados	0.3338757	-0.1264424	-0.7590913	0.2833306	-0.4134445	-0.0714094
franja	0.2563034	-0.0863924	-0.1101873	-0.1841973	0.2355650	-0.4108952
galões	0.5800105	0.0998651	0.5103471	-0.0501441	-0.5099296	-0.2425331
passa fita	0.0606592	-0.0719284	-0.0020513	-0.1102965	0.0406173	-0.0257490
pom	0.2451148	-0.0602229	-0.0564040	-0.2938020	0.4259515	-0.2607933
ponto palito	0.1190348	-0.0576955	0.1243547	-0.0716925	0.1049200	-0.0156032
rendas	0.3276515	-0.0413261	0.2286727	0.7904008	0.3853775	0.1697160
sianinha	0.1998258	-0.0148863	-0.1697902	0.0198266	0.3333473	-0.3645099
soutache	0.0967228	-0.0007102	0.0630308	-0.0459848	-0.0938046	-0.0259821
vira	0.0134768	-0.0094627	0.0068683	-0.0045711	0.0094946	-0.0284274

No componente um, a família com maior peso é a de galões. Componente dois: elásticos de crochet. Componente três: elásticos trançados. Componente quatro: rendas. Componente cinco: Mix de elásticos trançados, galões e pom. Por último, componente seis: Cordões.

Resumindo:

resumo.pca<-data.frame(componente_principal = c("PC1","PC2","PC3","PC4","PC5","PC6"),
  explicacao_familia = c("galões","elásticos de crochet","elásticos trançados","rendas",
                         " mix de elásticos trançados, galões e pom","cordões"))
kable(resumo.pca)

componente_principal	explicacao_familia
PC1	galões
PC2	elásticos de crochet
PC3	elásticos trançados
PC4	rendas
PC5	mix de elásticos trançados, galões e pom
PC6	cordões

biplot(fat_hak_pca)

No biplot, conseguimos ver claramente os vetores galões e elástico crochet se sobressaindo. Já que são as duas famílias com maiores cargas em PC1 e PC2, como vimos acima.

Por enquanto, vamos dar uma parada com PCA e vamos para os algoritmos de cluster.

Cluster com K-means

Vamos começar com nosso algoritmo de K-means. Como o algoritmo precisa que passemos um número para dividirmos o dataset emcenter e não sabemos ao certo quantos clusters queremos, vamos fazer uma iteração de 1 à 20 clusters para decidirmos com um gráfico de cotovelo, que mostra a soma total dos quadrados da distância dentro do cluster para cada opção center que criamos (nesse caso, de 1 à 20).

set.seed(42)
library(purrr)
tot_withinss <- map_dbl(1:20,  function(k){
  model <- kmeans(x = fat_hak_pca$x[,1:6], centers = k)
  model$tot.withinss
})

elbow_df <- data.frame(
  k = 1:20,
  tot_withinss = tot_withinss
)
ggplot(elbow_df, aes(x = k, y = tot_withinss)) +
  geom_line() +
  scale_x_continuous(breaks = 1:20)

A análise do cotovelo parece que está indicando um k de valor 3. Para confirmar, vamos fazer uma análise da silhueta com o cluster package.

library(cluster)

sil_width <- map_dbl(2:20,  function(k){
  model <- pam(fat_hak_pca$x[,1:6], k = k)
  model$silinfo$avg.width
})
sil_df <- data.frame(
  k = 2:20,
  sil_width = sil_width
)
ggplot(sil_df, aes(x = k, y = sil_width)) +
  geom_line() +
  scale_x_continuous(breaks = 2:20)

Parece que temos três opções para o valor de k com o gráfico de silhueta:3,6 e 15. Vamos dar uma breve olhada na heterogenia dos dados!

Vamos usar um gráfico de três dimensões, para visualizar as três opções de cluster com os três componentes principais da nossa análise de PCA.

Lembrando que os três componentes conseguem representar juntos 64,15% da variação total dos dados!

kcluster_1<- kmeans(x = fat_hak_pca$x[,1:6], centers = 3)
kcluster_2 <- kmeans(x = fat_hak_pca$x[,1:6], centers = 6)
kcluster_3<- kmeans(x = fat_hak_pca$x[,1:6], centers = 15)

analise<- as.data.frame(fat_hak_pca$x[,1:6])%>%
  mutate(cluster_kmeans_k3 = kcluster_1$cluster,
         cluster_kmeans_k6 = kcluster_2$cluster,
         
         cluster_kmeans_k15 = kcluster_3$cluster,
         clientes = names
         
         )


  analise%>%
  group_by(cluster_kmeans_k3)%>%
  count()

## # A tibble: 3 x 2
## # Groups:   cluster_kmeans_k3 [3]
##   cluster_kmeans_k3     n
##               <int> <int>
## 1                 1    95
## 2                 2    98
## 3                 3    42

  analise%>%
  group_by(cluster_kmeans_k6)%>%
  count()

## # A tibble: 6 x 2
## # Groups:   cluster_kmeans_k6 [6]
##   cluster_kmeans_k6     n
##               <int> <int>
## 1                 1    26
## 2                 2    27
## 3                 3    33
## 4                 4    39
## 5                 5    79
## 6                 6    31

  analise%>%
  group_by(cluster_kmeans_k15)%>%
  count()

## # A tibble: 15 x 2
## # Groups:   cluster_kmeans_k15 [15]
##    cluster_kmeans_k15     n
##                 <int> <int>
##  1                  1     6
##  2                  2    17
##  3                  3    21
##  4                  4    27
##  5                  5     7
##  6                  6    14
##  7                  7    24
##  8                  8    10
##  9                  9     9
## 10                 10    20
## 11                 11    28
## 12                 12    11
## 13                 13     8
## 14                 14    12
## 15                 15    21

  library(plotly)
  
  plot_ly(analise, x = ~PC1, y = ~PC2, z = ~PC3, color = ~as.factor(cluster_kmeans_k3))%>%
  add_markers()%>%
  layout(scene = list(xaxis = list(title = '+Cordõe e Galões'),
                      yaxis = list(title = '-Elásticos Crochet'),
                      zaxis = list(title = '+Rendas')))

  plot_ly(analise, x = ~PC1, y = ~PC2, z = ~PC3, color = ~as.factor(cluster_kmeans_k6))%>%
  add_markers()%>%
  layout(scene = list(xaxis = list(title = '+Cordões e Galões'),
                      yaxis = list(title = '-Elásticos Crochet'),
                      zaxis = list(title = '+Rendas')))

  plot_ly(analise, x = ~PC1, y = ~PC2, z = ~PC3, color = ~as.factor(cluster_kmeans_k15))%>%
  add_markers()%>%
  layout(scene = list(xaxis = list(title = '+Cordões e Galões'),
                      yaxis = list(title = '-Elásticos Crochet'),
                      zaxis = list(title = '+Rendas')))

Como segundo o gráfico de cotovelo, a partir de k=3 a variação não é tão grande assim e um k=15 seria uma k muito distante de três. Sendo assim, decidimos ficar com o valor de k =6, que seria um intermediário entre ambos e permite um número maior de campanhas. Por decisão estratégica, apenas três clusters ficariam com campanhas muito generalizadas.

Então vamos de k = 6!

Mais para frente, discutiremos o que pode ser tirado de insight do PCA, nesses gráficos. Mas, primeiro vamos dar uma olhada no cluster hierárquico.

Cluster Hierárquico

Para o agrupamento hierárquico vamos tirar a distância euclidiana da nossa matriz reduzida com PCA.

dist_faturamento<-dist(fat_hak_pca$x[,1:6], method = "euclidean")

Vamos também analisar todos os seis métodos que a função hclust nos permite calcular a distância entre clusters, “complete”, “average”, “single”, “centroid”, “mcquitty” e “median”.

dist_faturamento<-dist(fat_hak_pca$x[,1:6], method = "euclidean")
hc_fat_complete <- hclust(dist_faturamento, method = "complete")
hc_fat_single <- hclust(dist_faturamento, method = "single")
hc_fat_average <- hclust(dist_faturamento, method = "average")
hc_fat_centroid<-hclust(dist_faturamento, method = "centroid")
hc_fat_mcquitty<-hclust(dist_faturamento, method = "mcquitty")
hc_fat_median<-hclust(dist_faturamento, method = "median")
dend_fat_complete <- as.dendrogram(hc_fat_complete)
dend_fat_single <- as.dendrogram(hc_fat_single)
dend_fat_average <- as.dendrogram(hc_fat_average)
dend_fat_centroid <- as.dendrogram(hc_fat_centroid)
dend_fat_mcquitty <- as.dendrogram(hc_fat_mcquitty)
dend_fat_median <- as.dendrogram(hc_fat_median)

#VISUALIZANDO OS DENDOGRAMAS

library(dendextend)
library(viridis)

dend_fat_complete%>%
  set("labels",NULL)%>%
  highlight_branches_col(viridis(100))%>%
  plot(main = "Método = Complete")

dend_fat_average%>%
  set("labels",NULL)%>%
  highlight_branches_col(viridis(100))%>%
  plot(main = "Método = Average")

dend_fat_single%>%
  set("labels",NULL)%>%
  highlight_branches_col(viridis(100))%>%
  plot(main = "Método = Single")

dend_fat_centroid%>%
  set("labels",NULL)%>%
  highlight_branches_col(viridis(100))%>%
  plot(main = "Método = Centroid")

dend_fat_mcquitty%>%
  set("labels",NULL)%>%
  highlight_branches_col(viridis(100))%>%
  plot(main = "Método = Mcquitty")

dend_fat_median%>%
  set("labels",NULL)%>%
  highlight_branches_col(viridis(100))%>%
  plot(main = "Método = Median")

Olhando de forma empírica, o método complete foi o que trouxe um agrupamento mais “limpo” e homogêneo. Por isso, vamos usá-lo daqui em diante.

Como já analisamos o k-means, e chegamos a uma conclusão de um k=6, vamos fazer esse mesmo corte em nosso agrupamento hierárquico.

cut_dendo <- cutree(hc_fat_complete,k=6)

analise<-analise%>%
  mutate(cluster_hclust6 = cut_dendo)

analise%>%
  group_by(cluster_hclust6)%>%
  count()

## # A tibble: 6 x 2
## # Groups:   cluster_hclust6 [6]
##   cluster_hclust6     n
##             <int> <int>
## 1               1    68
## 2               2   100
## 3               3    32
## 4               4     7
## 5               5    27
## 6               6     1

table(analise$cluster_kmeans_k6,analise$cluster_hclust6)

##    
##      1  2  3  4  5  6
##   1 16  8  0  0  2  0
##   2 10  3 12  0  2  0
##   3  0  4  1  7 20  1
##   4 38  1  0  0  0  0
##   5  0 79  0  0  0  0
##   6  4  5 19  0  3  0

Parece que nosso agrupamento usando k-means, separa os clientes de forma muito mais homogênea do que o agrupamento hierárquico.

Mas não vamos tomar decisões agora.

Para bater o martelo de vez vamos mesclar as duas análises usando o PCA!

Vamos usar um gráfico de dispersão usando os dois componentes principais (juntos mostram 54,37% da variação total).

PCA com K-means

PCA com Cluster Hierárquico

Tanto em k-means quanto em hclust, obtivemos uma separação bem definida do cluster na parte inferior-esquerda (cluster cinco em k-means e dois em hclust) mostrando um forte padrão para produtos da família de elásticos de crochet (lembrando que o componente de Crochet é negativo). Entretanto, o cluster três em k-means também apresentou uma separação distinta contendo assim um padrão bom para galões, como para os elásticos crochet. No mesmo quadrante, no agrupamento hierárquico, não vemos uma separação tão boa assim. Temos um pouco do cluster dois, invadindo o quadrante, uma parte do 5, invadindo o quadrante de cima e o cluster seis contendo apenas um cliente isolado nesse quadrante.

Por esses motivos e, principalmente pelo modelo k-means, separar os clusters de forma mais homogênea do que o modelo hierárquico, por consenso e decisão estratégica o k-means, venceu a disputa!

Recomendações de Campanhas com K-means e PCA

Bem, chegamos na hora da ação. Vamos elaborar campanhas a partir dos insights que o modelo híbrido de k-means e PCA nos forneceu.

plotfun <- function(x,y,...){
    points(x,y,...) #plot them
    abline(h = 0) #horizontal line
    abline(v = 0) #vertical line
}

analise$cluster_kmeans_K6<-as.factor(analise$cluster_kmeans_k6)

pairs(analise[,1:6],col=analise$cluster_kmeans_K6,upper.panel = NULL,
lower.panel = plotfun, labels = c("Galões","E.crochet","E.trançados","Rendas",
" Mix E.trançados,

Galões e

Pom","Cordões"),

font.labels = 12,cex.labels =1.6,main = "K-means com todos os 6 principais componentes")
par(xpd = TRUE)
legend("topright", fill = unique(analise$cluster_kmeans_K6), 
legend =c(levels(analise$cluster_kmeans_K6)),title = "Clusters")

Por sigilo da empresa não podemos entrar em detalhes em como ficou a montagem de cada campanha. Mas, para simplificar de modo geral foi feito o seguinte:

Para cada cluster foi feito uma análise de quais famílias realmente tinha impacto em diferenciar aquele cluster dos demais.

Vamos dar dois exemplos de como foi feito:

Para o cluster 2, a campanha foi voltada exclusivamente para elásticos crochet com um mix que representa 80% do valor líquido gasto historicamente pelos clientes desse cluster (Princípio de Pareto).

No Cluster 4, a campanha foi voltada para um mix de galões e Crochet, sendo o Crochet como tem um peso maior na análise de PCA (0,96 contra 0,58 de galões) vai ser a família com mais variedade de produtos no mix da campanha em comparação a família de Galões.

Bom, paramos por aí. Essa é uma das diversas aplicações de aprendizado não supervisionado, principalmente na área de marketing e vendas, elas são ilimitadas!

Sobre os resultados da campanha: ela ainda está na fase de produção de conteúdo, assim que entrar em ação e tivermos um resultado postarei um feedback aqui!

Espero que tenham gostado e sucesso!