Control 3
Bulnes, Lastra, Paredes, Gutierrez
22/06/2021
Control 3 - Lastra
P.1 Cargue todos los paquetes que necesita para trabajar con data.table, modelos de predicción de regresión, árboles de decisión, cluster y Cross-Validation. Además, cargue la base de datos.
rm(list=ls())
library(data.table)
library(margins)
library(caret)
library(ggplot2)
library(rpart)
library(rpart.plot)
library(factoextra)
library(dbscan)
base <- fread("C:/Users/Esteban/Desktop/UAI/1 Sem 2021/Data Science/Controles/Control 3/DATOS CONTROL 3.csv")P.2 Realice dos modelos de regresión lineal multiple para predecir la Presión arterial en reposo ¿Cuál predice mejor dentro de muestra?. (8 puntos)
Observación: No obtendrá puntaje si compara un modelo de regresión de una variable.
Primera regresión: Buscamos predecir la Presión Arterial en reposo a partir de las variables edad, sexo, Colesterol, Frecuencia cardíaca máxima alcanzada y ataque al corazón.
d.reg1 <- formula(trtbps ~age+sex+chol+thalachh+output)
reg_1 <- lm(d.reg1,data=base)
summary(reg_1)##
## Call:
## lm(formula = d.reg1, data = base)
##
## Residuals:
## Min 1Q Median 3Q Max
## -38.991 -11.229 -0.966 10.019 64.248
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 88.52941 11.85669 7.467 9.20e-13 ***
## age 0.54469 0.11973 4.549 7.85e-06 ***
## sex -2.13415 2.23900 -0.953 0.3413
## chol 0.01368 0.01960 0.698 0.4858
## thalachh 0.09610 0.04978 1.931 0.0545 .
## output -5.15991 2.26243 -2.281 0.0233 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 16.76 on 297 degrees of freedom
## Multiple R-squared: 0.1024, Adjusted R-squared: 0.08729
## F-statistic: 6.777 on 5 and 297 DF, p-value: 5.31e-06Al realizar esta regresion notamos que las variables sex chol thalachh output, no son estadisticamente significativas. Por lo que no es conveniente agregarlas al modelo. De hecho si corremos un modelo de regersión solo con la variable significativa (age ) notaremos que el R cuadrado ajustado es más alto, lo que no indica que es mejor excluir las variables estaditicamente no siginificativas .
Para plantear un buen segundo modelo de regresion realice varias regresiones lineales simples para evaluar la significancia estaditica de las variables. En este segundo modelo mejorado quitamos las variables independientes sex chol thalachh output y agregamos fbs, que corresponde a una variable dummy que indica si el azúcar en sangre en ayunas es mayor a 120 mg / dl.
Segunda regresión: Buscamos predecir la Presión Arterial en reposo a partir de las variables age,oldpeak y fbs.
d.reg2 <- formula(trtbps~age+oldpeak+fbs)
reg_2 <- lm(d.reg2,data=base)
summary(reg_2)##
## Call:
## lm(formula = d.reg2, data = base)
##
## Residuals:
## Min 1Q Median 3Q Max
## -35.872 -10.785 -1.239 10.039 63.885
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 104.0149 5.7970 17.943 < 2e-16 ***
## age 0.4463 0.1080 4.131 4.7e-05 ***
## oldpeak 2.1725 0.8389 2.590 0.01008 *
## fbs 7.3200 2.6935 2.718 0.00696 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 16.55 on 299 degrees of freedom
## Multiple R-squared: 0.1187, Adjusted R-squared: 0.1099
## F-statistic: 13.43 on 3 and 299 DF, p-value: 3.029e-08Al realizar esta segunda regresion encontramos que todas las variables incluidas so significativas al 95% . Y también podemos notar que el R cuadrado ajustado es superior al del modelo 1. (0.08729<0.1099). Además si comparamos los R squared de ambos modelos, el r squared del primero es superior al del segundo, lo que nos indica una mayor capacidad predictiva. (0.1024 <0.1187)
Otra forma de ver las capacidades predictivas de nuestros modelos es comparando los RMSE de ambos.
base$fit_lineal1 <- fitted(reg_1,base)
base$fit_lineal2 <- fitted(reg_2,base)
data.table(RMSE=RMSE(base$fit_lineal1,base$trtbps),
MAE=MAE(base$fit_lineal1,base$trtbps))## RMSE MAE
## 1: 16.58848 12.82995data.table(RMSE=RMSE(base$fit_lineal2,base$trtbps),
MAE=MAE(base$fit_lineal2,base$trtbps))## RMSE MAE
## 1: 16.43678 12.86658Podemos notar que el RMSE del segundo modelo es inferior al del primero. De esta manera podemos concluir que el segundo modelo predice de mejor manera de dentro de la muestra.
P.3 Realice validación cruzada (CV) a los modelos de la pregunta anterior por el método K-folds con 5 folds. ¿Se mantienen las conclusiones anteriores?. (8 putos)
Pista1: Recuerde setear la semilla set.seed(12345).
Pista2: Si existen variables con NA recuerde que puede excluirlas esas observaciones del análisis, pero no las elimine.
set.seed(12345)
setupKCV <- trainControl(method = 'cv',number = 5, p=0.7)Primer Modelo
train(d.reg1,data=base,method='lm',trControl=setupKCV)## Linear Regression
##
## 303 samples
## 5 predictor
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 242, 242, 242, 244, 242
## Resampling results:
##
## RMSE Rsquared MAE
## 16.86823 0.08034923 13.03859
##
## Tuning parameter 'intercept' was held constant at a value of TRUESegundo Modelo
train(d.reg2,data=base,method='lm',trControl=setupKCV)## Linear Regression
##
## 303 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 243, 241, 242, 243, 243
## Resampling results:
##
## RMSE Rsquared MAE
## 16.33825 0.1251715 12.9107
##
## Tuning parameter 'intercept' was held constant at a value of TRUEManteneos las conclusiones anteriores pues el RSME del segundo modelo sigue siendo inferior al del primero. De hecho la diferencia incremento.
P.4 Proponga dos variables sobre las cuales segmentar la muestra, en orden de hacer análisis de clusters con el método de kmeans. Muestre sus resultados gráficamente. (5 puntos)
Segmentaremos la muestra en base a las variables age y oldpeak, que seria la edad del inidividuo y el peak anterior.
samp <- base[ age > 30 & trtbps <181 ,.(age,trtbps)]
ggplot(samp) +
geom_point(aes(x=age ,y=trtbps))
cluster <- kmeans(x = samp,centers = 5)
fviz_cluster(cluster,data=samp,geom = "point")
P.5 Realice dos modelos de árboles de clasificación de la variable output. Pruebe cuál modelo clasifica mejor con validación cruzada. Entrene el modelo con un 80% de la muestra y testee con el 20% restante. Explicite qué modelo es mejor y porqué. (12 puntos)
Importante: Recuerde setear la semilla set.seed(12345).
Observación: No obtendrá puntaje si compara un modelo de clasificación de una variable.
Primer Arbol: Usaremos las variables age, sex, cp, restecg y caa
arbol1 <- rpart(output ~ age+sex+cp+restecg+caa,data=base,method = 'class')Segundo Arbol: Usaremos las variables age, thall, thalachh, trtbps
arbol2 <- rpart(output ~ age+thall+thalachh+trtbps,data=base,method = 'class')Entrenamos los modelos y los graficamos
set.seed(12345)
div <- createDataPartition(base$output, times = 1, p = 0.8, list = F)
train <- base[div,]
test <- base[-div,]
arbol1t <- rpart(output ~ age+sex+cp+restecg+caa, data=train, method = "class")
rpart.plot(arbol1t, main = "Modelo 1: Clasificacion ataque cardiaco")
arbol2t <- rpart(output ~ age+thall+thalachh+trtbps, data=train, method = "class")
rpart.plot(arbol2t, main = "Modelo 2: Clasificacion ataque cardiaco")
Finalmente, hacemos las predicciones y evalueamos los modelos
Del primer Modelo
prediccion_1 <- predict(arbol1t, newdata = test, type = "class")
matriz1 <- table(test$output, prediccion_1)
matriz1## prediccion_1
## 0 1
## 0 21 8
## 1 8 23Precisión
sum(diag(matriz1))/sum(matriz1)## [1] 0.7333333Del Segundo Modelo
prediccion_2 <- predict(arbol2t, newdata = test, type = "class")
matriz2 <- table(test$output, prediccion_2)
matriz2## prediccion_2
## 0 1
## 0 16 13
## 1 9 22Precisión
sum(diag(matriz2))/sum(matriz2)## [1] 0.6333333Nos quedamos con el primer modelo, pues tiene una mayor precisión que el segundo. Podemos observar de las matrices que para ambos casos el modelo 1 predice mejor un ataque al corazón.