1.1 Criação do conjunto de dados

Para criar o conjunto de dados Baralho, eu crio uma matriz e a converto em data.frame, dando às colunas os nomes apropriados.

baralho <- matrix(0, nrow = 52, ncol = 3)
baralho <- data.frame(baralho)
colnames(baralho) <- c("naipe", "cor", "numero")
head(baralho)

##   naipe cor numero
## 1     0   0      0
## 2     0   0      0
## 3     0   0      0
## 4     0   0      0
## 5     0   0      0
## 6     0   0      0

Depois preencho com os valores. Primeiro o naipe, cada um repetido 13 vezes.

baralho$naipe <- c(rep("copas",13), 
                  rep("ouros",13), 
                  rep("espadas",13),
                  rep("paus",13))

Depois os números

numeros <- as.character(c(2:10))
baralho$numero <- c("A", numeros , "J", "Q", "K")

Por fim, eu digo que todas as cores são pretas e quando o naipe for copas ou ouros, eu substituo pela cor vermelha.

baralho$cor <- "preto"
baralho[(baralho$naipe == "copas") | 
          baralho$naipe == "ouros","cor"] <- "vermelho"

head(baralho)

##   naipe      cor numero
## 1 copas vermelho      A
## 2 copas vermelho      2
## 3 copas vermelho      3
## 4 copas vermelho      4
## 5 copas vermelho      5
## 6 copas vermelho      6

1.2 Primeiro teste do Kmeans:

set.seed(10)
kmeans(x = baralho, 
       centers = 2, iter.max = 100)

## Warning in kmeans(x = baralho, centers = 2, iter.max = 100): NAs
## introduzidos por coerção

## Error in do_one(nmeth): NA/NaN/Inf em chamada de função externa (argumento 1)

Erro porque tenho que converter os valores para numérico. Então vamos refazer o conjunto de dados com números apenas.

1.3 Recriação do conjunto de dados

Ao invés de trabalhar com categorias nominais, opto por trabalhar com números que representem tais categorias.

baralho_num <- matrix(0, nrow = 52, ncol = 3)
baralho_num <- data.frame(baralho_num)
colnames(baralho_num) <- c("naipe", "cor", "numero")
baralho_num$naipe <- c(rep(1,13), 
                   rep(2,13), 
                   rep(3,13),
                   rep(4,13))
baralho_num$numero <- as.numeric(1:13)
baralho_num$cor <- 1
baralho_num[(baralho_num$naipe == "3") | 
          baralho_num$naipe == "4","cor"] <- 2

head(baralho_num)

##   naipe cor numero
## 1     1   1      1
## 2     1   1      2
## 3     1   1      3
## 4     1   1      4
## 5     1   1      5
## 6     1   1      6

1.4 Refazendo o teste com o KMeans

Refaço o teste com o KMeans e observo que:

set.seed(10)
baralho_cluster <- kmeans(x = baralho_num, 
       centers = 2, iter.max = 100)

somas <- baralho_cluster$tot.withinss
somas <- cbind(somas,baralho_cluster$betweenss)
somas <- as.data.frame(somas)
colnames(somas) <- c("interna", "externa")
somas

##   interna externa
## 1     260     546

comparacao <- cbind(baralho_num$cor,baralho_cluster$cluster)
colnames(comparacao) <- c("cor", "cluster")
head(comparacao,10)

##       cor cluster
##  [1,]   1       1
##  [2,]   1       1
##  [3,]   1       1
##  [4,]   1       1
##  [5,]   1       1
##  [6,]   1       1
##  [7,]   1       2
##  [8,]   1       2
##  [9,]   1       2
## [10,]   1       2

O Kmeans não identificou uma das divisões naturais do conjunto. Posso tentar mais uma vez, desta vez, dividindo pelo naipe:

set.seed(10)
baralho_cluster <- kmeans(x = baralho_num, 
                          centers = 4, iter.max = 100)

parcial <- as.data.frame(cbind(baralho_cluster$tot.withinss,baralho_cluster$betweenss))
colnames(parcial) <- colnames(somas)
somas <- rbind(somas,parcial)
somas

##   interna externa
## 1     260     546
## 2     122     684

comparacao <- cbind(baralho_num$naipe,baralho_cluster$cluster)
colnames(comparacao) <- c("naipe", "cluster")
head(comparacao,10)

