Carga de paquetes:

library(data.table)
library(factoextra)
library(dbscan)
library(ggplot2)
library(rpart.plot)
library(rpart)
library(caret)

library(jtools)
library(scales)
library(corrplot)
library(plotly)
library(tidyverse)
library(lubridate)
library(texreg)
library(corrgram)
library(knitr)
library(moderndive)

Carga de bases:

path <- 'C:/Users/matir/OneDrive/Escritorio/Mati/Universidad/2021/Segundo Semestre/Data Science/control 3/'
cancer <- fread(paste0(path,'Cancer_de_mama.csv'))
prima <- fread(paste0(path,'Prima_de_seguros.csv'))

Parte 1

Pregunta 1.

Realice dos modelos de regresión lineal multiple para predecir la variable charges (prima de seguros) ¿Cuál predice mejor dentro de muestra?. (8 puntos)

Regresion lineal multiple para predecir charges con variables: bmi y age

prima <- data.table(prima)

f1 <- formula(charges ~ bmi  + age)
reg1 <- lm(formula = f1, data = prima)
sum1 <- summary(reg1)

sum <- summary(reg1)
sum
## 
## Call:
## lm(formula = f1, data = prima)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -14457  -7045  -5136   7211  48022 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -6424.80    1744.09  -3.684 0.000239 ***
## bmi           332.97      51.37   6.481 1.28e-10 ***
## age           241.93      22.30  10.850  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11390 on 1335 degrees of freedom
## Multiple R-squared:  0.1172, Adjusted R-squared:  0.1159 
## F-statistic:  88.6 on 2 and 1335 DF,  p-value: < 2.2e-16
get_regression_table(reg1) %>% kable()
term estimate std_error statistic p_value lower_ci upper_ci
intercept -6424.805 1744.091 -3.684 0 -9846.262 -3003.347
bmi 332.965 51.374 6.481 0 232.182 433.748
age 241.931 22.298 10.850 0 198.187 285.674 
screenreg(reg1)
## 
## =========================
##              Model 1     
## -------------------------
## (Intercept)  -6424.80 ***
##              (1744.09)   
## bmi            332.97 ***
##                (51.37)   
## age            241.93 ***
##                (22.30)   
## -------------------------
## R^2              0.12    
## Adj. R^2         0.12    
## Num. obs.     1338       
## =========================
## *** p < 0.001; ** p < 0.01; * p < 0.05
prediccion.todas1 <-  predict(reg1, newdata = prima)

prima[,predicciont1:= prediccion.todas1]


gg2 <- ggplot(prima, aes(charges, predicciont1)) +
  geom_point()  + geom_abline(colour="red") +
  labs(title = "Regresión lineal múltiple de la Prima", subtitle = "Variables: bmi y age", x = "Variables",
       y = "Predicción de la prima") +
  theme(plot.title = element_text(family = "Helvetica", face = "bold", size = (15)), 
        axis.title = element_text(family = "Helvetica", size = (10)))
gg2

Regresion lineal multiple para predecir charges con variables: age, children, smoker,bmi ,region y sex

prima <- data.table(prima)

f2 <- formula(charges ~ age + children + smoker + bmi + region + sex)
reg2 <- lm(formula = f2, data = prima)
sum2 <- summary(reg2)

sum2 <- summary(reg2)
sum2
## 
## Call:
## lm(formula = f2, data = prima)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11304.9  -2848.1   -982.1   1393.9  29992.8 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     -11938.5      987.8 -12.086  < 2e-16 ***
## age                256.9       11.9  21.587  < 2e-16 ***
## children           475.5      137.8   3.451 0.000577 ***
## smokeryes        23848.5      413.1  57.723  < 2e-16 ***
## bmi                339.2       28.6  11.860  < 2e-16 ***
## regionnorthwest   -353.0      476.3  -0.741 0.458769    
## regionsoutheast  -1035.0      478.7  -2.162 0.030782 *  
## regionsouthwest   -960.0      477.9  -2.009 0.044765 *  
## sexmale           -131.3      332.9  -0.394 0.693348    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 6062 on 1329 degrees of freedom
## Multiple R-squared:  0.7509, Adjusted R-squared:  0.7494 
## F-statistic: 500.8 on 8 and 1329 DF,  p-value: < 2.2e-16
get_regression_table(reg2) %>% kable()
term estimate std_error statistic p_value lower_ci upper_ci
intercept -11938.539 987.819 -12.086 0.000 -13876.393 -10000.684
age 256.856 11.899 21.587 0.000 233.514 280.199
children 475.501 137.804 3.451 0.001 205.163 745.838
smoker: yes 23848.535 413.153 57.723 0.000 23038.031 24659.038
bmi 339.193 28.599 11.860 0.000 283.088 395.298
region: northwest -352.964 476.276 -0.741 0.459 -1287.298 581.370
region: southeast -1035.022 478.692 -2.162 0.031 -1974.097 -95.947
region: southwest -960.051 477.933 -2.009 0.045 -1897.636 -22.466
sex: male -131.314 332.945 -0.394 0.693 -784.470 521.842 
screenreg(reg2)
## 
## ==============================
##                  Model 1      
## ------------------------------
## (Intercept)      -11938.54 ***
##                    (987.82)   
## age                 256.86 ***
##                     (11.90)   
## children            475.50 ***
##                    (137.80)   
## smokeryes         23848.53 ***
##                    (413.15)   
## bmi                 339.19 ***
##                     (28.60)   
## regionnorthwest    -352.96    
##                    (476.28)   
## regionsoutheast   -1035.02 *  
##                    (478.69)   
## regionsouthwest    -960.05 *  
##                    (477.93)   
## sexmale            -131.31    
##                    (332.95)   
## ------------------------------
## R^2                   0.75    
## Adj. R^2              0.75    
## Num. obs.          1338       
## ==============================
## *** p < 0.001; ** p < 0.01; * p < 0.05
prediccion.todas2 <-  predict(reg2, newdata = prima)

