E3
Jamil Belen Barreto
14/11/2019
#INSERTAR LA BASE DE DATOS BUPA Y VERIFICAR QUE TODOS LOS DATOS SEAN CUANTITATIVOS
bupa=read.csv("https://raw.githubusercontent.com/VictorGuevaraP/Mineria-de-datos-2019-2/master/bupa.txt", sep = ",")
str(bupa)## 'data.frame': 345 obs. of 7 variables:
## $ V1: int 85 85 86 91 87 98 88 88 92 90 ...
## $ V2: int 92 64 54 78 70 55 62 67 54 60 ...
## $ V3: int 45 59 33 34 12 13 20 21 22 25 ...
## $ V4: int 27 32 16 24 28 17 17 11 20 19 ...
## $ V5: int 31 23 54 36 10 17 9 11 7 5 ...
## $ V6: num 0 0 0 0 0 0 0.5 0.5 0.5 0.5 ...
## $ V7: int 1 2 2 2 2 2 1 1 1 1 ...#1. PRUEBA DE CORRELACIONES #Examinando la matriz de correlaciones se puede evidenciar la existencia de #correlaciones significativas
cor(bupa)## V1 V2 V3 V4 V5 V6
## V1 1.00000000 0.04410300 0.14769505 0.1877652 0.2223145 0.31267960
## V2 0.04410300 1.00000000 0.07620761 0.1460565 0.1331404 0.10079606
## V3 0.14769505 0.07620761 1.00000000 0.7396749 0.5034353 0.20684793
## V4 0.18776515 0.14605655 0.73967487 1.0000000 0.5276259 0.27958777
## V5 0.22231449 0.13314040 0.50343525 0.5276259 1.0000000 0.34122396
## V6 0.31267960 0.10079606 0.20684793 0.2795878 0.3412240 1.00000000
## V7 -0.09107012 -0.09805018 -0.03500879 0.1573558 0.1463925 -0.02204853
## V7
## V1 -0.09107012
## V2 -0.09805018
## V3 -0.03500879
## V4 0.15735580
## V5 0.14639252
## V6 -0.02204853
## V7 1.00000000library(VIM)
library(corrplot)
corrplot(cor(bupa))
#Se observa la correlacion de cada campo, es decir cara esfera "azul" indica si presenta o no correlacion asi como las casillas con esferas "rojas" que indican lo contrario
library(PerformanceAnalytics)
chart.Correlation(bupa)
#En el siguiente grafico muestra una situacion similar ya que permite visualizar las correlaciones pero en este caso se indica por las "estrellas rojas"
library(psych)
#PRUEBA GENERAL DE CORRELACIONES
cortest(cor(bupa))## Tests of correlation matrices
## Call:cortest(R1 = cor(bupa))
## Chi Square value 208.01 with df = 21 with probability < 9.6e-33#2. PRUEBA DE BARLERT #Permite probar si existe una intercorrelación significativa entre las variables originales.
#indicas los valores de los componentes y se visualiza el chi cuadrado
cortest.bartlett(cor(bupa), n=345)## $chisq
## [1] 544.8724
##
## $p.value
## [1] 6.004754e-102
##
## $df
## [1] 21cor(bupa)## V1 V2 V3 V4 V5 V6
## V1 1.00000000 0.04410300 0.14769505 0.1877652 0.2223145 0.31267960
## V2 0.04410300 1.00000000 0.07620761 0.1460565 0.1331404 0.10079606
## V3 0.14769505 0.07620761 1.00000000 0.7396749 0.5034353 0.20684793
## V4 0.18776515 0.14605655 0.73967487 1.0000000 0.5276259 0.27958777
## V5 0.22231449 0.13314040 0.50343525 0.5276259 1.0000000 0.34122396
## V6 0.31267960 0.10079606 0.20684793 0.2795878 0.3412240 1.00000000
## V7 -0.09107012 -0.09805018 -0.03500879 0.1573558 0.1463925 -0.02204853
## V7
## V1 -0.09107012
## V2 -0.09805018
## V3 -0.03500879
## V4 0.15735580
## V5 0.14639252
## V6 -0.02204853
## V7 1.00000000#3. PRUEBA kMO
#El ındice de Kaiser-Meyer-Olkin o medida de adecuación muestral KMO tiene el mismo objetivo que el test de Bartlett
library(psych)
#Ddebe tener un numero mayor A 0.50 para ser aprobada
KMO(bupa) ## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = bupa)
## Overall MSA = 0.64
## MSA for each item =
## V1 V2 V3 V4 V5 V6 V7
## 0.70 0.53 0.59 0.63 0.81 0.73 0.23#SEGUN LOS RESULTADOS SE JUSTIFICA LA REALIZACION DEL ACP#Grafico de sedimentacion, tomar en cuenta la cantidad, en este caso es 3 componentes
scree(bupa)
#analisis paralelo
fa.parallel(bupa, fa="pc")
## Parallel analysis suggests that the number of factors = NA and the number of components = 2#parallel analisys suggest that number of factor
#COMPONENTES PRINCIPALES
#se observa el grafico de barra e indica la suma mas factible para agrupar
componentes=prcomp(bupa, scale=TRUE, center = T)
componentes## Standard deviations (1, .., p=7):
## [1] 1.5837765 1.0926330 1.0046350 0.9465752 0.8188865 0.7061828 0.4724823
##
## Rotation (n x k) = (7 x 7):
## PC1 PC2 PC3 PC4 PC5 PC6
## V1 0.26093155 0.4869910 0.49039467 -0.02430417 0.67017404 0.04830950
## V2 0.14769977 0.3252950 -0.66587263 -0.62523056 0.15949171 0.06888411
## V3 0.50668951 -0.1526510 -0.23040936 0.41245134 0.03558136 0.19739104
## V4 0.53762897 -0.2217274 -0.14693268 0.13167289 0.08655906 0.36430265
## V5 0.49239652 -0.1143955 0.03814116 -0.10572417 -0.07449247 -0.84970661
## V6 0.34359042 0.3470071 0.37146594 -0.27134023 -0.69137189 0.25772936
## V7 0.06173834 -0.6716080 0.31938586 -0.57986125 0.18200666 0.18115126
## PC7
## V1 0.04700907
## V2 0.08880155
## V3 0.67566973
## V4 -0.69473462
## V5 -0.06539520
## V6 0.07416000
## V7 0.20234232summary(componentes)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 1.5838 1.0926 1.0046 0.9466 0.8189 0.70618 0.47248
## Proportion of Variance 0.3583 0.1706 0.1442 0.1280 0.0958 0.07124 0.03189
## Cumulative Proportion 0.3583 0.5289 0.6731 0.8011 0.8969 0.96811 1.00000#Se observa las relacions en forma de flecha para cada campo y segun se acoplen
plot(componentes)
componentes$rotation## PC1 PC2 PC3 PC4 PC5 PC6
## V1 0.26093155 0.4869910 0.49039467 -0.02430417 0.67017404 0.04830950
## V2 0.14769977 0.3252950 -0.66587263 -0.62523056 0.15949171 0.06888411
## V3 0.50668951 -0.1526510 -0.23040936 0.41245134 0.03558136 0.19739104
## V4 0.53762897 -0.2217274 -0.14693268 0.13167289 0.08655906 0.36430265
## V5 0.49239652 -0.1143955 0.03814116 -0.10572417 -0.07449247 -0.84970661
## V6 0.34359042 0.3470071 0.37146594 -0.27134023 -0.69137189 0.25772936
## V7 0.06173834 -0.6716080 0.31938586 -0.57986125 0.18200666 0.18115126
## PC7
## V1 0.04700907
## V2 0.08880155
## V3 0.67566973
## V4 -0.69473462
## V5 -0.06539520
## V6 0.07416000
## V7 0.20234232biplot(componentes, scale=1)
#extraemos los componentes
componentes_print=componentes$x
componentes_print=componentes_print[,1:3]
head(componentes_print)## PC1 PC2 PC3
## [1,] -0.1390785 0.11105334 -2.3448572
## [2,] 0.2907050 -1.94038272 -0.9286607
## [3,] -0.8721346 -1.54263788 0.1152322
## [4,] -0.1580974 -0.70132800 -0.3506241
## [5,] -1.1408941 -1.12133672 -0.3251554
## [6,] -1.0901984 0.03114855 1.5875375#exportamos los componentes
write.csv(componentes_print, file="componentes_clientes.csv")
getwd()## [1] "C:/Users/15-cc601/Desktop"#METODO PAM Para realiza el método PAM se tomó como muestra la base de datos “BUPA”, antes de realizar el método se debe verificar que no tenga datos cualitativos pues este solo trabaja con cuantitativos.
datos <- scale(bupa)
#insertaremos las librerías “cluster” para las particiones y “Factoextra” para visualizar el resultado del análisis. Se debe tener en cuenta que nuestras distancias de “bupa” están almacenadas en “datos” y el valor “K” es el numero de cluster que se generaran, en este caso se eligió al azar 8 para poder observar.
library(cluster)
library(factoextra)
fviz_nbclust(x = datos, FUNcluster = pam, method = "wss", k = 10,
diss = dist(datos, method = "manhattan"))
summary(datos)## V1 V2 V3 V4
## Min. :-5.65622 Min. :-2.5545 Min. :-1.3533 Min. :-1.9518
## 1st Qu.:-0.71029 1st Qu.:-0.7014 1st Qu.:-0.5845 1st Qu.:-0.5607
## Median :-0.03584 Median :-0.1564 Median :-0.2258 Median :-0.1633
## Mean : 0.00000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.63861 3rd Qu.: 0.5521 3rd Qu.: 0.1842 3rd Qu.: 0.2341
## Max. : 2.88676 Max. : 3.7133 Max. : 6.3854 Max. : 5.6989
## V5 V6 V7
## Min. :-0.8479 Min. :-1.0351 Min. :-1.1727
## 1st Qu.:-0.5932 1st Qu.:-0.8853 1st Qu.:-1.1727
## Median :-0.3384 Median :-0.1363 Median : 0.8502
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.1966 3rd Qu.: 0.7624 3rd Qu.: 0.8502
## Max. : 6.5907 Max. : 4.9568 Max. : 0.8502#Se observa en el grafico que el valor mas optimo para generar los clusters es de 3 ya que a partir de ese número la línea presenta una desviación hacia adelante
set.seed(111)
#Una vez obtenida definido el número cluster, se inserte un “set.seed(xxx)” eso puede ser opcional ya que solo permite obtener un valor mas exacto, se ejecuta la métrica “manhattan” utilizando el método “PAM” y generando 3 clusters para ser almacenadas en “cluster_pam”
library(cluster)
cluster_pam=pam(datos, 3, metric = "manhattan")
#Finalmente se observa que el Cluster 1 agrupo 132 datos con un 38% , el cluster 2 agrupo 170 con un 49% y el cluster 3 agrupo 43 datos con un 12% de una total de 345 datos.
table(cluster_pam$clustering)##
## 1 2 3
## 132 170 43prop.table(table(cluster_pam$clustering))##
## 1 2 3
## 0.3826087 0.4927536 0.1246377#En este último grafico se podrá visualizar la dispersión de todos los datos en cada cluster diferenciándose por un color diferente, también se observa que hay una intersección entre ambos cluster.
library(factoextra)
fviz_cluster(object = cluster_pam, data = dat, ellipse.type = "convex",
repel = TRUE) +
theme_bw()+
labs(title = "Resultados clustering PAM") +
theme(legend.position= "none")
plot(cluster_pam)
#METODO CLARA Los resultados finales de la agrupación corresponden al conjunto de medoides con el costo mínimo.
#Utilizar la libreria Cluster para generar los grupos
library(cluster)#Utilizar la libreria Cluster para utilizar el comando "factoextra"
library(factoextra)
#Encontrar el numero optimo de cluster
wss=as.numeric()
for (k in 2:10){
agrupa=kmeans(bupa, k)
wss[k-1]=agrupa$tot.withinss
}
plot(2:10, wss, type = "b") 
#Se observa en el grafico que el valor mas optimo para generar los clusters es de 3 ya que a partir de ese número la línea presenta una desviación hacia adelante
#Se utilizara las librerias "ggplot2" y "factoextra" para generar el grafico y cluster respectivamente enfocados en el metodo clara
library(ggplot2)
library(factoextra)
clara_clusters=clara(bupa, k =3, metric ="manhattan", stand = TRUE, samples = 50, pamLike =TRUE)
clara_clusters## Call: clara(x = bupa, k = 3, metric = "manhattan", stand = TRUE, samples = 50, pamLike = TRUE)
## Medoids:
## V1 V2 V3 V4 V5 V6 V7
## [1,] 90 73 34 21 22 2.0 1
## [2,] 90 63 24 24 24 0.5 2
## [3,] 93 84 58 47 62 7.0 2
## Objective function: 5.273574
## Clustering vector: int [1:345] 1 2 2 2 2 2 1 1 1 1 2 1 1 1 1 1 1 1 ...
## Cluster sizes: 131 171 43
## Best sample:
## [1] 18 24 30 37 43 45 60 74 89 97 100 101 110 114 119 120 129
## [18] 135 141 149 152 169 178 179 181 187 195 199 203 220 222 227 230 234
## [35] 250 258 263 266 270 278 284 299 310 314 334 336
##
## Available components:
## [1] "sample" "medoids" "i.med" "clustering" "objective"
## [6] "clusinfo" "diss" "call" "silinfo" "data"#En el grafico finalmente se observa los 3 clusters y el cluster 3 en el de mayor area siendo los otros de menor area
fviz_cluster(object = clara_clusters, ellipse.type ="t", geom="point", pointsize = 2.5) +
theme_bw()+
labs(title= "Resultados clustering CLARA")
theme(legend.position = "none") ## List of 1
## $ legend.position: chr "none"
## - attr(*, "class")= chr [1:2] "theme" "gg"
## - attr(*, "complete")= logi FALSE
## - attr(*, "validate")= logi TRUE