Regresiones_Reto

# Cargar librerías y bases de datos

library(readxl)

## Warning: package 'readxl' was built under R version 4.2.3

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.2.3

library(dplyr)

## Warning: package 'dplyr' was built under R version 4.2.3

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

df_donadores <- read_xlsx("C:\\Users\\alfon\\OneDrive\\Desktop\\Bases de Datos\\BASE DATOS DONADORES LIMPIA.xlsx", sheet = "DONACIONES_ORGANIZACIONES")

#Datos nulos
df0_donadores <- mutate_all(df_donadores, ~replace(., is.na(.), 0))
View(df0_donadores)

# Hipotesis 1

# Nosotros pensamos que de las personas que realizaron una donacion por lo menos el 70% realizo la donacion por motivos de filantropia

modelo0 <- glm(donacion_reciente ~ motivo_filantropia, data = df0_donadores, family = "binomial")
summary(modelo0)

## 
## Call:
## glm(formula = donacion_reciente ~ motivo_filantropia, family = "binomial", 
##     data = df0_donadores)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.48928   0.00008   0.00008   0.89479   0.89479  
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)   
## (Intercept)           0.7087     0.2160   3.282  0.00103 **
## motivo_filantropia   18.8574  1097.5769   0.017  0.98629   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 173.38  on 192  degrees of freedom
## Residual deviance: 123.02  on 191  degrees of freedom
## AIC: 127.02
## 
## Number of Fisher Scoring iterations: 18

# Gráfica
df0_donadores$donacion_reciente <- as.character(df0_donadores$donacion_reciente)
df0_donadores$donacion_reciente <- as.numeric(df0_donadores$donacion_reciente)

plot(donacion_reciente ~ motivo_filantropia, df0_donadores, col = "darkblue",
     main = "Modelo regresión logística",
     ylab = "",
     xlab = "")

curve(predict(modelo0, data.frame(motivo_filantropia = x), type = "response"),
      col = "firebrick", lwd = 2.5, add = TRUE)

# Hipótesis 2

# Creemos que alrededor del 80% de las personas que realizaron una donacion la realizaron para sentirse bien consigo mismas.

modelo1 <- glm(donacion_reciente ~ beneficio_unomismo, data = df0_donadores, family = "binomial")
summary(modelo1)

## 
## Call:
## glm(formula = donacion_reciente ~ beneficio_unomismo, family = "binomial", 
##     data = df0_donadores)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.50292   0.00008   0.00008   0.88366   0.88366  
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)           0.7390     0.2149   3.439 0.000584 ***
## beneficio_unomismo   18.8271  1109.1918   0.017 0.986458    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 173.38  on 192  degrees of freedom
## Residual deviance: 124.60  on 191  degrees of freedom
## AIC: 128.6
## 
## Number of Fisher Scoring iterations: 18

# Gráfica
df0_donadores$donacion_reciente <- as.character(df0_donadores$donacion_reciente)
df0_donadores$donacion_reciente <- as.numeric(df0_donadores$donacion_reciente)

plot(donacion_reciente ~ beneficio_unomismo, df0_donadores, col = "darkblue",
     main = "Modelo regresión logística",
     ylab = "",
     xlab = "")

curve(predict(modelo1, data.frame(beneficio_unomismo = x), type = "response"),
      col = "firebrick", lwd = 2.5, add = TRUE)

#Hipótesis 3

# Creemos que mas del 50% de las donaciones realizadas van dirigidas a Organizaciones de Caridad

modelo2 <- glm(donacion_reciente ~ desti0_caridad, data = df0_donadores, family = "binomial")
summary(modelo2)

## 
## Call:
## glm(formula = donacion_reciente ~ desti0_caridad, family = "binomial", 
##     data = df0_donadores)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.60490   0.00008   0.00008   0.80346   0.80346  
## 
## Coefficients:
##                 Estimate Std. Error z value Pr(>|z|)    
## (Intercept)       0.9651     0.2077   4.646 3.39e-06 ***
## desti0_caridad   18.6010  1225.5335   0.015    0.988    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 173.38  on 192  degrees of freedom
## Residual deviance: 136.65  on 191  degrees of freedom
## AIC: 140.65
## 
## Number of Fisher Scoring iterations: 18

# Gráfica
df0_donadores$donacion_reciente <- as.character(df0_donadores$donacion_reciente)
df0_donadores$donacion_reciente <- as.numeric(df0_donadores$donacion_reciente)

plot(donacion_reciente ~ desti0_caridad, df0_donadores, col = "darkblue",
     main = "Modelo regresión logística",
     ylab = "",
     xlab = "")

curve(predict(modelo2, data.frame(desti0_caridad = x), type = "response"),
      col = "firebrick", lwd = 2.5, add = TRUE)

# Hipótesis 4

# Recibir información del impacto que generan las donaciones influye en la decisión de si una persona vuelve a realizar una donación.

modelo3 <- glm(donacion_reciente ~ evaluacion_impacto, data = df0_donadores, family = "binomial")
summary(modelo3)

## 
## Call:
## glm(formula = donacion_reciente ~ evaluacion_impacto, family = "binomial", 
##     data = df0_donadores)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8645   0.6219   0.6219   0.6219   0.6219  
## 
## Coefficients:
##                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)           1.5449     0.1947   7.934 2.12e-15 ***
## evaluacion_impacto   16.0212  1192.8333   0.013    0.989    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 173.38  on 192  degrees of freedom
## Residual deviance: 169.26  on 191  degrees of freedom
## AIC: 173.26
## 
## Number of Fisher Scoring iterations: 16

# Gráfica
df0_donadores$donacion_reciente <- as.character(df0_donadores$donacion_reciente)
df0_donadores$donacion_reciente <- as.numeric(df0_donadores$donacion_reciente)

plot(donacion_reciente ~ evaluacion_impacto, df0_donadores, col = "darkblue",
     main = "Modelo regresión logística",
     ylab = "",
     xlab = "")

curve(predict(modelo3, data.frame(evaluacion_impacto = x), type = "response"),
      col = "firebrick", lwd = 2.5, add = TRUE)