#library(readxl)
#data <- read_excel("~/METODOS ESTADISTICOS/Reg_1.xlsx")
#View(data)

Ingreso <- c(76, 57, 140, 97, 75, 107, 65, 77, 102, 53)
Contribucion <- c(15, 4, 42, 33, 5, 32, 10, 18, 28, 4)

Datos <- data.frame(Ingreso, Contribucion)

Y<-Datos$Contribucion
X1<-Datos$Ingreso

X: Ingreso (variable explicativa) Y: Contribucion (variable respuesta)

Diagrama de dispersión

with(Datos, plot(Ingreso, Contribucion))

En el gráfico de dispersión se observa una correlación positiva entre la variable ingreso y la contribución caritativa, ya que a medida que aumenta en promedio el ingreso, la contribución caritativa aumenta; sin embargo, se realizan las pruebas estadísticas correspondientes para confirmarlo a continuación.

Resumen ingresos (X1) y contribución caritativa (Y)

summary(X1)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    53.0    67.5    76.5    84.9   100.8   140.0
summary(Y)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    4.00    6.25   16.50   19.10   31.00   42.00
desviacion_x<-sd(X1)
desviacion_x
## [1] 26.65604
desviacion_y<-sd(Y) #IQR(Y)
desviacion_y
## [1] 13.81987
hist(X1,
     main = "Histograma de los ingresos (miles de dolares)",
     xlab = "Ingreso",
     col = "skyblue",
     border = "white")

Se nota una mayor frecuencia de ingresos entre 60 y 80 miles de dólares y una baja frecuencia entre 80 y 100 miles de dólares y entre 120 y 140 miles de dólares.

hist(Y,
     main = "Histograma de la contribucion caritativa (cientos de dolares)",
     xlab = "Contribucion caritativa",
     col = "skyblue",
     border = "white")

Se observa una leve asímetria a la derecha, con mayores contribución caritativas de entre 0 y 10 cientos de dólares y pocas contribuciones entre 40 y 50 cientos de dólares.

Normalidad

Verifiquemos que los datos sean normales, utilizando el test de shapiro pues los datos son menores a 50.

shapiro.test(X1)
## 
##  Shapiro-Wilk normality test
## 
## data:  X1
## W = 0.92797, p-value = 0.4282
shapiro.test(Y)
## 
##  Shapiro-Wilk normality test
## 
## data:  Y
## W = 0.90583, p-value = 0.2536
#ks.test(X1, "pnorm", mean = mean(X1), sd = sd(X1)
#ks.test(Y, "pnorm", mean = mean(Y), sd = sd(Y))

Para verificar el supuesto de normalidad se usó la prueba Shapiro-Wilk obteniendo un p-valor mayor que 0.05 en los ingresos y la contribución caritativa, lo que indica que estas siguen una distribución aproximadamente normal.

Se observa que los ingresos oscilan entre 67.5 y 100.8 miles de dólares. Además, el ingreso promedio es de 84.9 miles de dólares, con una desviación estándar de +-26.67 miles de dólares. Por parte de las contribuciones caritativas, estas varian entre 6.25 y 31 cientos de dólares, y el promedio de las contribuciones fue de 19.10 cientos de dólares con una desviación estandar de +-13.81 cientos de dólares..

#Tamaño de muestra
N = nrow(Datos)

#Medias
x1m = mean(X1)
ym = mean(Y)

#Covarianza
Cov = sum((X1 - x1m) * (Y - ym) / (N - 1))
Cov
## [1] 348.4556
cov(X1,Y)
## [1] 348.4556

Como la covarianza entre los ingresos y la contribución caritativa tiene un valor positivo, esto que indica que el coeficiente de correlación lineal será positivo. Sin embargo, como la covarianza no es adimensional, no podemos usarla para medir la fuerza de la relación ni compararla con otros estudios.

Coeficiente de correlación

Como observamos previamente, los datos son normales, por tanto, calculamos el coeficiente de correlación de Pearson de la siguiente forma:

# Sumas de x, y, xy

sum_x1 <- sum(X1)    
sum_y <- sum(Y)     
sum_x1y <- sum(X1 * Y)  

# Cálculo de Sxy 
Sxy <- sum_x1y - (sum_x1 * sum_y) / N 

# Suma de cuadrados
sum_x1_sq <- sum(X1^2) 
sum_y_sq <- sum(Y^2)    

# Sumas al cuadrado (del tipo (sumx)^2)

sum_x1_squared <- sum_x1^2  
sum_y_squared <- sum_y^2    

# Cálculo de Sxx y Syy

