1 Análisis de regresión simple.

Supongamos que se extrae una muestra de farmacias instaladas en la ciudad de Querétaro. Los datos de la Tabla 1 corresponden a los costos \((x_i)\) y ventas \((y_i)\) de las 12 farmacias seleccionadas en la muestra.

Los datos se capturan en R de la siguiente manera:

datos_ejem<-matrix(c(11,19,10,15,14,20,13,14,12,16,20,33,21,32,
15,18,22,29,18,22,19,23,16,20),ncol=2,byrow=T) #Se capturan los datos en forma de matriz

dato_ejem2<-data.frame(Costo=datos_ejem[,1],Venta=datos_ejem[,2]) #Se arreglan los datos en forma de marco de datos

Se ajusto el modelo de regresión lineal simple mediante las siguientes instrucciones:

regre_ejem<-lm(Venta~Costo,data=dato_ejem2)
summary(regre_ejem)
## 
## Call:
## lm(formula = Venta ~ Costo, data = dato_ejem2)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.6914 -2.5181 -0.7575  1.9065  5.5679 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  -0.3984     3.8889  -0.102 0.920421    
## Costo         1.3915     0.2374   5.862 0.000159 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.193 on 10 degrees of freedom
## Multiple R-squared:  0.7746, Adjusted R-squared:  0.7521 
## F-statistic: 34.37 on 1 and 10 DF,  p-value: 0.0001589

Se observa de la anterior salida que, la variable \(costo\) sí es significativa (p valor de 0.000159). El valor de \(R_{ajustada}^2\) es muy bueno (75.21%).

Para ilustrar el ajuste del modelo de regresión, se realiza un gráfico de dispersión, donde se muestra (en color rojo) la recta de regresión obtenida mediante el método de Mínimos cuadrados. En azul, se muestran otras rectas no obtenidas mediante dicho método.

plot(dato_ejem2)
abline(a=-0.3984,b=1.3915,col="red",lwd=2) #Recta de mínimos cuadrados
abline(a=-0.3984,b=1.2315,col="blue",lwd=2) #No mínimos cuadrados
abline(a=-0.3984,b=1.59,col="blue",lwd=2) #No mínimos cuadrados
abline(a=-0.3984,b=2.3915,col="blue",lwd=2) #No mínimos cuadrados
legend("topleft",legend = c("Mínimos cuadrados","No mínimos cuadrados"),
       col=c("Red","Blue"),pch="-----",cex=1.5)

Se realiza un análisis de varianza para visualizar la proporción de varianza explicada por el modelo y por los residuales.

summary(aov(regre_ejem))
##             Df Sum Sq Mean Sq F value   Pr(>F)    
## Costo        1  350.3   350.3   34.37 0.000159 ***
## Residuals   10  101.9    10.2                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

De lo anterior se puede notar que el total de varianza es: 350.3+101.9 = 452.2, de la cual (350.3/452.2) el 77.49% es explicada por el modelo, y el restante 22.51% por los residuales.

Los intervalos de confianza para los coefiencientes se obtienen de la siguiente manera:

regre_ejem$coefficients
## (Intercept)       Costo 
##  -0.3984339   1.3915246
resumen_regre<-summary(regre_ejem)

confint(regre_ejem)
##                 2.5 %   97.5 %
## (Intercept) -9.063393 8.266526
## Costo        0.862639 1.920410

Ahora, si se desea estimar las ventas promedio para farmacias que reportan un costo de \(25\), se obtiene mediante la siguiente instrucción:

predict(regre_ejem, newdata=data.frame(Costo=25),interval='confidence',level=0.95)
##        fit      lwr      upr
## 1 34.38968 29.16512 39.61424

Supóngase que se desea realizar un intervalo de predicción para los costos de 30 y 35, lo cual se obtiene con la siguiente instrucción:

predict(regre_ejem, newdata=data.frame(Costo=c(30,35)),interval='prediction',level=0.95)
##        fit      lwr      upr
## 1 41.34731 30.84478 51.84983
## 2 48.30493 35.78735 60.82251

1.1 Análisis de residuales

El siguiente paso a seguir corresponde a la validación de los supuestos del modelo mediante el análisis de los residuales. El primer supuesto a probar es el relacionado a la distribución de los residuales. Dichos residuales se analizarán en su versión estandarizada. Este supuesto se probará mediante el gráfico QQ Normal y mediante la prueba Shapiro-Wilk. El gráfico se obtiene mediante las siguientes instrucciones:

residuales_stand<-rstandard(regre_ejem)
qqnorm(residuales_stand,pch=19)
qqline(residuales_stand)

La prueba de Shapiro-Wilk se obtiene al ejecutar las siguientes instrucciones:

shapiro.test(residuales_stand)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuales_stand
## W = 0.92236, p-value = 0.3061

Al observar el p valor de la prueba de Shapiro-Wilk y el gráfico QQ Normal, podemos concluir que los residuales sí siguen una distribución Normal.

En cuanto al supuesto de varianza constante, con las siguientes instrucciones se realizará el gráfico necesario para dicho supuesto:

plot(regre_ejem$fitted.values,residuales_stand,xlab = "y_ajustados",ylab ="res_estand")

Se observa en el gráfico anterior que la varianza es constante a lo largo de los valores ajustados.

Finalmente, se investigará si existen outliers entre los residuales, para lo cual se generan estadísticas de resumen de estos mediante la siguiente instrucción:

summary(residuales_stand)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1.23982 -0.82820 -0.27699  0.01926  0.69246  1.92061

Se observa de lo anterior que no existen outliers mayores a 3. En resumen, se cumplieron los supuestos del modelo y no existen outliers, el modelo mostró un buen ajuste y explica un buen porcentaje de la varianza.