Regresión lineal simple

Importar

Datos

library(pacman)
p_load("base64enc", "htmltools", "mime", "xfun", "prettydoc", "readr", "knitr", "DT", "scales", "tidyverse", "gridExtra", "modeest", "fdth")
library(readr)
tuberculosis <- read_csv("C:/Users/urias/Downloads/Tasa_incidencia_tuberculosis_Serie_Historica.csv")
## Parsed with column specification:
## cols(
##   Periodo = col_double(),
##   Confirmados = col_double(),
##   `Población total` = col_double(),
##   Incidencia = col_double()
## )
names(tuberculosis)
## [1] "Periodo"         "Confirmados"     "Población total" "Incidencia"

Visualizar

head(tuberculosis)
## # A tibble: 6 x 4
##   Periodo Confirmados `Población total` Incidencia
##     <dbl>       <dbl>             <dbl>      <dbl>
## 1    2014       20126         119713203      16.8 
## 2    2014          56           1270174       4.41
## 3    2014        1897           3432944      55.3 
## 4    2014         170            741037      22.9 
## 5    2014         125            894136      14.0 
## 6    2014         528           2925594      18.0

Analisis de correlación

  • Matriz de diagramas de dispersión
pairs(tuberculosis) #relaciona contra todas las variables

A continuación se hará una cuantificación del grado de relación linea, por medio de la matriz de coeficientes de correlación.

cor(tuberculosis)
##                     Periodo Confirmados Población total  Incidencia
## Periodo          1.00000000  0.01384052      0.03333385 -0.09740436
## Confirmados      0.01384052  1.00000000      0.98073184  0.06640346
## Población total  0.03333385  0.98073184      1.00000000 -0.05538975
## Incidencia      -0.09740436  0.06640346     -0.05538975  1.00000000

Con esto observamos que a medida que aumenta la edad de una persona, aumenta el contenido de grasas en su cuerpo con un indice de relacion del 83% Esto explicado con un coeficiente de correlación de: 0.8373534

Recta de minimos cuadrados

regresion <- lm(Incidencia ~ Periodo, data=tuberculosis)
summary(regresion)
## 
## Call:
## lm(formula = Incidencia ~ Periodo, data = tuberculosis)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -16.450  -8.856  -2.059   6.881  40.683 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)   
## (Intercept) 319.58576  106.93798   2.989  0.00289 **
## Periodo      -0.14997    0.05342  -2.808  0.00511 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 11.06 on 823 degrees of freedom
## Multiple R-squared:  0.009488,   Adjusted R-squared:  0.008284 
## F-statistic: 7.883 on 1 and 823 DF,  p-value: 0.005108

Con base a lo estimado en el analisis de regresión lineal, obtenemos la ecuación de la recta de minimos cuadrados

\[y = 319.58576 - 0.14997x\]

Grafica de la Recta de minimos cuadrados

plot(tuberculosis$Incidencia, tuberculosis$Periodo, xlab="Incidencia", ylab="Periodo")
abline(regresion)

Modelación (cálculo) de predicciones

nuevas.incidencias <- data.frame(Periodo=seq(20,50))
predict(regresion,nuevas.incidencias)
##        1        2        3        4        5        6        7        8 
## 316.5863 316.4363 316.2864 316.1364 315.9864 315.8364 315.6865 315.5365 
##        9       10       11       12       13       14       15       16 
## 315.3865 315.2365 315.0866 314.9366 314.7866 314.6366 314.4867 314.3367 
##       17       18       19       20       21       22       23       24 
## 314.1867 314.0368 313.8868 313.7368 313.5868 313.4369 313.2869 313.1369 
##       25       26       27       28       29       30       31 
## 312.9869 312.8370 312.6870 312.5370 312.3870 312.2371 312.0871

\[ y_i = \beta_0 + \beta_1 x_i + \epsilon_i, \ \ \ \ i=1,\ldots,n, \] Donde: * Los errores aleatorios \(\epsilon_i\) son independientes con distribucion normal 0 y varianza \(\sigma^2\)

  • Los errores

Intervalo de confianza

  • Intervalo de confianza para el 95% de los datos
confint(regresion, level=0,90)
##      50 % 50 %
## <NA>   NA   NA

Representacion grafica de los intervalos de confianza

nuevas.incidencias <- data.frame(Periodo=seq(20,60))
#Grafico de disprecion y recta
plot(tuberculosis$Incidencia, tuberculosis$Periodo, xlab="Incidencia", ylab="Periodo")
abline(regresion)

#Intervalos de confianza de la respuesta media
# ic es una matriz que tendrá 3 columnas:
# La 1ra que es la predicción, y las otras son los extremos del intervalo
ic <- predict(regresion, nuevas.incidencias, interval = "confidence")
lines(nuevas.incidencias$Periodo, ic[, 2], lty=2)
lines(nuevas.incidencias$Periodo, ic[, 3], lty=3)

#Intervalos de predicción
ic <- predict(regresion, nuevas.incidencias, interval = "prediction")
lines(nuevas.incidencias$Periodo, ic[, 2], lty=2, col = "blue")
lines(nuevas.incidencias$Periodo, ic[, 3], lty=3, col = "blue")

Conclusion

En este script vemos la varianza entre la Incidencia por 1000 de poblacion en los periodos del 1990, 2000 y 2010, acerca de la enfermedad de tuberculosis en México.