Analisis Cluster - Metodo k-Means

Waldo Gómez

2022-06-04

I. LECTURA DE DATOS

Emilio Gondar en su libro ” Analisis de Conglomerados”(Editorial : Data Mining Institute. 2004) (Nores, 2014) presenta un ejemplo donde a un grupo de 21 personas se le midío una serie de variables de tipo métrico, y segun estos atributos se van a clasificar a estas personas en grupos o categorias de tal forma que dentro de cada grupo las unidades muestrales sean lo mas homogonea posible, y entre los grupos estas unidades, comparativamente, sean lo mas heterogenea posible

La información que se recolectó de un grupo de 21 personas (usando una escala de Likert del 1 al 7, donde 1 es desacuerdo y 7 de acuerdo), fue su grado de conformidad a las siguientes afirmaciones cuando visita un centro comercial:

  • Salir de compras es divertido

  • Salir de compras afecta el presupuesto

  • Al salir de compras aprovecho de comer fuera

  • Al salir a comprar trato de hacer las mejores

  • No me importa salir de compras

  • Al salir de compra voy a ahorrar si comparo precios

Se desarrollará el caso con el lenguaje de programacion R (R Core Team, 2022a)

datosc <- read.table(file = "compras-cluster.csv", header = TRUE,
                        sep = ",", stringsAsFactors = TRUE)
str(datosc)
## 'data.frame':    21 obs. of  7 variables:
##  $ caso    : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ divertid: int  6 2 7 4 1 6 5 7 2 3 ...
##  $ presupu : int  4 3 2 6 3 4 3 3 4 3 ...
##  $ aprovech: int  7 1 6 4 2 6 6 7 3 3 ...
##  $ buenacom: int  3 4 4 5 2 3 3 4 3 6 ...
##  $ noimport: int  2 5 1 3 6 3 3 1 6 4 ...
##  $ ahorro  : int  3 4 3 6 4 4 4 4 3 6 ...
attr(datosc,"variable.labels") <- NULL
datosc$caso <- NULL#Se elimino la variable "caso"

II ANÁLISIS EXPLORATORIO

Usamos la libreria DataExplorer(Cui, 2020) para obtener una grafica que detecte los % de datos perdidos

summary(datosc)
##     divertid      presupu     aprovech       buenacom      noimport   
##  Min.   :1.0   Min.   :2   Min.   :1.00   Min.   :2.0   Min.   :1.00  
##  1st Qu.:2.0   1st Qu.:3   1st Qu.:2.00   1st Qu.:3.0   1st Qu.:2.00  
##  Median :4.0   Median :4   Median :4.00   Median :4.0   Median :3.00  
##  Mean   :3.9   Mean   :4   Mean   :4.05   Mean   :4.1   Mean   :3.43  
##  3rd Qu.:5.0   3rd Qu.:5   3rd Qu.:6.00   3rd Qu.:5.0   3rd Qu.:4.00  
##  Max.   :7.0   Max.   :7   Max.   :7.00   Max.   :7.0   Max.   :7.00  
##      ahorro    
##  Min.   :2.00  
##  1st Qu.:3.00  
##  Median :4.00  
##  Mean   :4.38  
##  3rd Qu.:5.00  
##  Max.   :7.00
#Analisis Exploratorio con DataExplorer
# Detectando y graficando los % de datos perdidos
plot_missing(datosc, ggtheme=theme_bw())+
               labs(tittle="Datos perdidos por variable",
                    y="Datos periddos",
                    x="Variables")

Usamos la libreria funModeling(Casas, 2020) (el cual usa ggplot2) para obtener una grafica de las variables

#Analisis Exploratorio con la librería funModeling
# Gráfico de variables numéricas
plot_num(datosc) + theme_bw()

III.USANDO MEDIDAS DE DISTANCIA

1. Distancia euclidiana

Usamos la libreria factoextra(Kassambara & Mundt, 2020) para hallar la matriz de distancia y una grafica de la matriz

#Calculando la matriz de distancia euclidiana con la
#funcion get_dist()
res.dist <- get_dist(datosc, stand = FALSE, 
                     method = "euclidean")

# Visualizando un subconjunto de la matriz de distancia
round(as.matrix(res.dist)[1:6, 1:6], 1)
##     1   2   3   4   5   6
## 1 0.0 8.0 2.8 5.6 8.3 1.7
## 2 8.0 0.0 8.2 5.6 2.6 6.9
## 3 2.8 8.2 0.0 6.6 9.1 3.3
## 4 5.6 5.6 6.6 0.0 6.6 4.5
## 5 8.3 2.6 9.1 6.6 0.0 7.2
## 6 1.7 6.9 3.3 4.5 7.2 0.0

2. Gráfico matriz de distancia

#Visualizando la matriz de distancia con fviz_dist()
fviz_dist(res.dist)  #ESTAN ORDENADOS, el problema es cuando hay miles de datos

fviz_dist(res.dist, 
          gradient = list(low = "#00AFBB", mid = "white", 
                          high = "#FC4E07"))

IV.CLUSTER DE PARTICIÓN - NO JERÁRQUICOS

1 Criterios para hallar el número de clusters

1.1 Usando el criterio del Gráfico de Silueta

Usamos la libreria factoextra(Kassambara & Mundt, 2020) para el criterio del “grafico de la silueta”

