Caso de estudio de predicción de seguro médico (sueldo) implementando K-means
Para el presente caso de estudio se hará un análisis de relación entre las 2 variables para comprobar la veracidad de la siguiente hipótesis: Las personas que cuentan con seguro médico es porque tienen un sueldo alto. De igual forma, se implementa el K-means para predecir si es posible que una persona, debido a sus ingresos, tenga seguro médico.
Algoritmo K-means
El algoritmo K-means es considerado de clasificación no supervisada, por clusterización, el cual organiza grupos en k grupos al basarse en sus características. Para realizar un agrupamiento se requiere minimizar la suma de distancias entre cada objeto y el centroide de su grupo o cluster respectivo. Generalmente se utiliza la distancia cuadrática. Este algoritmo cuenta con tres pasos:
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)
En la grafica se puede apreciar datos como el sueldo y edad, donde se pueden apreciar quienes tienen seguro medico donde se pueden visualizar dentro de la misma grafica, asi mismo quienes no tienen seguro medico, se puede notar que las personas son las que tienen menor ingresos. Estos datos se encuentran muy agrupados por lo cual no se puede ser tan especificos con los resultados
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"Construimos el modelo K-Means que nos permita agrupar los objetos según sus características.
table(wageCluster$cluster,datos$health_ins)##
## 1. Yes 2. No
## 1 729 118
## 2 1354 799Comparando estos clusters con los datos originales, podemos analizar como no existe ninguna agrupación especifica, 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)")
Esta gráfica representa los clusters ya agrupados. Se puede observar como los datos se encuentran distribuidos entre sí, lo que hace 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)
Este método “codo” nos ayuda a buscar el valor K óptimo de conglomerados. para esto seleccionamos el valor donde la gráfica comienza a disminuir de forma lineal. Por tanto, para estos datos se observa que el número óptimo es 2.
Conclusiones
Conclusión Jorge
Se comprueba que utilizar el modelo k-means nos da una referencia sobre las personas cuentan con seguro médico, pero a su vez este nos muestra una respuesta un tanto imprecisa por la naturaleza del mismo, es por ello que se llega a la conclusión de que para este tipo de casos es difícil dar con asertividad a las personas que cuentan con su seguro médico.
Conclusión grupal.
Concluyendo con la información recopilada anteriormente analizada, concluimos que la hipótesis se cumple con valores de sueldos muy altos, pero, existen individuos con un sueldo alto que no cuentan con seguro médico aunque se lo puedan permitir. Para casi todos los datos que se pueden manejar, k-means no funciona de la manera que nosotros quisieramos, ya que no es un modelo muy preciso. Esto se debe a que la gran mayoría de estos, se encuentran muy juntos, lo que hace que no se visualicen de forma muy clara, sino de una forma más dispersa, por lo que hace que estos datos no sean muy confiables, por tanto resulta dificil determinar si una persona tiene o no seguro médico tomando en cuenta su sueldo.