Sxx <- sum_x1_sq - (sum_x1_squared / N)
Syy <- sum_y_sq - (sum_y_squared / N)

# Coeficiente de correlación de Pearson (R)
R11 <- Sxy / sqrt(Sxx * Syy)
R11
## [1] 0.9459054
R1 = cor(X1, Y) #cor(X1,Y,method = "spearman" )
R1
## [1] 0.9459054

Se obtuvo un coeficiente de correlación de 0.95 (valor exacto: 0.94959). Por tanto, existe una correlación positiva fuerte entre los ingresos y las contrubuciones caritativas. Es decir, a medida que los ingresos aumentan, las contribuciones caritativas también aumentan.

Prueba de hipótesis

Ho: Ρ = 0 H1: Ρ ≠ 0

cor.test(X1, Y) #method = "spearman"
## 
##  Pearson's product-moment correlation
## 
## data:  X1 and Y
## t = 8.2462, df = 8, p-value = 3.508e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.7820308 0.9874432
## sample estimates:
##       cor 
## 0.9459054

Dado que el p-valor es menor a 0.05, rechazamos la hipótesis nula. Esto indica que hay evidencia estadística suficiente para afirmar que existe una correlación significativa entre los ingresos y las contribuciones caritativas.

R12 <- (cor(X1, Y))^2
R12
## [1] 0.8947371

El 89.47% de la variabilidad observada en las contribuciones caritativas se debe a los ingresos, y el 10.53% restante se debe a otros facroees que no han sido incluidas en el estudio.

#Se realiza la estimación de Bo y B1
B1<-((sum_x1*ym)-sum_x1y)/((sum_x1*x1m)-sum_x1_sq)
B1
## [1] 0.4904064
B0<-ym -B1*x1m
B0
## [1] -22.5355
#lm linear model (y~x)
M1 = lm(Y ~ X1)
summary(M1)
## 
## Call:
## lm(formula = Y ~ X1)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -9.2450 -0.9971  0.5290  1.7113  7.9661 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -22.53550    5.26826  -4.278   0.0027 ** 
## X1            0.49041    0.05947   8.246 3.51e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.756 on 8 degrees of freedom
## Multiple R-squared:  0.8947, Adjusted R-squared:  0.8816 
## F-statistic:    68 on 1 and 8 DF,  p-value: 3.508e-05

La ecuación quedaría de la siguiente manera:

\[ y = -22.53 + 0.49x \] La recta de regresión obtenida representa el mejor ajuste lineal posible para modelar la relación entre los ingresos y las contribuciones caritativas, según el método de mínimos cuadrados. Al interpretarla analizamos que por cada mil dólares que se le adicione a los ingresos, las contribuciones caritativas aumentan en promedio 0.49 cientos de dólares. Además, el intercepto no es interpretable por el dinero es una cantidad positiva.

# Graficar la relación con la línea de regresión
plot(X1, Y, 
     main = "Regresion Lineal: Contribucion caritativa vs ingresos", 
     xlab = "Ingresos", ylab = "Contribucion caritativa", pch = 19, col = "blue")
abline(M1, col = "red", lwd = 2)  # Línea de regresión

Además, como el coeficiente de determinación es mayor a 70%, podemos afirmar que el modelo tiene una buena capacidad predictoria.

Significancia de los B’s

IC<-confint(M1)
IC
##                   2.5 %      97.5 %
## (Intercept) -34.6841231 -10.3868866
## X1            0.3532673   0.6275455

Como en el intervalo de confianza de la pendiente (B1) no se incluye al cero, es correcto afirmar que el modelo es adecuado y hay linealidad.

Evaluación de supuestos

residuos <- M1$residuals
boxplot(residuos)

Se observa la presencia de datos atípicos.

plot(M1)

Residuals vs Fitted: dado que el 4 está muy alejado del 0 puede ser un dato atípico; sin embargo, parecen estar alrededor del cero, por tanto

Q-Q Residuals: se observa que los residuos están en su mayoria en la normal teórica, por tanto parecen serguir una distribución normal.

shapiro.test(residuos)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuos
## W = 0.92517, p-value = 0.4021

Dado que el p-valor es mayor que 0.05, los residuos siguen una distribución normal.

library(lmtest)
## Cargando paquete requerido: zoo
## 
## Adjuntando el paquete: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
bptest(M1)
## 
##  studentized Breusch-Pagan test
## 
## data:  M1
## BP = 0.12491, df = 1, p-value = 0.7238

Dado que el p-valor es mayor que 0.05 no se rechaza la hipótesis nula, por tanto los residuos cumplen el supuesto de homocedasticidad.