Agrupamento de clientes baseado em proximidade espacial

Fornecendo um exemplo de codificação de como conduzir agrupamento de clientes de proximidade espacial, aplicável, por exemplo, ao pesquisar vários centros de gravidade (ou seja, ao desejar localizar vários armazéns). A lógica e a abordagem são as mesmas de qualquer tipo de problema de agrupamento baseado em distância.

Vou aplicar o agrupamento k-means para agrupar clientes com base em sua distância espacial.

O algoritmo para agrupamento k-means é bem explicado, por exemplo, por este artigo: https://www.datanovia.com/en/lessons/k-means-clustering-in-r-algorith-and-practical-examples/

Primeiro, defino um dataframe contendo coordenadas aleatórias de latitude e longitude, representando clientes distribuídos aleatoriamente.

customer_df <- as.data.frame(matrix(nrow=1000,ncol=2))
colnames(customer_df) <- c("lat","long")
customer_df$lat <- runif(n=1000,min=-90,max=90)
customer_df$long <- runif(n=1000,min=-180,max=180)

Aqui você vê o cabeçalho do dataframe:

head(customer_df)

##         lat        long
## 1 -42.69660   58.067160
## 2  37.31715  179.655272
## 3 -28.68660   -3.025719
## 4 -76.15463  117.119388
## 5 -14.84898 -162.408406
## 6  54.19468 -128.476143

O algoritmo de agrupamento padrão k-means seleciona k pontos iniciais aleatórios e os define como os centros do agrupamento. O algoritmo então atribui pontos de dados a cada agrupamento de clientes, com base na distância mínima.

Neste caso, queremos usar posteriormente o algoritmo de agrupamento para resolver problemas de localização de instalações, considerando vários armazéns para localizar. Parece-me, portanto, mais apropriado selecionar agrupamento de clientes que estejam razoavelmente distanciados uns dos outros. Para isso defino uma função que escolhe o número definido de centros iniciais com base na dimensão de longitude do conjunto de dados espaciais:

initial_centers <- function(customers,centers){
  quantiles <- c()
  for(i in 1:centers){
    quantiles <- c(quantiles,i*as.integer(nrow(customers)/centers))
  }
  quantiles
}

Agora podemos aplicar a função acima, em combinação com a função kmeans do pacote base do R. Neste exemplo, derivo quatro grupos de clientes baseados em proximidade.

cluster_obj <- kmeans(customer_df,centers=customer_df[initial_centers(customer_df,4),])
head(cluster_obj)

