leer datos de pruba
setwd('C:/Users/facu/Google Drive/Tesis Lic/Bibliografia no citable/Curso de R')
Datos <- read.table('BD_PRUEBA_SIMPLE.csv',header = TRUE,sep = ",",dec = '.')
str(Datos)## 'data.frame': 300 obs. of 24 variables:
## $ EDAD : int 56 54 24 20 59 19 36 52 19 18 ...
## $ GENERO : Factor w/ 2 levels "F","M": 2 1 2 2 1 1 1 1 1 1 ...
## $ TABAQUISMO : Factor w/ 2 levels "NO","SI": 1 2 2 1 1 2 1 2 2 1 ...
## $ ALCOHOLISMO : Factor w/ 2 levels "NO","SI": 2 2 1 1 1 2 1 1 1 2 ...
## $ PERIODONTITIS : Factor w/ 2 levels "CONTROLADA","NO CONTROLADA": 1 1 2 1 1 1 2 2 1 2 ...
## $ RIESGO_PERIODONTAL: Factor w/ 3 levels "ALTO","BAJO",..: 1 2 2 2 3 3 3 1 1 2 ...
## $ INGESTA_MED : Factor w/ 2 levels "NO","SI": 2 1 1 1 1 1 2 1 1 2 ...
## $ MATERIAL : Factor w/ 2 levels "TITANIO 4","ZIRCONIO": 1 2 2 1 1 2 1 1 2 1 ...
## $ MARCA : Factor w/ 7 levels "ASTRATECH","DIOHORIZONS",..: 7 3 2 3 3 6 1 2 7 3 ...
## $ DISENO : Factor w/ 2 levels "CILINDRICO","CONICO": 2 1 1 2 1 1 2 2 1 1 ...
## $ LONGITUD : int 10 11 8 11 11 11 8 13 13 5 ...
## $ DIAMETRO : int 3 4 3 3 3 3 4 3 3 3 ...
## $ CONEXION : Factor w/ 2 levels "HEXAGONO EXTERNO",..: 1 1 1 2 2 2 2 2 2 1 ...
## $ PROCEDENCIA : Factor w/ 2 levels "IMPORTADO","NACIONAL": 1 2 2 1 2 1 2 1 1 2 ...
## $ TRAT_SUP : Factor w/ 4 levels "ARENOSO","LASER",..: 4 2 2 2 4 1 4 3 4 1 ...
## $ PROTOCOLO_CARGA : Factor w/ 3 levels "INMEDIATO","TARDIO",..: 2 2 1 3 2 1 3 1 3 3 ...
## $ EXODONCIA : Factor w/ 2 levels "NO","SI": 2 1 2 2 1 1 2 1 1 1 ...
## $ EXPANSION_OSEA : Factor w/ 2 levels "NO","SI": 1 1 1 1 1 2 2 1 1 2 ...
## $ ELEV_SENO_MAXILAR : Factor w/ 2 levels "NO","SI": 1 2 1 1 1 2 2 2 2 2 ...
## $ REG_TEJIDO_DURO : Factor w/ 2 levels "NO","SI": 1 1 1 1 2 2 2 2 2 2 ...
## $ REG_TEJIDO_BLANDO : Factor w/ 2 levels "NO","SI": 1 1 1 2 1 2 2 1 2 2 ...
## $ TIEMPO_COLOC : Factor w/ 3 levels "INMEDIATO","TARDIO",..: 1 3 3 2 3 2 2 1 2 2 ...
## $ TIPO_HUESO : Factor w/ 4 levels "TIPO I","TIPO II",..: 1 1 3 2 3 4 2 4 2 1 ...
## $ INDIC_PROTESICA : Factor w/ 4 levels "PIEZA UNITARIA",..: 1 3 3 4 2 1 2 1 3 4 ...Clustering para variables cualitativas la funcion dayse de la biblioteca cluster permite calcular la amtriz de distancia en tablas cuyas variables estan mezcalda entres variables cualitativas y cuantitativas
library(cluster)
D<-daisy(Datos,metric = "gower")hago hclust
jer<-hclust(D,method="complete")
plot(jer,hang = -1)
rect.hclust(jer,k=4,border = "red")
Interpretacion de los datos cualitativos
library(rattle)## Warning: package 'rattle' was built under R version 3.4.2## Rattle: A free graphical interface for data science with R.
## Versión 5.1.0 Copyright (c) 2006-2017 Togaware Pty Ltd.
## Escriba 'rattle()' para agitar, sacudir y rotar sus datos.str(Datos)## 'data.frame': 300 obs. of 24 variables:
## $ EDAD : int 56 54 24 20 59 19 36 52 19 18 ...
## $ GENERO : Factor w/ 2 levels "F","M": 2 1 2 2 1 1 1 1 1 1 ...
## $ TABAQUISMO : Factor w/ 2 levels "NO","SI": 1 2 2 1 1 2 1 2 2 1 ...
## $ ALCOHOLISMO : Factor w/ 2 levels "NO","SI": 2 2 1 1 1 2 1 1 1 2 ...
## $ PERIODONTITIS : Factor w/ 2 levels "CONTROLADA","NO CONTROLADA": 1 1 2 1 1 1 2 2 1 2 ...
## $ RIESGO_PERIODONTAL: Factor w/ 3 levels "ALTO","BAJO",..: 1 2 2 2 3 3 3 1 1 2 ...
## $ INGESTA_MED : Factor w/ 2 levels "NO","SI": 2 1 1 1 1 1 2 1 1 2 ...
## $ MATERIAL : Factor w/ 2 levels "TITANIO 4","ZIRCONIO": 1 2 2 1 1 2 1 1 2 1 ...
## $ MARCA : Factor w/ 7 levels "ASTRATECH","DIOHORIZONS",..: 7 3 2 3 3 6 1 2 7 3 ...
## $ DISENO : Factor w/ 2 levels "CILINDRICO","CONICO": 2 1 1 2 1 1 2 2 1 1 ...
## $ LONGITUD : int 10 11 8 11 11 11 8 13 13 5 ...
## $ DIAMETRO : int 3 4 3 3 3 3 4 3 3 3 ...
## $ CONEXION : Factor w/ 2 levels "HEXAGONO EXTERNO",..: 1 1 1 2 2 2 2 2 2 1 ...
## $ PROCEDENCIA : Factor w/ 2 levels "IMPORTADO","NACIONAL": 1 2 2 1 2 1 2 1 1 2 ...
## $ TRAT_SUP : Factor w/ 4 levels "ARENOSO","LASER",..: 4 2 2 2 4 1 4 3 4 1 ...
## $ PROTOCOLO_CARGA : Factor w/ 3 levels "INMEDIATO","TARDIO",..: 2 2 1 3 2 1 3 1 3 3 ...
## $ EXODONCIA : Factor w/ 2 levels "NO","SI": 2 1 2 2 1 1 2 1 1 1 ...
## $ EXPANSION_OSEA : Factor w/ 2 levels "NO","SI": 1 1 1 1 1 2 2 1 1 2 ...
## $ ELEV_SENO_MAXILAR : Factor w/ 2 levels "NO","SI": 1 2 1 1 1 2 2 2 2 2 ...
## $ REG_TEJIDO_DURO : Factor w/ 2 levels "NO","SI": 1 1 1 1 2 2 2 2 2 2 ...
## $ REG_TEJIDO_BLANDO : Factor w/ 2 levels "NO","SI": 1 1 1 2 1 2 2 1 2 2 ...
## $ TIEMPO_COLOC : Factor w/ 3 levels "INMEDIATO","TARDIO",..: 1 3 3 2 3 2 2 1 2 2 ...
## $ TIPO_HUESO : Factor w/ 4 levels "TIPO I","TIPO II",..: 1 1 3 2 3 4 2 4 2 1 ...
## $ INDIC_PROTESICA : Factor w/ 4 levels "PIEZA UNITARIA",..: 1 3 3 4 2 1 2 1 3 4 ...Voy a quitar los datos cualitativos
centros <- centers.hclust(Datos[,-c(2,3,4,5,6,7,8,9,10,13,14,15,16,17,18,19,20,21,22,23,24)],jer,nclust = 4,use.median = FALSE)
centros## EDAD LONGITUD DIAMETRO
## [1,] 43.42593 9.481481 12.29630
## [2,] 48.43704 10.000000 15.11852
## [3,] 47.05714 9.857143 21.78571
## [4,] 44.24390 8.317073 22.41463Analisammos lo datos cualitativos
row.names(centros)<-c("Cluster 1" ,"Cluster 2" ,"Cluster 3","Cluster 4")
centros <- as.data.frame(centros)
maximos <- apply(centros,2,max)
minimos <- apply(centros,2,min)
centros <- rbind(maximos,centros)
centros <-rbind(minimos,centros)
centros## EDAD LONGITUD DIAMETRO
## 1 43.42593 8.317073 12.29630
## 11 48.43704 10.000000 22.41463
## Cluster 1 43.42593 9.481481 12.29630
## Cluster 2 48.43704 10.000000 15.11852
## Cluster 3 47.05714 9.857143 21.78571
## Cluster 4 44.24390 8.317073 22.41463library(fmsb)
radarchart(centros,maxmin = TRUE, axistype = 4, axislabcol = "slategray4",
centerzero = FALSE,seg = 8,cglcol = "gray67",
pcol = c("black","red","green","blue"),
plty = 1,
plwd = 5,
title = "comparacion de clusteres"
)
legenda <- legend(1.5,1,legend = c("Cluster 1","Cluster2","Cluster 3","Cluster 4"),
seg.len=1.4,
title = "clusteres",
pch=21,
bty = "n",lwd = 3, y.intersp = 1,horiz = FALSE,
col=c("black","red","green","blue"))
Interpretar las cualitativas aparte
plot(Datos$ALCOHOLISMO, col= c(4,6),las=2, main = " Variable Alcoholismo", xlab= "todos los datos")
vamos a separar las variables por cluster
grupo <- cutree(jer,k=4)
Ndatos <- cbind(Datos,grupo)
cluster <- Ndatos$grupo
sel.cluster1 <- match(cluster,1,0)
sel.cluster1[1:10]## [1] 1 0 0 0 0 0 1 1 0 1Datos.Cluster1<- Ndatos[sel.cluster1>0,]
dim(Datos.Cluster1)## [1] 54 25Calculamos la Cantidad de Individuos por Cluster
sel.cluster2 <- match(cluster,2,0)
Datos.Cluster2<- Ndatos[sel.cluster2>0,]
dim(Datos.Cluster2)## [1] 135 25sel.cluster3 <- match(cluster,3,0)
Datos.Cluster3<- Ndatos[sel.cluster3>0,]
dim(Datos.Cluster3)## [1] 70 25sel.cluster4 <- match(cluster,4,0)
Datos.Cluster4<- Ndatos[sel.cluster4>0,]
dim(Datos.Cluster4)## [1] 41 25vamos a plotear las variables por cluster para analizarlas individualmente
plot(Datos.Cluster1$ALCOHOLISMO, col= c(4,6),las=2, main = " Variable Alcoholismo", xlab= "Cluster 1")
plot(Datos.Cluster1$TABAQUISMO, col= c(4,6),las=2, main = " Variable Tabaquismo", xlab= "Cluster 1")
plot(Datos.Cluster1$PERIODONTITIS, col= c(4,6),las=2, main = " Variable Peritonitis", xlab= "Cluster 1")
plot(Datos.Cluster1$RIESGO_PERIODONTAL, col= c(4,6),las=2, main = " Variable Peritonitis", xlab= "Cluster 1")
cluster 2
plot(Datos.Cluster2$ALCOHOLISMO, col= c(4,6),las=2, main = " Variable Alcoholismo", xlab= "Cluster 2")
Acp Mediante un escalamiento multidimensional con datos cualitativos y cuantitativos mexclados.
str(Datos)## 'data.frame': 300 obs. of 24 variables:
## $ EDAD : int 56 54 24 20 59 19 36 52 19 18 ...
## $ GENERO : Factor w/ 2 levels "F","M": 2 1 2 2 1 1 1 1 1 1 ...
## $ TABAQUISMO : Factor w/ 2 levels "NO","SI": 1 2 2 1 1 2 1 2 2 1 ...
## $ ALCOHOLISMO : Factor w/ 2 levels "NO","SI": 2 2 1 1 1 2 1 1 1 2 ...
## $ PERIODONTITIS : Factor w/ 2 levels "CONTROLADA","NO CONTROLADA": 1 1 2 1 1 1 2 2 1 2 ...
## $ RIESGO_PERIODONTAL: Factor w/ 3 levels "ALTO","BAJO",..: 1 2 2 2 3 3 3 1 1 2 ...
## $ INGESTA_MED : Factor w/ 2 levels "NO","SI": 2 1 1 1 1 1 2 1 1 2 ...
## $ MATERIAL : Factor w/ 2 levels "TITANIO 4","ZIRCONIO": 1 2 2 1 1 2 1 1 2 1 ...
## $ MARCA : Factor w/ 7 levels "ASTRATECH","DIOHORIZONS",..: 7 3 2 3 3 6 1 2 7 3 ...
## $ DISENO : Factor w/ 2 levels "CILINDRICO","CONICO": 2 1 1 2 1 1 2 2 1 1 ...
## $ LONGITUD : int 10 11 8 11 11 11 8 13 13 5 ...
## $ DIAMETRO : int 3 4 3 3 3 3 4 3 3 3 ...
## $ CONEXION : Factor w/ 2 levels "HEXAGONO EXTERNO",..: 1 1 1 2 2 2 2 2 2 1 ...
## $ PROCEDENCIA : Factor w/ 2 levels "IMPORTADO","NACIONAL": 1 2 2 1 2 1 2 1 1 2 ...
## $ TRAT_SUP : Factor w/ 4 levels "ARENOSO","LASER",..: 4 2 2 2 4 1 4 3 4 1 ...
## $ PROTOCOLO_CARGA : Factor w/ 3 levels "INMEDIATO","TARDIO",..: 2 2 1 3 2 1 3 1 3 3 ...
## $ EXODONCIA : Factor w/ 2 levels "NO","SI": 2 1 2 2 1 1 2 1 1 1 ...
## $ EXPANSION_OSEA : Factor w/ 2 levels "NO","SI": 1 1 1 1 1 2 2 1 1 2 ...
## $ ELEV_SENO_MAXILAR : Factor w/ 2 levels "NO","SI": 1 2 1 1 1 2 2 2 2 2 ...
## $ REG_TEJIDO_DURO : Factor w/ 2 levels "NO","SI": 1 1 1 1 2 2 2 2 2 2 ...
## $ REG_TEJIDO_BLANDO : Factor w/ 2 levels "NO","SI": 1 1 1 2 1 2 2 1 2 2 ...
## $ TIEMPO_COLOC : Factor w/ 3 levels "INMEDIATO","TARDIO",..: 1 3 3 2 3 2 2 1 2 2 ...
## $ TIPO_HUESO : Factor w/ 4 levels "TIPO I","TIPO II",..: 1 1 3 2 3 4 2 4 2 1 ...
## $ INDIC_PROTESICA : Factor w/ 4 levels "PIEZA UNITARIA",..: 1 3 3 4 2 1 2 1 3 4 ...calculo la matriz de distancia con daisy usando metrica gower por que son datos mixtos
D<-daisy(Datos,metric = "gower")ahora hago multidimensional scaling
res<- cmdscale(D,eig = TRUE,k=5)# K ES EL NUMERO DE COMPONENTES
#PLOTEAR LA SOLUCION
x<- res$points[,1]
y<- res$points[,2]
plot(x,y,xlab = "Componente 1", ylab = "Componente 2", main = "MDS", type = "n")
text(x, y, labels = row.names(Datos),cex=.7)
Opcion 2 Acp Usando Variables Dummy
library(dummies)## dummies-1.5.6 provided by Decision Patterns datos.new <- dummy.data.frame(Datos, sep = ".")
names(datos.new)## [1] "EDAD"
## [2] "GENERO.F"
## [3] "GENERO.M"
## [4] "TABAQUISMO.NO"
## [5] "TABAQUISMO.SI"
## [6] "ALCOHOLISMO.NO"
## [7] "ALCOHOLISMO.SI"
## [8] "PERIODONTITIS.CONTROLADA"
## [9] "PERIODONTITIS.NO CONTROLADA"
## [10] "RIESGO_PERIODONTAL.ALTO"
## [11] "RIESGO_PERIODONTAL.BAJO"
## [12] "RIESGO_PERIODONTAL.MEDIO"
## [13] "INGESTA_MED.NO"
## [14] "INGESTA_MED.SI"
## [15] "MATERIAL.TITANIO 4"
## [16] "MATERIAL.ZIRCONIO"
## [17] "MARCA.ASTRATECH"
## [18] "MARCA.DIOHORIZONS"
## [19] "MARCA.FIA"
## [20] "MARCA.NEODENT"
## [21] "MARCA.ROSTER DENT"
## [22] "MARCA.STRAUMANN"
## [23] "MARCA.TREE-OSS"
## [24] "DISENO.CILINDRICO"
## [25] "DISENO.CONICO"
## [26] "LONGITUD"
## [27] "DIAMETRO"
## [28] "CONEXION.HEXAGONO EXTERNO"
## [29] "CONEXION.HEXAGONO INTERNO"
## [30] "PROCEDENCIA.IMPORTADO"
## [31] "PROCEDENCIA.NACIONAL"
## [32] "TRAT_SUP.ARENOSO"
## [33] "TRAT_SUP.LASER"
## [34] "TRAT_SUP.LISO"
## [35] "TRAT_SUP.RUGOSO"
## [36] "PROTOCOLO_CARGA.INMEDIATO"
## [37] "PROTOCOLO_CARGA.TARDIO"
## [38] "PROTOCOLO_CARGA.TEMPRANO"
## [39] "EXODONCIA.NO"
## [40] "EXODONCIA.SI"
## [41] "EXPANSION_OSEA.NO"
## [42] "EXPANSION_OSEA.SI"
## [43] "ELEV_SENO_MAXILAR.NO"
## [44] "ELEV_SENO_MAXILAR.SI"
## [45] "REG_TEJIDO_DURO.NO"
## [46] "REG_TEJIDO_DURO.SI"
## [47] "REG_TEJIDO_BLANDO.NO"
## [48] "REG_TEJIDO_BLANDO.SI"
## [49] "TIEMPO_COLOC.INMEDIATO"
## [50] "TIEMPO_COLOC.TARDIO"
## [51] "TIEMPO_COLOC.TEMPRANO"
## [52] "TIPO_HUESO.TIPO I"
## [53] "TIPO_HUESO.TIPO II"
## [54] "TIPO_HUESO.TIPO III"
## [55] "TIPO_HUESO.TIPO IV"
## [56] "INDIC_PROTESICA.PIEZA UNITARIA"
## [57] "INDIC_PROTESICA.PROTESIS COMPLETA FIJA"
## [58] "INDIC_PROTESICA.PROTESIS COMPLETA REMOVIBLE"
## [59] "INDIC_PROTESICA.PUENTE"#hago un cap con las varyables dummy
suppressMessages(suppressWarnings(library(FactoMineR)))
# npc cantidad de componentes, centrar y reducir con scale.unit,
res <- PCA(datos.new,scale.unit = TRUE,ncp=5,graph = FALSE)
# ploteo ejes 1, 2 choix grafico el plano de los individuos color de los individuos en rojo new plot en true para borrar graficos
plot(res,axes = c(1,2), choix="ind",col.ind="red", new.plot=TRUE)
plot(res,axes = c(1,2), choix="var",col.ind="red", new.plot=TRUE)
establecemos el cos2 mayo o igual que dos para eliminar los infividuos mal representados y visualizar mejor los graficos
plot(res,axes = c(1,2), choix="ind",col.ind="red", new.plot=TRUE,select = "cos2 0.2")
Hacemos lo mismo para las varibles
plot(res,axes = c(1,2), choix="var",col.ind="red", new.plot=TRUE,select = "cos2 0.25")
Hacemos clusterin jerarquico sobre las componentes principales con el algoritmo completo
modelo <- hclust(dist(datos.new),method = "complete")
plot(modelo)
Alinemos y pedimos que nos marque 2 cluster
plot(modelo,hang = -1)
#la siguente instruccion separa los cluster en 3
rect.hclust(modelo,k=2,border = "red")
Hacemos lo mismo pero cambiamos el algoritmo a ward.d2
modelo <- hclust(dist(datos.new),method = "ward.D2")
plot(modelo,hang = -1)
#la siguente instruccion separa los cluster en 3
rect.hclust(modelo,k=2,border = "red")
Hacemos un analisis de improtancia de comoponentes principales entre 2 y 200 cluster asi el algoritmo eligira la mejor opcion de cluster
res <- PCA(datos.new,scale.unit = TRUE,ncp=3,graph = FALSE)
# nb.clust -1
#min y max para indicar la cant de cluster
res.hcpc <- HCPC(res, nb.clust = -1, consol = TRUE,min = 2, max = 200, graph = TRUE)
plot.HCPC(res.hcpc,choice = "bar")
plot.HCPC(res.hcpc,choice = "map",select="cos2 0.2")
plot.HCPC(res.hcpc, choice = "3D.map", angle=60)
library(rattle)
#vamos a calcular los centros de graveda de cada cluster
centros <- centers.hclust(datos.new,modelo,nclust = 2,use.median = FALSE)Hacemos 2 graficos uno con todas las variables y otro quitando als cuantitativas que estane n otra escala para poder apreciar las cualitativas a parte de cada cluster
Analisis para el cluster 1
row.names(centros)<-c("Cluster 1" ,"Cluster 2")
centros2<-centros[,-1:-27:-28]## Warning in -1:-27:-28: numerical expression has 27 elements: only the first
## usedbarplot(centros2[1,],col = c(2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40),las=2)
barplot(centros[1,],col = c(2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40),las=2)
Analisis para el cluster 2
row.names(centros)<-c("Cluster 1" ,"Cluster 2")
centros2<-centros[,-1:-27:-28]## Warning in -1:-27:-28: numerical expression has 27 elements: only the first
## usedbarplot(centros2[2,],col = c(2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,29,30,31,32,33,34,35,36,37,38,39,40),las=2)
barplot(centros[2,],col = c(2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,29,30,31,32,33,34,35,36,37,38,39,40),las=2)