Rumlig nærhedsbaseret cluster-dannelse af kunder med algoritme i R

Jeg viser her et kodeeksempel til hvordan man udfører rumlig nærhedsbaseret kunde-clustering i tilfælde hvor du f.eks. søger efter flere cluster-centre (dvs. når du vil finde flere tyndgepunkter). Logikken og tilgangen er den samme som i enhver form for afstandsbaseret cluster-dannelse.

Jeg vil anvende k-mean clustering for grupperingen af kunder baseret på deres geografiske afstand.

Algoritmen bag k-means clustering er godt forklaret og yderst veldokumenteret, f.eks. af denne artikel: https://www.datanovia.com/da/lessons/k-means-clustering-in-r-algorith-and-practical-examples/

Først definerer jeg en dataramme, der indeholder tilfældige bredde- og længdegradskoordinater, der repræsenterer tilfældigt distribuerede kunder.

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)

Her ser du de første linjer i det dataframe som indeholder kundeplaceringerne:

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

Standardalgoritmen k-means clustering vælger k tilfældige startpunkter og definerer dem som klyngecentrene. Algoritmen tildeler derefter datapunkter til hvert klyngecenter baseret på minimale afstande. I dette tilfælde vil vi senere bruge klyngealgoritmen til at løse anlægsplaceringsproblemer under hensyntagen til flere lagre som skal placeres i et netværk.

Siden vi i dette problem optimerer tilgængeligheden af centre til kunder synes jeg, i modsætning til standardalgoritmen bag k-means clustering (tilfældige klyngecentre), at det er hensigtsmæssigt at vælge klyngecentre der er rimeligt distancerede fra hinanden. Til dette definerer jeg en funktion som vælger det definerede antal startcentre baseret på længdedimensionen for det geodatasæt:

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

Vi kan nu anvende funktionen ovenfor i kombination med k-means clustering algoritmen i form af kmeans-funktionen fra R-basispakken. I dette eksempel danner jeg fire nærhedsbaserede kundegrupper.

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

Ovenfor ser du overskriften på resultatobjektet der returneres af funktionen kmeans. Nedenfor kombinerer jeg klyngeindekserne fra kmeans-objektet med kundens dataframe, således at vi nu har 3 kolonner. Dette giver os mulighed for at lave ggplots osv.

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

Jeg afslutter dette indlæg ved at visualisere resultaterne i med et plot (scatterplot ved hjælp af ggplot2 R-pakken). Til farvegivningen brugte jeg viridis-pakken i R:

library(ggplot2)
library(viridis)

## Loading required package: viridisLite

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)

Lad os køre endnu en test med 20 lagre (klyngecentre):

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)