Teoria

Agrupamiento o clustering es una tecnica de aprendizaje automatico no supervisado que agrupa datos en funcion de su similitud.

Algunos usos tipicos de esta tecnica son:

  • Segmetnacion de clientes
  • Deteccion de anormalidades
  • Categorizacion de documentos

Instalar paquetes y llamar librerias

#install.packages("clusters") #analisis de agrupamiento
#install.packages("ggplot2") # graficar
#install.packages("data.table") # Manejo de muchos datos
#install.packages("factoextra") # grafica de optimizacion del numero de clusters
#install.packages("datasets")

library(ggplot2)
library(cluster)
library(data.table)
## 
## Adjuntando el paquete: 'data.table'
## The following object is masked from 'package:base':
## 
##     %notin%
library(factoextra)
## Welcome to factoextra!
## Want to learn more? See two factoextra-related books at https://www.datanovia.com/library/principal-component-methods
library(datasets)
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
library(dplyr)

ejercicio1. Puntos

Contexto

Agrupa los siguientes 8 puntos

Contexto

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

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
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

Escalar Datos/span>

#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 clustersk", main="optimizacion de clusters")

#se selecciona como optimo el primer punto mas alto 
# si es diferente al original, regresar y ajustar

Graficar los grupos

fviz_cluster(clusters1, data=df1)

Agregar grupos a la base de datos

df1_clusters <- cbind(df1, clusters = clusters1$cluster)
head(df1_clusters)
##   x  y clusters
## 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 datos sin necesidad de etiquetas previas.

Ejercicio2. usarrests

Contexto

La base de datos USArrest contiene estadisticas en arrestos por cada 100,000 residentes por agreison, asesinatos y violacion en cada uno de los 50 estados de EE.UU en 1973.

Obtener Datos

df2 <- USArrests
df2 <- df2 %>% select(-UrbanPop)

Entender Datos

summary(df2)
##      Murder          Assault           Rape      
##  Min.   : 0.800   Min.   : 45.0   Min.   : 7.30  
##  1st Qu.: 4.075   1st Qu.:109.0   1st Qu.:15.07  
##  Median : 7.250   Median :159.0   Median :20.10  
##  Mean   : 7.788   Mean   :170.8   Mean   :21.23  
##  3rd Qu.:11.250   3rd Qu.:249.0   3rd Qu.:26.18  
##  Max.   :17.400   Max.   :337.0   Max.   :46.00
str(df2)
## 'data.frame':    50 obs. of  3 variables:
##  $ Murder : num  13.2 10 8.1 8.8 9 7.9 3.3 5.9 15.4 17.4 ...
##  $ Assault: int  236 263 294 190 276 204 110 238 335 211 ...
##  $ Rape   : num  21.2 44.5 31 19.5 40.6 38.7 11.1 15.8 31.9 25.8 ...

Escalar Datos

df2_escalados <- scale(df2)
summary(df2_escalados)
##      Murder           Assault             Rape        
##  Min.   :-1.6044   Min.   :-1.5090   Min.   :-1.4874  
##  1st Qu.:-0.8525   1st Qu.:-0.7411   1st Qu.:-0.6574  
##  Median :-0.1235   Median :-0.1411   Median :-0.1209  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
##  3rd Qu.: 0.7949   3rd Qu.: 0.9388   3rd Qu.: 0.5277  
##  Max.   : 2.2069   Max.   : 1.9948   Max.   : 2.6444

Asignar numero de grupos

grupos2 <- 3

Agrupar los puntos

set.seed(123)
clusters2 <- kmeans(df2_escalados,grupos2)
clusters2
## K-means clustering with 3 clusters of sizes 19, 14, 17
## 
## Cluster means:
##       Murder   Assault       Rape
## 1  1.0431796  1.062614  0.8523875
## 2 -1.0812577 -1.077921 -1.0070054
## 3 -0.2754591 -0.299928 -0.1233698
## 
## Clustering vector:
##        Alabama         Alaska        Arizona       Arkansas     California 
##              1              1              1              3              1 
##       Colorado    Connecticut       Delaware        Florida        Georgia 
##              1              2              3              1              1 
##         Hawaii          Idaho       Illinois        Indiana           Iowa 
##              2              2              1              3              2 
##         Kansas       Kentucky      Louisiana          Maine       Maryland 
##              3              3              1              2              1 
##  Massachusetts       Michigan      Minnesota    Mississippi       Missouri 
##              3              1              2              1              3 
##        Montana       Nebraska         Nevada  New Hampshire     New Jersey 
##              3              2              1              2              3 
##     New Mexico       New York North Carolina   North Dakota           Ohio 
##              1              1              1              2              3 
##       Oklahoma         Oregon   Pennsylvania   Rhode Island South Carolina 
##              3              3              3              2              1 
##   South Dakota      Tennessee          Texas           Utah        Vermont 
##              2              1              1              3              2 
##       Virginia     Washington  West Virginia      Wisconsin        Wyoming 
##              3              3              2              2              3 
## 
## Within cluster sum of squares by cluster:
## [1] 26.305392  5.645542  9.205038
##  (between_SS / total_SS =  72.0 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"

Optimizar numero de grupos

set.seed(123)
optimizacion2 <- 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(optimizacion2, xlab="numero de clustersk", main="optimizacion de clusters")

#se selecciona como optimo el primer punto mas alto 
# si es diferente al original, regresar y ajustar

Graficar los grupos

fviz_cluster(clusters2, data=df2_escalados)

Agregar grupos a la base de datos

