Para esto se colectaron los últimos 12 meses de datos de búsquedas de Google a través de la herramienta Google Trends: https://trends.google.com.mx
library(pacman)
p_load("readr", "DT")
library(readr)
busquedas <- read_csv("~/3er Semestre/ProbYEst/multiTimeline.csv", col_types = cols(contaminacion = col_number(), reciclaje = col_number()))
datatable(busquedas)
Consideramos que los datos si están relacionados. Debido a que la gente busca cubrebocas por la situación actual de la pandemia.
Para esto realizaremos una matríz de diagramas de dispersión
pairs(busquedas)
cor(busquedas)
## contaminacion reciclaje
## contaminacion 1.000000 0.939014
## reciclaje 0.939014 1.000000
Se hace el ajuste de la tendencia de los puntos a un modelo lineal (lm)
regresion <- lm(formula=reciclaje ~ contaminacion, data=busquedas)
summary(regresion)
##
## Call:
## lm(formula = reciclaje ~ contaminacion, data = busquedas)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3220 -1.2510 0.1033 1.5327 5.0345
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.32595 0.70081 10.45 3.54e-14 ***
## contaminacion 0.21423 0.01109 19.31 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.376 on 50 degrees of freedom
## Multiple R-squared: 0.8817, Adjusted R-squared: 0.8794
## F-statistic: 372.8 on 1 and 50 DF, p-value: < 2.2e-16
Ecuación de la recta de mínimos cuadrados
\[ y = 7.32595 + 0.21423x \]
Trazado de la recta de mínimos cuadrados
plot(busquedas$contaminacion, busquedas$reciclaje, xlab="Búsquedas de contaminacion", ylab="Búsquedas de reciclaje");
abline(regresion)
### Modelación (cálculo) de predicciones
nuevas.reciclajes <- data.frame(contaminacion=seq(20,50))
predict(regresion,nuevas.reciclajes)
## 1 2 3 4 5 6 7 8
## 11.61054 11.82476 12.03899 12.25322 12.46745 12.68168 12.89591 13.11014
## 9 10 11 12 13 14 15 16
## 13.32437 13.53860 13.75283 13.96706 14.18129 14.39552 14.60974 14.82397
## 17 18 19 20 21 22 23 24
## 15.03820 15.25243 15.46666 15.68089 15.89512 16.10935 16.32358 16.53781
## 25 26 27 28 29 30 31
## 16.75204 16.96627 17.18050 17.39472 17.60895 17.82318 18.03741
\[ 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\)
confint(regresion, level=0,90)
## 50 % 50 %
## <NA> NA NA
nuevas.reciclajes <- data.frame(contaminacion=seq(20,60))
#Grafico de disprecion y recta
plot(busquedas$contaminacion, busquedas$reciclaje, xlab="contaminacion", ylab="reciclaje")
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.reciclajes, interval = "confidence")
lines(nuevas.reciclajes$contaminacion, ic[, 2], lty=2)
lines(nuevas.reciclajes$contaminacion, ic[, 3], lty=3)
#Intervalos de predicción
ic <- predict(regresion, nuevas.reciclajes, interval = "prediction")
lines(nuevas.reciclajes$contaminacion, ic[, 2], lty=2, col = "purple")
lines(nuevas.reciclajes$contaminacion, ic[, 3], lty=3, col = "purple")
Con base a lo visto en lo anterior, podemos darnos cuenta que tienen una relacion a la hora de buscar contaminacion y reciclaje, se puede decir que tienen un incremento ya que estan parecidos, ya que la informacion acerca de la contaminacion te puede dar indicios de querer empezar a reciclar y buscar informacino acerca de eso.