Definições Gerais

Points <- Vetor com latitude e longitude

Pacotes Utilizados:

tidyverse <- Pacote para manipulação dos bancos de dados

broom <- Pacote para extração de expressões regulares em modelos

Objetivo

Deseja-se agrupar estas 20 cidades em 2 grupos e os centros de cada grupo serão utilizados como referência para a instalação de duas antenas de telefonia móvel que irão atender aos 20 municípios.

Plotar o gráfico dos 20 objetos nos eixos longitude e latitude visando ter uma primeira ideia da distribuição dos dados da amostra.

ggplot(data = points, aes(V1, V2)) +
  geom_point(color = "lightslateblue", size = 4) +
  theme_bw()

Resolver o problema usando o método k-means através de função residente

Primeiramente faremos com dois centróides:

kclusts <- tibble(k = 2) %>%
  mutate(
    kclust = map(k, ~kmeans(points, .x)),
    tidied = map(kclust, tidy),
    glanced = map(kclust, glance),
    augmented = map(kclust, augment, points)
  )


clusters <- kclusts %>%
  unnest(tidied)

### Valor dos centroides

clusters
## # A tibble: 2 x 6
##       k    x1    x2  size withinss cluster
##   <dbl> <dbl> <dbl> <int>    <dbl> <fct>  
## 1     2 0.584 0.789    10    1.08  1      
## 2     2 0.423 0.219    10    0.791 2

Ainda sobre dois centroides faremos a representação gráfica:

assignments <- kclusts %>% 
  unnest(augmented)

clusterings <- kclusts %>%
  unnest(glanced, .drop = TRUE)

p1 <- ggplot(assignments, aes(V1, V2)) +
  geom_point(aes(color = .cluster), size = 3) + 
  stat_ellipse(type = "norm", aes(color = .cluster)) + 
  facet_wrap(~ k) +
  theme_bw()

p1

p2 <- p1 + geom_point(data = clusters, aes(x1, x2), size = 5, shape = "x")
p2

Resolvemos agora para até 6 grupos:

kclusts <- tibble(k = 1:6) %>%
  mutate(
    kclust = map(k, ~kmeans(points, .x)),
    tidied = map(kclust, tidy),
    glanced = map(kclust, glance),
    augmented = map(kclust, augment, points)
  )

kclusts
## # A tibble: 6 x 5
##       k kclust       tidied               glanced              augmented  
##   <int> <list>       <list>               <list>               <list>     
## 1     1 <S3: kmeans> <data.frame [1 x 5]> <data.frame [1 x 4]> <data.fram~
## 2     2 <S3: kmeans> <data.frame [2 x 5]> <data.frame [1 x 4]> <data.fram~
## 3     3 <S3: kmeans> <data.frame [3 x 5]> <data.frame [1 x 4]> <data.fram~
## 4     4 <S3: kmeans> <data.frame [4 x 5]> <data.frame [1 x 4]> <data.fram~
## 5     5 <S3: kmeans> <data.frame [5 x 5]> <data.frame [1 x 4]> <data.fram~
## 6     6 <S3: kmeans> <data.frame [6 x 5]> <data.frame [1 x 4]> <data.fram~
clusters <- kclusts %>%
  unnest(tidied)

assignments <- kclusts %>% 
  unnest(augmented)

clusterings <- kclusts %>%
  unnest(glanced, .drop = TRUE)

p1 <- ggplot(assignments, aes(V1, V2)) +
  geom_point(aes(color = .cluster), size = 3) + 
  stat_ellipse(type = "norm", aes(color = .cluster)) + 
  facet_wrap(~ k) + 
  theme_bw()

p1

p2 <- p1 + geom_point(data = clusters, aes(x1, x2), size = 5, shape = "x")
p2

Resolver o problema programando o método k-means:

#### Letra C ----

# Começa a função

antena <- antena %>% 
  mutate(id = seq(1:20)) %>% 
  mutate(cluster = rep(0,20))

### Kmeans

# 1 : Definindo número de grupos 

k <- 2 


# Definindo os primeiros centroides 

a <- sample(antena$id, 10)

antena <- antena %>% 
  mutate(cluster = as.factor(if_else(id %in% a, 1, 0)))


# Defino primeiro centroide
  
centroide <- antena %>% 
  group_by(cluster) %>% 
  dplyr::summarise(c_lat = mean(V1),
            c_long = mean(V2)) %>% 
  select(c_lat, c_long)

c0 <- cbind(centroide$c_lat[1], centroide$c_long[2]) %>% as.tibble()
c1 <- cbind(centroide$c_lat[1], centroide$c_long[2]) %>% as.tibble()


# Ajustar

n <- 50  # Numero de interações

for(i in 1:n){
  
points <- cbind(antena$V1, antena$V2)

distancia <- cbind(x = dist(points, centroide[1,]), y = dist(points, centroide[2,])) %>%
  as.tibble() %>% 
  mutate(id = seq(1,20)) %>% 
  `colnames<-`(c("d0","d1","id"))
  
antena <- antena %>% 
  select(V1,V2,id,cluster) %>% 
  left_join(distancia) %>% 
  mutate(cluster_i = ifelse(d0 < d1, 0, 1))

centroide <- antena %>% 
  group_by(cluster_i) %>% 
  dplyr::summarise(c_lat = mean(V1),
            c_long = mean(V2)) %>% 
  select(c_lat, c_long)


c0[i+1,] <- cbind(centroide$c_lat[1], centroide$c_long[2]) %>% as.tibble()
c1[i+1,] <- cbind(centroide$c_lat[1], centroide$c_long[2]) %>% as.tibble()

if((c0[i+1,1] - c0[i,1] == 0) & (c0[i+1,2] - c0[i,2] == 0) & (c1[i+1,1] - c0[i,1] == 0)
   & (c1[i+1,2] - c1[i,2] == 0)){
  
  break(i)
  
}}


# Gráfico do Cluster Gerado

ggplot(antena, aes(x = V1, y = V2, col = as.factor(cluster_i))) +
  geom_point() +
  theme_bw()