Algortmos de Clustering
Ciriaco A. Angel, Hilario M. Crhistian, Mamani C. Marielena, Rodriguez V. Hilton, Salcedo P. Jorge
14/11/2019
##CARGA DE DATA Y SU VISUALIZACIÓN
cliente<-read.csv("https://raw.githubusercontent.com/VictorGuevaraP/Mineria-de-datos-2019-2/master/clientes.csv", sep = ";")
##MUESTRA LA ESTRUCTURA
str(cliente)## 'data.frame': 850 obs. of 9 variables:
## $ ID_cliente : int 1 2 3 4 5 6 7 8 9 10 ...
## $ edad : int 41 47 33 29 47 40 38 42 26 47 ...
## $ educacion : int 2 1 2 2 1 1 2 3 1 3 ...
## $ años_empleo : int 6 26 10 4 31 23 4 0 5 23 ...
## $ Ingreso : int 19 100 57 19 253 81 56 64 18 115 ...
## $ Tarjeta_credito : num 0.124 4.582 6.111 0.681 9.308 ...
## $ otra_tarjeta : num 1.073 8.218 5.802 0.516 8.908 ...
## $ Direccion : Factor w/ 32 levels "NBA000","NBA001",..: 2 22 14 10 9 17 14 10 7 12 ...
## $ Ratio.ingreso.deuda: num 6.3 12.8 20.9 6.3 7.2 10.9 1.6 6.6 15.5 4 ...Se puede apreciar que la data cuenta con 850 datos y 9 variables. Tambien se visc ualiza el tipo de dato de cada uno.
##MUESTRA EL RESUMEN DE LA DATA
summary(cliente)## ID_cliente edad educacion años_empleo
## Min. : 1.0 Min. :20.00 Min. :1.000 Min. : 0.000
## 1st Qu.:213.2 1st Qu.:29.00 1st Qu.:1.000 1st Qu.: 3.000
## Median :425.5 Median :34.00 Median :1.000 Median : 7.000
## Mean :425.5 Mean :35.03 Mean :1.711 Mean : 8.566
## 3rd Qu.:637.8 3rd Qu.:41.00 3rd Qu.:2.000 3rd Qu.:13.000
## Max. :850.0 Max. :56.00 Max. :5.000 Max. :33.000
##
## Ingreso Tarjeta_credito otra_tarjeta Direccion
## Min. : 13.00 Min. : 0.0120 Min. : 0.046 NBA001 : 71
## 1st Qu.: 24.00 1st Qu.: 0.3825 1st Qu.: 1.046 NBA002 : 71
## Median : 35.00 Median : 0.8850 Median : 2.003 NBA000 : 60
## Mean : 46.68 Mean : 1.5768 Mean : 3.079 NBA004 : 58
## 3rd Qu.: 55.75 3rd Qu.: 1.8985 3rd Qu.: 3.903 NBA003 : 55
## Max. :446.00 Max. :20.5610 Max. :35.197 NBA006 : 50
## (Other):485
## Ratio.ingreso.deuda
## Min. : 0.10
## 1st Qu.: 5.10
## Median : 8.70
## Mean :10.17
## 3rd Qu.:13.80
## Max. :41.30
## El código ‘summary’ muestra un resumen de toda la data y en esto me muestra Min(el valor minimo),1st Qu.(primer cuartil), Median(valor mediana), Mean(valor media), 3rd(tercer cuartil), Max.(el valor máximo que puede tomar).
##LIMPIEZA DE DATA
#Fijarse si existe missing
library(Amelia)## Loading required package: Rcpp## ##
## ## Amelia II: Multiple Imputation
## ## (Version 1.7.5, built: 2018-05-07)
## ## Copyright (C) 2005-2019 James Honaker, Gary King and Matthew Blackwell
## ## Refer to http://gking.harvard.edu/amelia/ for more information
## ##missmap(cliente)
missing(cliente)## [1] FALSEPara empezar en la limpieza de la data se utilizará la librerÃa ‘Amelia’.Luego usamos el código missmap para que muestre un cuadro para ver los valores perdidos (missing), pero en nuestro caso no muestra ningun valor perdido pero para asegurarnos utilizamos el código ‘missing’ y pues reafirma lo que se dijo anteriormente (que no hay valores perdidos) ya que con ‘missing’ muestra FALSE.
#Crear nueva variable
cliente1<-cliente[ ,c(2:7,9)]
# Análisis de datos atÃpicos
par(mfrow=c(2,3))
boxplot(cliente1$educacion)
boxplot(cliente1$años_empleo)
boxplot(cliente1$Ingreso)
boxplot(cliente1$Tarjeta_credito)
boxplot(cliente1$otra_tarjeta)
boxplot(cliente1$Ratio.ingreso.deuda)
Despues de analizar los valores perdidos se crea una nueva variable y dentro de esa variable se pondrá 7 columnas de la data principal pues solo será necesario esa cantidad para el análisis.
#Eliminando datos atÃpicos
par(mfrow=c(2,3))
cliente1<- cliente1[-which(cliente1$educacion %in% boxplot(cliente1$educacion, plot = FALSE)$out),]
cliente1<- cliente1[-which(cliente1$años_empleo %in% boxplot(cliente1$años_empleo, plot = FALSE)$out),]
cliente1<- cliente1[-which(cliente1$Ingreso %in% boxplot(cliente1$Ingreso, plot = FALSE)$out),]
cliente1<- cliente1[-which(cliente1$Tarjeta_credito %in% boxplot(cliente1$Tarjeta_credito, plot = FALSE)$out),]
cliente1<- cliente1[-which(cliente1$otra_tarjeta %in% boxplot(cliente1$otra_tarjeta, plot = FALSE)$out),]
cliente1<- cliente1[-which(cliente1$Ratio.ingreso.deuda %in% boxplot(cliente1$Ratio.ingreso.deuda, plot = FALSE)$out),]
#Reduccion de datos atÃpicos
par(mfrow=c(2,3))
boxplot(cliente1$educacion)
boxplot(cliente1$años_empleo)
boxplot(cliente1$Ingreso)
boxplot(cliente1$Tarjeta_credito)
boxplot(cliente1$otra_tarjeta)
boxplot(cliente1$Ratio.ingreso.deuda)
En la gráfica anterior se mostró muchos valores atÃpicos, y eso no es bueno para el análisis.Por ello aplicamos codigos de reducción de outliers, y si queremos visualizar los datos volvemos a utilizar el código ‘boxplot’ Nos damos cuenta que se ha reducido la cantidad de valores atÃpicos.
##APLICAMOS EL ALGORITMO PAM
cliente1_scale<- scale(cliente1)
library(cluster)
library(factoextra)## Loading required package: ggplot2## Welcome! Related Books: `Practical Guide To Cluster Analysis in R` at https://goo.gl/13EFCZPara empezar el algoritmo de PAM se necesita que los datos estén en una misma unidad por ello se aplica el código ‘scale’.
#Identificar el número óptimo de clusters,como existen Outliers se utiliza manhattan
fviz_nbclust(x = cliente1_scale,FUNcluster = pam, method="wss" , k.max = 15,
diss = dist(cliente1_scale,method = "manhattan"))
Luego aplicamos el metodo del codo para ver cuantos clusters se formarán, y por ello ponemos que la cantidad maxima de clusters sea 15. Ademas se puede ver que se utilizó el método de ’Manhattan’porque apesar de que se redujo los outliers aún sigue existiendo valores atÃpicos .
#EspecÃfica la cantidad de grupos
set.seed(111)
pam_cluster <- pam(x = cliente1_scale,k = 3,metric = "manhattan")
pam_cluster## Medoids:
## ID edad educacion años_empleo Ingreso Tarjeta_credito
## 226 165 -0.3534715 -0.7380080 -0.03610448 -0.7075797 -0.86227702
## 105 76 -0.8797466 0.7403964 -0.57679821 -0.7661113 0.29598326
## 678 491 0.9622162 -0.7380080 1.22551422 0.9898362 0.08074325
## otra_tarjeta Ratio.ingreso.deuda
## 226 -0.7391985 -0.7115077
## 105 -0.0281568 1.0358696
## 678 0.7884544 -0.2062420
## Clustering vector:
## 1 4 7 8 9 11 12 13 14 15 16 17 19 20 21 22 24 26
## 1 2 1 3 2 3 1 1 3 2 1 1 3 3 1 2 3 3
## 27 28 29 30 32 33 34 35 36 37 38 39 41 45 47 48 49 50
## 1 3 3 3 3 2 2 3 2 1 2 1 1 2 2 1 1 3
## 51 54 56 57 58 59 60 61 62 65 66 67 68 69 70 71 73 74
## 3 3 2 1 2 3 1 3 3 1 1 3 2 2 2 1 3 2
## 75 76 77 78 80 84 86 88 89 91 92 93 94 95 96 97 98 99
## 1 2 1 2 3 3 1 2 2 3 1 1 2 1 1 1 1 2
## 100 103 104 105 107 108 109 110 111 113 114 115 116 117 118 120 121 122
## 1 3 3 2 1 2 1 3 3 1 2 1 1 1 3 1 2 2
## 124 125 126 127 128 129 130 131 132 133 134 135 137 138 139 140 141 142
## 3 3 3 1 1 2 1 1 3 2 1 2 3 2 3 2 3 2
## 143 144 146 147 148 149 150 151 153 154 155 159 160 161 162 163 164 165
## 2 1 2 3 2 2 1 1 2 1 3 2 2 1 3 3 3 2
## 167 168 169 172 173 174 175 177 178 179 180 182 183 187 188 189 193 194
## 1 1 1 1 1 2 1 3 1 2 3 3 1 1 1 3 3 1
## 195 196 197 200 202 203 204 205 207 209 211 212 213 215 216 219 220 221
## 3 2 1 1 1 2 1 1 1 3 1 1 3 1 2 3 3 2
## 223 225 226 228 230 231 232 234 236 237 238 240 241 242 243 244 245 247
## 1 1 1 1 3 1 3 2 1 3 2 1 1 1 2 1 1 3
## 251 252 253 255 257 258 259 260 261 263 264 266 267 269 270 271 272 273
## 1 2 1 3 3 1 1 1 1 3 1 3 3 1 1 2 1 1
## 274 275 276 277 279 280 281 284 286 288 291 292 293 295 296 297 298 301
## 3 2 1 2 1 2 1 1 2 1 1 3 1 1 2 2 1 3
## 302 303 304 305 306 309 310 311 312 313 314 315 316 317 318 319 320 322
## 3 1 1 2 3 2 3 3 1 1 1 3 1 1 2 3 1 1
## 324 325 326 327 328 330 331 333 334 336 337 339 340 341 342 343 344 346
## 1 1 3 2 1 3 3 2 2 3 1 2 3 2 3 1 2 1
## 347 348 349 350 353 354 355 356 359 360 362 363 365 366 367 370 371 372
## 2 2 1 1 1 1 1 1 1 2 2 1 3 2 3 3 1 2
## 373 374 376 378 379 380 381 382 383 384 386 387 388 389 390 391 393 395
## 3 1 2 3 1 2 2 1 1 1 3 3 2 1 1 2 1 2
## 396 397 399 400 401 402 403 404 405 407 410 411 412 415 416 418 420 421
## 2 2 1 1 2 1 2 2 2 2 1 1 3 2 3 2 1 3
## 423 424 426 427 428 429 430 432 433 434 436 437 438 440 441 442 443 445
## 2 2 3 1 3 2 1 3 2 2 1 1 1 3 3 3 1 3
## 446 447 448 449 450 452 453 454 456 458 459 461 464 465 466 467 468 469
## 2 1 3 3 1 2 2 1 2 2 1 1 2 1 2 3 1 3
## 472 473 474 475 476 477 478 479 481 483 484 485 486 489 490 491 493 495
## 2 3 3 3 2 3 1 1 2 3 2 2 1 2 1 2 3 3
## 496 497 499 500 501 502 505 506 507 509 510 511 513 515 516 517 518 519
## 2 2 3 1 2 2 1 2 1 3 2 2 2 3 3 2 2 1
## 522 524 525 526 527 528 530 531 535 536 537 538 539 540 542 543 544 545
## 2 2 3 2 1 3 2 1 1 3 1 1 1 3 1 1 3 3
## 546 547 548 549 550 555 556 558 559 560 561 562 563 565 566 567 568 570
## 3 3 2 3 1 3 2 1 2 1 3 3 2 1 3 3 1 1
## 571 573 574 575 577 578 579 580 583 584 585 587 588 589 591 593 596 597
## 1 3 1 3 2 1 2 3 3 3 3 3 1 1 2 3 1 1
## 598 599 600 601 602 603 605 609 610 611 612 613 614 616 617 618 619 620
## 1 3 3 1 3 2 2 2 2 1 1 1 1 2 3 1 3 1
## 622 623 625 626 627 628 629 632 633 634 636 637 639 640 641 642 644 645
## 2 2 1 3 1 1 3 3 3 3 1 3 1 3 1 1 1 3
## 648 649 650 651 652 655 656 657 660 661 662 663 665 666 667 668 669 670
## 2 1 1 1 2 1 1 1 1 1 1 3 3 1 3 1 1 1
## 672 674 675 677 678 679 680 681 682 683 684 685 687 688 689 690 691 692
## 3 1 2 1 3 2 3 3 1 2 3 2 2 3 1 1 1 1
## 693 695 696 698 699 700 702 703 704 705 707 708 710 715 717 719 721 722
## 2 1 1 3 2 1 3 2 1 1 2 1 2 1 1 3 2 1
## 723 724 727 728 729 730 731 733 734 736 737 738 739 740 742 743 746 749
## 1 3 1 2 1 2 3 2 1 3 2 2 2 3 3 1 3 2
## 750 751 752 753 754 755 756 757 758 759 763 764 765 767 768 769 770 771
## 2 1 1 1 2 2 1 2 1 3 1 3 2 1 3 1 3 1
## 772 773 774 776 778 779 781 782 783 784 786 787 788 789 790 791 795 796
## 1 2 1 3 2 3 1 1 1 3 1 3 1 2 3 3 1 1
## 798 799 800 801 803 804 805 806 807 808 811 812 813 814 815 816 817 818
## 1 2 1 1 1 2 3 1 3 2 1 2 1 3 1 1 1 1
## 819 820 821 823 825 828 829 830 832 833 835 836 837 838 839 840 841 842
## 2 3 2 1 2 2 1 1 2 2 2 2 2 2 1 1 1 3
## 843 844 845 846 847 849 850
## 1 1 1 1 2 1 3
## Objective function:
## build swap
## 4.376560 4.259651
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call" "data"Para que nos salga los mismos resultados ponemos una semilla de ‘111’, luego especificamos la cantidad de clusters con ‘pam’ y se especifica que ‘metric’ (metrica) sea ‘manhattan’.(en nuestro caso la cantidad óptima de cluster es 3)
#Diagrama de dispersión
fviz_cluster(object = pam_cluster, data = cliente1_scale,geom = "point",
ellipse.type = "t",repel = TRUE)+
theme_bw() +
labs(title = "RESULTADOS ALGORITMO PAM")
Para la mejor visualización del algoritmo PAM se aplicó un diagrama de dispersión donde mustra los 3 grupos(clusters).
##APLICAMOS EL ALGORITMO CLARA
# Diagrama de dispersión
clara_cluster<-clara(cliente1,2)
fviz_cluster(clara_cluster,stand = T,geom = "point",pointsize = 1)+
theme_bw() +
labs(title = "RESULTADOS ALGORITMO CLARA")
Para aplicar CLARA solamente aplicamos el codigo que se mostró porque anteriormente ya hicimos el análisis respectivo. Aparte de lo mencionado CLARA es similar PAM, pues CLARA se define el punto centro de los clusters mientras que en PAM lo hace aleatorio.
##APLICAMOS EL ALGORITMO DIANA
matriz_diana <- diana(cliente1_scale)
#Gráfica de DIANA
pltree(matriz_diana, cex = 0.6, hang = -1, main = "Dendrograma de DIANA")
Para aplicar este algoritmo se aplica la matriz DIANA (ahi se utiliza la varible cliente1_scale). Despues se grafica el algoritmo con el código ‘pltree’. Aparte de ello, tambien cabe mencionar que el dendrograma se nota es una forma de graficar el algoritmo, pero tambien se puede visualizar mejor con un diagrama de dispersión.
#Diagrama de dispersiÓn
cluster <- cutree(matriz_diana, k = 3)
library(factoextra)
fviz_cluster(list(data = cliente1_scale, cluster = cluster)) +
labs(title = "RESULTADOS ALGORITMO DIANA")
Como se mencionó anteriormente el diagrama de dispersión es para que se visualice mejor el agrupamiento de datos.