set.seed(123)
fviz_nbclust(datosc, kmeans, method = "silhouette") +
  labs(subtitle = "Silhouette method")

1.2 Usando el criterio de Suma de Cuadrados dentro de clusters

Usamos la libreria factoextra(Kassambara & Mundt, 2020) para el criterio del “Suma de cuadrados dentro de clusters”

set.seed(123)
wss <- numeric()
for(h in 1:10){
  b<-kmeans(datosc,h)
  wss[h]<-b$tot.withinss #scintra
}
wss 
##  [1] 334.7 177.6  89.9  73.7  67.5  55.3  40.8  35.6  30.3  24.5
wss1 <- data.frame(cluster=c(1:10),wss)
wss1
##    cluster   wss
## 1        1 334.7
## 2        2 177.6
## 3        3  89.9
## 4        4  73.7
## 5        5  67.5
## 6        6  55.3
## 7        7  40.8
## 8        8  35.6
## 9        9  30.3
## 10      10  24.5

Usamos la libreria ggplot2(Wickham, 2016) para el grafico de los cluster segun la suma de cuadrados dentro de cluster

# Gráficamos el cluster con la S.C.
ggplot(wss1) + aes(cluster,wss) + geom_line(color="blue") + 
  geom_point(color="blue") +
  geom_vline(xintercept = 3, linetype = 2, col="red") +
  labs(title = "Método Elbow") + 
  scale_x_continuous(breaks=1:10) +
  theme_classic()

1.3 NbClust: 30 Indices para determinar el número de clusters

Usamos la libreria NbClust(Charrad et al., 2014) el cual usa 30 indices para determinar el tamaño optimo de clusters ademas te indica cuantos criterios han elegido cada clusters y la decision final

set.seed(123)
res.nbclust <- NbClust(datosc, distance = "euclidean",
                       min.nc = 2, max.nc = 5, 
                       method = "average", index ="all")

Usamos la libreria factoextra(Kassambara & Mundt, 2020) para una grafica de barrras el cual indique cuantos indices han elegido el “k” cluster

factoextra::fviz_nbclust(res.nbclust) + theme_minimal()
## Among all indices: 
## ===================
## * 2 proposed  0 as the best number of clusters
## * 1 proposed  1 as the best number of clusters
## * 2 proposed  2 as the best number of clusters
## * 14 proposed  3 as the best number of clusters
## * 4 proposed  4 as the best number of clusters
## * 3 proposed  5 as the best number of clusters
## 
## Conclusion
## =========================
## * According to the majority rule, the best number of clusters is  3 .

2.Método de particion: K-means

Usamos la libreria stats(R Core Team, 2022b) el cual es una libreria predeterminada de R con el cual usaremos la funcion kmeans para hallar los clusters

set.seed(123)
km <- kmeans(datosc, 
             centers=3,      # Número de Cluster
             iter.max = 100, # Número de iteraciones máxima
             nstart = 1,     # Número de puntos iniciales 
             algorithm = "Lloyd")    
#nstart=25, significa que se probaran 25 puntos iniciales
#aleatorios y luego eligirá aquel donde la variación dentro
#(intra) de cluster sea minima.
#El valor por defecto es 1

A continuacion toda la informacion que da usar la funcion kmeans:

# Mostrar los clusters que pertenece cada individuo 
km$cluster
##  [1] 1 3 1 2 3 1 1 1 3 2 3 1 3 2 1 2 1 3 2 3 1
clusters1 = km$cluster

# Tamaño de cada cluster
km$size
## [1] 9 5 7
# Promedios de cada cluster
km$centers
##   divertid presupu aprovech buenacom noimport ahorro
## 1     5.67    3.67     6.00     3.22     2.00   4.00
## 2     3.60    5.20     3.60     6.00     3.40   6.60
## 3     1.86    3.57     1.86     3.86     5.29   3.29
# Número de interaciones
km$iter
## [1] 4
# Sumas de cuadrados
km$withinss     #Suma de cuadrados dentro de cada cluster
## [1] 37.6 15.6 43.1
km$tot.withinss #Suma de cuadrados Total dentro de cada cluster
## [1] 96.3
km$betweenss    #Suma de cuadrados entre cluster
## [1] 238
                #Se obtiene por diferencia

Usamos la libreria factoextra(Kassambara & Mundt, 2020) para una grafica de los clusters usando ACP

# Visualización de las soluciones usando ACP
fviz_cluster(km,data=datosc,ellipse.type = "convex") + 
  theme_classic()

V.CARACTERIZANDO A LOS CLUSTERS

Consiste en analizar los centros de gravedad de cada grupo (promedios)

datos.j <- cbind(datosc,clusters1)
datos.j$clusters1 <- factor(datos.j$clusters1) #los clusters

Usamos la libreria dplyr(Wickham et al., 2022)

#Diagrama de líneas de promedio por cluster
datos.j %>%   
  group_by(clusters1) %>%
  summarise_all(list(mean)) -> medias #promedios por grupo por cada variable
medias
## # A tibble: 3 x 7
##   clusters1 divertid presupu aprovech buenacom noimport ahorro
##   <fct>        <dbl>   <dbl>    <dbl>    <dbl>    <dbl>  <dbl>
## 1 1             5.67    3.67     6        3.22     2      4   
## 2 2             3.6     5.2      3.6      6        3.4    6.6 
## 3 3             1.86    3.57     1.86     3.86     5.29   3.29
#tapply(datos.j$divertid,grp,mean)

