Mínimos Cuadrados

  1. La tabla refleja un modelo de elasticidad de la demanda, donde el precio aumenta con la producción hasta un punto máximo y luego disminuye a medida que la oferta supera la demanda.

El modelo matemático que lo representa es el siguiente:

\[{y}=\alpha x e^{\beta x}\]

x <- c(0.1, 0.2, 0.4, 0.6, 0.9, 1.3, 1.5, 1.7, 1.8)
y <- c(0.75, 1.25, 1.45, 1.25, 0.85, 0.55, 0.35, 0.28, 0.18)

tabla <- c(x,y)
matrix_tabla <- matrix(tabla, byrow = T, 2)
plot(x,y)

matrix_tabla <- data.frame(x = x, y = y)

\[y* = \beta x + \ln \alpha\]

a. Encuentre los coeficientes 𝛼 𝑦 𝛽, si es necesario, linealice el modelo dado.

y_mod1 <- log(y/x)

matrix_tabla["y_mod"] <- y_mod1
plot(x, y_mod1)

modelo1 <- lm(y_mod1~x, data = matrix_tabla)
modelo1
## 
## Call:
## lm(formula = y_mod1 ~ x, data = matrix_tabla)
## 
## Coefficients:
## (Intercept)            x  
##       2.268       -2.473
alpha <- exp(modelo1$coefficients[1])
alpha
## (Intercept) 
##    9.661786

El coeficiente de alpha es igual a 9.66, mientras que el coeficiente de Beta es igual a -2.47.

b. Con el modelo linealizado. Realice la validación de supuestos con respecto a los residuales.

modelo2 <- lm(y_mod1~x, data = matrix_tabla)
summary(modelo2)
## 
## Call:
## lm(formula = y_mod1 ~ x, data = matrix_tabla)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.118808 -0.050224 -0.005945  0.059065  0.132852 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.26818    0.05429   41.78 1.17e-09 ***
## x           -2.47331    0.04813  -51.38 2.77e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.08904 on 7 degrees of freedom
## Multiple R-squared:  0.9974, Adjusted R-squared:  0.997 
## F-statistic:  2640 on 1 and 7 DF,  p-value: 2.77e-10

ANÁLISIS DE RESIDUALES

plot(modelo2$residuals)

VALIDACIÓN DE SUPUESTOS

Normalidad

Ho: Hay normalidad Ha: No hay normalidad

shapiro.test(modelo2$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo2$residuals
## W = 0.97267, p-value = 0.9166

Con un valor-p = 0.9166 (no menor a 0.05). No hay evidencia estadísticamente significativa para rechazar la hipótesis nula. Por lo tanto, es razonable suponer normalidad en los residuales.

Independencia

Ho: \[\rho = 0\] Ha: \[\rho \neq 0\]

library(lmtest)
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
dwtest(modelo2)
## 
##  Durbin-Watson test
## 
## data:  modelo2
## DW = 2.5619, p-value = 0.6824
## alternative hypothesis: true autocorrelation is greater than 0

Con un valor-p de 0.6824 no hay evidencia suficiente para rechazar la hipótesis nula, por lo tanto, si hay independecia en los datos.

Varianza constante

bptest(modelo2)
## 
##  studentized Breusch-Pagan test
## 
## data:  modelo2
## BP = 4.5165, df = 1, p-value = 0.03357

Con un valor-p de 0.03357, podemos concluir que la varianza de los errores no es constante a lo largo de los valores de las variables independientes.

c. ¿Recomendaría el modelo generado?

No, recomendaría el modelo ya que la varianza constante tiene un valor p de 0.03 sugiere que la heteroscedasticidad es un problema significativo y que sería recomendable considerar alternativas para abordarla. Esto es debido a que los resultados pueden ser sesgados y no ser óptimos.

d. Use el modelo generado para pronosticar el valor de y, si 𝑥 = 2

\[y* = \beta x + \ln \alpha\]

alpha = 9.66 Beta = -2.47

alpha1 <- 9.66
alpha_ln <- log(alpha1)
Beta <- -2.47
x <- 2
y <- Beta*x+alpha_ln
y
## [1] -2.672006

y = -2.67006