##       naipe cluster
##  [1,]     1       1
##  [2,]     1       1
##  [3,]     1       1
##  [4,]     1       2
##  [5,]     1       2
##  [6,]     1       2
##  [7,]     1       4
##  [8,]     1       4
##  [9,]     1       4
## [10,]     1       3

Mais uma vez os clusters não fazem sentido, apesar da grande queda nas distâncias internas. Qual um problema? Pode ser que eu precise normalizar. O uso dos valores numéricos cria distâncias inexistentes entre categorias.

1.5 Normalização do conjunto de dados numerico e mais um teste com o KMeans

baralho_sc <- scale(baralho_num)
head(baralho_sc)

##          naipe        cor     numero
## [1,] -1.328678 -0.9903379 -1.5880737
## [2,] -1.328678 -0.9903379 -1.3233947
## [3,] -1.328678 -0.9903379 -1.0587158
## [4,] -1.328678 -0.9903379 -0.7940368
## [5,] -1.328678 -0.9903379 -0.5293579
## [6,] -1.328678 -0.9903379 -0.2646789

set.seed(10)
baralho_cluster <- kmeans(x = baralho_sc,
                          centers = 4, iter.max = 100)

parcial <- as.data.frame(cbind(baralho_cluster$tot.withinss,baralho_cluster$betweenss))
colnames(parcial) <- colnames(somas)
somas <- rbind(somas,parcial)
somas

##   interna externa
## 1  260.00  546.00
## 2  122.00  684.00
## 3   22.95  130.05

comparacao <- cbind(baralho_num$naipe,baralho_cluster$cluster)
head(comparacao,10)

##       [,1] [,2]
##  [1,]    1    2
##  [2,]    1    2
##  [3,]    1    2
##  [4,]    1    2
##  [5,]    1    2
##  [6,]    1    2
##  [7,]    1    3
##  [8,]    1    3
##  [9,]    1    3
## [10,]    1    3

Isso também não foi suficiente. Outra possibilidade de tratamento é de binarizar os atributos categóricos. Passo, então, a utilizar uma mistura das duas condições:

• Naipe e cor voltarão a ser considerados atributos categóricos e
• Os números do baralho serão mantidos como numéricos e serão normalizados.

baralho$numero <- as.numeric(1:13)
baralho$numero <- scale(baralho$numero)
baralho <- model.matrix(~. -1, baralho)
baralho <- as.data.frame(baralho)
head(baralho)

##   naipecopas naipeespadas naipeouros naipepaus corvermelho     numero
## 1          1            0          0         0           1 -1.5880737
## 2          1            0          0         0           1 -1.3233947
## 3          1            0          0         0           1 -1.0587158
## 4          1            0          0         0           1 -0.7940368
## 5          1            0          0         0           1 -0.5293579
## 6          1            0          0         0           1 -0.2646789

set.seed(10)
baralho_cluster <- kmeans(x = baralho,
                          centers = 4, iter.max = 100)

parcial <- as.data.frame(cbind(baralho_cluster$tot.withinss,baralho_cluster$betweenss))
colnames(parcial) <- colnames(somas)
somas <- rbind(somas,parcial)
somas

##   interna externa
## 1  260.00  546.00
## 2  122.00  684.00
## 3   22.95  130.05
## 4   38.75   64.25

comparacao <- cbind(baralho,baralho_cluster$cluster)
colnames(comparacao) <- c(colnames(comparacao[,-ncol(comparacao)]),"cluster") #Modifica o nome da ultima coluna
head(comparacao[,-match("numero",colnames(baralho))]) #Nao exibe a coluna Numero

##   naipecopas naipeespadas naipeouros naipepaus corvermelho cluster
## 1          1            0          0         0           1       2
## 2          1            0          0         0           1       2
## 3          1            0          0         0           1       2
## 4          1            0          0         0           1       2
## 5          1            0          0         0           1       2
## 6          1            0          0         0           1       2

E se eu quiser binarizar inclusive os números?

baralho_bin <- matrix(0, nrow = 52, ncol = 3)
baralho_bin <- data.frame(baralho_bin)
colnames(baralho_bin) <- c("naipe", "cor", "numero")
baralho_bin$naipe <- c(rep("copas",13),
                   rep("ouros",13),
                   rep("espadas",13),
                   rep("paus",13))
baralho_bin$cor <- "preto"
baralho_bin[(baralho_bin$naipe == "copas") |
          baralho_bin$naipe == "ouros","cor"] <- "vermelho"
