E3 Mineria de Datos
FABRICIO AGUILAR QUISPE
14/11/2019
#MINERIA DE DATOS
Aqui cargamos la data
bupaE3<-read.csv("https://raw.githubusercontent.com/VictorGuevaraP/Mineria-de-datos-2019-2/master/bupa.txt", sep = ",")Damos el comando de encabezado para mostrar variables
head(bupaE3)## V1 V2 V3 V4 V5 V6 V7
## 1 85 92 45 27 31 0 1
## 2 85 64 59 32 23 0 2
## 3 86 54 33 16 54 0 2
## 4 91 78 34 24 36 0 2
## 5 87 70 12 28 10 0 2
## 6 98 55 13 17 17 0 2Eliminamos la columna, de esta manera podremos tener mejor data ya que no es necesaria.
bupaE301=bupaE3[,c(1:5,7)]Aqui se aprecia que la data ya fue cambiada
head(bupaE301)## V1 V2 V3 V4 V5 V7
## 1 85 92 45 27 31 1
## 2 85 64 59 32 23 2
## 3 86 54 33 16 54 2
## 4 91 78 34 24 36 2
## 5 87 70 12 28 10 2
## 6 98 55 13 17 17 2#1° prueba de correlaciones
Usamos este comando para que nos muestre la correlacion que tienen todos contra todos.
cor(bupaE301)## V1 V2 V3 V4 V5 V7
## V1 1.00000000 0.04410300 0.14769505 0.1877652 0.2223145 -0.09107012
## V2 0.04410300 1.00000000 0.07620761 0.1460565 0.1331404 -0.09805018
## V3 0.14769505 0.07620761 1.00000000 0.7396749 0.5034353 -0.03500879
## V4 0.18776515 0.14605655 0.73967487 1.0000000 0.5276259 0.15735580
## V5 0.22231449 0.13314040 0.50343525 0.5276259 1.0000000 0.14639252
## V7 -0.09107012 -0.09805018 -0.03500879 0.1573558 0.1463925 1.00000000Un gráfico lo cual nos muestra, efectivamente la correlación.
library(corrplot)
corrplot(cor(bupaE301))
Aqui se muestra un Gráfico mas general
library(PerformanceAnalytics)
chart.Correlation(bupaE301)
#PRUEBA GENERAL DE CORRELACIONES
Aqui nos muestra la probabilidad que se ha generado
library(psych)
cortest(cor(bupaE301))## Tests of correlation matrices
## Call:cortest(R1 = cor(bupaE301))
## Chi Square value 172.28 with df = 15 with probability < 8.5e-29#2° PRUEBA DE BARTLET
library(rela)
cortest.bartlett(cor(bupaE301), n=345)## $chisq
## [1] 472.7159
##
## $p.value
## [1] 3.30508e-91
##
## $df
## [1] 15#3° Prueba KMO
library(psych)
KMO(bupaE301)## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = bupaE301)
## Overall MSA = 0.61
## MSA for each item =
## V1 V2 V3 V4 V5 V7
## 0.64 0.47 0.59 0.61 0.80 0.24Según los resultados se justifica la realización del PCA #GRÁFICO DE SEDIMENTACIÓN
scree(bupaE301)
Según el gráfico de sedimentación deberia tomarse tres componentes
#Análisis paralelo
fa.parallel(bupaE301, fa="pc")
## Parallel analysis suggests that the number of factors = NA and the number of components = 2#Parallel analysis suggests that the number of factors = NA and the number of components = 2
componentes=prcomp(bupaE301, scale=TRUE, center = T)
componentes## Standard deviations (1, .., p=6):
## [1] 1.5200338 1.0690820 0.9769714 0.9217029 0.7184888 0.4757367
##
## Rotation (n x k) = (6 x 6):
## PC1 PC2 PC3 PC4 PC5 PC6
## V1 0.2327962 0.38854443 0.639934751 -0.5844288 0.1973974 -0.06928156
## V2 0.1511070 0.47588993 -0.754185658 -0.4028910 0.1046041 -0.09293183
## V3 0.5589465 0.01306629 0.017225076 0.4115143 0.2394649 -0.67854547
## V4 0.5826737 -0.10341115 -0.058769387 0.1434114 0.3758114 0.69609097
## V5 0.5136442 -0.08444962 0.001901549 -0.1385104 -0.8415496 0.04054015
## V7 0.0849261 -0.77753821 -0.133915451 -0.5357480 0.2081081 -0.19988410summary(componentes)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 1.5200 1.0691 0.9770 0.9217 0.71849 0.47574
## Proportion of Variance 0.3851 0.1905 0.1591 0.1416 0.08604 0.03772
## Cumulative Proportion 0.3851 0.5756 0.7347 0.8762 0.96228 1.00000plot(componentes)
#Graficamos los componentes
biplot(componentes, scale=1)
#Extraemos los componentes
componentes_prin=componentes$x
componentes_prin=componentes_prin[,1:3]
head(componentes_prin)## PC1 PC2 PC3
## [1,] 0.2718209 1.0364040 -1.496130231
## [2,] 0.7988551 -1.2875680 -0.633315258
## [3,] -0.4966290 -1.3792951 -0.006417727
## [4,] 0.2189788 -0.3628503 -0.320311637
## [5,] -0.7950928 -0.9196490 -0.610975830
## [6,] -0.8595250 -0.2492176 1.653595231#Exportamos los componentes
write.csv(componentes_prin, file = "Componentes_bupa.csv")componentes_prin=as.data.frame(componentes_prin)
corrplot(cor(componentes_prin))
clustering=kmeans(componentes_prin, 3)
clustering## K-means clustering with 3 clusters of sizes 144, 161, 40
##
## Cluster means:
## PC1 PC2 PC3
## 1 -0.3460495 0.9914437 -0.044754205
## 2 -0.5226288 -0.8568780 0.042056296
## 3 3.3493589 -0.1202634 -0.008161452
##
## Clustering vector:
## [1] 1 2 2 2 2 2 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 2 1 1 1 1 1
## [36] 3 2 2 2 2 3 2 1 2 2 2 2 2 2 2 2 2 3 2 2 2 2 2 2 2 2 2 2 2 1 1 2 2 1 2
## [71] 1 1 1 1 1 1 3 2 2 2 1 2 1 2 3 2 2 2 1 1 1 2 1 1 1 1 2 2 2 2 2 2 1 1 1
## [106] 2 1 1 1 1 2 2 2 2 3 2 2 2 2 2 3 2 1 2 2 2 2 2 2 2 1 1 3 3 2 2 2 2 2 2
## [141] 1 1 1 1 1 1 1 3 1 1 3 2 2 2 2 2 3 1 1 2 1 2 2 2 2 2 3 3 3 1 1 1 1 1 3
## [176] 1 2 2 3 2 3 1 3 2 2 3 3 1 3 3 1 1 2 1 1 1 2 1 1 1 1 2 1 1 1 1 1 1 1 1
## [211] 1 2 1 1 1 1 1 1 2 1 2 2 2 2 2 2 2 2 2 2 2 2 3 2 2 2 1 2 2 2 2 2 2 2 1
## [246] 1 1 1 1 2 2 2 2 2 1 1 2 1 1 1 1 1 1 2 2 1 2 1 2 2 2 1 1 1 2 2 2 3 1 2
## [281] 2 2 2 2 2 3 2 2 2 2 2 2 2 2 3 2 2 2 2 3 2 2 2 2 1 2 3 1 1 1 3 3 1 1 1
## [316] 3 3 1 2 1 1 2 3 2 1 1 1 1 1 2 3 1 1 3 1 1 1 1 2 3 1 3 3 1 3
##
## Within cluster sum of squares by cluster:
## [1] 284.8147 268.6883 191.9575
## (between_SS / total_SS = 50.8 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss"
## [5] "tot.withinss" "betweenss" "size" "iter"
## [9] "ifault"plot(componentes_prin$PC1,componentes_prin$PC2, col=clustering$cluster)
library(rgl)
plot3d(x=componentes_prin$PC1,
componentes_prin$PC2,
componentes_prin$PC3, col=clustering$cluster)#ALGORITMO PAM
bupapam <- scale(bupaE301)
library(cluster)
library(factoextra)CON ESTE GRAFICO DE CODO OBSERVAMOS QUE LO OPTIMO SERIA CREAR DOS CLUESTERING, PERO OPTAMOS CREAR 3 PORQUE DE ESTA MANERA GANAMOS UN POCO MAS DE EFICIENCIA.
fviz_nbclust(x = bupaE301, FUNcluster = pam, method = "wss", k.max =15,
diss = dist(bupaE301, method = "manhattan"))
set.seed(111)
pam_clusters <- pam(bupaE301, k = 3, metric = "manhattan")
pam_clusters## Medoids:
## ID V1 V2 V3 V4 V5 V7
## [1,] 4 91 78 34 24 36 2
## [2,] 173 90 62 22 21 21 1
## [3,] 189 93 77 39 37 108 1
## Clustering vector:
## [1] 1 2 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 3 2 2 2 2 2 2 1 1 1 2
## [36] 3 2 2 1 2 1 1 2 2 2 2 2 1 2 1 2 2 3 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 2 2
## [71] 1 1 2 1 2 1 3 1 2 1 1 1 1 2 3 2 2 2 2 2 2 2 1 2 2 2 1 3 2 1 2 2 2 2 2
## [106] 2 1 1 2 1 2 1 2 2 3 2 2 2 2 2 1 2 2 2 1 2 1 3 2 2 2 2 3 3 2 2 2 2 3 2
## [141] 2 2 2 1 2 1 1 3 2 2 3 1 2 2 1 1 3 1 1 2 1 2 2 1 2 2 3 3 1 1 1 1 2 2 3
## [176] 1 1 2 3 2 1 3 1 2 3 1 3 1 3 3 2 2 1 2 2 2 2 1 1 2 2 2 1 1 3 1 2 2 1 2
## [211] 1 2 1 2 2 1 2 1 2 1 1 2 2 2 2 2 1 1 1 1 2 2 3 1 2 2 2 2 2 2 2 2 2 1 2
## [246] 2 2 2 2 3 1 3 2 1 1 2 2 2 2 2 1 2 2 2 1 1 2 1 1 2 2 2 2 2 2 1 3 1 2 1
## [281] 2 2 2 2 2 1 2 2 1 2 1 2 2 3 1 2 2 1 2 3 2 2 2 2 1 1 3 2 2 1 3 3 2 2 2
## [316] 3 3 2 1 1 1 1 3 2 2 2 1 2 1 2 3 1 1 3 1 1 2 1 2 1 1 3 3 2 3
## Objective function:
## build swap
## 45.08696 43.48986
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call" "data"FINALMENTE PODEMOS OBSERVAR LOS 3 CLUESTERING CREADOS POR EL METODO PAM.
fviz_cluster(object = pam_clusters, data = bupaE301) +
theme_bw() +
labs(title = "Resultados Cluestering PAM") +
theme(legend.position = "none")
#ALGORITMO KOHONEN
Aqui repartimos la data
muestra <- sample(1:200,75)
ttesting <- bupaE301[muestra,]
taprendizaje <- bupaE301[-muestra,]
head(taprendizaje)## V1 V2 V3 V4 V5 V7
## 2 85 64 59 32 23 2
## 3 86 54 33 16 54 2
## 4 91 78 34 24 36 2
## 5 87 70 12 28 10 2
## 6 98 55 13 17 17 2
## 7 88 62 20 17 9 1Antes de crear un SOM, debemos elegir las variables con las cuales trabajaremos
colnames(bupaE301)## [1] "V1" "V2" "V3" "V4" "V5" "V7"Comenzaremos con algunos ejemplos simples usando intentos de disparo de esta manera podremos tener resultados con los que se podrán trabajar después.
library(kohonen)bupaE301.measures1 <- c("V1", "V2", "V3")
bupaE301.SOM1 <- som(scale(bupaE301[bupaE301.measures1]), grid = somgrid(6, 4, "rectangular"))
plot(bupaE301.SOM1)
reverse color ramp
colors <- function(n, alpha = 1) {
rev(heat.colors(n, alpha))
}
plot(bupaE301.SOM1, type = "counts", palette.name = colors, heatkey = TRUE)
par(mfrow = c(1, 2))
plot(bupaE301.SOM1, type = "mapping", pchs = 20, main = "Mapping Type SOM")
plot(bupaE301.SOM1, main = "Default SOM Plot")
bupaE301.SOM2 <- som(scale(bupaE301[bupaE301.measures1]), grid = somgrid(6, 6, "hexagonal"))
par(mfrow = c(1, 2))
plot(bupaE301.SOM2, type = "mapping", pchs = 20, main = "Mapping Type SOM")
plot(bupaE301.SOM2, main = "Default SOM Plot")
plot(bupaE301.SOM2, type = "dist.neighbours", palette.name = terrain.colors)
#SOM supervisados El kohonenpaquete también admite SOM supervisados, lo que nos permite hacer clasificaciones. Hasta ahora solo hemos trabajado con el mapeo de datos tridimensionales a dos dimensiones. La utilidad de los SOM se vuelve más evidente cuando trabajamos con datos dimensionales más altos, así que hagamos este ejemplo supervisado con una lista ampliada de estadísticas de bupas:
colnames(bupaE301)## [1] "V1" "V2" "V3" "V4" "V5" "V7"bupaE301.measures1 <- c("V1", "V2", "V3")training_indices <- sample(nrow(bupaE301), 150)
bupaE301.training <- scale(bupaE301[training_indices, bupaE301.measures1])
bupaE301.testing <- scale(bupaE301[-training_indices, bupaE301.measures1])
summary(bupaE301.testing)## V1 V2 V3
## Min. :-2.58592 Min. :-1.8745 Min. :-1.2861
## 1st Qu.:-0.64208 1st Qu.:-0.6568 1st Qu.:-0.5746
## Median :-0.07037 Median :-0.1587 Median :-0.2557
## Mean : 0.00000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.38701 3rd Qu.: 0.4502 3rd Qu.: 0.1369
## Max. : 2.90256 Max. : 3.8264 Max. : 6.1232Tenga en cuenta que cuando cambiamos la escala de nuestros datos de prueba, debemos escalar de acuerdo con la escala de nuestros datos de capacitación.
bupaE301.SOM3 <- xyf(bupaE301.training, classvec2classmat(bupaE301$V1[training_indices]),
grid = somgrid(6, 6, "hexagonal"), rlen = 100)
summary(bupaE301.SOM3)## SOM of size 6x6 with a hexagonal topology and a bubble neighbourhood function.
## The number of data layers is 2.
## Distance measure(s) used: sumofsquares, tanimoto.
## Training data included: 150 objects.
## Mean distance to the closest unit in the map: 0.024.