Laboratorio 2 - Técnicas de minería de datos y aprendizaje automático
John Wilmar Ortiz Villegas - 1940225
2024-05-26
Importar librerias
library (easypackages)
lib_req = c ("visdat","corrplot","plotrix","cluster","factoextra","FactoMineR","HSAUR2","arules","arulesViz","reshape2","ggplot2")
easypackages :: packages (lib_req)Lectura y ajuste del Data Frame
Datos = data.frame (heptathlon)
Datos $ hurdles = max (Datos $ hurdles) - Datos $ hurdles
Datos $ run200m = max (Datos $ run200m) - Datos $ run200m
Datos $ run800m = max (Datos $ run800m) - Datos $ run800m
str (Datos)## 'data.frame': 25 obs. of 8 variables:
## $ hurdles : num 3.73 3.57 3.22 2.81 2.91 2.67 3.04 2.87 2.79 3.17 ...
## $ highjump: num 1.86 1.8 1.83 1.8 1.74 1.83 1.8 1.8 1.83 1.77 ...
## $ shot : num 15.8 16.2 14.2 15.2 14.8 ...
## $ run200m : num 4.05 2.96 3.51 2.69 2.68 1.96 3.02 2.13 1.75 3.02 ...
## $ longjump: num 7.27 6.71 6.68 6.25 6.32 6.33 6.37 6.47 6.11 6.28 ...
## $ javelin : num 45.7 42.6 44.5 42.8 47.5 ...
## $ run800m : num 34.9 37.3 39.2 31.2 35.5 ...
## $ score : int 7291 6897 6858 6540 6540 6411 6351 6297 6252 6252 ...Punto 1: Análisis Exploratorio - Visualización de datos
Datos Atipicos univariados
par(mfrow=c(2,4))
lapply(colnames(Datos),function(y){
boxplot(Datos[,y],ylab=y,cex=1.5,pch=20,col="blue")})
Análisis Bivariado de la correlación
pairs(Datos,pch=20,cex=1.5,lower.panel = NULL)
M.cor = cor(Datos,method="pearson")
p.cor=corrplot::cor.mtest(Datos)$p
corrplot::corrplot(M.cor, method = "ellipse",addCoef.col = "black",type="upper",
col=c("blue","red"),diag=FALSE,
p.mat = p.cor, sig.level = 0.01, insig = "blank")
Análisis Bivariado de la correlación sin considerar el registro atípico Launa
pairs(Datos[-25,],pch=20,cex=1.5,lower.panel = NULL)
M.cor = cor(Datos[-25,],method="pearson")
p.cor=corrplot::cor.mtest(Datos[-25,])$p
corrplot::corrplot(M.cor, method = "ellipse",addCoef.col = "black",type="upper",
col=c("blue","red"),diag=FALSE,
p.mat = p.cor, sig.level = 0.01, insig = "blank")
Punto 2: Reducción de dimensión
a. Identifique cuantas componentes principales retendrá para el análisis
PCA$eig
VP=PCA$eig[,1]; Var= PCA$eig[,2]; Var_acum=PCA$eig[,3]
par(mfrow=c(1,2))
coord=barplot(VP, xlab="Componente",ylab="Valor Propio", ylim=c(0,max(VP)+1))
lines(coord,VP,col="blue",lwd=2)
text(coord,VP,paste(round(Var,2),"%"), pos=3,cex=0.6)
abline(h=1,col="red", lty=2)
coord=barplot(Var_acum, xlab="Componente",ylab="Varianza Acumulada")
lines(coord,Var_acum,col="blue",lwd=2)
text(coord,Var_acum,round(Var_acum,2), pos=3,cex=0.6)
Por medio de este grafico, se puede observar que la eleccion de 3 componentes principales es la adecuada, ya que cuentan con el 86.46% de la Varianza Explicada.
b. Genere una interpretación de contexto para estas componentes
PCA_var=get_pca_var(PCA)
PCA_var$coord[,1:3]; PCA_var$cos2[,1:3]; PCA_var$contrib[,1:3]
corrplot(PCA_var$cos2, is.corr=FALSE)
par(mfrow=c(3,1))
barplot(PCA_var$coord[,1],ylim=c(-0.8,0.8),col=ifelse(PCA_var$coord[,1]>0,"green","red"),
main="Desempeño General")
barplot(PCA_var$coord[,2],ylim=c(-0.8,0.8),col=ifelse(PCA_var$coord[,2]>0,"green","red"),
main="Contraste Potencia Velocidad")
barplot(PCA_var$coord[,3],ylim=c(-0.8,0.8),col=ifelse(PCA_var$coord[,3]>0,"green","red"),
main="Desempeño en Jabalina")
Por medio de estos graficos, se puede generar una interpretacion de las componentes principales, las cuales fueron: Dim.1 = Desempeño General, Dim.2 = Contraste Potencia Velocidad, Dim.3 = Desempeño en Jabalina.
c. Proyecte los individuos en el nuevo plano de los componentes
PCA_ind=get_pca_ind(PCA)
Sector_1 = PCA_ind$coord[,1]
Sector_2 = PCA_ind$coord[,2]
Sector_3 = PCA_ind$coord[,3]
par(mfrow=c(1,3))
dotchart(Sector_1,labels=rownames(X),pch=20,cex.lab=0.5, main= "Dim.1 = Desempeno General",
cex.lab=0.8, cex.main=0.7)
abline(v=0,col="red",lty=2)
dotchart(Sector_2,pch=20,labels=rownames(X), main= "Dim.2 = Contraste Potencia Velocidad",
cex.lab=0.8, cex.main=0.7)
abline(v=0,col="red",lty=2)
dotchart(Sector_3,pch=20,labels=rownames(X), main= "Dim.3 = Desempeno en Jabalina",
cex.lab=0.8, cex.main=0.7)
abline(v=0,col="red",lty=2)
Factores = PCA_ind$coord[, 1:3]
Launa_PNG = predict(PCA,newdata=Datos[25,])$coord[,1:3]
Factores = rbind(Factores, Launa_PNG)
plot(Factores[,1:2],pch=20,xlab="Dim.1 = Desempeno General",ylab="Dim.2 = Contraste Potencia Velocidad")
grid()
abline(h=0,v=0,lty=2, col="red")
text(Factores[,1:2],rownames(Factores),cex=0.8,col="blue",pos=3)
plot(Factores[,2:3],pch=20,xlab="Dim.2 = Contraste Potencia Velocidad",ylab="Dim.3 = Desempeno en Jabalina")
grid()
abline(h=0,v=0,lty=2, col="red")
text(Factores[,2:3],rownames(Factores),cex=0.8,col="blue",pos=3)
plot(Factores[,c(1,3)],pch=20,xlab="Dim.1 = Desempeno General",ylab="Dim.3 = Desempeno en Jabalina")
grid()
abline(h=0,v=0,lty=2, col="red")
text(Factores[,c(1,3)],rownames(Factores),cex=0.8,col="blue",pos=3)
d. Analice la relación entre variables desde el plano de las componentes
fviz_pca_var(PCA,axes=c(1,2), col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE )
fviz_pca_var(PCA,axes=c(1,3), col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
fviz_pca_var(PCA,axes=c(2,3), col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE)
Punto 3: Agrupación – segmentación
a. Determinar el número adecuado/óptimo de grupos
Evaluar_k=function(n_clust,data,iter.max,nstart){
km <- kmeans(x = data, centers = n_clust, nstart = nstart,iter.max=iter.max)
return(km$tot.withinss)
}
k.opt=2:10
Eval_k=sapply(k.opt,Evaluar_k,data=Factores,iter.max=1000,nstart=50)
plot(k.opt,Eval_k,type="l",xlab="Número Cluster",ylab="SSE")
Por medio de este grafico, se puede observar que la eleccion de 4 clusters es la adecuada.
b. Caracterice los grupos conformados. Que tipos de competidoras conforman cada grupo
DatosGrupos = cbind(Datos[, !names(Datos) %in% "score", drop = FALSE], Grupos)
DatosGrupos_Box = DatosGrupos %>% tibble::rownames_to_column ("Nombre")
datos_largos = melt(DatosGrupos_Box, id.vars = c("Nombre", "Grupos"),
measure.vars = c("hurdles", "highjump", "shot", "run200m", "longjump", "javelin", "run800m"),
variable.name = "Variable", value.name = "Valor")
ggplot(datos_largos, aes(x = as.factor(Grupos), y = Valor, fill = as.factor(Grupos))) +
geom_boxplot() +
facet_wrap(~ Variable, scales = "free") +
labs(x = "Grupos", y = "Valores", fill = "Grupos") +
theme_minimal()
Punto 4: Asociación
a. Identificar los itemset frecuentes
inspect(sort(itemset)[1:23])## items support count
## [1] {4} 0.56 14
## [2] {Menores highjump} 0.36 9
## [3] {Mejores shot} 0.36 9
## [4] {Mejores run800m} 0.36 9
## [5] {Mejores run200m} 0.36 9
## [6] {Mejores longjump} 0.36 9
## [7] {Mejores javelin} 0.36 9
## [8] {Mejores hurdles} 0.36 9
## [9] {Mejores highjump} 0.36 9
## [10] {Menores hurdles} 0.32 8
## [11] {Menores run800m} 0.32 8
## [12] {Menores longjump} 0.32 8
## [13] {Menores run200m} 0.32 8
## [14] {Menores shot} 0.32 8
## [15] {Menores javelin} 0.32 8
## [16] {Intermedias run800m} 0.32 8
## [17] {Intermedias shot} 0.32 8
## [18] {Intermedias run200m} 0.32 8
## [19] {Intermedias longjump} 0.32 8
## [20] {Intermedias hurdles} 0.32 8
## [21] {Intermedias javelin} 0.32 8
## [22] {4, Intermedias hurdles} 0.32 8
## [23] {Mejores hurdles, Mejores run200m} 0.32 8Luego de identificar los itemset frecuentes, se procede a hacer una representacion grafica de los 23 itemset mas frecuentes.
L=list()
par(mfrow=c(1,2))
par(oma=c(2,6,1,2))
for (k in 1:2){
h=itemset[size(itemset)==k]
L[[k]]=as(sort(h, by = "support", decreasing = TRUE),Class = "data.frame")
top_20_itemset=as(sort(h, by = "support", decreasing = TRUE)[1:min(23,length(h))]
,Class = "data.frame")
barplot(top_20_itemset$count,horiz=TRUE,xlab="Número de Transacciones",las=1,cex.names = 0.6, cex.main=0.8,
names.arg = top_20_itemset$items,main=paste("Most Frecuent",k,"-itemset"))}
b. Generar las reglas de asociación y visualizarlas
inspect(head(Reglas,5 ,by="confidence"))## lhs rhs support confidence coverage
## [1] {Intermedias hurdles} => {4} 0.32 1.0000000 0.32
## [2] {Mejores run200m} => {Mejores hurdles} 0.32 0.8888889 0.36
## [3] {Mejores hurdles} => {Mejores run200m} 0.32 0.8888889 0.36
## [4] {4} => {Intermedias hurdles} 0.32 0.5714286 0.56
## [5] {} => {4} 0.56 0.5600000 1.00
## lift count
## [1] 1.785714 8
## [2] 2.469136 8
## [3] 2.469136 8
## [4] 1.785714 8
## [5] 1.000000 14Luego de identificar las reglas de asociación, se procede a hacer una visualización de las mismas.
plot(Reglas,measure=c("support","confidence"),shading="lift")
plot(Reglas, measure=c("support","confidence"),shading="order", control=list(main ="Two-key plot"))
plot(head(Reglas,5), method="paracoord", control=list(type="items"))
plot(head(Reglas,5), method="grouped matrix")