baralho_bin$numero <- as.character(1:13)

baralho_bin <- model.matrix(~. , baralho_bin)
baralho_bin <- as.data.frame(baralho_bin)
baralho_bin <- baralho_bin[,-1]
head(baralho_bin)

##   naipeespadas naipeouros naipepaus corvermelho numero10 numero11 numero12
## 1            0          0         0           1        0        0        0
## 2            0          0         0           1        0        0        0
## 3            0          0         0           1        0        0        0
## 4            0          0         0           1        0        0        0
## 5            0          0         0           1        0        0        0
## 6            0          0         0           1        0        0        0
##   numero13 numero2 numero3 numero4 numero5 numero6 numero7 numero8 numero9
## 1        0       0       0       0       0       0       0       0       0
## 2        0       1       0       0       0       0       0       0       0
## 3        0       0       1       0       0       0       0       0       0
## 4        0       0       0       1       0       0       0       0       0
## 5        0       0       0       0       1       0       0       0       0
## 6        0       0       0       0       0       1       0       0       0

set.seed(10)
baralho_cluster <- kmeans(x = baralho_bin,
                          centers = 4, iter.max = 100)

parcial <- as.data.frame(cbind(baralho_cluster$tot.withinss,baralho_cluster$betweenss))
colnames(parcial) <- colnames(somas)
somas <- rbind(somas,parcial)
somas

##     interna   externa
## 1 260.00000 546.00000
## 2 122.00000 684.00000
## 3  22.95000 130.05000
## 4  38.75000  64.25000
## 5  55.32051  31.23718

comparacao <- cbind(baralho_bin,baralho_cluster$cluster)
colnames(comparacao) <- c(colnames(comparacao[,-ncol(comparacao)]),"cluster") #Modifica o nome da ultima coluna
comparacao[,c(grep("naipe",colnames(comparacao)),
              match("cluster",colnames(comparacao)))] #Seleciona apenas as colunas que iniciem com naipe ou com cluster, pois, neste caso, são os resultados que interessam. Observa-se que apenas dois registros não são agrupados de acordo com o naipe.

##    naipeespadas naipeouros naipepaus cluster
## 1             0          0         0       3
## 2             0          0         0       3
## 3             0          0         0       3
## 4             0          0         0       3
## 5             0          0         0       3
## 6             0          0         0       3
## 7             0          0         0       3
## 8             0          0         0       3
## 9             0          0         0       3
## 10            0          0         0       3
## 11            0          0         0       3
## 12            0          0         0       3
## 13            0          0         0       3
## 14            0          1         0       2
## 15            0          1         0       2
## 16            0          1         0       2
## 17            0          1         0       2
## 18            0          1         0       2
## 19            0          1         0       2
## 20            0          1         0       2
## 21            0          1         0       2
## 22            0          1         0       2
## 23            0          1         0       2
## 24            0          1         0       2
## 25            0          1         0       2
## 26            0          1         0       2
## 27            1          0         0       1
## 28            1          0         0       1
## 29            1          0         0       1
## 30            1          0         0       1
## 31            1          0         0       1
## 32            1          0         0       1
## 33            1          0         0       1
## 34            1          0         0       4
## 35            1          0         0       1
## 36            1          0         0       1
## 37            1          0         0       1
## 38            1          0         0       1
## 39            1          0         0       1
## 40            0          0         1       1
## 41            0          0         1       1
## 42            0          0         1       1
## 43            0          0         1       1
## 44            0          0         1       1
## 45            0          0         1       1
## 46            0          0         1       1
## 47            0          0         1       4
## 48            0          0         1       1
## 49            0          0         1       1
## 50            0          0         1       1
## 51            0          0         1       1
## 52            0          0         1       1

1.6 Testando outros pacotes

Posso utilizar outro pacote para agrupamento, que utiliza medoids. A mudança do pacote implica mudança de algoritmo ou de parâmetro. Quando se busca clusters, mas nenhum a principio faz sentido, esta é uma alternativa.

O conjunto de dados Baralho, no momento, tem esta configuração:

head(baralho)

##   naipecopas naipeespadas naipeouros naipepaus corvermelho     numero
## 1          1            0          0         0           1 -1.5880737
## 2          1            0          0         0           1 -1.3233947
## 3          1            0          0         0           1 -1.0587158
## 4          1            0          0         0           1 -0.7940368
## 5          1            0          0         0           1 -0.5293579
## 6          1            0          0         0           1 -0.2646789

