SOM
Domingues Facundo
26 de noviembre de 2017
R Markdown
traigo los datos
setwd("C:/Users/fdominguez/Google Drive/Tesis Lic/Bibliografia no citable/Curso de R")
datos<-read.csv("BD_PRUEBA_SIMPLE.csv",sep=",",dec = ".",header = T)
summary(datos)## EDAD GENERO TABAQUISMO ALCOHOLISMO PERIODONTITIS
## Min. :18.00 F:155 NO:146 NO:146 CONTROLADA :161
## 1st Qu.:31.00 M:145 SI:154 SI:154 NO CONTROLADA:139
## Median :46.00
## Mean :46.64
## 3rd Qu.:62.00
## Max. :80.00
##
## RIESGO_PERIODONTAL INGESTA_MED MATERIAL MARCA
## ALTO : 96 NO:156 TITANIO 4:134 ASTRATECH :52
## BAJO :110 SI:144 ZIRCONIO :166 DIOHORIZONS:33
## MEDIO: 94 FIA :44
## NEODENT :49
## ROSTER DENT:48
## STRAUMANN :36
## TREE-OSS :38
## DISENO LONGITUD DIAMETRO CONEXION
## CILINDRICO:153 Min. : 5.000 Min. : 3.00 HEXAGONO EXTERNO:133
## CONICO :147 1st Qu.: 8.000 1st Qu.: 3.00 HEXAGONO INTERNO:167
## Median :11.000 Median : 4.00
## Mean : 9.643 Mean :17.16
## 3rd Qu.:11.000 3rd Qu.:25.00
## Max. :13.000 Max. :75.00
##
## PROCEDENCIA TRAT_SUP PROTOCOLO_CARGA EXODONCIA EXPANSION_OSEA
## IMPORTADO:140 ARENOSO:65 INMEDIATO:107 NO:170 NO:147
## NACIONAL :160 LASER :70 TARDIO : 91 SI:130 SI:153
## LISO :82 TEMPRANO :102
## RUGOSO :83
##
##
##
## ELEV_SENO_MAXILAR REG_TEJIDO_DURO REG_TEJIDO_BLANDO TIEMPO_COLOC
## NO:159 NO:157 NO:159 INMEDIATO:119
## SI:141 SI:143 SI:141 TARDIO : 94
## TEMPRANO : 87
##
##
##
##
## TIPO_HUESO INDIC_PROTESICA
## TIPO I :74 PIEZA UNITARIA :82
## TIPO II :76 PROTESIS COMPLETA FIJA :66
## TIPO III:65 PROTESIS COMPLETA REMOVIBLE:76
## TIPO IV :85 PUENTE :76
##
##
## muestra <- sample(1:200,75)
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]
head(taprendizaje)## EDAD GENERO TABAQUISMO ALCOHOLISMO PERIODONTITIS RIESGO_PERIODONTAL
## 1 56 M NO SI CONTROLADA ALTO
## 3 24 M SI NO NO CONTROLADA BAJO
## 4 20 M NO NO CONTROLADA BAJO
## 5 59 F NO NO CONTROLADA MEDIO
## 6 19 F SI SI CONTROLADA MEDIO
## 7 36 F NO NO NO CONTROLADA MEDIO
## INGESTA_MED MATERIAL MARCA DISENO LONGITUD DIAMETRO
## 1 SI TITANIO 4 TREE-OSS CONICO 10 3
## 3 NO ZIRCONIO DIOHORIZONS CILINDRICO 8 3
## 4 NO TITANIO 4 FIA CONICO 11 3
## 5 NO TITANIO 4 FIA CILINDRICO 11 3
## 6 NO ZIRCONIO STRAUMANN CILINDRICO 11 3
## 7 SI TITANIO 4 ASTRATECH CONICO 8 4
## CONEXION PROCEDENCIA TRAT_SUP PROTOCOLO_CARGA EXODONCIA
## 1 HEXAGONO EXTERNO IMPORTADO RUGOSO TARDIO SI
## 3 HEXAGONO EXTERNO NACIONAL LASER INMEDIATO SI
## 4 HEXAGONO INTERNO IMPORTADO LASER TEMPRANO SI
## 5 HEXAGONO INTERNO NACIONAL RUGOSO TARDIO NO
## 6 HEXAGONO INTERNO IMPORTADO ARENOSO INMEDIATO NO
## 7 HEXAGONO INTERNO NACIONAL RUGOSO TEMPRANO SI
## EXPANSION_OSEA ELEV_SENO_MAXILAR REG_TEJIDO_DURO REG_TEJIDO_BLANDO
## 1 NO NO NO NO
## 3 NO NO NO NO
## 4 NO NO NO SI
## 5 NO NO SI NO
## 6 SI SI SI SI
## 7 SI SI SI SI
## TIEMPO_COLOC TIPO_HUESO INDIC_PROTESICA
## 1 INMEDIATO TIPO I PIEZA UNITARIA
## 3 TEMPRANO TIPO III PROTESIS COMPLETA REMOVIBLE
## 4 TARDIO TIPO II PUENTE
## 5 TEMPRANO TIPO III PROTESIS COMPLETA FIJA
## 6 TARDIO TIPO IV PIEZA UNITARIA
## 7 TARDIO TIPO II PROTESIS COMPLETA FIJAAntes de crear un SOM, debemos elegir las variables en las que queremos buscar patrones
colnames(datos)## [1] "EDAD" "GENERO" "TABAQUISMO"
## [4] "ALCOHOLISMO" "PERIODONTITIS" "RIESGO_PERIODONTAL"
## [7] "INGESTA_MED" "MATERIAL" "MARCA"
## [10] "DISENO" "LONGITUD" "DIAMETRO"
## [13] "CONEXION" "PROCEDENCIA" "TRAT_SUP"
## [16] "PROTOCOLO_CARGA" "EXODONCIA" "EXPANSION_OSEA"
## [19] "ELEV_SENO_MAXILAR" "REG_TEJIDO_DURO" "REG_TEJIDO_BLANDO"
## [22] "TIEMPO_COLOC" "TIPO_HUESO" "INDIC_PROTESICA"Comenzaremos con algunos ejemplos simples usando intentos de disparo:
# Load the kohonen package
library(kohonen)## Warning: package 'kohonen' was built under R version 3.4.2datos.measures1 <- c("EDAD", "DIAMETRO", "LONGITUD")
datos.SOM1 <- som(scale(datos[datos.measures1]), grid = somgrid(6, 4, "rectangular"))
plot(datos.SOM1)
Tenga en cuenta que escalamos y centramos nuestros datos de entrenamiento, y definimos el tamaño y la disposición de la cuadrícula. La trama estándar de Kohonen SOM crea estas representaciones circulares de los vectores representativos para las celdas de la cuadrícula, donde el radio de una cuña corresponde a la magnitud en una dimensión particular. Algunos patrones comienzan a surgir.
Mapa de calor SOM Recuerde que lo anterior es solo un mapa de los datos del jugador: cada celda muestra su vector representativo. Podríamos identificar jugadores con celdas en el mapa asignando a cada jugador a la celda con el vector representativo más cercano a la línea estadística de ese jugador. El tipo SOM de “conteo” hace exactamente esto, y crea un mapa de calor basado en la cantidad de jugadores asignados a cada celda. Solo por diversión, invertimos el orden de la paleta predefinida heat.colorspara que el rojo represente las celdas de la cuadrícula con un mayor número de jugadores representados.
# reverse color ramp
colors <- function(n, alpha = 1) {
rev(heat.colors(n, alpha))
}
plot(datos.SOM1, type = "counts", palette.name = colors, heatkey = TRUE)
Puntos de trazado De forma alternativa, podría trazar los jugadores como puntos en la cuadrícula utilizando el tipo SOM “mapeo”. Lo hacemos codo a codo con el SOM normal para comenzar a hacer comparaciones visuales.
par(mfrow = c(1, 2))
plot(datos.SOM1, type = "mapping", pchs = 20, main = "Mapping Type SOM")
plot(datos.SOM1, main = "Default SOM Plot")
El vector representativo de cada celda de mapa se muestra a la derecha. A la izquierda, los jugadores se trazan en este mapa en función de qué tan cerca están sus líneas estadísticas de estos vectores representativos. Tenga en cuenta que cada uno de estos ejemplos toma un typeparámetro diferente para la función de trazado de Kohonen. Si desea personalizar estos gráficos, por ejemplo, trazando puntos en una cuadrícula que muestre alguna otra medida de su SOM como fondo, tendrá que profundizar en algunas de las propiedades de los objetos SOM. Lo haremos en una próxima publicación sobre minería de textos y SOM.
Toroidal SOMs El siguiente ejemplo no es otro typede la gráfica de SOM, sino una forma de cambiar la geometría de cualquiera de los tipos de gráfica. Cuando entrenamos el SOM para los ejemplos anteriores, utilizamos una cuadrícula rectangular. Como las celdas en los bordes, y particularmente en las esquinas, tienen menos vecinos que las celdas interiores, los valores más extremos tienden a empujarse hacia los bordes. En nuestro primer ejemplo, el máximo en cada una de las tres estadísticas que miramos cayó en una esquina separada. Alternativamente, podemos usar una topología toroidal para nuestro mapa, básicamente reglas de pac-man, donde los bordes superiores e inferiores son adyacentes.
datos.SOM2 <- som(scale(datos[datos.measures1]), grid = somgrid(6, 6, "hexagonal"))
par(mfrow = c(1, 2))
plot(datos.SOM2, type = "mapping", pchs = 20, main = "Mapping Type SOM")
plot(datos.SOM2, main = "Default SOM Plot")
Distancia de mapeo Cuando graficamos type = “dist.neighbours”, las celdas se colorean dependiendo de la distancia total a sus vecinos más cercanos, lo que nos permite visualizar qué tan separadas están las diferentes características en el espacio dimensional superior.
plot(datos.SOM2, type = "dist.neighbours", palette.name = terrain.colors)
Puedes pensar en esta pantalla con una analogía topográfica. Las celdas con mayores distancias a sus vecinos son como los picos de las montañas: el área de superficie deformada significa que las distancias en la superficie son mayores. Exploraremos más esta idea en una publicación de seguimiento a esta, donde intentaremos visualizar la distancia entre las obras de Shakespeare en función de su uso de la palabr
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 jugadores:
colnames(datos)## [1] "EDAD" "GENERO" "TABAQUISMO"
## [4] "ALCOHOLISMO" "PERIODONTITIS" "RIESGO_PERIODONTAL"
## [7] "INGESTA_MED" "MATERIAL" "MARCA"
## [10] "DISENO" "LONGITUD" "DIAMETRO"
## [13] "CONEXION" "PROCEDENCIA" "TRAT_SUP"
## [16] "PROTOCOLO_CARGA" "EXODONCIA" "EXPANSION_OSEA"
## [19] "ELEV_SENO_MAXILAR" "REG_TEJIDO_DURO" "REG_TEJIDO_BLANDO"
## [22] "TIEMPO_COLOC" "TIPO_HUESO" "INDIC_PROTESICA"datos.measures2 <- c("EDAD", "DIAMETRO", "LONGITUD")La función xyf () Utilizaremos la xyf()función para crear un SOM supervisado y clasificación de jugadores según su posición en la cancha. Al azar dividiremos nuestros datos en conjuntos de entrenamiento y prueba.
training_indices <- sample(nrow(datos), 150)
datos.training <- scale(datos[training_indices, datos.measures1])
datos.testing <- scale(datos[-training_indices, datos.measures1])
summary(datos.testing)## EDAD DIAMETRO LONGITUD
## Min. :-1.60937 Min. :-0.5768 Min. :-1.91150
## 1st Qu.:-0.90611 1st Qu.:-0.5768 1st Qu.:-0.71181
## Median : 0.02679 Median :-0.5356 Median : 0.08798
## Mean : 0.00000 Mean : 0.0000 Mean : 0.00000
## 3rd Qu.: 0.78746 3rd Qu.: 0.3292 3rd Qu.: 0.48787
## Max. : 1.95000 Max. : 2.3881 Max. : 1.28766Tenga 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.
datos.SOM3 <- xyf(datos.training, classvec2classmat(datos$GENERO[training_indices]),
grid = somgrid(6, 6, "hexagonal"), rlen = 100)
summary(datos.SOM3)## SOM of size 6x6 with a hexagonal topology and a bubble neighbourhood function.
## Training data included of 150 objects
## The number of layers is 2
## Mean distance to the closest unit in the map: 0.02121081Tenga en cuenta el xweightparámetro para xyf(). Esto le permite ponderar el conjunto de variables de entrenamiento ( NBA.training) frente a la variable de predicción ( NBA$Pos) en el algoritmo de entrenamiento. Ahora veamos la precisión de la predicción:
#gen.prediction <- predict(datos.SOM3, newdata = datos.testing)
#table(datos[-training_indices, "GENERO"], gen.prediction$prediction)