datos.j %>%  summarise_if(is.numeric,mean) %>%
  round(4) -> general #promedio general

general
##   divertid presupu aprovech buenacom noimport ahorro
## 1      3.9       4     4.05      4.1     3.43   4.38
general <- cbind(clusters1="general",general)
general #para tener dos resultados con los mismos campos(numero de columnas)
##   clusters1 divertid presupu aprovech buenacom noimport ahorro
## 1   general      3.9       4     4.05      4.1     3.43   4.38
medias  <- as.data.frame(rbind(medias,general))
medias
##   clusters1 divertid presupu aprovech buenacom noimport ahorro
## 1         1     5.67    3.67     6.00     3.22     2.00   4.00
## 2         2     3.60    5.20     3.60     6.00     3.40   6.60
## 3         3     1.86    3.57     1.86     3.86     5.29   3.29
## 4   general     3.90    4.00     4.05     4.10     3.43   4.38

Usamos la libreria tidyr(Wickham et al., 2022) para convertir la data a formato tidy con pivot_longer(pasar de filas a columnas)

gathered_datos.j <- pivot_longer(data=medias,
                                 -clusters1,
                                 names_to="variable",
                                 values_to = "valor")
head(gathered_datos.j)
## # A tibble: 6 x 3
##   clusters1 variable valor
##   <fct>     <chr>    <dbl>
## 1 1         divertid  5.67
## 2 1         presupu   3.67
## 3 1         aprovech  6   
## 4 1         buenacom  3.22
## 5 1         noimport  2   
## 6 1         ahorro    4

A continuacion finalmente la grafica de caracterizacion de los clusters:

ggplot(gathered_datos.j) + aes(x=variable,y=valor,color=clusters1) + 
  geom_point() + 
  geom_line(aes(group = clusters1)) +
  theme_bw() +
  theme(legend.position = "bottom",legend.title=element_blank()) +
  labs(title="Diagrama de líneas de Cluster por Variable",
       x="Variable",y="") + ylim(0,8)+
  scale_colour_discrete("Cluster") #+ coord_flip()