df2_clusters <- cbind(df2, clusters = clusters2$cluster)
head(df2_clusters)
##            Murder Assault Rape clusters
## Alabama      13.2     236 21.2        1
## Alaska       10.0     263 44.5        1
## Arizona       8.1     294 31.0        1
## Arkansas      8.8     190 19.5        3
## California    9.0     276 40.6        1
## Colorado      7.9     204 38.7        1
df2_clusters %>% group_by(clusters) %>% summarise_all(mean) %>%
mutate(indicator_inseguridad=Murder+Assault+Rape)
## # A tibble: 3 × 5
##   clusters Murder Assault  Rape indicator_inseguridad
##      <int>  <dbl>   <dbl> <dbl>                 <dbl>
## 1        1  12.3    259.   29.2                 301. 
## 2        2   3.08    80.9  11.8                  95.8
## 3        3   6.59   146.   20.1                 172.
df2_clusters <- df2_clusters %>%
  mutate(clusters= case_when(
    clusters == 1 ~ "Muy inseguro",
    clusters == 2 ~ "Seguridad Alta",
    clusters == 3 ~ "Inseguridad Media"
    
  ))

Ejercicio3. segmentacion de clientes

Contexto

la bse de datos ventas tiene los registros entre el 1 de diciembre de 2010 y el 9 de diciembre de 2011 de las ventas d euna empresa monirista en linea sin tienda fisica, basada en reino unido. La empresa vende principalmente regalos unics para toda ocasion, y muchos de sus clientes son mayoristas. objetivo: segmentar clientes, asignarles nombre y caracteristicas de comportamiento y proponer sugerencias a la empresa para aumentar vrentas.

## Obtener Datos
#file.choose()

df3 <- read.csv("C:\\Users\\usuario1\\Downloads\\ventas (1).csv")

head(df3)
##   Ticket                            Producto Cantidad      Fecha     Hora
## 1 536365  WHITE HANGING HEART T-LIGHT HOLDER        6 01/12/2010 08:26:00
## 2 536365                 WHITE METAL LANTERN        6 01/12/2010 08:26:00
## 3 536365      CREAM CUPID HEARTS COAT HANGER        8 01/12/2010 08:26:00
## 4 536365 KNITTED UNION FLAG HOT WATER BOTTLE        6 01/12/2010 08:26:00
## 5 536365      RED WOOLLY HOTTIE WHITE HEART         6 01/12/2010 08:26:00
## 6 536365        SET 7 BABUSHKA NESTING BOXES        2 01/12/2010 08:26:00
##   Precio Cliente           País
## 1   2.55   17850 United Kingdom
## 2   3.39   17850 United Kingdom
## 3   2.75   17850 United Kingdom
## 4   3.39   17850 United Kingdom
## 5   3.39   17850 United Kingdom
## 6   7.65   17850 United Kingdom
## Entender Datos

summary(df3)
##        Ticket            Producto         Cantidad              Fecha       
##  Length   :522064   Length   :522064   Min.   :-9600.00   Length   :522064  
##  N.unique : 21663   N.unique :  4183   1st Qu.:    1.00   N.unique :   305  
##  N.blank  :     0   N.blank  :  1455   Median :    3.00   N.blank  :     0  
##  Min.nchar:     6   Min.nchar:     0   Mean   :   10.09   Min.nchar:    10  
##  Max.nchar:     7   Max.nchar:    36   3rd Qu.:   10.00   Max.nchar:    10  
##                                        Max.   :80995.00                     
##                                                                             
##         Hora            Precio              Cliente              País       
##  Length   :522064   Min.   :-11062.060   Min.   :12346    Length   :522064  
##  N.unique :   739   1st Qu.:     1.250   1st Qu.:13950    N.unique :    30  
##  N.blank  :     0   Median :     2.080   Median :15265    N.blank  :     0  
##  Min.nchar:     8   Mean   :     3.827   Mean   :15317    Min.nchar:     3  
##  Max.nchar:     8   3rd Qu.:     4.130   3rd Qu.:16837    Max.nchar:    20  
##                     Max.   : 13541.330   Max.   :18287                      
##                                          NAs    :134041
str(df3)
## 'data.frame':    522064 obs. of  8 variables:
##  $ Ticket  : chr  "536365" "536365" "536365" "536365" ...
##  $ Producto: chr  "WHITE HANGING HEART T-LIGHT HOLDER" "WHITE METAL LANTERN" "CREAM CUPID HEARTS COAT HANGER" "KNITTED UNION FLAG HOT WATER BOTTLE" ...
##  $ Cantidad: int  6 6 8 6 6 2 6 6 6 32 ...
##  $ Fecha   : chr  "01/12/2010" "01/12/2010" "01/12/2010" "01/12/2010" ...
##  $ Hora    : chr  "08:26:00" "08:26:00" "08:26:00" "08:26:00" ...
##  $ Precio  : num  2.55 3.39 2.75 3.39 3.39 7.65 4.25 1.85 1.85 1.69 ...
##  $ Cliente : int  17850 17850 17850 17850 17850 17850 17850 17850 17850 13047 ...
##  $ País    : chr  "United Kingdom" "United Kingdom" "United Kingdom" "United Kingdom" ...
## Limpiar Datos

df3 <- df3 %>%
  filter(!is.na(Cliente)) %>%
  filter(Cantidad > 0) %>%
  filter(Precio > 0)
df3 <- df3 %>%
  mutate(Venta = Cantidad * Precio)

