Teoria

Agrupamiento o Clustering es una tecnica de aprendizaje automatico no supervisado que agrupa datos en funcion a su solicitud.

Algunos uso tipicos de esta tecnica son:

  • Segmentacion de clientes
  • Deteccion de anomalidades
  • Categorizacion de documentos

Instalar paquetes y llamar librerias

#install.packages("cluster")  #Analisis de agrupamiento
library(cluster)
#install.packages("ggplot2") #Graficar
library(ggplot2)
#install.packages("data.table") #Manejo de muchos datos
library(data.table)
## 
## Attaching package: 'data.table'
## The following object is masked from 'package:base':
## 
##     %notin%
#install.packages("factoextra") #Grafica de optimizacion de clusters
library(factoextra)
## Welcome to factoextra!
## Want to learn more? See two factoextra-related books at https://www.datanovia.com/library/principal-component-methods
#install.packages("datasets")
library(datasets)
#install.packages("tidyverse")
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.1     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ lubridate 1.9.5     ✔ tibble    3.3.1
## ✔ purrr     1.2.2     ✔ tidyr     1.3.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between()     masks data.table::between()
## ✖ dplyr::filter()      masks stats::filter()
## ✖ dplyr::first()       masks data.table::first()
## ✖ lubridate::hour()    masks data.table::hour()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ lubridate::isoyear() masks data.table::isoyear()
## ✖ dplyr::lag()         masks stats::lag()
## ✖ dplyr::last()        masks data.table::last()
## ✖ lubridate::mday()    masks data.table::mday()
## ✖ lubridate::minute()  masks data.table::minute()
## ✖ lubridate::month()   masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second()  masks data.table::second()
## ✖ purrr::transpose()   masks data.table::transpose()
## ✖ lubridate::wday()    masks data.table::wday()
## ✖ lubridate::week()    masks data.table::week()
## ✖ lubridate::yday()    masks data.table::yday()
## ✖ lubridate::year()    masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

Contexto

Agrupa los siguientes 8 puntos

Ejercicio 1. Puntos

df1 <- data.frame(x=c(2,2,8,5,7,6,1,4), y=c(10,5,4,8,5,4,2,9))

Entender datos

summary(df1)
##        x               y         
##  Min.   :1.000   Min.   : 2.000  
##  1st Qu.:2.000   1st Qu.: 4.000  
##  Median :4.500   Median : 5.000  
##  Mean   :4.375   Mean   : 5.875  
##  3rd Qu.:6.250   3rd Qu.: 8.250  
##  Max.   :8.000   Max.   :10.000
str(df1)
## 'data.frame':    8 obs. of  2 variables:
##  $ x: num  2 2 8 5 7 6 1 4
##  $ y: num  10 5 4 8 5 4 2 9
plot(df1$x, df1$y)

Escalar datos

#datos_escalados <- scale(datos_originales)

Asignar numero de grupos

grupos1 <- 3

Agrupar los puntos

set.seed(123)
clusters1 <- kmeans(df1,grupos1)
clusters1
## K-means clustering with 3 clusters of sizes 2, 3, 3
## 
## Cluster means:
##          x        y
## 1 1.500000 3.500000
## 2 3.666667 9.000000
## 3 7.000000 4.333333
## 
## Clustering vector:
## [1] 2 1 3 2 3 3 1 2
## 
## Within cluster sum of squares by cluster:
## [1] 5.000000 6.666667 2.666667
##  (between_SS / total_SS =  85.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Optimizar numero de grupos

set.seed(123)
optimizacion1 <- clusGap(df1, FUN=kmeans, nstart=1, K.max=7)
#el k.max normalmente es 10, en este ejercicio al ser 8 datos se dejo en 7
plot(optimizacion1, xlab= "Numero de clusters k", main="Optimizacion de clusters")

clusters1
## K-means clustering with 3 clusters of sizes 2, 3, 3
## 
## Cluster means:
##          x        y
## 1 1.500000 3.500000
## 2 3.666667 9.000000
## 3 7.000000 4.333333
## 
## Clustering vector:
## [1] 2 1 3 2 3 3 1 2
## 
## Within cluster sum of squares by cluster:
## [1] 5.000000 6.666667 2.666667
##  (between_SS / total_SS =  85.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Graficar los grupos