prima[,predicciont2:= prediccion.todas2]


gg2 <- ggplot(prima, aes(charges, predicciont2)) +
  geom_point()  + geom_abline(colour="red") +
  labs(title = "Regresión lineal múltiple de la Prima", subtitle = "Variables: age, children, smoker,bmi ,region y sex", x = "Variables",
       y = "Predicción de la prima") +
  theme(plot.title = element_text(family = "Helvetica", face = "bold", size = (15)), 
        axis.title = element_text(family = "Helvetica", size = (10)))
gg2

Respuesta: Claramente al incluir variables que sean significativas (ver nivel de significancia en tabla), el modelo 2 predice mejor dentro de esta muestra. El primero tenía un R^2 ajustado de 0,12 y el segundo uno de 0,75, mucho mayor.

Pregunta 2.

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)

Para modelo 1:

predkfolds1<-train(f1,data=prima,method="lm",trControl= setupKCV)
print(predkfolds1)
## Linear Regression 
## 
## 1338 samples
##    2 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 1070, 1072, 1070, 1070, 1070 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   11378.53  0.1176962  9045.051
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

Para modelo 2:

predkfolds2<-train(f2,data=prima,method="lm",trControl= setupKCV)
print(predkfolds2)
## Linear Regression 
## 
## 1338 samples
##    6 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (5 fold) 
## Summary of sample sizes: 1070, 1071, 1071, 1070, 1070 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   6072.407  0.7484253  4192.455
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

Si, los resultados siguen manteniendose. Sin embargo el R^2 es casi igual en ambas muestras, son practicamente iguales. El modelo 2 tiene un R2 levemente mayor.

Pregunta 3. (o 4 en el ctrl)

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. (8 puntos)

Creo que se podría hacer la comparacion entre prima y años, dado que siempre se ha dicho que a medida que

ggplot(data = prima,aes(x=age,y=charges))+
  geom_point()

samp <- prima[,.(age,charges)]

Entonces, al graficar y encontrar cierto patron en el orden de los datos, procedemos a realizar un grafico de codo:

fviz_nbclust(x = samp, FUNcluster = kmeans, method = "wss", k.max = 25, 
             diss = get_dist(samp, method = "euclidean"), nstart = 50)

Vemos en el grafico de codo, que el numero optimo de clusters es el 5 dado que reduce sustancialmente el total de N por cluster. Por lo tanto, dividiremos en k=5.

Resultados graficamente:

k1<-kmeans(x=samp,centers=5,nstart=25)

fviz_cluster(k1,data=samp,geom = "point")

Parte 2

Pregunta 4 (5 del ctrl).

Realice dos modelos de árboles de clasificación de la variable diagnosis. 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)

Modelo 1:

arbol_1 <- rpart(diagnosis~texture_mean +radius_mean, data=cancer, method = "class")

rpart.plot(arbol_1, main = "Árbol de Clasificación: Cancer de Mamas (Modelo 1)",extra = 104,
box.palette = "GnBu",
branch.lty = 3,
shadow.col = "gray",
nn = TRUE,)

rpart.rules(arbol_1, style = "tall")
## diagnosis is 0.05 when
##     radius_mean < 15
##     texture_mean < 20
## 
## diagnosis is 0.12 when
##     radius_mean < 13
##     texture_mean >= 20
## 
## diagnosis is 0.25 when
##     radius_mean is 13 to 15
##     texture_mean >= 25
## 
## diagnosis is 0.66 when
##     radius_mean is 13 to 15
##     texture_mean is 20 to 25
## 
## diagnosis is 0.94 when
##     radius_mean >= 15