head(df3)
##   Ticket                            Producto Cantidad      Fecha     Hora
## 1 536365  WHITE HANGING HEART T-LIGHT HOLDER        6 01/12/2010 08:26:00
## 2 536365                 WHITE METAL LANTERN        6 01/12/2010 08:26:00
## 3 536365      CREAM CUPID HEARTS COAT HANGER        8 01/12/2010 08:26:00
## 4 536365 KNITTED UNION FLAG HOT WATER BOTTLE        6 01/12/2010 08:26:00
## 5 536365      RED WOOLLY HOTTIE WHITE HEART         6 01/12/2010 08:26:00
## 6 536365        SET 7 BABUSHKA NESTING BOXES        2 01/12/2010 08:26:00
##   Precio Cliente           País Venta
## 1   2.55   17850 United Kingdom 15.30
## 2   3.39   17850 United Kingdom 20.34
## 3   2.75   17850 United Kingdom 22.00
## 4   3.39   17850 United Kingdom 20.34
## 5   3.39   17850 United Kingdom 20.34
## 6   7.65   17850 United Kingdom 15.30
## Agrupar Datos por Cliente

clientes <- df3 %>%
  group_by(Cliente) %>%
  summarise(
    Frecuencia = n_distinct(Ticket),
    Cantidad = sum(Cantidad),
    Gasto = sum(Venta),
    Precio_Promedio = mean(Precio)
  )

head(clientes)
## # A tibble: 6 × 5
##   Cliente Frecuencia Cantidad  Gasto Precio_Promedio
##     <int>      <int>    <int>  <dbl>           <dbl>
## 1   12346          1    74215 77184.            1.04
## 2   12347          7     2458  4310             2.64
## 3   12349          1      631  1758.            8.29
## 4   12350          1      197   334.            3.84
## 5   12352          8      536  2506.           15.9 
## 6   12353          1       20    89             6.07
datos_clientes <- clientes %>%
  select(-Cliente)

head(datos_clientes)
## # A tibble: 6 × 4
##   Frecuencia Cantidad  Gasto Precio_Promedio
##        <int>    <int>  <dbl>           <dbl>
## 1          1    74215 77184.            1.04
## 2          7     2458  4310             2.64
## 3          1      631  1758.            8.29
## 4          1      197   334.            3.84
## 5          8      536  2506.           15.9 
## 6          1       20    89             6.07
## Escalar Datos

df3_escalados <- scale(datos_clientes)

summary(df3_escalados)
##    Frecuencia         Cantidad            Gasto          Precio_Promedio   
##  Min.   :-0.4556   Min.   :-0.23935   Min.   :-0.23167   Min.   :-0.12621  
##  1st Qu.:-0.4556   1st Qu.:-0.20655   1st Qu.:-0.19640   1st Qu.:-0.06577  
##  Median :-0.3144   Median :-0.16200   Median :-0.15424   Median :-0.04510  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.00000   Mean   : 0.00000  
##  3rd Qu.: 0.1092   3rd Qu.:-0.03667   3rd Qu.:-0.03968   3rd Qu.:-0.01876  
##  Max.   :28.9132   Max.   :40.38244   Max.   :32.39138   Max.   :59.01198
## Asignar numero de grupos

grupos3 <- 3
## Agrupar Clientes

set.seed(123)

clusters3 <- kmeans(df3_escalados, grupos3)

clusters3
## K-means clustering with 3 clusters of sizes 4053, 15, 228
## 
## Cluster means:
##   Frecuencia   Cantidad      Gasto Precio_Promedio
## 1 -0.1621282 -0.1062324 -0.1059811    -0.019720371
## 2  8.2514599 12.9406728 12.6105217     0.006600417
## 3  2.3391824  1.0370606  1.0543141     0.350121301
## 
## Clustering vector:
##    [1] 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##   [38] 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 3 1 3 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1
##   [75] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [112] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1
##  [149] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1
##  [186] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [223] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 3 3 3 1 1 1 1 1
##  [260] 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 3 1 1 1
##  [297] 1 1 1 1 1 1 3 1 2 1 1 1 3 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [334] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 3 1
##  [371] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [408] 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [445] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 3 1 1
##  [482] 3 1 1 1 1 1 1 1 1 1 1 3 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1
##  [519] 1 1 1 1 1 1 1 1 1 3 1 1 1 1 3 1 1 3 1 1 1 2 3 1 1 1 1 1 1 3 1 1 3 1 1 1 1
##  [556] 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [593] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1
##  [630] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [667] 1 3 1 1 3 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [704] 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [741] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1
##  [778] 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 3 1
##  [815] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [852] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [889] 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1
##  [926] 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1
##  [963] 1 1 1 1 1 1 1 1 1 1 1 2 3 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1000] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 3 1 1 1 1 3
## [1037] 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1074] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1
## [1111] 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1148] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3
## [1185] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1
## [1222] 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 3 3 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1
## [1259] 3 1 1 3 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1
## [1296] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 3 3 1 3
## [1333] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1370] 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1
## [1407] 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1444] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 3 1 1 1
## [1481] 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1518] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1555] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 3 1 1 1 1 1 1 1 1 3 1
## [1592] 1 1 1 1 1 1 1 1 1 1 1 3 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1629] 1 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1
## [1666] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 3 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 3
## [1703] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1740] 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1
## [1777] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1
## [1814] 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1
## [1851] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1888] 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1925] 1 1 1 3 1 1 1 3 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 3
## [1962] 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [1999] 3 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1
## [2036] 1 1 1 1 1 1 1 1 1 3 3 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2073] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2110] 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1
## [2147] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1
## [2184] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2221] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1
## [2258] 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 3 1 3 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1
## [2295] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1
## [2332] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1
## [2369] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2406] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2443] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3
## [2480] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1
## [2517] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1
## [2554] 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2591] 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2628] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 2
## [2665] 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2702] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2739] 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 3 1 1 1 1 1 1 1 1 1 1
## [2776] 1 1 1 1 1 1 1 3 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1
## [2813] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2850] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1
## [2887] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2924] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1
## [2961] 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [2998] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 1 1 1 1 1 1 1
## [3035] 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3
## [3072] 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1
## [3109] 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1
## [3146] 1 1 1 3 3 3 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 3 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1
## [3183] 1 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1
## [3220] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3257] 1 1 1 1 3 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3294] 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 3 1 1 3 1 1 1 1
## [3331] 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3368] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3405] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3442] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1
## [3479] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3516] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 3 1 1 1 1 1 1 1 1 1
## [3553] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 3
## [3590] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3627] 1 1 1 1 1 1 1 1 3 1 3 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1
## [3664] 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1
## [3701] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1
## [3738] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3775] 1 1 1 1 3 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 3 1 1 1 1 1 1
## [3812] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [3849] 1 1 1 1 1 3 1 3 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1
## [3886] 1 1 1 3 1 1 1 1 1 1 1 3 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1
## [3923] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1
## [3960] 1 1 1 1 1 1 1 1 1 1 2 1 3 1 1 3 1 1 1 1 3 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1
## [3997] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1
## [4034] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 3 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1
## [4071] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [4108] 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [4145] 1 1 1 1 1 3 1 3 1 1 1 1 1 1 1 2 1 1 1 1 3 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1
## [4182] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1
## [4219] 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1
## [4256] 3 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [4293] 1 1 3 1
## 
## Within cluster sum of squares by cluster:
## [1] 1245.611 2991.649 5050.605
##  (between_SS / total_SS =  45.9 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"
## Optimizar numero de grupos

