R Markdown
#Para abrir los datos me meto a la parte superior derecha de rstudio (donde está el panel "environment"); clic en el botón "Import Dataset"
#1
#Queremos explicar el número pasajeros de autobús con las siguientes variables: la variable indicadora si hubo o no escuela, la variable
#indicadora día de la semana, la precipitación promedio, la nieve promedio, la temperatura máxima del día, la temperatura mínima del día, la
#temperatura promedio del día, el mes del día en el que estamos y el año en cuestión.Para ellos realizaremos varias regresiones para ver la relación de dichas
#variablescon el número de pasajeros.
busrider<-data_final_project$Bus_ridership
school<-data_final_project$School
dayoftheweek<-data_final_project$Day_of_week
precipitacion<-data_final_project$PRCP
snow<-data_final_project$SNOW
tempmax<-data_final_project$TMAX
tempmin<-data_final_project$TMIN
tempprom<-data_final_project$TAVG
month<-data_final_project$Month
year<-data_final_project$Year
ind<-data_final_project$ind
busridersxday<-lm(busrider~dayoftheweek)
summary(busridersxday)
confint(busridersxday,level=.95)
#2
#date: cualitativa, ordinal
#busrider: cuantitativa, razon y discreta
#school: cualitativa, nominal
#dayoftheweek: cualitativa nominal
#precipitacion: cuantitativa, razon y continua
#snow: cuantitativa, razon y continua
#tempmax: cuantitativa, intervalo y continua
#tempmin: cuantitativa, intervalo y continua
#tempprom: cuantitativa, intervalo y continua
#month: cualitativa, nominal
#year: cuantitativa, intervalo y discreta
hist(busrider, main= "Histograma 1: Busriders")
# Esta sesgado a la izquierda
hist(precipitacion, main= "Histograma 2: Precipitación")
# La precipitacion es poca
hist(snow, main= "Histograma 3: Snow")
#Hay poca nieve
hist(tempmax, main= "Histograma 4: Temperatura máxima")
#La temperatura maxima va aprox de 15 a 100 Farenheit, es constante
hist(tempmin, main= "Histograma 5: Temperatura mínima")
#La temperatura minima va aprox de 0 a 80 Farenheit, es constante
hist(tempprom, main= "Histograma 6: Temperatura promedio")
#La temperatura promedio va aprox de 10 a 90 Farenheit, es constante
hist(year)
#En realidad no es necesario hacer este histograma ya que no me dice nada
boxplot(busrider~school, main="Boxplot 1: (Busriders ~ School)")
#Hay mas busriders en los dias que hay escuela, y en los que no hay escuela, hay mayor dispersion (no hay certeza de la disponibilidad de los busriders)
boxplot(busrider~dayoftheweek, main="Boxplot 2: (Busriders ~ Day of the week)")
#Para los fines de semanas hay menos busriders, y para los de entre semana permanece constante (la gente tiene una rutina).
plot(precipitacion,busrider, main="A) Plot (Precipitación , Busriders)")
#A mayor precipitacion menos busriders. No es seguro manejar con lluvia y la gente prefiere quedarse resguardada.
plot(snow,busrider, main="B) Plot (Snow , Busriders)")
#A mayor snow, menos busriders. No es seguro manejar con nieve y la gente prefiere quedarse resguardada.
plot(tempmax,busrider, main="C) Plot (Temperatura máxima , Busriders)")
#La temperatura máxima separa a los bus drivers en dos grupos.
plot(tempmin,busrider, main="D) Plot (Temperatura mínima , Busriders)")
#La temperatura mínima separa a los bus drivers en dos grupos.
plot(tempprom,busrider, main="E) Plot (Temperatura promedio , Busriders)")
#La temperatura promedio separa a los bus drivers en dos grupos.
#3a
modeloa<-lm(busrider~school) #modelo de busriders con escuela
summary(modeloa)
#Si no hay escuelas, el promedio de busriders es de 929006, y por pasar de un dia sin escuela a un dia con escuela, el numero de busriders aumenta en 460305, en promedio
#Como los pvalues son menores a .1 son significativos, si hay relacion positiva: pvalue busriders (B0) < .1 , pvalue school < .1
#La R2 es .5358, por lo que el 53.58% de la varianza de busriders se explica por el modelo
#3b
#Supongo Supuestos Esféricos
residuosa<-residuals(modeloa)
qqnorm(residuosa, main= "QQ Plot Modelo A") #ando probando si se cumple o no la normalidad
#La gráfica qqplot de los errores no parece una línea recta, por lo que no parece ser Normal. Vamos a confirmar con Jarque Bera
install.packages("moments")
install.packages("tseries")
load("tseries")
jarque.bera.test(residuosa)
#Como el pvalue JB es .01736 que es menor a .1, Rechazo H0, por lo que los errores no se distribuyen Normal
#4a
modelob<-lm(busrider~school+tempmax+precipitacion+dayoftheweek)
summary(modelob)
confint(modelob,level=.95)
residuosb<-residuals(modelob)
qqnorm(residuosb, main= "QQ Plot Modelo B")
jarque.bera.test(residuosb)
#Si no hay escuela, la temperatura maxima es cero, no hay precipitacion, el dia es viernes, el numero promedio de busriders es de 892289.9 (B0)
#Por pasar de un dia sin escuela a un dia con escuela el numero de busriders aumenta en promedio 255253.4 (B1)
#Por cada grado farenheit adicional el numero de busriders aumenta en promedio 3494.9 (B2)
#Por cada pulgada de lluvia adicional el numero de busriders dismninuye en promedio 65038.2 (B3)
#Por pasar de viernes a lunes el numero de busriders disminuye en promedio 23697.1 (B4)
#Por pasar de viernes a sabado el numero de busriders disminuye en promedio 292748.5 (B5)
#Por pasar de viernes a domingo el numero de busriders disminuye en promedio 466590.1 (B6)
#Por pasar de viernes a jueves el numero de busriders aumenta en promedio 60464.6 (B7)
#Por pasar de viernes a martes el numero de busriders aumenta en promedio 69334.5 (B8)
#Por pasar de viernes a miercoles el numero de busriders aumenta en promedio 82251.0 (B9)
#Como todos los pvalues son menroes a .1 (rechazo H0), todas las variables son significativas.
#La R2 es .8708, el 87.08% de la varianza de busriders se explica por el modelo.
#El unico intervalo que contiene al cero, es el de Lunes, lo que nos dice que no hay diferencia estadística entre el viernes y el lunes al 95%
#4b
# en el primer modelo la beta de escuela es 460305, mientras que para el modelo con las variables adicionales salio de 25253.4, el cambio fue que se agregaron variables que le quitan importancia a school.
#4c
#modeloa R2=.5358
#modelob R2=.8708
#Estas R2 no son comparables, para comparar usamos las ajustadas, en el modelo A salio R2adj=.5354 y el modelo B .8698, lo que nos indica que es mejor el modelo B
#5a
modeloc<-lm(busrider~precipitacion+snow+tempmax+tempmin+tempprom)
summary(modeloc)
#Si no hay lluvia, ni nieve y todas las temperaturas son cero, entonces el numero promedio de busriders es 1021670 (B0)
#por cada pulgada adicional de precipitacion el numero de busriders disminuye en rpomedio 72564 (B1)
#por cadaq pulgqada adicional de nieve, el numero de busriders disminuye en promedio 74198 (B2)
#por cada grada adicional farenheit de temperatura maxima el numero de busriders auemnta en promedio 1918 (B3)
#por cada grado adicional faerenheit de temperatura minimia el numoer de busriders disminiye en promedio 8011 (B4)
#por cada grado adicional farenheit de temperatrura promedio el numero de busriders disminuy en promedio 7300 (B5)
#Las variables temperatura maxima y temperatura promedio son estaditicamente iguales a cero (sus pvalues son mayores a .1)
#la R2 es .03401, solo el 3.4% de la varianza de busriders se explica por el modelo.
#5b
modelod<-lm(busrider~school+tempmax+school*tempmax) #interacción de tempmax * school
summary(modelod)
#interacción de tempmax * school
#Si no hay escuela y la temperatura maxima es cero, entontces el numero promedio de busriders es 426312.6 (B0)
#Si hay escuela y la temperatura maxima es cero, entonces el numero promedio de busriders es (426312.6+764514.4)
#Si no hay escuela, por cada grado farenheit el numero promedio de busriders aumenta en 7357.1, en promedio
#Si hay escuela, por cada grado farenheit, el numero promedio de busriders auemnta en (7357.1-4044.8), en promedio
#Como todos los pvalues son menores a .1, todas son significativas
#La R2=.6299, el 62.99% de la variacion de Busriders se explcia por el modeolo
#5c
desvestbusrider<-sd(busrider)
desvestprecipitacion<-sd(precipitacion)
desvestsnow<-sd(snow)
desvesttempmax<-sd(tempmax)
desvesttempmin<-sd(tempmin)
desvesttempprom<-sd(tempprom)
beta1estand<-(-72564)*desvestprecipitacion/desvestbusrider
beta2estand<-(-74198)*desvestsnow/desvestbusrider
beta3estand<-(1918)*desvesttempmax/desvestbusrider
beta4estand<-(-8011)*desvesttempmin/desvestbusrider
beta5estand<-(7300)*desvesttempprom/desvestbusrider
beta1estand
beta2estand
beta3estand
beta4estand
beta5estand
#Como la beta estadanrizada mas grande en valor absoluto es la beta 4, entonces la variable que mas influye es temperatura minima.
#6
modeloe<-lm(busrider~school+dayoftheweek+precipitacion+snow+tempmax+tempmin+tempprom+month+year)
summary(modeloe)
#usando el metodo Backwards, metemos todas las variables y quitamos la menos significativa, es decir, tempmin: 0.2473 > .1
modelof<-lm(busrider~school+dayoftheweek+precipitacion+snow+tempmax+tempprom+month+year)
summary(modelof)
#Como el pvalue de temprom es mayor a .1, la quitamos : 0.48056 > .1
modelog<-lm(busrider~school+dayoftheweek+precipitacion+snow+tempmax+month+year)
summary(modelog)
#Ahora en este modelo nos quedamos con todas las variables que son significativas
#El modelo g es el mejor modelo utilizando la técnica backwards
#Sabemos que el 4 de Diciembre de 2025 cae en Miércoles
#Vamos a utilizar los datos del clima de dos sitios para el 4 de diciembre de 2024: 36 grados farenheit y 37.4 grados farenheit. Promedio: 36.7 grados farenheit
#Además vamos a utilizar el pronóstico del sitio a continuación https://www.accuweather.com/es/us/new-york/10021/daily-weather-forecast/349727?day=10
#El pronóstico a continuación es usando datos sobre la precipitación, clima y nieve de google:
new_disp <- data.frame(
school = 1,
dayoftheweek = "Wednesday",
precipitacion = 0.00394,
snow = 0.787,
tempmax = 36.7,
month = 12,
year = 2024)
new_disp
predict(modelog,newdata=new_disp,interval="predict", level=.8)
# Para el 4 de diciembre se pronostica un numero de busriders de 1281103, y su intervalo va de 1138290 a 1423916 con una confianza del 80%
predict(modelog,newdata=new_disp,interval="predict", level=.9)
# Para el 4 de diciembre se pronostica un numero de busriders de 1281103, y su intervalo va de 1097762 a 1464444 con una confianza del 90%
predict(modelog,newdata=new_disp,interval="predict", level=.95)
# Para el 4 de diciembre se pronostica un numero de busriders de 1281103, y su intervalo va de 1062584 a 1499621 con una confianza del 95%
predict(modelog,newdata=new_disp,interval="predict", level=.99)
# Para el 4 de diciembre se pronostica un numero de busriders de 1281103, y su intervalo va de 993745.3 a 1568461 con una confianza del 99%
predict(modelog,newdata=new_disp,interval="predict", level=.999)
# Para el 4 de diciembre se pronostica un numero de busriders de 1281103, y su intervalo va de 913676.8 a 1648529 con una confianza del 99.9%
#la predicción de busriders para el 4 de Diciembre es 1281103 (o sea ŷ) PRONÓSTICO DE BUSRIDERS PARA DICIEMBRE 4 2024
#El pronóstico a continuación es usando regresión lineal simple para cada una de las variables:
modeloprecip<-lm(precipitacion~ind)
summary(modeloprecip)
precipitacionestimada<-.1016+.00002366*1191
precipitacionestimada
modelosnow<-lm(snow~ind)
summary(modelosnow)
snowestimada<-.05955-.00004198*1191
snowestimada
modelotempmax<-lm(tempmax~ind)
summary(modelotempmax)
tempmaxestimada<-59.276628-.00863*1191
tempmaxestimada
new_disp <- data.frame(
school = 1,
dayoftheweek = "Wednesday",
precipitacion = precipitacionestimada,
snow = snowestimada,
tempmax = tempmaxestimada,
month = 12,
year = 2024)
new_disp
predict(modelog,newdata=new_disp,interval="predict", level=.8)
# Para el 4 de diciembre se pronostica un numero de busriders de 1352885, y su intervalo va de 1210527 a 1495244 con una confianza del 80%
predict(modelog,newdata=new_disp,interval="predict", level=.9)
# Para el 4 de diciembre se pronostica un numero de busriders de 1352885, y su intervalo va de 1170128 a 1535643 con una confianza del 90%
predict(modelog,newdata=new_disp,interval="predict", level=.95)
# Para el 4 de diciembre se pronostica un numero de busriders de 1352885, y su intervalo va de 1135062 a 1570709 con una confianza del 95%
predict(modelog,newdata=new_disp,interval="predict", level=.99)
# Para el 4 de diciembre se pronostica un numero de busriders de 1352885, y su intervalo va de 1066442 a 1639329 con una confianza del 99%
predict(modelog,newdata=new_disp,interval="predict", level=.999)
# Para el 4 de diciembre se pronostica un numero de busriders de 1352885, y su intervalo va de 986628.2 a 1719142 con una confianza del 99.9%
#la predicción de busriders para el 4 de Diciembre es 1352885 (o sea ŷ) PRONÓSTICO DE BUSRIDERS PARA DICIEMBRE 4 2024.
#7
#Encontramos que las variables significativas son: la variable idicadora de escuela, la variable indicadora de día de la semana, la variable de precipitación,
#la variable de nieve, la variable de temperatura máxima, la variable de mes y la variable de año. Para el día miércoles 4 Diciembre del 2024 tomando en cuenta que
#hay escuela, con temperatura maxima estimada, precipitación estimada, nieve estimada, la prediccío de número de pasajeros de autobús es de 1281103 o de 1352885 (según los datos estimados escogidos).
#Cabe mencioanr que hay factores como la nieve y la precipitación que alteran el numero de busriders