Donaciones

Método de los mínimos cuadrados, ajuste lineal y correlación de Pearson, usando R.

El siguiente estudio de caso fue desarrollado por el Dr. Chris Burt, un psicólogo cognitivo de la University of Canterbury en New Zeland. En su estudio Burt los voluntarios reciben una cantidad de dinero (cent. de US\( \ \)$) en pago por su participación. Una vez que el experimento concluye, y abandonan la sala en donde se realizó el experimento, a la salida los espera una persona que les pide una donación para la caridad. Los participantes no contaban con este evento ni fueron puestos sobre aviso, pero ya que contaban una pequeña cifra de dinero, cada uno estimó cuánto dinero donar. Este en realidad era el verdadero experimento creado por el Dr. Burt.

Base de datos

Creamos la base de datos consistente en 6 grupos que incluyen el pago recibido y la donación para cada uno de los 6 grupos, los grupos varían de la siguiente manera:

grupo1 <- read.table("~/DropboxE/Dropbox/CODE/R/RProjects/donaciones/grupo1", 
    header = T, quote = "\"")
grupo2 <- read.table("~/DropboxE/Dropbox/CODE/R/RProjects/donaciones/grupo2", 
    header = T, quote = "\"")
grupo3 <- read.table("~/DropboxE/Dropbox/CODE/R/RProjects/donaciones/grupo3", 
    header = T, quote = "\"")
grupo4 <- read.table("~/DropboxE/Dropbox/CODE/R/RProjects/donaciones/grupo4", 
    header = T, quote = "\"")
grupo5 <- read.table("~/DropboxE/Dropbox/CODE/R/RProjects/donaciones/grupo5", 
    header = T, quote = "\"")
grupo6 <- read.table("~/DropboxE/Dropbox/CODE/R/RProjects/donaciones/grupo6", 
    header = T, quote = "\"")

Plot

La visualización de estos grupos se realiza usando el código:

par(mfrow = c(2, 3))
plot(grupo1$pago, grupo1$donaciones, xlab = "pago", ylab = "donación", main = "Grupo 1", 
    pch = 46, cex = 9)
plot(grupo2$pago, grupo2$donaciones, xlab = "pago", ylab = "donación", main = "Grupo 2", 
    pch = 46, cex = 9)
plot(grupo3$pago, grupo3$donaciones, xlab = "pago", ylab = "donación", main = "Grupo 3", 
    pch = 46, cex = 9)
plot(grupo4$pago, grupo4$donaciones, xlab = "pago", ylab = "donación", main = "Grupo 4", 
    pch = 46, cex = 9)
plot(grupo5$pago, grupo5$donaciones, xlab = "pago", ylab = "donación", main = "Grupo 5", 
    pch = 46, cex = 9)
plot(grupo6$pago, grupo6$donaciones, xlab = "pago", ylab = "donación", main = "Grupo 6", 
    pch = 46, cex = 9)

plot of chunk unnamed-chunk-2

Integrando todos los grupos, obtenemos una panorámica más general y muy “sugerente”, observe:

grupos <- read.table("~/DropboxE/Dropbox/CODE/R/RProjects/donaciones/grupos", 
    header = T, quote = "\"")
plot(grupos$pago, grupos$donaciones, xlab = "pago", ylab = "donación", main = "Todos los grupos")

plot of chunk unnamed-chunk-3

Ajuste lineal

Finalmente, creamos el modelo de regresión lineal (R usará el Método de los Mínimos Cuadrados) y le pedimos que genere la recta de ajuste lineal.

par(mfrow = c(1, 1))
plot(grupos$pago, grupos$donaciones, xlab = "pago", ylab = "donación", main = "Recta de ajuste")
lm(grupos$donaciones ~ grupos$pago)
## 
## Call:
## lm(formula = grupos$donaciones ~ grupos$pago)
## 
## Coefficients:
## (Intercept)  grupos$pago  
##      41.516        0.371  
## 
modelo1 <- lm(grupos$donaciones ~ grupos$pago)
abline(modelo1)

plot of chunk unnamed-chunk-4

Para obtener un resumen completo que incluye (entre otros) residuales, error standar, coeficiente de correlación de momentos \( r \) de Pearson, usamos:

summary(modelo1)
## 
## Call:
## lm(formula = grupos$donaciones ~ grupos$pago)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -53.05 -13.60  -2.09  14.02  39.82 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  41.5163     8.3522    4.97  1.9e-05 ***
## grupos$pago   0.3708     0.0142   26.03  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
## 
## Residual standard error: 22.2 on 34 degrees of freedom
## Multiple R-squared: 0.952,   Adjusted R-squared: 0.951 
## F-statistic:  677 on 1 and 34 DF,  p-value: <2e-16 
##