Control 3

Control 3 - Edwyn Turner

Pregunta 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.

ac <- fread("DATOS CONTROL 3.csv")

Pregunta 2

Realice dos modelos de regresión lineal multiple para predecir la Presión arterial en reposo ¿Cuál predice mejor dentro de muestra?

g

Regression Linear 1: La primera es a base de la presión arterial en repsoso en relacion a la frecuencia cardiaca maxima alcanzada + la edad + nivel de dolor.

summary(reg1)  

## 
## Call:
## lm(formula = trtbps ~ thalachh + age + cp, data = ac)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -37.135 -11.281  -1.682  10.284  69.015 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 91.61113   11.22293   8.163 9.22e-15 ***
## thalachh     0.04643    0.04830   0.961    0.337    
## age          0.59284    0.11664   5.083 6.57e-07 ***
## cp           0.86241    0.98546   0.875    0.382    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 16.86 on 299 degrees of freedom
## Multiple R-squared:  0.08535,    Adjusted R-squared:  0.07617 
## F-statistic:   9.3 on 3 and 299 DF,  p-value: 6.747e-06

get_regression_table(reg1) %>% kable()

term	estimate	std_error	statistic	p_value	lower_ci	upper_ci
intercept	91.611	11.223	8.163	0.000	69.525	113.697
thalachh	0.046	0.048	0.961	0.337	-0.049	0.141
age	0.593	0.117	5.083	0.000	0.363	0.822
cp	0.862	0.985	0.875	0.382	-1.077	2.802

Regression Linear 2: La segunda es a base de la presión arterial en repsoso en relación a a los resultados electrocardigraficos en reposo + la edad + chol.

summary(reg2)

## 
## Call:
## lm(formula = trtbps ~ restecg + age + chol, data = ac)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -40.269 -11.287  -1.052   9.475  65.432 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 101.10500    7.13630  14.168  < 2e-16 ***
## restecg      -2.51884    1.87061  -1.347    0.179    
## age           0.49917    0.10960   4.555 7.65e-06 ***
## chol          0.01913    0.01930   0.991    0.322    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 16.83 on 299 degrees of freedom
## Multiple R-squared:  0.08779,    Adjusted R-squared:  0.07864 
## F-statistic: 9.592 on 3 and 299 DF,  p-value: 4.581e-06

get_regression_table(reg2) %>% kable()

term	estimate	std_error	statistic	p_value	lower_ci	upper_ci
intercept	101.105	7.136	14.168	0.000	87.061	115.149
restecg	-2.519	1.871	-1.347	0.179	-6.200	1.162
age	0.499	0.110	4.555	0.000	0.283	0.715
chol	0.019	0.019	0.991	0.322	-0.019	0.057

Interpretación

Cual es la mejor regreción para el metodo:

Para estos primeros 2 modelos podemos concluir que la mejor regression es la segunda por las siguentes razones:

Ante un aumento en una unidad de la Frecuencia cardíaca máxima alcanzada vemos que la presion arterial en reposo aumenta en 0,059 mantenitendo la edad constante. Ante un aumento de 1 año de la persona la presión arterial aumenta en 0,599 manteniendo el resto de las variabels constantes. Según los resultados de estimación la variable “pertenecer al sindicato” es estadísticamente significativa, el p-valor asociado para contrastar H0 : βunion = 0 es cerca de cero, es decir, menor de cualquier nivel de significancia α.

Dado esto, y viendo que el Rsquared, nos damos cuenta que el Rsquared de la segunda regression es mayor por un minimo valor que la primera regression por lo que se puede concluir que predice mejor la muestra.

Pregunta 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?

print(predkfolds1) %>% kable()

## Linear Regression 
## 
## 303 samples
##   2 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 242, 242, 242, 244, 242 
## Resampling results:
## 
##   RMSE     Rsquared    MAE     
##   16.8324  0.08340251  12.89862
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

	RMSE	Rsquared	MAE
	16.8324	0.08340251	12.89862

print(predkfolds2) %>% kable()

## Linear Regression 
## 
## 303 samples
##   2 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 243, 241, 242, 243, 243 
## Resampling results:
## 
##   RMSE      Rsquared    MAE     
##   16.67876  0.09043137  12.92614
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

	RMSE	Rsquared	MAE
	16.67876	0.09043137	12.92614