Casas, P. (2020). funModeling: Exploratory data analysis and data preparation tool-box. https://CRAN.R-project.org/package=funModeling
Charrad, M., Ghazzali, N., Boiteau, V., & Niknafs, A. (2014). NbClust: An R package for determining the relevant number of clusters in a data set. Journal of Statistical Software, 61(6), 1–36. http://www.jstatsoft.org/v61/i06/
Cui, B. (2020). DataExplorer: Automate data exploration and treatment. https://CRAN.R-project.org/package=DataExplorer
Kassambara, A., & Mundt, F. (2020). Factoextra: Extract and visualize the results of multivariate data analyses. https://CRAN.R-project.org/package=factoextra
Nores, J. E. G. (2014). Análisis de conglomerados (cluster analysis). R Foundation for Statistical Computing; Data Mining Institute.
R Core Team. (2022a). R: A language and environment for statistical computing. R Foundation for Statistical Computing. https://www.R-project.org/
R Core Team. (2022b). R: A language and environment for statistical computing. R Foundation for Statistical Computing. https://www.R-project.org/
Wickham, H. (2016). ggplot2: Elegant graphics for data analysis. Springer-Verlag New York. https://ggplot2.tidyverse.org
Wickham, H., François, R., Henry, L., & Müller, K. (2022). Dplyr: A grammar of data manipulation. https://CRAN.R-project.org/package=dplyr
LS0tDQp0aXRsZTogIkFuYWxpc2lzIENsdXN0ZXIgLSBNZXRvZG8gay1NZWFucyINCmF1dGhvcjogIldhbGRvIEfDs21leiINCmRhdGU6ICJgciBTeXMuRGF0ZSgpYCINCmVtYWlsOiAid2FsZG9nMjc3QGdtYWlsLmNvbSINCm91dHB1dDogDQogIHJtZGZvcm1hdHM6OmRvd25jdXRlOg0KICAgIHNlbGZfY29udGFpbmVkOiB0cnVlDQogICAgZGVmYXVsdF9zdHlsZTogImxpZ2h0Ig0KICAgIGRvd25jdXRlX3RoZW1lOiAiY2hhb3MiDQogICAgdG9jX2Zsb2F0OiBUUlVFDQogICAgY29kZV9kb3dubG9hZDogVFJVRQ0KYmlibGlvZ3JhcGh5OiBiaWJsaW9ncmFmaWEuYmliDQpjc2w6IGFwYS5jc2wNCmxpbmstY2l0YXRpb25zOiB5ZXMNCi0tLQ0KDQpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0NCm9wdGlvbnMoc2NpcGVuID0gOTk5KSAgICAgICMgRWxpbWluYXIgbGEgbm90YWNpw7NuIGNpZW50w61maWNhDQpvcHRpb25zKGRpZ2l0cyA9IDMpICAgICAgICAjIE7Dum1lcm8gZGUgZGVjaW1hbGVzDQoNCiMgUGFxdWV0ZXMNCmxpYnJhcnkocGFjbWFuKQ0KcF9sb2FkKGZhY3RvZXh0cmEsTmJDbHVzdCxEYXRhRXhwbG9yZXIsDQogICAgICAgZnVuTW9kZWxpbmcsdGlkeXIsZ2dwbG90MixkcGx5cikNCmtuaXRyOjpvcHRzX2NodW5rJHNldChlY2hvID0gVFJVRSkNCmBgYA0KDQojIyBJLiBMRUNUVVJBIERFIERBVE9TDQoNCkVtaWxpbyBHb25kYXIgZW4gc3UgbGlicm8gIiBBbmFsaXNpcyBkZSBDb25nbG9tZXJhZG9zIihFZGl0b3JpYWwgOiBEYXRhIE1pbmluZyBJbnN0aXR1dGUuIDIwMDQpICBbQENsdXN0ZXJBbmFseXNpc10gcHJlc2VudGEgdW4gZWplbXBsbyBkb25kZSBhIHVuIGdydXBvIGRlIDIxDQpwZXJzb25hcyBzZSBsZSBtaWTDrW8gdW5hIHNlcmllIGRlIHZhcmlhYmxlcyBkZSB0aXBvIG3DqXRyaWNvLCB5IHNlZ3VuDQplc3RvcyBhdHJpYnV0b3Mgc2UgdmFuIGEgY2xhc2lmaWNhciBhIGVzdGFzIHBlcnNvbmFzIGVuIGdydXBvcyBvDQpjYXRlZ29yaWFzIGRlIHRhbCBmb3JtYSBxdWUgZGVudHJvIGRlIGNhZGEgZ3J1cG8gbGFzIHVuaWRhZGVzIG11ZXN0cmFsZXMNCnNlYW4gbG8gbWFzIGhvbW9nb25lYSBwb3NpYmxlLCB5IGVudHJlIGxvcyBncnVwb3MgZXN0YXMgdW5pZGFkZXMsDQpjb21wYXJhdGl2YW1lbnRlLCBzZWFuIGxvIG1hcyBoZXRlcm9nZW5lYSBwb3NpYmxlDQoNCkxhIGluZm9ybWFjacOzbiBxdWUgc2UgcmVjb2xlY3TDsyBkZSB1biBncnVwbyBkZSAyMSBwZXJzb25hcyAodXNhbmRvIHVuYQ0KZXNjYWxhIGRlIExpa2VydCBkZWwgMSBhbCA3LCBkb25kZSAxIGVzIGRlc2FjdWVyZG8geSA3IGRlIGFjdWVyZG8pLCBmdWUNCnN1IGdyYWRvIGRlIGNvbmZvcm1pZGFkIGEgbGFzIHNpZ3VpZW50ZXMgYWZpcm1hY2lvbmVzIGN1YW5kbyB2aXNpdGEgdW4NCmNlbnRybyBjb21lcmNpYWw6DQoNCi0gICBTYWxpciBkZSBjb21wcmFzIGVzIGRpdmVydGlkbw0KDQotICAgU2FsaXIgZGUgY29tcHJhcyBhZmVjdGEgZWwgcHJlc3VwdWVzdG8NCg0KLSAgIEFsIHNhbGlyIGRlIGNvbXByYXMgYXByb3ZlY2hvIGRlIGNvbWVyIGZ1ZXJhDQoNCi0gICBBbCBzYWxpciBhIGNvbXByYXIgdHJhdG8gZGUgaGFjZXIgbGFzIG1lam9yZXMNCg0KLSAgIE5vIG1lIGltcG9ydGEgc2FsaXIgZGUgY29tcHJhcw0KDQotICAgQWwgc2FsaXIgZGUgY29tcHJhIHZveSBhIGFob3JyYXIgc2kgY29tcGFybyBwcmVjaW9zDQoNClNlIGRlc2Fycm9sbGFyw6EgZWwgY2FzbyBjb24gZWwgbGVuZ3VhamUgZGUgcHJvZ3JhbWFjaW9uIFIgW0BSXQ0KDQpgYGB7cn0NCmRhdG9zYyA8LSByZWFkLnRhYmxlKGZpbGUgPSAiY29tcHJhcy1jbHVzdGVyLmNzdiIsIGhlYWRlciA9IFRSVUUsDQogICAgICAgICAgICAgICAgICAgICAgICBzZXAgPSAiLCIsIHN0cmluZ3NBc0ZhY3RvcnMgPSBUUlVFKQ0Kc3RyKGRhdG9zYykNCg0KYXR0cihkYXRvc2MsInZhcmlhYmxlLmxhYmVscyIpIDwtIE5VTEwNCmRhdG9zYyRjYXNvIDwtIE5VTEwjU2UgZWxpbWlubyBsYSB2YXJpYWJsZSAiY2FzbyINCmBgYA0KDQoNCiMjIElJIEFOw4FMSVNJUyBFWFBMT1JBVE9SSU8NClVzYW1vcyBsYSBsaWJyZXJpYSBEYXRhRXhwbG9yZXJbQGRhdGFleHBsb3Jlcl0gcGFyYSBvYnRlbmVyIHVuYSBncmFmaWNhIHF1ZSBkZXRlY3RlIGxvcyAlIGRlIGRhdG9zIHBlcmRpZG9zDQoNCmBgYHtyIGV4cGxvLGZpZy5hbGlnbj0nY2VudGVyJ30NCg0Kc3VtbWFyeShkYXRvc2MpDQoNCiNBbmFsaXNpcyBFeHBsb3JhdG9yaW8gY29uIERhdGFFeHBsb3Jlcg0KIyBEZXRlY3RhbmRvIHkgZ3JhZmljYW5kbyBsb3MgJSBkZSBkYXRvcyBwZXJkaWRvcw0KcGxvdF9taXNzaW5nKGRhdG9zYywgZ2d0aGVtZT10aGVtZV9idygpKSsNCiAgICAgICAgICAgICAgIGxhYnModGl0dGxlPSJEYXRvcyBwZXJkaWRvcyBwb3IgdmFyaWFibGUiLA0KICAgICAgICAgICAgICAgICAgICB5PSJEYXRvcyBwZXJpZGRvcyIsDQogICAgICAgICAgICAgICAgICAgIHg9IlZhcmlhYmxlcyIpIA0KYGBgDQoNClVzYW1vcyBsYSBsaWJyZXJpYSBmdW5Nb2RlbGluZ1tAZnVuTW9kZWxpbmddIChlbCBjdWFsIHVzYSBnZ3Bsb3QyKSBwYXJhIG9idGVuZXIgdW5hIGdyYWZpY2EgZGUgbGFzIHZhcmlhYmxlcyANCmBgYHtyIGV4cGxvX2dyYWYsd2FybmluZz1GQUxTRX0NCiNBbmFsaXNpcyBFeHBsb3JhdG9yaW8gY29uIGxhIGxpYnJlcsOtYSBmdW5Nb2RlbGluZw0KIyBHcsOhZmljbyBkZSB2YXJpYWJsZXMgbnVtw6lyaWNhcw0KcGxvdF9udW0oZGF0b3NjKSArIHRoZW1lX2J3KCkNCmBgYA0KDQojIyBJSUkuVVNBTkRPIE1FRElEQVMgREUgRElTVEFOQ0lBDQoNCiMjIyAxLiBEaXN0YW5jaWEgZXVjbGlkaWFuYQ0KDQpVc2Ftb3MgbGEgbGlicmVyaWEgZmFjdG9leHRyYVtAZmFjdG9leHRyYV0gcGFyYSBoYWxsYXIgbGEgbWF0cml6IGRlIGRpc3RhbmNpYSB5IHVuYSBncmFmaWNhIGRlIGxhIG1hdHJpeg0KYGBge3IgZXVjbGksIGZpZy5hbGlnbj0nY2VudGVyJ30NCiNDYWxjdWxhbmRvIGxhIG1hdHJpeiBkZSBkaXN0YW5jaWEgZXVjbGlkaWFuYSBjb24gbGENCiNmdW5jaW9uIGdldF9kaXN0KCkNCnJlcy5kaXN0IDwtIGdldF9kaXN0KGRhdG9zYywgc3RhbmQgPSBGQUxTRSwgDQogICAgICAgICAgICAgICAgICAgICBtZXRob2QgPSAiZXVjbGlkZWFuIikNCg0KIyBWaXN1YWxpemFuZG8gdW4gc3ViY29uanVudG8gZGUgbGEgbWF0cml6IGRlIGRpc3RhbmNpYQ0Kcm91bmQoYXMubWF0cml4KHJlcy5kaXN0KVsxOjYsIDE6Nl0sIDEpDQpgYGANCg0KIyMjIDIuIEdyw6FmaWNvIG1hdHJpeiBkZSBkaXN0YW5jaWENCg0KYGBge3IgbWF0cml6LCBmaWcuYWxpZ249J2NlbnRlcid9DQojVmlzdWFsaXphbmRvIGxhIG1hdHJpeiBkZSBkaXN0YW5jaWEgY29uIGZ2aXpfZGlzdCgpDQpmdml6X2Rpc3QocmVzLmRpc3QpICAjRVNUQU4gT1JERU5BRE9TLCBlbCBwcm9ibGVtYSBlcyBjdWFuZG8gaGF5IG1pbGVzIGRlIGRhdG9zDQoNCmZ2aXpfZGlzdChyZXMuZGlzdCwgDQogICAgICAgICAgZ3JhZGllbnQgPSBsaXN0KGxvdyA9ICIjMDBBRkJCIiwgbWlkID0gIndoaXRlIiwgDQogICAgICAgICAgICAgICAgICAgICAgICAgIGhpZ2ggPSAiI0ZDNEUwNyIpKQ0KYGBgDQoNCg0KIyMgSVYuQ0xVU1RFUiBERSBQQVJUSUNJw5NOIC0gTk8gSkVSw4FSUVVJQ09TDQoNCjxjZW50ZXI+IA0KIVtdKGttZWFucy5wbmcpe3dpZHRoPSI4MDAifSA8IS0tIFdpZHRoIHBhcmEgcmVkdWNpciBlbCB0YW1hw7FvIGRlIGxhIGltYWdlbiAtLT4NCjwvY2VudGVyPg0KDQojIyMgMSBDcml0ZXJpb3MgcGFyYSBoYWxsYXIgZWwgbsO6bWVybyBkZSBjbHVzdGVycw0KDQojIyMjIDEuMSBVc2FuZG8gZWwgY3JpdGVyaW8gZGVsIEdyw6FmaWNvIGRlIFNpbHVldGENCg0KVXNhbW9zIGxhIGxpYnJlcmlhIGZhY3RvZXh0cmFbQGZhY3RvZXh0cmFdIHBhcmEgZWwgY3JpdGVyaW8gZGVsICJncmFmaWNvIGRlIGxhIHNpbHVldGEiDQpgYGB7ciBzaWx1ZXRhLCBmaWcuYWxpZ249J2NlbnRlcid9DQpzZXQuc2VlZCgxMjMpDQpmdml6X25iY2x1c3QoZGF0b3NjLCBrbWVhbnMsIG1ldGhvZCA9ICJzaWxob3VldHRlIikgKw0KICBsYWJzKHN1YnRpdGxlID0gIlNpbGhvdWV0dGUgbWV0aG9kIikNCmBgYA0KDQojIyMjIDEuMiBVc2FuZG8gZWwgY3JpdGVyaW8gZGUgU3VtYSBkZSBDdWFkcmFkb3MgZGVudHJvIGRlIGNsdXN0ZXJzDQoNClVzYW1vcyBsYSBsaWJyZXJpYSBmYWN0b2V4dHJhW0BmYWN0b2V4dHJhXSBwYXJhIGVsIGNyaXRlcmlvIGRlbCAiU3VtYSBkZSBjdWFkcmFkb3MgZGVudHJvIGRlIGNsdXN0ZXJzIg0KYGBge3Igc3VtYWN1YWRyYWludHJhLCBmaWcuYWxpZ249J2NlbnRlcid9DQpzZXQuc2VlZCgxMjMpDQp3c3MgPC0gbnVtZXJpYygpDQpmb3IoaCBpbiAxOjEwKXsNCiAgYjwta21lYW5zKGRhdG9zYyxoKQ0KICB3c3NbaF08LWIkdG90LndpdGhpbnNzICNzY2ludHJhDQp9DQp3c3MgDQoNCndzczEgPC0gZGF0YS5mcmFtZShjbHVzdGVyPWMoMToxMCksd3NzKQ0Kd3NzMQ0KYGBgDQoNClVzYW1vcyBsYSBsaWJyZXJpYSBnZ3Bsb3QyW0BnZ3Bsb3QyXSBwYXJhIGVsIGdyYWZpY28gZGUgbG9zIGNsdXN0ZXIgc2VndW4gbGEgc3VtYSBkZSBjdWFkcmFkb3MgZGVudHJvIGRlIGNsdXN0ZXINCg0KYGBge3Igc2MsZmlnLmFsaWduPSdjZW50ZXInfQ0KIyBHcsOhZmljYW1vcyBlbCBjbHVzdGVyIGNvbiBsYSBTLkMuDQpnZ3Bsb3Qod3NzMSkgKyBhZXMoY2x1c3Rlcix3c3MpICsgZ2VvbV9saW5lKGNvbG9yPSJibHVlIikgKyANCiAgZ2VvbV9wb2ludChjb2xvcj0iYmx1ZSIpICsNCiAgZ2VvbV92bGluZSh4aW50ZXJjZXB0ID0gMywgbGluZXR5cGUgPSAyLCBjb2w9InJlZCIpICsNCiAgbGFicyh0aXRsZSA9ICJNw6l0b2RvIEVsYm93IikgKyANCiAgc2NhbGVfeF9jb250aW51b3VzKGJyZWFrcz0xOjEwKSArDQogIHRoZW1lX2NsYXNzaWMoKQ0KYGBgDQoNCg0KIyMjIyAxLjMgTmJDbHVzdDogMzAgSW5kaWNlcyBwYXJhIGRldGVybWluYXIgZWwgbsO6bWVybyBkZSBjbHVzdGVycw0KDQpVc2Ftb3MgbGEgbGlicmVyaWEgTmJDbHVzdFtATmJDbHVzdF0gZWwgY3VhbCB1c2EgMzAgaW5kaWNlcyBwYXJhIGRldGVybWluYXIgZWwgdGFtYcOxbyBvcHRpbW8gZGUgY2x1c3RlcnMgYWRlbWFzIHRlIGluZGljYSBjdWFudG9zIGNyaXRlcmlvcyBoYW4gZWxlZ2lkbyBjYWRhIGNsdXN0ZXJzIHkgbGEgZGVjaXNpb24gZmluYWwNCmBgYHtyIG5iY2x1c3QscmVzdWx0cz0naGlkZScsZmlnLnNob3c9J2hpZGUnfQ0Kc2V0LnNlZWQoMTIzKQ0KcmVzLm5iY2x1c3QgPC0gTmJDbHVzdChkYXRvc2MsIGRpc3RhbmNlID0gImV1Y2xpZGVhbiIsDQogICAgICAgICAgICAgICAgICAgICAgIG1pbi5uYyA9IDIsIG1heC5uYyA9IDUsIA0KICAgICAgICAgICAgICAgICAgICAgICBtZXRob2QgPSAiYXZlcmFnZSIsIGluZGV4ID0iYWxsIikgDQpgYGANCg0KVXNhbW9zIGxhIGxpYnJlcmlhIGZhY3RvZXh0cmFbQGZhY3RvZXh0cmFdIHBhcmEgdW5hIGdyYWZpY2EgZGUgYmFycnJhcyBlbCBjdWFsIGluZGlxdWUgY3VhbnRvcyBpbmRpY2VzIGhhbiBlbGVnaWRvIGVsICJrIiBjbHVzdGVyDQoNCmBgYHtyIG5iY2x1c3RfZ3JhZixmaWcuYWxpZ249J2NlbnRlcicsd2FybmluZz1GQUxTRX0NCmZhY3RvZXh0cmE6OmZ2aXpfbmJjbHVzdChyZXMubmJjbHVzdCkgKyB0aGVtZV9taW5pbWFsKCkNCmBgYA0KDQoNCiMjIyAyLk3DqXRvZG8gZGUgcGFydGljaW9uOiBLLW1lYW5zDQoNClVzYW1vcyBsYSBsaWJyZXJpYSBzdGF0c1tAc3RhdHNdIGVsIGN1YWwgZXMgdW5hIGxpYnJlcmlhIHByZWRldGVybWluYWRhIGRlIFIgY29uIGVsIGN1YWwgdXNhcmVtb3MgbGEgZnVuY2lvbiBrbWVhbnMgcGFyYSBoYWxsYXIgbG9zIGNsdXN0ZXJzDQpgYGB7ciBrbWVhbnN9DQpzZXQuc2VlZCgxMjMpDQprbSA8LSBrbWVhbnMoZGF0b3NjLCANCiAgICAgICAgICAgICBjZW50ZXJzPTMsICAgICAgIyBOw7ptZXJvIGRlIENsdXN0ZXINCiAgICAgICAgICAgICBpdGVyLm1heCA9IDEwMCwgIyBOw7ptZXJvIGRlIGl0ZXJhY2lvbmVzIG3DoXhpbWENCiAgICAgICAgICAgICBuc3RhcnQgPSAxLCAgICAgIyBOw7ptZXJvIGRlIHB1bnRvcyBpbmljaWFsZXMgDQogICAgICAgICAgICAgYWxnb3JpdGhtID0gIkxsb3lkIikgICAgDQojbnN0YXJ0PTI1LCBzaWduaWZpY2EgcXVlIHNlIHByb2JhcmFuIDI1IHB1bnRvcyBpbmljaWFsZXMNCiNhbGVhdG9yaW9zIHkgbHVlZ28gZWxpZ2lyw6EgYXF1ZWwgZG9uZGUgbGEgdmFyaWFjacOzbiBkZW50cm8NCiMoaW50cmEpIGRlIGNsdXN0ZXIgc2VhIG1pbmltYS4NCiNFbCB2YWxvciBwb3IgZGVmZWN0byBlcyAxDQpgYGANCg0KQSBjb250aW51YWNpb24gdG9kYSBsYSBpbmZvcm1hY2lvbiBxdWUgZGEgdXNhciBsYSBmdW5jaW9uIGttZWFuczoNCg0KYGBge3IgaW5mb19jbHVzdGVyc30NCiMgTW9zdHJhciBsb3MgY2x1c3RlcnMgcXVlIHBlcnRlbmVjZSBjYWRhIGluZGl2aWR1byANCmttJGNsdXN0ZXINCmNsdXN0ZXJzMSA9IGttJGNsdXN0ZXINCg0KIyBUYW1hw7FvIGRlIGNhZGEgY2x1c3Rlcg0Ka20kc2l6ZQ0KDQojIFByb21lZGlvcyBkZSBjYWRhIGNsdXN0ZXINCmttJGNlbnRlcnMNCg0KIyBOw7ptZXJvIGRlIGludGVyYWNpb25lcw0Ka20kaXRlcg0KDQojIFN1bWFzIGRlIGN1YWRyYWRvcw0Ka20kd2l0aGluc3MgICAgICNTdW1hIGRlIGN1YWRyYWRvcyBkZW50cm8gZGUgY2FkYSBjbHVzdGVyDQprbSR0b3Qud2l0aGluc3MgI1N1bWEgZGUgY3VhZHJhZG9zIFRvdGFsIGRlbnRybyBkZSBjYWRhIGNsdXN0ZXINCmttJGJldHdlZW5zcyAgICAjU3VtYSBkZSBjdWFkcmFkb3MgZW50cmUgY2x1c3Rlcg0KICAgICAgICAgICAgICAgICNTZSBvYnRpZW5lIHBvciBkaWZlcmVuY2lhDQpgYGANCg0KVXNhbW9zIGxhIGxpYnJlcmlhIGZhY3RvZXh0cmFbQGZhY3RvZXh0cmFdIHBhcmEgdW5hIGdyYWZpY2EgZGUgbG9zIGNsdXN0ZXJzIHVzYW5kbyBBQ1ANCmBgYHtyIGdyYWZfYWNwLCBmaWcuYWxpZ249J2NlbnRlcid9DQojIFZpc3VhbGl6YWNpw7NuIGRlIGxhcyBzb2x1Y2lvbmVzIHVzYW5kbyBBQ1ANCmZ2aXpfY2x1c3RlcihrbSxkYXRhPWRhdG9zYyxlbGxpcHNlLnR5cGUgPSAiY29udmV4IikgKyANCiAgdGhlbWVfY2xhc3NpYygpDQpgYGANCg0KIyMgVi5DQVJBQ1RFUklaQU5ETyBBIExPUyBDTFVTVEVSUw0KDQpDb25zaXN0ZSBlbiBhbmFsaXphciBsb3MgY2VudHJvcyBkZSBncmF2ZWRhZCBkZSBjYWRhIGdydXBvIChwcm9tZWRpb3MpDQoNCmBgYHtyIGNiaW5kX2NsdXN0fQ0KZGF0b3MuaiA8LSBjYmluZChkYXRvc2MsY2x1c3RlcnMxKQ0KZGF0b3MuaiRjbHVzdGVyczEgPC0gZmFjdG9yKGRhdG9zLmokY2x1c3RlcnMxKSAjbG9zIGNsdXN0ZXJzDQoNCmBgYA0KDQpVc2Ftb3MgbGEgbGlicmVyaWEgZHBseXJbQGRwbHlyXSANCmBgYHtyIGRwbHlyfQ0KI0RpYWdyYW1hIGRlIGzDrW5lYXMgZGUgcHJvbWVkaW8gcG9yIGNsdXN0ZXINCmRhdG9zLmogJT4lICAgDQogIGdyb3VwX2J5KGNsdXN0ZXJzMSkgJT4lDQogIHN1bW1hcmlzZV9hbGwobGlzdChtZWFuKSkgLT4gbWVkaWFzICNwcm9tZWRpb3MgcG9yIGdydXBvIHBvciBjYWRhIHZhcmlhYmxlDQptZWRpYXMNCiN0YXBwbHkoZGF0b3MuaiRkaXZlcnRpZCxncnAsbWVhbikNCg0KZGF0b3MuaiAlPiUgIHN1bW1hcmlzZV9pZihpcy5udW1lcmljLG1lYW4pICU+JQ0KICByb3VuZCg0KSAtPiBnZW5lcmFsICNwcm9tZWRpbyBnZW5lcmFsDQoNCmdlbmVyYWwNCg0KZ2VuZXJhbCA8LSBjYmluZChjbHVzdGVyczE9ImdlbmVyYWwiLGdlbmVyYWwpDQpnZW5lcmFsICNwYXJhIHRlbmVyIGRvcyByZXN1bHRhZG9zIGNvbiBsb3MgbWlzbW9zIGNhbXBvcyhudW1lcm8gZGUgY29sdW1uYXMpDQoNCm1lZGlhcyAgPC0gYXMuZGF0YS5mcmFtZShyYmluZChtZWRpYXMsZ2VuZXJhbCkpDQptZWRpYXMNCmBgYA0KDQpVc2Ftb3MgbGEgbGlicmVyaWEgdGlkeXJbQGRwbHlyXSBwYXJhIGNvbnZlcnRpciBsYSBkYXRhIGEgZm9ybWF0byB0aWR5IGNvbiBwaXZvdF9sb25nZXIocGFzYXIgZGUgZmlsYXMgYSBjb2x1bW5hcykNCmBgYHtyIHBpdm90fQ0KZ2F0aGVyZWRfZGF0b3MuaiA8LSBwaXZvdF9sb25nZXIoZGF0YT1tZWRpYXMsDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAtY2x1c3RlcnMxLA0KICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgbmFtZXNfdG89InZhcmlhYmxlIiwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHZhbHVlc190byA9ICJ2YWxvciIpDQpoZWFkKGdhdGhlcmVkX2RhdG9zLmopDQpgYGANCg0KQSBjb250aW51YWNpb24gZmluYWxtZW50ZSBsYSBncmFmaWNhIGRlIGNhcmFjdGVyaXphY2lvbiBkZSBsb3MgY2x1c3RlcnM6DQpgYGB7ciBncmFmaWNvX2NhcmFjdCxmaWcuYWxpZ249J2NlbnRlcid9DQpnZ3Bsb3QoZ2F0aGVyZWRfZGF0b3MuaikgKyBhZXMoeD12YXJpYWJsZSx5PXZhbG9yLGNvbG9yPWNsdXN0ZXJzMSkgKyANCiAgZ2VvbV9wb2ludCgpICsgDQogIGdlb21fbGluZShhZXMoZ3JvdXAgPSBjbHVzdGVyczEpKSArDQogIHRoZW1lX2J3KCkgKw0KICB0aGVtZShsZWdlbmQucG9zaXRpb24gPSAiYm90dG9tIixsZWdlbmQudGl0bGU9ZWxlbWVudF9ibGFuaygpKSArDQogIGxhYnModGl0bGU9IkRpYWdyYW1hIGRlIGzDrW5lYXMgZGUgQ2x1c3RlciBwb3IgVmFyaWFibGUiLA0KICAgICAgIHg9IlZhcmlhYmxlIix5PSIiKSArIHlsaW0oMCw4KSsNCiAgc2NhbGVfY29sb3VyX2Rpc2NyZXRlKCJDbHVzdGVyIikgIysgY29vcmRfZmxpcCgpIA0KYGBgDQoNCjxkaXYgY2xhc3M9InRvY2lmeS1leHRlbmQtcGFnZSIgZGF0YS11bmlxdWU9InRvY2lmeS1leHRlbmQtcGFnZSIgc3R5bGU9ImhlaWdodDogMDoiPjwvZGl2Pg0K