## $cluster
##    [1] 1 4 2 1 3 3 3 1 2 1 3 2 2 4 3 4 4 4 3 4 3 2 3 4 2 3 2 3 1 4 4 4 1 1 4 2 2
##   [38] 2 4 4 3 3 1 2 4 1 2 1 3 1 2 2 3 3 4 1 4 2 3 3 2 4 2 2 3 2 1 4 2 2 2 4 4 2
##   [75] 4 3 3 4 1 1 1 3 3 2 1 1 3 3 4 4 3 1 2 4 3 1 3 2 2 2 3 2 3 4 4 2 3 3 1 3 1
##  [112] 2 2 4 1 1 1 3 4 1 2 3 3 3 1 1 2 3 3 2 1 3 4 2 2 3 2 2 1 2 1 2 2 2 2 3 2 3
##  [149] 1 2 2 1 2 3 2 2 1 4 2 4 3 3 3 2 1 1 2 2 3 3 4 1 2 4 1 2 1 2 3 2 2 2 3 3 2
##  [186] 1 1 1 4 3 4 4 2 1 3 2 4 2 2 3 3 1 3 2 3 2 4 2 3 2 4 1 1 3 1 2 1 3 4 2 4 3
##  [223] 4 2 4 3 4 2 4 2 1 2 1 3 4 2 2 3 2 4 2 1 2 3 3 2 2 3 3 1 3 4 4 3 4 1 1 2 3
##  [260] 3 4 2 1 1 1 2 2 2 1 4 4 3 1 2 4 3 3 3 3 3 3 3 2 3 3 3 3 2 2 3 3 1 4 1 2 1
##  [297] 4 2 2 3 1 4 4 2 3 3 2 4 4 3 2 1 2 3 2 2 4 4 2 2 2 3 2 2 2 2 2 2 2 1 2 2 4
##  [334] 3 3 2 2 3 3 1 2 4 2 1 3 3 4 1 2 4 1 4 4 4 1 2 3 1 3 1 3 3 2 3 4 1 2 2 2 2
##  [371] 1 2 2 2 1 3 2 1 2 2 2 4 3 2 2 3 1 3 3 4 1 1 3 4 2 4 1 1 4 4 2 4 2 3 3 2 4
##  [408] 4 4 3 2 1 3 3 4 1 3 3 1 3 4 2 3 2 2 3 2 2 2 1 2 3 4 3 4 3 4 4 2 1 3 2 3 1
##  [445] 3 1 1 2 3 3 2 2 3 4 1 1 3 1 2 4 2 2 2 3 1 3 2 1 4 2 3 2 4 1 4 3 1 1 4 4 3
##  [482] 1 2 4 3 3 2 1 4 2 3 2 4 3 4 4 1 2 2 2 3 3 4 4 1 3 2 3 2 4 1 2 4 1 2 3 1 3
##  [519] 2 3 3 3 1 3 2 4 1 3 4 3 4 4 3 4 4 2 1 1 3 3 3 3 3 4 2 1 3 3 1 1 4 1 4 2 2
##  [556] 1 1 4 4 3 3 4 3 1 4 3 1 2 3 3 2 4 1 2 3 3 1 2 2 1 3 1 4 4 3 2 4 3 1 4 2 3
##  [593] 3 2 2 1 1 2 4 2 3 3 2 1 4 1 4 3 3 3 3 3 3 2 2 2 1 1 2 3 2 1 1 2 1 1 1 1 1
##  [630] 2 4 2 1 1 3 1 4 2 4 2 2 1 4 1 2 2 3 1 1 3 1 1 3 4 3 2 4 1 1 1 2 1 1 1 2 3
##  [667] 4 3 2 4 4 4 2 4 4 3 2 1 2 2 3 3 3 4 2 4 3 1 2 4 2 3 1 3 3 1 4 3 4 4 1 2 3
##  [704] 3 4 4 2 2 1 2 2 1 3 4 1 2 2 3 4 4 2 3 1 2 4 3 1 2 2 2 1 4 1 3 1 4 2 2 1 1
##  [741] 2 2 2 2 1 2 4 3 3 3 1 3 4 1 1 3 2 1 4 4 2 4 2 3 2 3 3 4 2 1 2 3 2 1 1 1 3
##  [778] 2 3 4 3 2 2 4 1 4 4 2 2 1 1 2 3 1 2 2 2 1 4 3 3 3 1 2 1 3 2 4 2 3 4 1 4 3
##  [815] 1 3 2 2 1 1 2 3 4 4 4 3 1 2 4 2 2 2 1 3 4 4 2 2 3 2 4 3 4 2 2 2 3 3 3 4 2
##  [852] 3 3 3 1 1 3 1 1 2 2 1 3 3 4 3 3 3 2 2 1 3 2 3 1 4 3 2 4 1 4 3 3 2 3 4 4 1
##  [889] 3 1 2 4 4 3 2 1 2 3 2 1 1 2 3 2 1 1 3 3 4 3 3 4 3 3 3 2 2 1 2 3 1 1 1 4 2
##  [926] 3 4 2 4 1 4 3 4 4 1 3 2 2 1 2 2 4 2 4 1 4 1 2 1 2 4 3 4 2 4 4 4 2 4 1 2 3
##  [963] 3 2 4 4 4 2 4 4 3 2 1 2 4 3 2 3 1 2 3 4 1 4 3 4 2 1 4 1 4 2 3 3 1 1 2 2 2
## [1000] 4
## 
## $centers
##          lat       long
## 1 -44.672042  103.20907
## 2   9.621406  -22.15262
## 3  -4.487789 -127.84173
## 4  48.358322  110.24174
## 
## $totss
## [1] 13417586
## 
## $withinss
## [1]  557304.2 1006745.4  962130.0  492832.8
## 
## $tot.withinss
## [1] 3019012
## 
## $betweenss
## [1] 10398574

Acima você vê o cabeçalho do objeto de resultado retornado pela função kmeans. Abaixo combino os índices de agrupamento de clientes contidos pelo objeto kmeans com o dataframe do cliente, de modo que agora temos 3 colunas. Isso nos permitirá fazer ggplots etc.

result_df <- customer_df
result_df$group <- cluster_obj$cluster
head(result_df)

##         lat        long group
## 1 -42.69660   58.067160     1
## 2  37.31715  179.655272     4
## 3 -28.68660   -3.025719     2
## 4 -76.15463  117.119388     1
## 5 -14.84898 -162.408406     3
## 6  54.19468 -128.476143     3

Concluo este post visualizando os resultados em um ggplot (scatterplot usando o pacote ggplot2 R). Para colorir usei o pacote viridis no R:

library(ggplot2)
library(viridis)

ggplot(result_df) + geom_point(mapping = aes(x=lat,y=long,color=group)) +
  xlim(-90,90) + ylim(-180,180) + scale_color_viridis(discrete = FALSE, option = "D") + scale_fill_viridis(discrete = FALSE)

Vamos fazer outro teste com 20 armazéns:

cluster_obj <- kmeans(customer_df,centers=customer_df[initial_centers(customer_df,20),])
result_df$group <- cluster_obj$cluster
ggplot(result_df) + geom_point(mapping = aes(x=lat,y=long,color=group)) +
  xlim(-90,90) + ylim(-180,180) + scale_color_viridis(discrete = FALSE, option = "D") + scale_fill_viridis(discrete = FALSE)