Vamos usar a função pamk do pacote fpc com o conjunto nesta configuração.

library("fpc")

set.seed(100)
baralho_cluster <- pamk(baralho, 2)
comparacao <- cbind(baralho,baralho_cluster$pamobject$clustering)

colnames(comparacao) <- c(colnames(comparacao[,-ncol(comparacao)]),"cluster") #Modifica o nome da ultima coluna
head(comparacao[,c(grep("cor",colnames(comparacao)),
              match("cluster",colnames(comparacao)))]
     ,30) #Seleciona apenas as colunas que iniciem com naipe ou com cluster, pois, neste caso, são os resultados que interessam. Observa-se que apenas dois registros não são agrupados de acordo com o naipe.

##    corvermelho cluster
## 1            1       1
## 2            1       1
## 3            1       1
## 4            1       1
## 5            1       1
## 6            1       1
## 7            1       1
## 8            1       1
## 9            1       1
## 10           1       1
## 11           1       1
## 12           1       1
## 13           1       1
## 14           1       1
## 15           1       1
## 16           1       1
## 17           1       1
## 18           1       1
## 19           1       1
## 20           1       1
## 21           1       1
## 22           1       1
## 23           1       1
## 24           1       1
## 25           1       1
## 26           1       1
## 27           0       2
## 28           0       2
## 29           0       2
## 30           0       2

set.seed(100)
baralho_cluster <- pamk(baralho, 4)
comparacao <- cbind(baralho,baralho_cluster$pamobject$clustering)

colnames(comparacao) <- c(colnames(comparacao[,-ncol(comparacao)]),"cluster") #Modifica o nome da ultima coluna
head(comparacao[,c(grep("naipe",colnames(comparacao)),
              match("cluster",colnames(comparacao)))]
     , 15) #Seleciona apenas as colunas que iniciem com naipe ou com cluster, pois, neste caso, são os resultados que interessam. Observa-se que apenas dois registros não são agrupados de acordo com o naipe.

##    naipecopas naipeespadas naipeouros naipepaus cluster
## 1           1            0          0         0       1
## 2           1            0          0         0       1
## 3           1            0          0         0       1
## 4           1            0          0         0       1
## 5           1            0          0         0       1
## 6           1            0          0         0       1
## 7           1            0          0         0       1
## 8           1            0          0         0       1
## 9           1            0          0         0       1
## 10          1            0          0         0       1
## 11          1            0          0         0       1
## 12          1            0          0         0       1
## 13          1            0          0         0       1
## 14          0            0          1         0       2
## 15          0            0          1         0       2

set.seed(100)
baralho_cluster <- pamk(baralho, 13)
comparacao <- cbind(baralho,baralho_cluster$pamobject$clustering)

colnames(comparacao) <- c(colnames(comparacao[,-ncol(comparacao)]),"cluster") #Modifica o nome da ultima coluna
head(comparacao[,c(grep("numero",colnames(comparacao)),
              match("cluster",colnames(comparacao)))]) #Seleciona apenas as colunas que iniciem com naipe ou com cluster, pois, neste caso, são os resultados que interessam. Observa-se que apenas dois registros não são agrupados de acordo com o naipe.

##       numero cluster
## 1 -1.5880737       1
## 2 -1.3233947       1
## 3 -1.0587158       1
## 4 -0.7940368       1
## 5 -0.5293579       1
## 6 -0.2646789       2

Bom, depois de tanto trabalho, vamos dar por encerrada a análise. Sabemos, porém, que outros resultados poderiam ter sido obtidos com mudança de seeds, por exemplo. Sabemos que algumas estratégias foram utilizadas com a função KMeans, mas não com a função pamk. O trabalho é mais exaustivo do que o que foi apresentado, mas de modo geral, é possível compreender um framework de trabalho.

O que acontece neste conjunto de dados é uma dominância dos atributos categóricos. É uma particularidade do conjunto de dados que faz com que os algoritmos gerem clusters muito instáveis, apesar de intuitivamente, para nós, as divisões serem claras.

É importante chamar a atenção que NESTE CASO eu interpretei o KMeans como se fosse supervisionado. Não se espera divisão “Certa” ou “Errada” do KMeans. Espera-se que, ao interpretar os resultados, você consiga atribuir significado a eles.