Caso de estudio de predicción de seguro médico ~ sueldo utilizando K-means
Se analizará la relación entre estas dos para probar la siguiente hipótesis: las personas más adineradas tienen seguro médico dado que pueden costearlo. Además, se utilizará k-means para determinar si es posible predecir si una persona tiene o no tiene seguro médico utilizando como dato de entrada cuanto gana.
Algoritmo K-Means:
K-means es un algoritmo de clasificación no supervisada (clusterización) que agrupa objetos en k grupos basándose en sus características. El agrupamiento se realiza minimizando la suma de distancias entre cada objeto y el centroide de su grupo o cluster. Se suele usar la distancia cuadrática. El algoritmo consta de tres pasos:
Inicialización: una vez escogido el número de grupos, k, se establecen k centroides en el espacio de los datos, por ejemplo, escogiéndolos aleatoriamente.
Asignación objetos a los centroides: cada objeto de los datos es asignado a su centroide más cercano.
Actualización centroides: se actualiza la posición del centroide de cada grupo tomando como nuevo centroide la posición del promedio de los objetos pertenecientes a dicho grupo.
Datos
library(pacman)
p_load("ggplot2","DT","xfun","prettydoc","cluster","ISLR","xfun","DT")
datos <- Wage
head(Wage)## year age maritl race education region
## 231655 2006 18 1. Never Married 1. White 1. < HS Grad 2. Middle Atlantic
## 86582 2004 24 1. Never Married 1. White 4. College Grad 2. Middle Atlantic
## 161300 2003 45 2. Married 1. White 3. Some College 2. Middle Atlantic
## 155159 2003 43 2. Married 3. Asian 4. College Grad 2. Middle Atlantic
## 11443 2005 50 4. Divorced 1. White 2. HS Grad 2. Middle Atlantic
## 376662 2008 54 2. Married 1. White 4. College Grad 2. Middle Atlantic
## jobclass health health_ins logwage wage
## 231655 1. Industrial 1. <=Good 2. No 4.318063 75.04315
## 86582 2. Information 2. >=Very Good 2. No 4.255273 70.47602
## 161300 1. Industrial 1. <=Good 1. Yes 4.875061 130.98218
## 155159 2. Information 2. >=Very Good 1. Yes 5.041393 154.68529
## 11443 2. Information 1. <=Good 1. Yes 4.318063 75.04315
## 376662 2. Information 2. >=Very Good 1. Yes 4.845098 127.11574datatable(datos)Primer grafica coloreando las respuestas (si seguro médico, no seguro médico).
ggplot(datos, aes(age, wage)) + geom_point(aes (col=health_ins), size=2)
La siguiente gráfica representa la distribución de los datos, según el sueldo y la edad. Se puede observar cómo la mayoría sí cuenta con seguro médico, estos datos se encuentran principalmente en el segundo sector de la gráfica, mientras que la mayoría de las personas que no cuentan con seguro médico, se encuentran en el primer sector (con un sueldo menor). Sin embargo, estos datos se encuentran muy cercanos entre sí, por lo tanto, no están bien agrupados.
Modelo K-means:
set.seed(101)
wageCluster <- kmeans(datos[,11], center=2, nstart=20 )
wageCluster## K-means clustering with 2 clusters of sizes 847, 2153
##
## Cluster means:
## [,1]
## 1 160.86502
## 2 92.36329
##
## Clustering vector:
## [1] 2 2 1 1 2 1 1 2 2 1 2 2 2 1 1 2 2 1 1 2 1 2 2 1 2 1 2 2 2 2 1 2 2 2 2 2 2
## [38] 2 2 2 2 2 2 2 2 1 1 1 2 2 1 2 1 2 2 2 1 1 2 2 1 2 2 2 2 2 1 1 2 2 2 2 2 2
## [75] 2 2 1 2 2 2 1 2 2 2 2 2 2 2 1 1 1 2 2 2 2 2 2 1 1 1 2 2 2 2 2 2 2 2 1 2 2
## [112] 2 2 2 2 2 2 1 1 2 2 2 1 1 2 2 1 2 2 2 2 1 1 2 1 2 2 2 2 2 2 2 2 2 2 2 1 1
## [149] 1 2 2 1 2 2 1 1 2 1 2 2 2 2 2 2 1 1 2 2 2 1 2 2 1 1 1 2 1 2 1 2 1 2 2 2 1
## [186] 2 2 2 2 2 1 2 2 2 1 1 2 1 2 2 2 1 2 2 2 2 1 1 1 2 1 2 1 2 2 2 1 2 2 2 2 2
## [223] 2 1 2 2 2 2 1 2 2 2 2 1 2 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 1
## [260] 2 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 1 2 2 2 2 1 2 2 2
## [297] 2 2 1 2 2 2 2 2 1 1 2 2 2 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 1 1 2
## [334] 2 1 2 2 2 2 2 1 2 2 2 1 2 2 1 1 1 1 1 2 2 1 2 2 2 2 2 2 1 1 2 2 2 2 2 1 1
## [371] 2 2 1 1 2 1 2 2 2 2 1 1 1 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 1
## [408] 2 2 1 1 2 2 2 1 2 2 2 1 2 2 2 1 1 1 1 2 2 2 1 2 2 1 2 2 2 2 2 1 2 2 2 1 2
## [445] 2 2 2 1 1 1 2 1 2 2 2 1 2 1 1 1 2 2 2 1 2 2 2 2 2 1 2 2 2 2 1 2 2 2 2 1 2
## [482] 1 2 2 2 2 2 2 2 1 2 2 2 2 2 2 1 2 2 2 2 2 1 1 2 1 2 2 2 2 2 1 2 2 2 1 2 1
## [519] 2 1 2 1 1 2 2 1 1 1 2 2 2 2 2 1 2 1 2 2 2 2 2 2 1 2 1 2 2 2 2 2 2 2 1 1 2
## [556] 2 2 2 2 2 2 2 2 1 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 1 1 2 2 2 2
## [593] 2 2 2 2 2 2 1 2 2 2 1 1 1 2 2 2 1 2 2 2 1 2 2 2 2 2 2 1 1 2 2 2 1 2 2 1 1
## [630] 1 2 1 1 2 2 1 2 2 2 1 2 2 1 2 2 1 2 2 2 2 1 2 1 2 1 2 2 1 2 2 2 2 2 2 2 2
## [667] 1 2 1 2 1 2 1 2 2 2 2 2 2 1 1 2 1 2 2 2 1 2 1 2 2 1 2 1 2 2 2 1 1 2 2 2 1
## [704] 2 1 1 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 2 1 2 1 1 1 1 1 2 2 2 2 1
## [741] 2 2 2 2 2 2 1 2 1 2 2 1 2 2 2 2 1 1 2 2 1 2 2 2 2 2 2 1 1 1 2 2 2 1 2 2 2
## [778] 2 1 2 1 2 1 2 1 2 2 1 1 1 2 1 1 2 2 2 1 1 2 1 2 1 2 1 2 2 1 2 2 1 2 2 2 2
## [815] 2 2 2 1 2 1 2 2 2 2 2 2 2 2 1 1 1 1 1 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 2 1 2
## [852] 2 2 2 2 1 2 1 2 2 2 1 1 1 2 2 1 1 2 1 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2
## [889] 2 2 2 2 1 2 2 2 2 2 1 2 2 1 1 2 2 2 1 1 2 2 2 1 2 2 1 2 1 2 2 2 1 2 2 2 2
## [926] 1 2 2 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 1 2 1 1 2 2 2 1 1 2 1 2 1 1 2 2 2 2 1
## [963] 2 2 2 1 2 1 1 2 2 1 2 2 2 2 1 1 2 2 2 1 1 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2
## [1000] 1 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 2 2 2 2 1 2 2 2 2 1 2 2 1 2 2 2 2 2 2
## [1037] 1 2 2 1 2 2 2 2 2 1 2 1 2 1 2 2 2 2 2 1 2 2 2 1 1 2 2 2 2 2 2 2 2 2 2 2 2
## [1074] 2 2 2 2 1 2 2 1 2 1 2 1 2 2 2 2 2 2 2 2 2 2 2 1 2 2 1 2 1 2 2 2 2 1 2 2 2
## [1111] 2 1 1 2 2 2 2 2 1 2 2 1 2 1 2 2 2 1 2 1 2 2 2 2 2 2 2 2 1 2 2 1 2 2 2 2 2
## [1148] 2 1 2 2 2 1 2 2 2 2 2 2 2 2 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 2 2 1 2
## [1185] 1 1 2 1 2 1 2 1 1 2 2 1 2 1 1 1 1 2 2 2 1 2 2 2 2 2 1 2 1 2 1 2 2 2 2 1 1
## [1222] 2 1 2 2 1 1 2 2 1 2 2 2 1 2 2 2 2 1 1 2 2 2 2 2 2 2 1 2 2 1 1 2 2 2 2 1 2
## [1259] 2 1 2 2 2 2 2 1 2 2 1 2 2 1 2 1 2 1 2 1 2 2 2 1 1 1 2 2 2 1 1 2 2 2 2 1 2
## [1296] 2 1 2 2 2 1 2 2 1 2 1 2 1 2 1 2 2 1 2 1 2 2 2 2 2 2 2 2 2 2 1 1 2 2 2 2 1
## [1333] 2 2 2 2 1 2 2 2 2 2 1 1 2 1 2 2 2 2 1 2 1 2 2 1 2 2 2 1 2 2 2 2 1 2 2 2 2
## [1370] 2 1 1 2 2 1 2 2 1 2 1 2 2 2 2 2 1 2 1 2 2 2 1 2 2 2 2 2 2 2 1 1 2 2 2 2 2
## [1407] 2 2 2 1 1 2 1 2 2 2 2 2 1 2 1 2 1 2 2 2 2 1 2 2 2 2 2 2 2 1 2 2 2 2 2 1 2
## [1444] 2 2 2 2 2 2 2 1 1 1 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 1 2 1 1 2 2 2 2
## [1481] 1 1 2 1 1 1 2 1 2 2 2 2 2 2 2 2 1 1 2 1 2 2 2 2 2 1 1 1 2 2 2 1 1 1 2 1 2
## [1518] 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 1 2 2 2 1 1
## [1555] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 1 2 1 1 2 2 1 2 1 2 2 2 2
## [1592] 2 2 2 2 2 2 2 2 2 2 1 2 2 1 2 1 1 2 2 2 2 2 2 2 2 1 1 2 2 1 2 2 2 2 2 2 2
## [1629] 2 2 2 2 1 2 2 1 1 1 2 2 2 2 1 2 2 2 2 2 1 2 2 1 1 2 1 2 2 2 2 2 2 1 2 2 2
## [1666] 2 2 1 2 1 2 2 2 1 2 2 2 1 1 2 1 2 2 2 2 1 1 2 2 2 2 1 2 1 2 2 1 1 2 2 2 1
## [1703] 2 1 1 2 2 2 2 2 2 1 1 2 1 2 1 2 2 2 1 2 2 1 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2
## [1740] 2 2 1 2 1 2 2 2 1 2 2 2 2 1 1 1 1 2 2 2 2 2 2 2 1 2 2 2 2 1 2 2 2 2 2 1 2
## [1777] 1 2 2 2 1 2 2 2 2 2 1 2 2 2 2 2 2 2 1 1 2 2 2 2 2 2 2 2 2 2 1 1 2 1 2 2 2
## [1814] 2 1 2 2 2 2 2 2 2 1 2 1 2 2 1 1 2 2 2 2 1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2
## [1851] 2 2 2 2 2 2 2 1 1 2 2 2 2 1 1 2 2 2 2 1 1 2 1 1 1 2 2 2 2 2 1 2 1 2 1 2 2
## [1888] 2 2 2 2 1 2 2 2 1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1
## [1925] 2 2 2 2 1 1 1 2 2 2 1 2 2 2 2 2 2 2 2 1 2 1 1 2 1 2 2 2 2 1 2 2 1 2 2 2 1
## [1962] 2 1 2 2 2 2 2 2 1 1 2 1 2 2 2 2 1 1 1 1 2 2 2 1 2 2 2 2 1 2 1 2 1 2 1 2 1
## [1999] 2 1 2 2 2 1 2 1 1 2 2 1 2 2 2 2 2 2 1 2 1 1 2 2 2 2 2 2 1 2 2 1 2 1 2 2 2
## [2036] 2 1 1 2 1 2 1 2 2 2 2 2 2 2 2 2 2 1 1 2 1 2 2 1 2 1 2 1 2 1 2 2 2 1 1 2 2
## [2073] 2 2 2 1 2 2 2 2 2 2 2 2 1 1 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 1 1 2 2 2 2 1 1
## [2110] 2 1 2 2 2 1 1 1 2 2 2 1 2 2 2 1 2 2 2 2 2 2 2 1 2 2 2 2 1 2 2 2 2 1 2 2 2
## [2147] 1 2 1 2 2 1 2 2 2 1 2 1 2 1 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 2 2 2 2 1 2 1 1
## [2184] 2 1 2 2 1 2 2 1 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 1 2
## [2221] 2 1 2 1 2 2 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 1 2 2
## [2258] 1 2 2 2 1 2 2 1 2 2 2 2 1 2 1 1 2 2 2 2 2 1 2 1 1 2 1 2 2 1 2 1 2 1 2 2 2
## [2295] 2 2 2 2 2 1 2 2 2 1 2 2 2 1 2 1 1 1 2 2 1 2 2 2 1 1 2 2 2 2 1 2 2 2 2 2 2
## [2332] 1 1 2 1 2 1 2 2 1 2 2 2 2 2 2 2 2 1 2 2 1 1 2 1 2 2 1 2 2 2 1 2 2 2 1 2 2
## [2369] 1 1 2 1 2 2 2 1 1 2 2 2 2 1 1 2 1 2 1 2 1 1 2 2 2 2 2 2 1 2 1 2 2 2 2 1 2
## [2406] 2 2 2 2 2 2 2 2 2 2 2 1 2 2 1 2 2 2 2 2 1 1 2 2 2 2 2 2 1 2 2 1 2 1 2 2 2
## [2443] 2 1 1 1 2 2 2 1 1 1 2 2 2 2 2 1 2 2 1 1 2 2 2 2 1 2 2 2 2 1 1 2 2 1 1 1 2
## [2480] 2 2 1 2 2 2 2 2 1 2 2 2 2 1 2 2 2 2 1 2 2 1 2 2 2 2 1 1 2 2 2 2 2 2 2 2 2
## [2517] 2 2 1 2 1 2 2 1 2 2 2 2 2 2 2 1 1 2 2 1 2 2 2 2 2 2 2 1 2 2 1 1 2 2 2 2 2
## [2554] 2 1 2 1 1 2 2 2 1 1 2 1 1 2 2 1 2 2 2 1 2 2 2 2 2 2 2 1 2 1 1 2 2 2 1 1 2
## [2591] 2 2 2 2 2 1 2 2 2 2 2 2 1 1 1 2 1 1 2 2 1 2 2 2 2 1 2 1 2 2 1 2 2 2 1 2 2
## [2628] 2 2 1 1 2 1 2 2 2 2 2 2 2 1 2 1 2 1 2 1 1 2 1 2 2 2 2 2 2 1 2 2 2 1 2 1 1
## [2665] 2 2 2 1 1 1 2 2 2 2 2 1 2 2 2 2 1 2 2 2 2 1 1 2 2 1 1 2 1 2 1 2 1 1 2 2 1
## [2702] 2 1 2 1 1 2 2 2 1 2 2 1 2 2 1 2 2 2 1 2 2 1 1 2 1 1 1 1 2 2 2 1 1 2 2 2 2
## [2739] 2 2 2 1 1 2 2 2 2 2 1 2 2 2 1 1 2 2 2 2 2 1 2 2 2 2 2 2 2 2 1 2 2 2 2 1 1
## [2776] 2 1 2 2 1 2 2 1 2 1 2 2 2 2 1 2 2 2 2 1 2 1 2 2 1 2 1 2 1 1 1 2 2 1 2 2 2
## [2813] 2 2 1 2 2 2 2 1 1 1 2 2 2 2 1 2 2 1 1 1 1 1 1 2 1 2 2 2 1 1 1 2 2 2 1 2 2
## [2850] 1 2 2 2 2 2 2 1 1 1 2 2 2 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 1 1 2 1 2 1 2 2 2
## [2887] 2 2 1 1 2 2 2 1 2 2 2 2 2 1 2 1 2 1 2 2 2 2 2 1 2 1 2 2 2 2 1 2 2 2 1 2 2
## [2924] 2 1 1 2 2 1 2 2 2 2 2 2 1 2 1 2 2 2 2 2 2 2 2 2 2 1 2 2 1 2 2 2 2 2 2 2 2
## [2961] 2 2 2 2 2 2 2 2 2 2 1 1 2 1 2 2 2 2 2 1 2 2 1 2 2 2 1 1 2 1 1 2 2 2 1 1 2
## [2998] 2 2 2
##
## Within cluster sum of squares by cluster:
## [1] 1484428.2 885265.4
## (between_SS / total_SS = 54.6 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"Construyendo el modelo K-Means que nos permita agrupar objetos según sus características.
table(wageCluster$cluster,datos$health_ins)##
## 1. Yes 2. No
## 1 729 118
## 2 1354 799Comparando los clusters con los datos originales, se observa como no existe ninguna agrupación en específico, ya que los datos están muy juntos, por lo que se mezclan.
clusplot(Wage[,c(9,11)], wageCluster$cluster, color=T, shade=T, lines=0, main ="CLUSPLOT (WAGE)")
La anterior gráfica representa los clusters agrupados. Se puede observar como los datos se encuentran distribuidos entre ambos, lo que provoca que no exista una agrupación clara, debido a que no se puede distinguir cuales datos pertenecen a cada cluster.
tot.withinss <- vector(mode="character", length=10)
for ( i in 1:3){
wageCluster <- kmeans(datos[,11], center=i, nstart=20 )
tot.withinss[i] <- wageCluster$tot.withinss
}Graficación del codo obtenido
plot(1:10, tot.withinss, type="b", pch=19)
El método codo nos ayuda a buscar el valor K óptimo de conglomerados. Para esto, debemos de seleccionar el valor donde, a partir de ese punto, la gráfica comienza a disminuir de forma lineal. Por lo tanto, para los datos dados, concluimos que el número óptimo es 2.
Conclusión.
Para finalizar, después de analizar nuestros resultados, hemos concluido que la hipótesis se cumple con valores de sueldos muy altos, sin embargo, existen algunas personas con un sueldo alto que no cuentan con seguro médico. Para la gran mayoría de datos, k-means no funciona correctamente, ya que no es un modelo muy claro. Esto debido a que la gran mayoría de los datos, se encuentran muy juntos (ya que comparten la misma característica), lo que provoca que no exista una agrupación muy clara y que los datos se encuentren muy dispersos entre sí, de esta manera, sería muy complicado poder predecir si una persona tiene o no tiene seguro médico, utilizando la entrada de cuánto gana.