set.seed(123)

optimizacion3 <- clusGap(
  df3_escalados,
  FUN = kmeans,
  nstart = 1,
  K.max = 10
)
## Warning: did not converge in 10 iterations
## Warning: did not converge in 10 iterations
plot(
  optimizacion3,
  xlab = "numero de clusters k",
  main = "optimizacion de clusters"
)

## Graficar los grupos

fviz_cluster(
  clusters3,
  data = df3_escalados
)

## Agregar grupos a la base de datos

clientes_clusters <- cbind(
  clientes,
  clusters = clusters3$cluster
)

head(clientes_clusters)
##   Cliente Frecuencia Cantidad    Gasto Precio_Promedio clusters
## 1   12346          1    74215 77183.60        1.040000        2
## 2   12347          7     2458  4310.00        2.644011        1
## 3   12349          1      631  1757.55        8.289041        1
## 4   12350          1      197   334.40        3.841176        1
## 5   12352          8      536  2506.04       15.930706        1
## 6   12353          1       20    89.00        6.075000        1
clientes_clusters %>%
  group_by(clusters) %>%
  summarise(
    Frecuencia = mean(Frecuencia),
    Cantidad = mean(Cantidad),
    Gasto = mean(Gasto),
    Precio_Promedio = mean(Precio_Promedio)
  )
## # A tibble: 3 × 5
##   clusters Frecuencia Cantidad   Gasto Precio_Promedio
##      <int>      <dbl>    <dbl>   <dbl>           <dbl>
## 1        1       3.08     646.   1083.            3.78
## 2        2      62.7    63891. 110306.            4.69
## 3        3      20.8     6188.  11049.           16.5
## Nombrar los segmentos

clientes_clusters <- clientes_clusters %>%
  mutate(
    Segmento = case_when(
      clusters == 1 ~ "Clientes Ocasionales",
      clusters == 2 ~ "Clientes de Alto Valor",
      clusters == 3 ~ "Clientes Frecuentes Premium"
    )
  )

head(clientes_clusters)
##   Cliente Frecuencia Cantidad    Gasto Precio_Promedio clusters
## 1   12346          1    74215 77183.60        1.040000        2
## 2   12347          7     2458  4310.00        2.644011        1
## 3   12349          1      631  1757.55        8.289041        1
## 4   12350          1      197   334.40        3.841176        1
## 5   12352          8      536  2506.04       15.930706        1
## 6   12353          1       20    89.00        6.075000        1
##                 Segmento
## 1 Clientes de Alto Valor
## 2   Clientes Ocasionales
## 3   Clientes Ocasionales
## 4   Clientes Ocasionales
## 5   Clientes Ocasionales
## 6   Clientes Ocasionales
## Cantidad de clientes por segmento

clientes_clusters %>%
  group_by(Segmento) %>%
  summarise(
    Clientes = n()
  )
## # A tibble: 3 × 2
##   Segmento                    Clientes
##   <chr>                          <int>
## 1 Clientes Frecuentes Premium      228
## 2 Clientes Ocasionales            4053
## 3 Clientes de Alto Valor            15

COnclusiones

Clientes Ocasionales:
Es el segmento más grande con 4,053 clientes. Realizan aproximadamente 3 compras y tienen un gasto promedio de 1,083. Son clientes que compran poco y con menor frecuencia.

Clientes Frecuentes Premium:
Este segmento tiene 228 clientes. Realizan aproximadamente 21 compras y tienen un gasto promedio de 11,049. Además, compran productos con un precio promedio más alto de 16.50, por lo que son clientes frecuentes con preferencia por productos de mayor precio.

Clientes de Alto Valor:
Es el segmento más pequeño con solamente 15 clientes, pero son los que generan las compras más grandes. Realizan aproximadamente 63 compras, compran grandes cantidades de productos y tienen un gasto promedio de 110,306.