Se mantiene la conclución ya que el RMSE es menor en la segunda regression. En esta ocación nos podemos dar cuenta que el RMSE (16.67876 < 16.8324). Por esto, neuvamente podemos concluir que la segunda regression es mejor, ya que un Error Cuadratico Medio nos entrega mas confianza detras de una prediccion a base de criterios estadisticos.

Pregunta 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.

data_cluster <- ac[,.(age, trtbps)]
ggplot(data_cluster, aes(x = age, y= trtbps)) + 
  geom_point()

k1 <- kmeans(x = data_cluster, centers = 5, nstart = 25)
fviz_cluster(k1, data=data_cluster, geom="point")

kNNdistplot(x=data_cluster,k=3)

k2<-dbscan(x=data_cluster,eps = 5,minPts = 3)

fviz_cluster(k2,data=data_cluster,geom = "point")

Pregunta 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é.

arbol1 <- rpart(output~chol+age+caa, data=ac, method = "class")
rpart.plot(arbol1, main = "Árbol de Clasificación Numero 1: Output")

set.seed(12345)

div <- createDataPartition(ac$output, times = 1, p = 0.8, list = F)

train <- ac[div,] 
test <- ac[-div,]
as.numeric(ac$age)

##   [1] 63 37 41 56 57 57 56 44 52 57 54 48 49 64 58 50 58 66 43 69 59 44 42 61 40
##  [26] 71 59 51 65 53 41 65 44 54 51 46 54 54 65 65 51 48 45 53 39 52 44 47 53 53
##  [51] 51 66 62 44 63 52 48 45 34 57 71 54 52 41 58 35 51 45 44 62 54 51 29 51 43
##  [76] 55 51 59 52 58 41 45 60 52 42 67 68 46 54 58 48 57 52 54 45 53 62 52 43 53
## [101] 42 59 63 42 50 68 69 45 50 50 64 57 64 43 55 37 41 56 46 46 64 59 41 54 39
## [126] 34 47 67 52 74 54 49 42 41 41 49 60 62 57 64 51 43 42 67 76 70 44 60 44 42
## [151] 66 71 64 66 39 58 47 35 58 56 56 55 41 38 38 67 67 62 63 53 56 48 58 58 60
## [176] 40 60 64 43 57 55 65 61 58 50 44 60 54 50 41 51 58 54 60 60 59 46 67 62 65
## [201] 44 60 58 68 62 52 59 60 49 59 57 61 39 61 56 43 62 63 65 48 63 55 65 56 54
## [226] 70 62 35 59 64 47 57 55 64 70 51 58 60 77 35 70 59 64 57 56 48 56 66 54 69
## [251] 51 43 62 67 59 45 58 50 62 38 66 52 53 63 54 66 55 49 54 56 46 61 67 58 47
## [276] 52 58 57 58 61 42 52 59 40 61 46 59 57 57 55 61 58 58 67 44 63 63 59 57 45
## [301] 68 57 57

arbol2 <- rpart(output ~ age+chol+caa, data = train, method = "class")

rpart.plot(arbol2)

prediccion1 <- predict(arbol2, newdata = test, type = "class")

matriz <- table(test$output, prediccion1)

precision <- sum(diag(matriz))/sum(matriz)

precision

## [1] 0.6666667

arbol3 <- rpart(output~chol+exng+sex+trtbps, data=ac, method = "class")
rpart.plot(arbol3, main = "Árbol de Clasificación Numero 2: Output")

set.seed(12345)

div2 <- createDataPartition(ac$output, times = 1, p = 0.8, list = F)

train2 <- ac[div2,] 
test2 <- ac[-div2,]

arbol4 <- rpart(output~chol+exng+sex+trtbps, data = train2, method = "class")

rpart.plot(arbol4)

prediccion2 <- predict(arbol4, newdata = test, type = "class")

matriz2 <- table(test2$output, prediccion2)

precision2 <- sum(diag(matriz2))/sum(matriz2)

precision2

## [1] 0.6166667

Respecto a lo que hicimos anteriormente, con los arboles, nos damos cuenta que el primer modelo tiene una precisión de un 75%, mientras que el segundo modelo tiene una precisión del 76.6%. Dado esto, el segundo modelo es mejor y es mas preciso para poder obtener información prediciendo la cantidad de personas que han tenido el ataque al corazon.