fviz_cluster(clusters1,data=df1)

Agregar grupos a la base de datos

df1_clusters <- cbind(df1, cluster = clusters1$cluster)
head(df1_clusters)
##   x  y cluster
## 1 2 10       2
## 2 2  5       1
## 3 8  4       3
## 4 5  8       2
## 5 7  5       3
## 6 6  4       3

Conclusiones

La tecnica de clustering permite identificar patrones o grupos naturales en los grupos sin necesidad de etiquetar previas.

LS0tCnRpdGxlOiAiQ2x1c3RlcnMgLSBQdW50b3MsIFVTQXJyZXN0cyB5IENsaWVudGVzIgphdXRob3I6ICJBbnVhciBHYW1leiBBMDEyMzQ5ODYiCmRhdGU6ICIyMDI2LTA4LTI1IgpvdXRwdXQ6IAogIGh0bWxfZG9jdW1lbnQ6CiAgICB0b2M6IFRSVUUKICAgIHRvY19mbG9hdDogVFJVRQogICAgY29kZV9kb3dubG9hZDogVFJVRQogICAgdGhlbWU6IHNwYWNlbGFiCi0tLQoKIVtdKGh0dHBzOi8vbWVkaWEyLmdpcGh5LmNvbS9tZWRpYS92MS5ZMmxrUFRaak1EbGlPVFV5TXpaaFpqWnlNMjR4ZVhNNVltNHdlamgyZW1wbVlYUTFlSEF5YXpaa2N6Z3dhR0V5YVhnNGRTWmxjRDEyTVY5bmFXWnpYM05sWVhKamFDWmpkRDFuL2YwTFBjRTJDWmtPS0xHM0VMMC9naXBoeS5naWYpCgojIDxzcGFuIHN5bGU9ImNvbG9yOnllbGxvdyI+IFRlb3JpYSA8L3NwYW4+CioqQWdydXBhbWllbnRvKiogbyAqQ2x1c3RlcmluZyogZXMgdW5hIHRlY25pY2EgZGUgYXByZW5kaXphamUgYXV0b21hdGljbyBubyBzdXBlcnZpc2FkbyBxdWUgYWdydXBhIGRhdG9zIGVuIGZ1bmNpb24gYSBzdSBzb2xpY2l0dWQuICAKCkFsZ3Vub3MgdXNvIHRpcGljb3MgZGUgZXN0YSB0ZWNuaWNhIHNvbjogIAoKKiBTZWdtZW50YWNpb24gZGUgY2xpZW50ZXMKKiBEZXRlY2Npb24gZGUgYW5vbWFsaWRhZGVzCiogQ2F0ZWdvcml6YWNpb24gZGUgZG9jdW1lbnRvcwoKIyA8c3BhbiBzeWxlPSJjb2xvcjp5ZWxsb3ciPiBJbnN0YWxhciBwYXF1ZXRlcyB5IGxsYW1hciBsaWJyZXJpYXMgPC9zcGFuPgpgYGB7cn0KI2luc3RhbGwucGFja2FnZXMoImNsdXN0ZXIiKSAgI0FuYWxpc2lzIGRlIGFncnVwYW1pZW50bwpsaWJyYXJ5KGNsdXN0ZXIpCiNpbnN0YWxsLnBhY2thZ2VzKCJnZ3Bsb3QyIikgI0dyYWZpY2FyCmxpYnJhcnkoZ2dwbG90MikKI2luc3RhbGwucGFja2FnZXMoImRhdGEudGFibGUiKSAjTWFuZWpvIGRlIG11Y2hvcyBkYXRvcwpsaWJyYXJ5KGRhdGEudGFibGUpCiNpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikgI0dyYWZpY2EgZGUgb3B0aW1pemFjaW9uIGRlIGNsdXN0ZXJzCmxpYnJhcnkoZmFjdG9leHRyYSkKI2luc3RhbGwucGFja2FnZXMoImRhdGFzZXRzIikKbGlicmFyeShkYXRhc2V0cykKI2luc3RhbGwucGFja2FnZXMoInRpZHl2ZXJzZSIpCmxpYnJhcnkodGlkeXZlcnNlKQpgYGAKCiMgPHNwYW4gc3lsZT0iY29sb3I6eWVsbG93Ij4gQ29udGV4dG8gPC9zcGFuPgpBZ3J1cGEgbG9zIHNpZ3VpZW50ZXMgOCBwdW50b3MKCiMgPHNwYW4gc3lsZT0iY29sb3I6eWVsbG93Ij4gRWplcmNpY2lvIDEuIFB1bnRvcyA8L3NwYW4+CmBgYHtyfQpkZjEgPC0gZGF0YS5mcmFtZSh4PWMoMiwyLDgsNSw3LDYsMSw0KSwgeT1jKDEwLDUsNCw4LDUsNCwyLDkpKQpgYGAKCiMgPHNwYW4gc3lsZT0iY29sb3I6eWVsbG93Ij4gRW50ZW5kZXIgZGF0b3MgPC9zcGFuPgpgYGB7cn0Kc3VtbWFyeShkZjEpCnN0cihkZjEpCnBsb3QoZGYxJHgsIGRmMSR5KQpgYGAKCiMgPHNwYW4gc3lsZT0iY29sb3I6eWVsbG93Ij4gRXNjYWxhciBkYXRvcyA8L3NwYW4+CmBgYHtyfQojZGF0b3NfZXNjYWxhZG9zIDwtIHNjYWxlKGRhdG9zX29yaWdpbmFsZXMpCmBgYAoKIyA8c3BhbiBzeWxlPSJjb2xvcjp5ZWxsb3ciPiBBc2lnbmFyIG51bWVybyBkZSBncnVwb3MgPC9zcGFuPgpgYGB7cn0KZ3J1cG9zMSA8LSAzCmBgYAoKIyA8c3BhbiBzeWxlPSJjb2xvcjp5ZWxsb3ciPiBBZ3J1cGFyIGxvcyBwdW50b3MgPC9zcGFuPgpgYGB7cn0Kc2V0LnNlZWQoMTIzKQpjbHVzdGVyczEgPC0ga21lYW5zKGRmMSxncnVwb3MxKQpjbHVzdGVyczEKYGBgCgojIDxzcGFuIHN5bGU9ImNvbG9yOnllbGxvdyI+IE9wdGltaXphciBudW1lcm8gZGUgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CnNldC5zZWVkKDEyMykKb3B0aW1pemFjaW9uMSA8LSBjbHVzR2FwKGRmMSwgRlVOPWttZWFucywgbnN0YXJ0PTEsIEsubWF4PTcpCiNlbCBrLm1heCBub3JtYWxtZW50ZSBlcyAxMCwgZW4gZXN0ZSBlamVyY2ljaW8gYWwgc2VyIDggZGF0b3Mgc2UgZGVqbyBlbiA3CnBsb3Qob3B0aW1pemFjaW9uMSwgeGxhYj0gIk51bWVybyBkZSBjbHVzdGVycyBrIiwgbWFpbj0iT3B0aW1pemFjaW9uIGRlIGNsdXN0ZXJzIikKY2x1c3RlcnMxCmBgYAoKIyA8c3BhbiBzeWxlPSJjb2xvcjp5ZWxsb3ciPiBHcmFmaWNhciBsb3MgZ3J1cG9zIDwvc3Bhbj4KYGBge3J9CmZ2aXpfY2x1c3RlcihjbHVzdGVyczEsZGF0YT1kZjEpCmBgYAoKIyA8c3BhbiBzeWxlPSJjb2xvcjp5ZWxsb3ciPiBBZ3JlZ2FyIGdydXBvcyBhIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+CmBgYHtyfQpkZjFfY2x1c3RlcnMgPC0gY2JpbmQoZGYxLCBjbHVzdGVyID0gY2x1c3RlcnMxJGNsdXN0ZXIpCmhlYWQoZGYxX2NsdXN0ZXJzKQpgYGAKCiMgPHNwYW4gc3lsZT0iY29sb3I6eWVsbG93Ij4gQ29uY2x1c2lvbmVzIDwvc3Bhbj4KTGEgdGVjbmljYSBkZSBjbHVzdGVyaW5nIHBlcm1pdGUgaWRlbnRpZmljYXIgcGF0cm9uZXMgbyBncnVwb3MgbmF0dXJhbGVzIGVuIGxvcyBncnVwb3Mgc2luIG5lY2VzaWRhZCBkZSBldGlxdWV0YXIgcHJldmlhcy4KCgoK