LS0tDQp0aXRsZTogIkNsdXN0ZXJzIC0gcHVudG9zLCB1c2FycmVzdHMgeSBjbGllbnRlcyINCmF1dGhvcjogIkthbWlsIE0iDQpkYXRlOiAiMjAyNi0wOC0yNSINCm91dHB1dDogDQogIGh0bWxfZG9jdW1lbnQ6DQogICAgdG9jOiBUUlVFDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KICAgIHRoZW1lOiBkYXJrbHkNCi0tLQ0KIVtdKGh0dHBzOi8vbWlyby5tZWRpdW0uY29tL3YyLzEqYjJzTzJmLS15ZlppSmF6YzVyWVNwZy5naWYpDQoNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5UZW9yaWE8L3NwYW4+DQoNCioqQWdydXBhbWllbnRvKiogbyAqY2x1c3RlcmluZyogZXMgdW5hIHRlY25pY2EgZGUgYXByZW5kaXphamUgYXV0b21hdGljbyBubyBzdXBlcnZpc2FkbyBxdWUgYWdydXBhIGRhdG9zIGVuIGZ1bmNpb24gZGUgc3Ugc2ltaWxpdHVkLiAgDQoNCkFsZ3Vub3MgdXNvcyB0aXBpY29zIGRlIGVzdGEgdGVjbmljYSBzb246ICANCg0KKiBTZWdtZXRuYWNpb24gZGUgY2xpZW50ZXMgDQoqIERldGVjY2lvbiBkZSBhbm9ybWFsaWRhZGVzICANCiogQ2F0ZWdvcml6YWNpb24gZGUgZG9jdW1lbnRvcyAgDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+SW5zdGFsYXIgcGFxdWV0ZXMgeSBsbGFtYXIgbGlicmVyaWFzPC9zcGFuPg0KDQpgYGB7cn0NCiNpbnN0YWxsLnBhY2thZ2VzKCJjbHVzdGVycyIpICNhbmFsaXNpcyBkZSBhZ3J1cGFtaWVudG8NCiNpbnN0YWxsLnBhY2thZ2VzKCJnZ3Bsb3QyIikgIyBncmFmaWNhcg0KI2luc3RhbGwucGFja2FnZXMoImRhdGEudGFibGUiKSAjIE1hbmVqbyBkZSBtdWNob3MgZGF0b3MNCiNpbnN0YWxsLnBhY2thZ2VzKCJmYWN0b2V4dHJhIikgIyBncmFmaWNhIGRlIG9wdGltaXphY2lvbiBkZWwgbnVtZXJvIGRlIGNsdXN0ZXJzDQojaW5zdGFsbC5wYWNrYWdlcygiZGF0YXNldHMiKQ0KDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KGNsdXN0ZXIpDQpsaWJyYXJ5KGRhdGEudGFibGUpDQpsaWJyYXJ5KGZhY3RvZXh0cmEpDQpsaWJyYXJ5KGRhdGFzZXRzKQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KGRwbHlyKQ0KYGBgDQojIDxzcGFuIHN0eWxlPSJjb2xvcjp5ZWxsb3ciPmVqZXJjaWNpbzEuIFB1bnRvczwvc3Bhbj4NCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+Q29udGV4dG88L3NwYW4+DQpBZ3J1cGEgbG9zIHNpZ3VpZW50ZXMgOCBwdW50b3MNCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+Q29udGV4dG88L3NwYW4+DQpgYGB7cn0NCmRmMSA8LSBkYXRhLmZyYW1lKHg9YygyLDIsOCw1LDcsNiwxLDQpLCB5PWMoMTAsNSw0LDgsNSw0LDIsOSkpDQpgYGANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+RW50ZW5kZXIgRGF0b3M8L3NwYW4+DQpgYGB7cn0NCnN0cihkZjEpDQpzdW1tYXJ5KGRmMSkNCg0KYGBgDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5Fc2NhbGFyIERhdG9zL3NwYW4+DQpgYGB7cn0NCiNkYXRvc19lc2NhbGFkb3MgPC0gc2NhbGUoZGF0b3Nfb3JpZ2luYWxlcykNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5Bc2lnbmFyIG51bWVybyBkZSBncnVwb3M8L3NwYW4+DQpgYGB7cn0NCmdydXBvczEgPC0gMw0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjp5ZWxsb3ciPkFncnVwYXIgIGxvcyBwdW50b3M8L3NwYW4+DQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCmNsdXN0ZXJzMSA8LSBrbWVhbnMoZGYxLGdydXBvczEpDQpjbHVzdGVyczENCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5PcHRpbWl6YXIgbnVtZXJvIGRlIGdydXBvczwvc3Bhbj4NCmBgYHtyfQ0Kc2V0LnNlZWQoMTIzKQ0Kb3B0aW1pemFjaW9uMSA8LSBjbHVzR2FwKGRmMSwgRlVOPWttZWFucywgbnN0YXJ0PTEsIEsubWF4ID0gNykNCiNlbCBrLm1heCBub3JtYWxtZW50ZSBlcyAxMCwgZW4gZXN0ZSBlamVyY2ljaW8gYWwgc2VyIDggZGF0b3Mgc2UgZGVqbyBlbiA3IA0KcGxvdChvcHRpbWl6YWNpb24xLCB4bGFiPSJudW1lcm8gZGUgY2x1c3RlcnNrIiwgbWFpbj0ib3B0aW1pemFjaW9uIGRlIGNsdXN0ZXJzIikNCiNzZSBzZWxlY2Npb25hIGNvbW8gb3B0aW1vIGVsIHByaW1lciBwdW50byBtYXMgYWx0byANCiMgc2kgZXMgZGlmZXJlbnRlIGFsIG9yaWdpbmFsLCByZWdyZXNhciB5IGFqdXN0YXINCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5HcmFmaWNhciBsb3MgZ3J1cG9zPC9zcGFuPg0KYGBge3J9DQpmdml6X2NsdXN0ZXIoY2x1c3RlcnMxLCBkYXRhPWRmMSkNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5BZ3JlZ2FyIGdydXBvcyBhIGxhIGJhc2UgZGUgZGF0b3M8L3NwYW4+DQpgYGB7cn0NCmRmMV9jbHVzdGVycyA8LSBjYmluZChkZjEsIGNsdXN0ZXJzID0gY2x1c3RlcnMxJGNsdXN0ZXIpDQpoZWFkKGRmMV9jbHVzdGVycykNCmBgYA0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5DT25jbHVzaW9uZXM8L3NwYW4+DQpMYSB0ZWNuaWNhIGRlICpjbHVzdGVyaW5nKiBwZXJtaXRlIGlkZW50aWZpY2FyIHBhdHJvbmVzIG8gZ3J1cG9zIG5hdHVyYWxlcyBlbiBsb3MgZGF0b3Mgc2luIG5lY2VzaWRhZCBkZSBldGlxdWV0YXMgcHJldmlhcy4gIA0KDQoNCiMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+RWplcmNpY2lvMi4gdXNhcnJlc3RzPC9zcGFuPg0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5Db250ZXh0bzwvc3Bhbj4NCkxhIGJhc2UgZGUgZGF0b3MgKipVU0FycmVzdCoqIGNvbnRpZW5lIGVzdGFkaXN0aWNhcyBlbiBhcnJlc3RvcyBwb3IgY2FkYSAxMDAsMDAwIHJlc2lkZW50ZXMgcG9yIGFncmVpc29uLCBhc2VzaW5hdG9zIHkgdmlvbGFjaW9uIGVuIGNhZGEgdW5vIGRlIGxvcyA1MCBlc3RhZG9zIGRlIEVFLlVVIGVuIDE5NzMuICANCg0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5PYnRlbmVyIERhdG9zPC9zcGFuPg0KYGBge3J9DQpkZjIgPC0gVVNBcnJlc3RzDQpkZjIgPC0gZGYyICU+JSBzZWxlY3QoLVVyYmFuUG9wKQ0KDQpgYGANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+RW50ZW5kZXIgRGF0b3M8L3NwYW4+DQpgYGB7cn0NCnN1bW1hcnkoZGYyKQ0Kc3RyKGRmMikNCmBgYA0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+RXNjYWxhciBEYXRvczwvc3Bhbj4NCmBgYHtyfQ0KZGYyX2VzY2FsYWRvcyA8LSBzY2FsZShkZjIpDQpzdW1tYXJ5KGRmMl9lc2NhbGFkb3MpDQpgYGANCg0KDQojIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5Bc2lnbmFyIG51bWVybyBkZSBncnVwb3M8L3NwYW4+DQpgYGB7cn0NCmdydXBvczIgPC0gMw0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjp5ZWxsb3ciPkFncnVwYXIgIGxvcyBwdW50b3M8L3NwYW4+DQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCmNsdXN0ZXJzMiA8LSBrbWVhbnMoZGYyX2VzY2FsYWRvcyxncnVwb3MyKQ0KY2x1c3RlcnMyDQpgYGANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+T3B0aW1pemFyIG51bWVybyBkZSBncnVwb3M8L3NwYW4+DQpgYGB7cn0NCnNldC5zZWVkKDEyMykNCm9wdGltaXphY2lvbjIgPC0gY2x1c0dhcChkZjEsIEZVTj1rbWVhbnMsIG5zdGFydD0xLCBLLm1heCA9IDcpDQojZWwgay5tYXggbm9ybWFsbWVudGUgZXMgMTAsIGVuIGVzdGUgZWplcmNpY2lvIGFsIHNlciA4IGRhdG9zIHNlIGRlam8gZW4gNyANCnBsb3Qob3B0aW1pemFjaW9uMiwgeGxhYj0ibnVtZXJvIGRlIGNsdXN0ZXJzayIsIG1haW49Im9wdGltaXphY2lvbiBkZSBjbHVzdGVycyIpDQojc2Ugc2VsZWNjaW9uYSBjb21vIG9wdGltbyBlbCBwcmltZXIgcHVudG8gbWFzIGFsdG8gDQojIHNpIGVzIGRpZmVyZW50ZSBhbCBvcmlnaW5hbCwgcmVncmVzYXIgeSBhanVzdGFyDQpgYGANCg0KIyMgPHNwYW4gc3R5bGU9ImNvbG9yOnllbGxvdyI+R3JhZmljYXIgbG9zIGdydXBvczwvc3Bhbj4NCmBgYHtyfQ0KZnZpel9jbHVzdGVyKGNsdXN0ZXJzMiwgZGF0YT1kZjJfZXNjYWxhZG9zKQ0KYGBgDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjp5ZWxsb3ciPkFncmVnYXIgZ3J1cG9zIGEgbGEgYmFzZSBkZSBkYXRvczwvc3Bhbj4NCmBgYHtyfQ0KZGYyX2NsdXN0ZXJzIDwtIGNiaW5kKGRmMiwgY2x1c3RlcnMgPSBjbHVzdGVyczIkY2x1c3RlcikNCmhlYWQoZGYyX2NsdXN0ZXJzKQ0KDQpkZjJfY2x1c3RlcnMgJT4lIGdyb3VwX2J5KGNsdXN0ZXJzKSAlPiUgc3VtbWFyaXNlX2FsbChtZWFuKSAlPiUNCm11dGF0ZShpbmRpY2F0b3JfaW5zZWd1cmlkYWQ9TXVyZGVyK0Fzc2F1bHQrUmFwZSkNCg0KZGYyX2NsdXN0ZXJzIDwtIGRmMl9jbHVzdGVycyAlPiUNCiAgbXV0YXRlKGNsdXN0ZXJzPSBjYXNlX3doZW4oDQogICAgY2x1c3RlcnMgPT0gMSB+ICJNdXkgaW5zZWd1cm8iLA0KICAgIGNsdXN0ZXJzID09IDIgfiAiU2VndXJpZGFkIEFsdGEiLA0KICAgIGNsdXN0ZXJzID09IDMgfiAiSW5zZWd1cmlkYWQgTWVkaWEiDQogICAgDQogICkpDQoNCmBgYA0KDQoNCg0KIyA8c3BhbiBzdHlsZT0iY29sb3I6eWVsbG93Ij5FamVyY2ljaW8zLiBzZWdtZW50YWNpb24gZGUgY2xpZW50ZXM8L3NwYW4+DQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjp5ZWxsb3ciPkNvbnRleHRvPC9zcGFuPg0KbGEgYnNlIGRlIGRhdG9zICoqdmVudGFzKiogdGllbmUgbG9zIHJlZ2lzdHJvcyBlbnRyZSBlbCAxIGRlIGRpY2llbWJyZSBkZSAyMDEwIHkgZWwgOSBkZSBkaWNpZW1icmUgZGUgMjAxMSBkZSBsYXMgdmVudGFzIGQgZXVuYSBlbXByZXNhIG1vbmlyaXN0YSBlbiBsaW5lYSBzaW4gdGllbmRhIGZpc2ljYSwgYmFzYWRhIGVuIHJlaW5vIHVuaWRvLiBMYSBlbXByZXNhIHZlbmRlIHByaW5jaXBhbG1lbnRlIHJlZ2Fsb3MgdW5pY3MgcGFyYSB0b2RhIG9jYXNpb24sIHkgbXVjaG9zIGRlIHN1cyBjbGllbnRlcyBzb24gbWF5b3Jpc3Rhcy4gb2JqZXRpdm86IHNlZ21lbnRhciBjbGllbnRlcywgYXNpZ25hcmxlcyBub21icmUgeSBjYXJhY3RlcmlzdGljYXMgZGUgY29tcG9ydGFtaWVudG8geSBwcm9wb25lciBzdWdlcmVuY2lhcyBhIGxhIGVtcHJlc2EgcGFyYSBhdW1lbnRhciB2cmVudGFzLiAgDQoNCmBgYHtyfQ0KIyMgT2J0ZW5lciBEYXRvcw0KI2ZpbGUuY2hvb3NlKCkNCg0KZGYzIDwtIHJlYWQuY3N2KCJDOlxcVXNlcnNcXHVzdWFyaW8xXFxEb3dubG9hZHNcXHZlbnRhcyAoMSkuY3N2IikNCg0KaGVhZChkZjMpDQpgYGANCg0KYGBge3J9DQojIyBFbnRlbmRlciBEYXRvcw0KDQpzdW1tYXJ5KGRmMykNCnN0cihkZjMpDQpgYGANCg0KYGBge3J9DQojIyBMaW1waWFyIERhdG9zDQoNCmRmMyA8LSBkZjMgJT4lDQogIGZpbHRlcighaXMubmEoQ2xpZW50ZSkpICU+JQ0KICBmaWx0ZXIoQ2FudGlkYWQgPiAwKSAlPiUNCiAgZmlsdGVyKFByZWNpbyA+IDApDQpgYGANCg0KYGBge3J9DQpkZjMgPC0gZGYzICU+JQ0KICBtdXRhdGUoVmVudGEgPSBDYW50aWRhZCAqIFByZWNpbykNCg0KaGVhZChkZjMpDQpgYGANCg0KYGBge3J9DQojIyBBZ3J1cGFyIERhdG9zIHBvciBDbGllbnRlDQoNCmNsaWVudGVzIDwtIGRmMyAlPiUNCiAgZ3JvdXBfYnkoQ2xpZW50ZSkgJT4lDQogIHN1bW1hcmlzZSgNCiAgICBGcmVjdWVuY2lhID0gbl9kaXN0aW5jdChUaWNrZXQpLA0KICAgIENhbnRpZGFkID0gc3VtKENhbnRpZGFkKSwNCiAgICBHYXN0byA9IHN1bShWZW50YSksDQogICAgUHJlY2lvX1Byb21lZGlvID0gbWVhbihQcmVjaW8pDQogICkNCg0KaGVhZChjbGllbnRlcykNCmBgYA0KDQpgYGB7cn0NCmRhdG9zX2NsaWVudGVzIDwtIGNsaWVudGVzICU+JQ0KICBzZWxlY3QoLUNsaWVudGUpDQoNCmhlYWQoZGF0b3NfY2xpZW50ZXMpDQpgYGANCg0KYGBge3J9DQojIyBFc2NhbGFyIERhdG9zDQoNCmRmM19lc2NhbGFkb3MgPC0gc2NhbGUoZGF0b3NfY2xpZW50ZXMpDQoNCnN1bW1hcnkoZGYzX2VzY2FsYWRvcykNCmBgYA0KDQpgYGB7cn0NCiMjIEFzaWduYXIgbnVtZXJvIGRlIGdydXBvcw0KDQpncnVwb3MzIDwtIDMNCmBgYA0KDQoNCmBgYHtyfQ0KIyMgQWdydXBhciBDbGllbnRlcw0KDQpzZXQuc2VlZCgxMjMpDQoNCmNsdXN0ZXJzMyA8LSBrbWVhbnMoZGYzX2VzY2FsYWRvcywgZ3J1cG9zMykNCg0KY2x1c3RlcnMzDQpgYGANCmBgYHtyfQ0KIyMgT3B0aW1pemFyIG51bWVybyBkZSBncnVwb3MNCg0Kc2V0LnNlZWQoMTIzKQ0KDQpvcHRpbWl6YWNpb24zIDwtIGNsdXNHYXAoDQogIGRmM19lc2NhbGFkb3MsDQogIEZVTiA9IGttZWFucywNCiAgbnN0YXJ0ID0gMSwNCiAgSy5tYXggPSAxMA0KKQ0KDQpwbG90KA0KICBvcHRpbWl6YWNpb24zLA0KICB4bGFiID0gIm51bWVybyBkZSBjbHVzdGVycyBrIiwNCiAgbWFpbiA9ICJvcHRpbWl6YWNpb24gZGUgY2x1c3RlcnMiDQopDQpgYGANCmBgYHtyfQ0KIyMgR3JhZmljYXIgbG9zIGdydXBvcw0KDQpmdml6X2NsdXN0ZXIoDQogIGNsdXN0ZXJzMywNCiAgZGF0YSA9IGRmM19lc2NhbGFkb3MNCikNCmBgYA0KYGBge3J9DQojIyBBZ3JlZ2FyIGdydXBvcyBhIGxhIGJhc2UgZGUgZGF0b3MNCg0KY2xpZW50ZXNfY2x1c3RlcnMgPC0gY2JpbmQoDQogIGNsaWVudGVzLA0KICBjbHVzdGVycyA9IGNsdXN0ZXJzMyRjbHVzdGVyDQopDQoNCmhlYWQoY2xpZW50ZXNfY2x1c3RlcnMpDQpgYGANCmBgYHtyfQ0KY2xpZW50ZXNfY2x1c3RlcnMgJT4lDQogIGdyb3VwX2J5KGNsdXN0ZXJzKSAlPiUNCiAgc3VtbWFyaXNlKA0KICAgIEZyZWN1ZW5jaWEgPSBtZWFuKEZyZWN1ZW5jaWEpLA0KICAgIENhbnRpZGFkID0gbWVhbihDYW50aWRhZCksDQogICAgR2FzdG8gPSBtZWFuKEdhc3RvKSwNCiAgICBQcmVjaW9fUHJvbWVkaW8gPSBtZWFuKFByZWNpb19Qcm9tZWRpbykNCiAgKQ0KYGBgDQoNCmBgYHtyfQ0KIyMgTm9tYnJhciBsb3Mgc2VnbWVudG9zDQoNCmNsaWVudGVzX2NsdXN0ZXJzIDwtIGNsaWVudGVzX2NsdXN0ZXJzICU+JQ0KICBtdXRhdGUoDQogICAgU2VnbWVudG8gPSBjYXNlX3doZW4oDQogICAgICBjbHVzdGVycyA9PSAxIH4gIkNsaWVudGVzIE9jYXNpb25hbGVzIiwNCiAgICAgIGNsdXN0ZXJzID09IDIgfiAiQ2xpZW50ZXMgZGUgQWx0byBWYWxvciIsDQogICAgICBjbHVzdGVycyA9PSAzIH4gIkNsaWVudGVzIEZyZWN1ZW50ZXMgUHJlbWl1bSINCiAgICApDQogICkNCg0KaGVhZChjbGllbnRlc19jbHVzdGVycykNCmBgYA0KYGBge3J9DQojIyBDYW50aWRhZCBkZSBjbGllbnRlcyBwb3Igc2VnbWVudG8NCg0KY2xpZW50ZXNfY2x1c3RlcnMgJT4lDQogIGdyb3VwX2J5KFNlZ21lbnRvKSAlPiUNCiAgc3VtbWFyaXNlKA0KICAgIENsaWVudGVzID0gbigpDQogICkNCmBgYA0KDQoNCiMjIDxzcGFuIHN0eWxlPSJjb2xvcjp5ZWxsb3ciPkNPbmNsdXNpb25lczwvc3Bhbj4NCg0KKipDbGllbnRlcyBPY2FzaW9uYWxlczoqKiAgDQpFcyBlbCBzZWdtZW50byBtw6FzIGdyYW5kZSBjb24gNCwwNTMgY2xpZW50ZXMuIFJlYWxpemFuIGFwcm94aW1hZGFtZW50ZSAzIGNvbXByYXMgeSB0aWVuZW4gdW4gZ2FzdG8gcHJvbWVkaW8gZGUgMSwwODMuIFNvbiBjbGllbnRlcyBxdWUgY29tcHJhbiBwb2NvIHkgY29uIG1lbm9yIGZyZWN1ZW5jaWEuICANCg0KKipDbGllbnRlcyBGcmVjdWVudGVzIFByZW1pdW06KiogIA0KRXN0ZSBzZWdtZW50byB0aWVuZSAyMjggY2xpZW50ZXMuIFJlYWxpemFuIGFwcm94aW1hZGFtZW50ZSAyMSBjb21wcmFzIHkgdGllbmVuIHVuIGdhc3RvIHByb21lZGlvIGRlIDExLDA0OS4gQWRlbcOhcywgY29tcHJhbiBwcm9kdWN0b3MgY29uIHVuIHByZWNpbyBwcm9tZWRpbyBtw6FzIGFsdG8gZGUgMTYuNTAsIHBvciBsbyBxdWUgc29uIGNsaWVudGVzIGZyZWN1ZW50ZXMgY29uIHByZWZlcmVuY2lhIHBvciBwcm9kdWN0b3MgZGUgbWF5b3IgcHJlY2lvLiAgDQoNCioqQ2xpZW50ZXMgZGUgQWx0byBWYWxvcjoqKiAgDQpFcyBlbCBzZWdtZW50byBtw6FzIHBlcXVlw7FvIGNvbiBzb2xhbWVudGUgMTUgY2xpZW50ZXMsIHBlcm8gc29uIGxvcyBxdWUgZ2VuZXJhbiBsYXMgY29tcHJhcyBtw6FzIGdyYW5kZXMuIFJlYWxpemFuIGFwcm94aW1hZGFtZW50ZSA2MyBjb21wcmFzLCBjb21wcmFuIGdyYW5kZXMgY2FudGlkYWRlcyBkZSBwcm9kdWN0b3MgeSB0aWVuZW4gdW4gZ2FzdG8gcHJvbWVkaW8gZGUgMTEwLDMwNi4gIA0K