Proyecto Final - Regresión Logística

Nombre: Oscar Padilla

Carné: 13000285

Clase: Econometria I

————————————————————————————————-

-DataSet = Social_Network_Ads

User ID = Código de identificación de usuario conectado en redes sociales

Gender = Género (Masculino o Femenino)

Age = Edad

EstimatedSalary = Salario aproximado

Purchased = Compra (1 si compro, 0 no compro)

library(ISLR)
library(ggplot2)
library(caret)

Loading required package: lattice

library(readr)
Social_Network_Ads <- read_csv("Social_Network_Ads.csv")

Parsed with column specification:
cols(
  `User ID` = col_integer(),
  Gender = col_character(),
  Age = col_integer(),
  EstimatedSalary = col_integer(),
  Purchased = col_integer()
)

View(Social_Network_Ads)

Modelo

La probabilidad de que una persona según su edad compre a través de publicidad en redes sociales

Variables utilizadas: Purchased, Age

logit_reg<-glm(formula=Purchased ~ Age, data=Social_Network_Ads,
               family = binomial(link="logit"))
summary(logit_reg)

Call:
glm(formula = Purchased ~ Age, family = binomial(link = "logit"), 
    data = Social_Network_Ads)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.5091  -0.6548  -0.2923   0.5706   2.4470  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -8.04414    0.78417 -10.258   <2e-16 ***
Age          0.18895    0.01915   9.866   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 521.57  on 399  degrees of freedom
Residual deviance: 336.26  on 398  degrees of freedom
AIC: 340.26

Number of Fisher Scoring iterations: 5

dominio<-seq(min(Social_Network_Ads$Age), max(Social_Network_Ads$Age),1)
pred<-predict(object = logit_reg,
              newdata = list(Age=dominio),
              type = "response")
plt.logit<-data.frame(dominio,pred)
colnames(plt.logit)<-c("Age", "Probabilidad")
plt.logit

Gráfica del modelo

————————————————————————————————-

Viendo la gráfica podemos decir que las personas a partir de los 42 años de edad tienen una probabilidad más alta que realicen una compra a través de publicidad en redes sociales

ggplot(data = plt.logit, aes(x=Age, y=Probabilidad))+
  geom_line(color="blue",size=1)+
  ggtitle("Modelo - Regresión Logistica")+
  labs(x="Edad")+
  labs(y="Probabilidad")+
  theme_minimal()

Tomamos únicamente el 70% de la data para hacer pruebas y entrenar a nuestro sistema

nrow(Social_Network_Ads)

[1] 400

df.train<-Social_Network_Ads[1:(0.7*(nrow(Social_Network_Ads))), ]
df.test<-Social_Network_Ads[(0.7*nrow(Social_Network_Ads)):nrow(Social_Network_Ads),]
logit_reg2<-glm(formula=Purchased ~ Age, data=df.train,
               family = binomial(link="logit"))
summary(logit_reg2)

Call:
glm(formula = Purchased ~ Age, family = binomial(link = "logit"), 
    data = df.train)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.1803  -0.6325  -0.3487  -0.1734   2.3793  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)    
(Intercept) -7.03011    0.82170  -8.556  < 2e-16 ***
Age          0.15779    0.02056   7.673 1.68e-14 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 312.69  on 279  degrees of freedom
Residual deviance: 219.25  on 278  degrees of freedom
AIC: 223.25

Number of Fisher Scoring iterations: 5

preds2<-predict(object = logit_reg2,
                newdata = df.test,
                type = "response")
df.results2<-data.frame(df.test$Age, Probabilidad=preds2)
df.results2

Resultado de evaluar la probabilidad que nos devuelve el modelo

threshresults<-ifelse(df.results2$Probabilidad >= 0.5, "Yes", "No")
df.test$Purchased<-as.factor(df.test$Purchased)
levels(df.test$Purchased)<-c("No","Yes")
#class(df.test$Purchased)
#levels(df.test$Purchased)
#class(threshresults)
confusionMatrix(as.factor(threshresults), df.test$Purchased)

Confusion Matrix and Statistics

          Reference
Prediction No Yes
       No  42  21
       Yes  4  54
                                          
               Accuracy : 0.7934          
                 95% CI : (0.7103, 0.8616)
    No Information Rate : 0.6198          
    P-Value [Acc > NIR] : 3.204e-05       
                                          
                  Kappa : 0.5908          
 Mcnemar's Test P-Value : 0.001374        
                                          
            Sensitivity : 0.9130          
            Specificity : 0.7200          
         Pos Pred Value : 0.6667          
         Neg Pred Value : 0.9310          
             Prevalence : 0.3802          
         Detection Rate : 0.3471          
   Detection Prevalence : 0.5207          
      Balanced Accuracy : 0.8165          
                                          
       'Positive' Class : No              
                                          

Conclusiones:

————————————————————————————————-

-Para los problemas de dos clases, la sensibilidad, la especificidad, el valor predictivo positivo y el valor predictivo negativo se calculan utilizando el argumento positivo.

Suponemos una matriz de \(2x2\) :

Predicted	\(Event\)	\(No\) \(Event\)
Event	A	B
No Event	C	D

Entonces:

\[Sensivity = A/(A+C)\]

\[Specificity = D/(B+D)\]

Matriz de Confusión:

Positivo Verdadero:

Interpretación: Se predice que es positivo y es verdad

Negativo Verdadero:

Interpretación: Se predice que es negativo y es verdad

Positivo Falso:

Interpretación: Se predice que es positivo y es falso

Negativo Falso:

Interpretación: Se predice que es falso y es falso

Accuracy:

La precisión general que tienen nuestras predicciones.

Sensitivity(Tasa verdadera positiva):

Que tan bien predice nuestro modelo que sea positivo verdadero

Specificity (Tasa negativa verdadera):

Que tan bien predice nuestro modelo que sea negativo verdadero

————————————————————————————————-

Accuracy = 0.7934

Sensitivity = 0.9130

Specificity = 0.72

Conclusión Final:

Podemos decir que el modelo en general predice en un 79% de una forma éxitosa, el modelo es muy bueno para predecir que es positivo verdadero con un 91% o sea que predice muy bien que a partir de los 42 años es muy probable que la persona realice la compra por medio de la publicidad que aparece en redes sociales y el modelo no es tan bueno para predecir que es negativo verdadero con un 72% o sea que a partir de los 42 años es poco probable que una persona realice la compra por medio de la publicidad que aparece en redes sociales.