Introducción

  1. Los analisis de regresión y correlación nos mostrarán cómo determinar tanto la naturaleza y la fuerza de una ralación entre dos variables.

  2. En el análisis de regresión se desarrollara una ecuación de estimación, es decir una formula matematica que relacione las variables independientes con una variable dependiente o desconocida.

  3. En el analisis de correlación se determina el grado de relacion entre las variables.

Regresion lineal

Cuando se tienen dos variables se pueden relacionar por medio de una recta de regresión lineal el método mas conocido es el de mínimos cuadrados donde se aplican las siguientes formulas

\[m=\frac{n \sum xy-\sum x\sum y}{n\sum x^2-\left(\sum x\right)^2}=\frac{\sum xy-n\overline{X}\ \overline{Y}}{\sum x^2-n(\overline{X})^2}\] \[b=\frac{\sum x^2\sum y-\sum x\sum xy}{n\sum x^2-\left(\sum x\right)^2}=\overline{Y}-m\overline{X}\] \[y=mx+b\]

Ejemplo

Una compañia fabricante de llantas esta interesada en eliminar contaminantes de los tubos de emision de su fábrica y el costo es una preocupación. La compañia ha recolectado datos de otras compañias respecto al monto gastado en medidas ambientales y la cantidad de contaminantes eliminada que resultó (como porcentaje de la emisión total).

Dinero gastado 8.4 10.2 16.5 21.7 9.4 8.3 11.5 18.4 16.7 19.3 28.4 4.7 12.3

Porcentaje 35.9 31.8 24.7 25.2 36.8 35.3 33.4 25.4 31.4 27.4 15.8 31.5 28.9

Calcular la recta de minimos cuadrados

# ingresando los datos del ejemplo
dg <- c(8.4, 10.2, 16.5, 21.7, 9.4, 8.3, 11.5, 18.4, 16.7, 19.3, 28.4, 4.7, 12.3)
pr <- c(35.9, 31.8, 24.7, 25.2, 36.8, 35.3, 33.4, 25.4, 31.4, 27.4, 15.8, 31.5, 28.9)
# calculando el total de datos
(n <- length(dg))
## [1] 13
# verificando que se tienen la misma cantidad de datos
length(dg)==length(pr)
## [1] TRUE
# calculo de la pendiente
(n*sum(dg*pr)-sum(dg)*sum(pr))/(n*sum(dg*dg)-sum(dg)^2)
## [1] -0.776405
(m <- (sum(dg*pr)-n*mean(dg)*mean(pr))/(sum(dg*dg)-n*mean(dg)^2)) # otra forma
## [1] -0.776405

el calculo nos da un resultado pero lo mas importante es interpretar el mismo, en este caso tenemos que por cada unidad de dinero gastado el porcentaje de reducción de la emision total decrese en 0.77 unidades porcentuales.

# calculo del intercepto
(sum(dg*dg)*sum(pr)-sum(dg)*sum(dg*pr))/(n*sum(dg*dg)-sum(dg)^2)
## [1] 40.59662
(b <- mean(pr)-m*mean(dg)) # otra forma
## [1] 40.59662
# usando la función de r
regej <- lm(pr~dg)
regej$coefficients
## (Intercept)          dg 
##   40.596619   -0.776405
# visualizando datos
plot(dg,pr, main = "Regresion dinero gastado vs porcentaje reducido", xlab = "Dinero gastado", ylab = "Porcentaje de emisiones", ylim = c(15,40), xlim = c(0,30))
# agregando recta por minimos cuadrados
abline(regej, col = "blue4")

Error de la estimación

Al ser una aproximacion se puede calcular la dispersion de los datos alrededor de la recta obtenidad mediante la siguiente formula \[S_e=\sqrt{\frac{\sum(Y-\hat{Y})^2}{n-2}}\] donde \(Y\) son los valores de la variable dependiente y \(\hat{Y}\) son los valores estimados y \(n\) la cantidad de datos usados para la regresi'on lineal.\

Este calculo puede ser realizado con una formula mas sencilla dada por; \[S_e=\sqrt{\frac{\sum Y^2-b\sum Y-m\sum XY}{n-2}}\]