Leyenda: - B = benigno - M = maligno

Entrenamos modelo 1:

set.seed(12345)

div <- createDataPartition(cancer$diagnosis, times = 1, p = 0.8, list = F)

train <- cancer[div,] 
test <- cancer[-div,]

arbol_3 <- rpart(diagnosis~texture_mean +radius_mean, data = train, method = "class")

rpart.plot(arbol_3)

prediccion_1 <- predict(arbol_3, newdata = test, type = "class")

matriz <- table(test$diagnosis, prediccion_1)
matriz
##    prediccion_1
##      B  M
##   B 65  6
##   M  8 34
precision <- sum(diag(matriz))/sum(matriz)
precision
## [1] 0.8761062

Modelo 2

arbol_2 <- rpart(diagnosis~perimeter_mean + smoothness_mean, data=cancer, method = "class")

rpart.plot(arbol_2, main = "Árbol de Clasificación: Cancer de Mamas (Modelo 2)",extra = 104,
box.palette = "GnBu",
branch.lty = 3,
shadow.col = "gray",
nn = TRUE,)

rpart.rules(arbol_2, style = "tall")
## diagnosis is 0.07 when
##     perimeter_mean < 90
## 
## diagnosis is 0.07 when
##     perimeter_mean is 90 to 99
##     smoothness_mean < 0.09
## 
## diagnosis is 0.67 when
##     perimeter_mean is 90 to 99
##     smoothness_mean >= 0.09
## 
## diagnosis is 0.95 when
##     perimeter_mean >= 99

Entrenamos modelo 2:

set.seed(12345)

div <- createDataPartition(cancer$diagnosis, times = 1, p = 0.8, list = F)

train <- cancer[div,] 
test <- cancer[-div,]

arbol_4 <- rpart(diagnosis~perimeter_mean + smoothness_mean, data = train, method = "class")

rpart.plot(arbol_4)

prediccion_2 <- predict(arbol_4, newdata = test, type = "class")

matriz <- table(test$diagnosis, prediccion_2)
matriz
##    prediccion_2
##      B  M
##   B 69  2
##   M  8 34
precision <- sum(diag(matriz))/sum(matriz)
precision
## [1] 0.9115044

Explicacion:

El modelo que clasifica mejor, es el modelo 2, queda demostrado a traves de la validacion cruzada. El modelo 2 tiene un 91% de efectividad en predecir si es un cancerr benigno o maligno. En cambio el modelo 1 tiene un 87% de efectividad en predecir el resultado. Si bien ambos, predicen de buena manera, el modelo 2 es mejor.

PD. Si se quiere ver la interpretacion de cada arbol de decsion queda registrada con el comando: “rpart.rules”.

Parte 3

Pregunta 5 (6 del ctrl).

¿Para qué se utiliza validación cruzada (Cross Validation)?

La validacion cruzada es una forma de corroborar que el metodo de prediccion que hemos armado funcione precisamente. Para esto, se divide nuestra poblacion en una proporcion “x” e “y” donde uno serán los datos de entrenamiento y otros serán los de prueba. De esta manera, podremos verificar si el modelo puede ser efectivo al predecir comportamientos o resultados.

En palabras simples, es una manera de ver si el modelo que creamos es preciso o no. Para evaluar la efectividad del modelo, se divide la muestra en entrenamiento y purbeas, luego se testean estos datos de prueba y se evalua la precision del modelo.

Pregunta 6 (7 del ctrl).

¿Cual es la diferencia entre regresión y clasificación?

La regresion es un modelo que permite predecir comportamientos/resultados en base a variables que nosotros creamos que serán influyentes en (valga la redundancia) este comportamiento/resultado. Las regresiones podrán ser forumladas a traves de los datos y variables que tengamos de una muestra. Mientras mas explicativos las variables, mejor será nuestra regresion para predecir.

La clasificacion es la agrupacion de datos en (valga la redundancia) un numero determinado de grupos. Esto tiene como fin poder predecir entre que limites (de las variables analizadas) se mueve un grupo determinado. De esta manera, se podran estimar patrones y segmentar por un target determinado.

Claramente, la diferencia entre regresion y clustering radicara en que la regresion en su modelo predicirá un resultado exacto en base a los datos que le entregemos. En cambio, el clustering predice el comportamiento de una agrupacion de datos (se mueven en un rango). Este ultimo metodo es sumamente util en el MKT dado que no se puede saber la caractersitica de cada cliente, por lo mismo, es mas eficiente crear grupos de clientes que compartan ciertos patrones comunes. Un ejemplo para el metodo de regresion podría ser la estimacion de precios de un objeto considerando “x” variables.