# calculando las estimaciones de y
(prest <- m*dg+b)
##  [1] 34.07482 32.67729 27.78594 23.74863 33.29841 34.15246 31.66796 26.31077
##  [9] 27.63066 25.61200 18.54672 36.94752 31.04684
regej$fitted.values
##        1        2        3        4        5        6        7        8 
## 34.07482 32.67729 27.78594 23.74863 33.29841 34.15246 31.66796 26.31077 
##        9       10       11       12       13 
## 27.63066 25.61200 18.54672 36.94752 31.04684
pr
##  [1] 35.9 31.8 24.7 25.2 36.8 35.3 33.4 25.4 31.4 27.4 15.8 31.5 28.9
regej$model$pr
##  [1] 35.9 31.8 24.7 25.2 36.8 35.3 33.4 25.4 31.4 27.4 15.8 31.5 28.9
# calculando el error de la estimación
sqrt(sum((pr-prest)^2)/(n-2))
## [1] 2.897829
sqrt((sum(pr*pr)-b*sum(pr)-m*sum(dg*pr))/(n-2))
## [1] 2.897829
summary(regej)
## 
## Call:
## lm(formula = pr ~ dg)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -5.447 -2.147  1.147  1.788  3.769 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  40.5966     1.9836  20.467 4.17e-10 ***
## dg           -0.7764     0.1269  -6.119 7.53e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.898 on 11 degrees of freedom
## Multiple R-squared:  0.7729, Adjusted R-squared:  0.7523 
## F-statistic: 37.44 on 1 and 11 DF,  p-value: 7.53e-05
sqrt(var(regej$residuals)*(n-1)/(n-2)) # otra forma de calcular el error de estimación
## [1] 2.897829

Coeficiente de correlación

Una de las medidas mas usadas es el coeficiente de correlación que nos permite calcular que tan relacionados estan los datos, si el valor es cercano a cero existe poca correlación, si es cercano a uno tenemos correlación positiva es decir una relación directamente proporcional, si es cercano a menos uno es inversamente proporcional.

\[r=\frac{\sum(x-\overline{x})(y-\overline{y})}{\sqrt{\sum(x-\overline{x})^2}\sqrt{\sum(y-\overline{y})^2}}\]

Ejemplo

(r <- (sum((dg-mean(dg))*(pr-mean(pr))))/sqrt(sum((dg-mean(dg))^2)*sum((pr-mean(pr))^2)))
## [1] -0.8791652
r^2
## [1] 0.7729314
summary(regej)
## 
## Call:
## lm(formula = pr ~ dg)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -5.447 -2.147  1.147  1.788  3.769 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  40.5966     1.9836  20.467 4.17e-10 ***
## dg           -0.7764     0.1269  -6.119 7.53e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.898 on 11 degrees of freedom
## Multiple R-squared:  0.7729, Adjusted R-squared:  0.7523 
## F-statistic: 37.44 on 1 and 11 DF,  p-value: 7.53e-05

Ejemplo 2 Donantes de sangre

# leyendo el archivo con los datos
BSHGM20240123 <- read.csv("Banco_de_sangre__Hospital_General_de_Medell_n_20240123.csv")
BSHGM20240123 <- na.omit(BSHGM20240123)
reg1 <- lm(EDAD ~ ESTATURA, data = BSHGM20240123)
# visualizando datos
plot(BSHGM20240123$ESTATURA,BSHGM20240123$EDAD, main = "Regresion Edad vs Estatura", xlab = "Estatura", ylab = "Edad")
# agregando recta por minimos cuadrados
abline(reg1, col = "blue4")

summary(reg1)
## 
## Call:
## lm(formula = EDAD ~ ESTATURA, data = BSHGM20240123)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -37.491 -10.596  -1.361   9.509  66.704 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  48.6722     1.2295  39.588   <2e-16 ***
## ESTATURA     -6.5005     0.7385  -8.802   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 12.48 on 28935 degrees of freedom
## Multiple R-squared:  0.002671,   Adjusted R-squared:  0.002636 
## F-statistic: 77.48 on 1 and 28935 DF,  p-value: < 2.2e-16
reg2 <- lm(BSHGM20240123$PESO ~ BSHGM20240123$ESTATURA)
summary(reg2)
## 
## Call:
## lm(formula = BSHGM20240123$PESO ~ BSHGM20240123$ESTATURA)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -85.875  -8.419  -1.778   6.449 155.614 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            -30.4543     1.1815  -25.78   <2e-16 ***
## BSHGM20240123$ESTATURA  62.2784     0.7097   87.75   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.99 on 28935 degrees of freedom
## Multiple R-squared:  0.2102, Adjusted R-squared:  0.2102 
## F-statistic:  7701 on 1 and 28935 DF,  p-value: < 2.2e-16
# visualizando datos
plot(BSHGM20240123$ESTATURA,BSHGM20240123$PESO, main = "Regresion Peso vs Estatura", xlab = "Estatura", ylab = "Peso")
# agregando recta por minimos cuadrados
abline(reg2, col = "blue4")

reg3 <- lm(PESO ~ ESTATURA + EDAD, data = BSHGM20240123)
summary(reg3)
## 
## Call:
## lm(formula = PESO ~ ESTATURA + EDAD, data = BSHGM20240123)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -84.134  -8.268  -1.918   6.116 154.537 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -37.935179   1.197490  -31.68   <2e-16 ***
## ESTATURA     63.277476   0.701511   90.20   <2e-16 ***
## EDAD          0.153699   0.005577   27.56   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.84 on 28934 degrees of freedom
## Multiple R-squared:  0.2304, Adjusted R-squared:  0.2303 
## F-statistic:  4331 on 2 and 28934 DF,  p-value: < 2.2e-16

Ejemplo 3 Analisis del pH

Análisis del pH usando los datos del proyecto Purple-Angel ejecutado entre la Asociación Nacional de Hidrocarburos (ANH) y el Instituto de Investigaciones Marinas y Costeras (INVEMAR), particularmente en el marco del proyecto INVEMAR-ANH I donde se caracterizan los fondos oceanicos y masas de agua de los bloques marinos sujetos a exploracion de hidrocarburos ubicado en la zona del mar caribe 8°54’36.4”N 76°54’33.0”W, se plantea la lectura inicial de alrededor de 29 parámetros cuyos datos fueron tomados en epoca seca durante el año 2015.

library(readxl)
DCAPA <- read_excel("Datos calidad de aguas (proy_PurpleAngel).xls")
str(DCAPA)
## tibble [60 × 10] (S3: tbl_df/tbl/data.frame)
##  $ Profundidad     : num [1:60] 5 5 150 550 5 150 550 1500 5 150 ...
##  $ Transparencia   : chr [1:60] "7" "5" "NaN" "NaN" ...
##  $ Temperatura     : num [1:60] 29.7 29.8 22.4 7.7 29.9 ...
##  $ Salinidad       : num [1:60] 32.9 31.8 36.8 34.9 32.9 36.8 34.9 34.9 31.9 36.8 ...
##  $ pH              : num [1:60] 8.14 8.17 8.02 7.69 8.13 8.04 7.8 7.84 8.15 8.06 ...
##  $ OD              : num [1:60] 6.29 6.41 4.61 3.92 6.32 ...
##  $ NitritosNitratos: num [1:60] 523 441 719 951 353 ...
##  $ Fosfatos        : num [1:60] 10 10 27.7 58.6 10 ...
##  $ Amonio          : num [1:60] 1.5 1.5 1.5 1.5 3 1.5 1.5 3.02 4.1 4.8 ...
##  $ Turbidez        : num [1:60] 0.2 0.4 0.13 0.1 0.2 0.19 0.1 0.1 0.4 0.16 ...
head(DCAPA,10)

de estos parametros solo 9 son objetos del actual estudio ya que muchos resultados se presentan con valores NAN asignados a mediciones por fuera del limite de detección o cuantificación y aquellos que no fueron analizados, se toman los 64 datos para cada parametro en consecuencia se analizan las siguientes variables:

Variable Dato Unidades
\(y\) pH (Potencial de Hidrogeno)
\(x_1\) Profundidad m
\(x_2\) Temperatura ºC
\(x_3\) Salinidad
\(x_4\) OD (Oxigeno Disuelto) mg/L
\(x_5\) Nitritos+Nitratos \(\mu g/L\)
\(x_6\) Fosfatos \(\mu g/L\)
\(x_7\) Amonio \(\mu g/L\)
\(x_8\) Turbidez NTU

Donde se tomara como variable explicada el pH y variables regresoras la Profundidad, Temperatura, Salinidad, Oxigeno Disuelto, Nitritos+Nitratos, Fosfatos, Amonio y Turbidez, se aclara que la compilacion de los datos se unificaron Nitritos+Nitratos en una sola medicion y de manera similar se hizo con los fosfatos y ortofosfatos, así mismo se eliminaron tres mediciones que no fueron tomadas o estaban fuera de los limites en algunas profundidades especificas, estas mediciones no se reemplazan por las medias debido a que pueden ser medidas atipicas.

reg1 <- lm(pH ~ Profundidad + Temperatura + Salinidad + OD + NitritosNitratos + Fosfatos + Amonio +Turbidez, data = DCAPA)
summary(reg1)
## 
## Call:
## lm(formula = pH ~ Profundidad + Temperatura + Salinidad + OD + 
##     NitritosNitratos + Fosfatos + Amonio + Turbidez, data = DCAPA)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.157824 -0.009839  0.007300  0.024803  0.052239 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       6.768e+00  3.044e-01  22.234  < 2e-16 ***
## Profundidad      -3.354e-05  6.916e-05  -0.485  0.62978    
## Temperatura       4.869e-03  4.095e-03   1.189  0.23996    
## Salinidad         2.772e-02  8.140e-03   3.405  0.00130 ** 
## OD                5.388e-02  1.665e-02   3.236  0.00213 ** 
## NitritosNitratos -1.185e-04  5.274e-05  -2.247  0.02902 *  
## Fosfatos         -3.493e-04  3.061e-04  -1.141  0.25921    
## Amonio            6.186e-03  5.441e-03   1.137  0.26090    
## Turbidez          6.554e-02  1.408e-01   0.465  0.64366    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0406 on 51 degrees of freedom
## Multiple R-squared:  0.917,  Adjusted R-squared:  0.9039 
## F-statistic: 70.41 on 8 and 51 DF,  p-value: < 2.2e-16
reg2 <- lm(pH ~ Salinidad + OD + NitritosNitratos, data = DCAPA)
summary(reg2)
## 
## Call:
## lm(formula = pH ~ Salinidad + OD + NitritosNitratos, data = DCAPA)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.13730 -0.03054  0.01237  0.03751  0.12771 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       7.292e+00  2.642e-01  27.598  < 2e-16 ***
## Salinidad         2.323e-02  6.836e-03   3.399  0.00125 ** 
## OD                3.944e-02  6.884e-03   5.730 4.17e-07 ***
## NitritosNitratos -4.524e-04  3.918e-05 -11.546  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.05714 on 56 degrees of freedom
## Multiple R-squared:  0.8194, Adjusted R-squared:  0.8097 
## F-statistic: 84.71 on 3 and 56 DF,  p-value: < 2.2e-16
reg3 <- lm(pH ~ Temperatura + Salinidad + OD + NitritosNitratos, data = DCAPA)
summary(reg3)
## 
## Call:
## lm(formula = pH ~ Temperatura + Salinidad + OD + NitritosNitratos, 
##     data = DCAPA)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.159529 -0.009662  0.004774  0.026274  0.068491 
## 
## Coefficients:
##                    Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       6.952e+00  1.907e-01  36.454  < 2e-16 ***
## Temperatura       7.320e-03  9.560e-04   7.657 3.17e-10 ***
## Salinidad         2.275e-02  4.800e-03   4.740 1.55e-05 ***
## OD                4.487e-02  4.884e-03   9.186 1.07e-12 ***
## NitritosNitratos -1.359e-04  4.966e-05  -2.737  0.00835 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.04012 on 55 degrees of freedom
## Multiple R-squared:  0.9126, Adjusted R-squared:  0.9062 
## F-statistic: 143.6 on 4 and 55 DF,  p-value: < 2.2e-16

Bibliografia

  1. Montgomery, D.C., Runger, G.C. (2002). Probabilidad y Estad'istica aplicadas a la ingenier'a. Editorial Limusa Wiley.
  2. Walpole, Ronald E. (2007) Probabilidad y estad'istica para ingenier'ia y ciencias. Editorial Pearson.
  3. Canavos, George. (1999) Probabilidad y Estadística. Editorial Mc. Graw Hill. M
  4. https://www.datos.gov.co/Salud-y-Protecci-n-Social/Banco-de-sangre-Hospital-General-de-Medell-n/65is-zhxx/about_data
  5. http://anh.invemar.org.co/descarga-datos