Modelo de ventas empresa

                    Dependent variable:    
                ---------------------------
                             V

C 0.92*** (0.22)

P 0.95*** (0.16)

M 1.30*** (0.43)

Constant 107.44*** (18.06)

Observations 24
R2 0.98
Adjusted R2 0.98
Residual Std. Error 9.51 (df = 20)
F Statistic 323.64*** (df = 3; 20)
=============================================== Note: p<0.1; p<0.05; p<0.01

Normalizar residuos

library(fitdistrplus)

## Warning: package 'fitdistrplus' was built under R version 4.5.3

## Cargando paquete requerido: MASS

## Cargando paquete requerido: survival

fit_normal<-fitdist(data = modelo_ventas$residuals,distr = "norm")
plot(fit_normal)

## Pruebas de normalidad ### Prueba Jaque Bera

library(tseries)

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

salida_JB<-jarque.bera.test(modelo_ventas$residuals)
salida_JB

## 
##  Jarque Bera Test
## 
## data:  modelo_ventas$residuals
## X-squared = 1.4004, df = 2, p-value = 0.4965

Forma grafica

library(fastGraph)

## Warning: package 'fastGraph' was built under R version 4.5.3

alpha_sig<-0.05
JB<-salida_JB$statistic
gl<-salida_JB$parameter
VC<-qchisq(1-alpha_sig,gl,lower.tail = TRUE)
shadeDist(JB,ddist = "dchisq",
          parm1 = gl,
          lower.tail = FALSE,xmin=0,
          sub=paste("VC:",round(VC,2)," ","JB:",round(JB,2)))

conclusion Como 1.4(JB) < 5.991(VC), Se concluye que no se rechaza la hipótesis nula “Los residuales tienen distribución normal”

Prueba SW

### LIbreria stats
salida_SW <- shapiro.test(modelo_ventas$residuals)
print(salida_SW)

## 
##  Shapiro-Wilk normality test
## 
## data:  modelo_ventas$residuals
## W = 0.95315, p-value = 0.3166

Wn_salida<-qnorm(salida_SW$p.value,lower.tail = FALSE)
print(Wn_salida)

## [1] 0.4773519

Forma grafica

library(fastGraph)
shadeDist(Wn_salida,ddist = "dnorm",lower.tail = FALSE)

conclusion SW como 0.3166 (P Value) > 0.05(alpha), se concluye que no se rechaza la hipótesis nula, los residuos siguen una distribución normal.

Prueba KS

library(nortest)

## Warning: package 'nortest' was built under R version 4.5.2

prueba_KS<-lillie.test(modelo_ventas$residuals)
prueba_KS

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  modelo_ventas$residuals
## D = 0.13659, p-value = 0.2935

Conclusión En este caso dado que 0.2935>0.0.5 No se rechaza la Hipótesis nula, por lo que los residuos siguen una distribución normal.

VIFS

library(car)

## Warning: package 'car' was built under R version 4.5.2

## Cargando paquete requerido: carData

## Warning: package 'carData' was built under R version 4.5.2

VIFs_car<-vif(modelo_ventas)
print(VIFs_car)

##        C        P        M 
## 7.631451 3.838911 9.449210

Pruebas de Colinealidad

Prueba Indice de condición

library(mctest)

## Warning: package 'mctest' was built under R version 4.5.2

mctest(mod = modelo_ventas)

## 
## Call:
## omcdiag(mod = mod, Inter = TRUE, detr = detr, red = red, conf = conf, 
##     theil = theil, cn = cn)
## 
## 
## Overall Multicollinearity Diagnostics
## 
##                        MC Results detection
## Determinant |X'X|:         0.0346         0
## Farrar Chi-Square:        71.2080         1
## Red Indicator:             0.8711         1
## Sum of Lambda Inverse:    20.9196         1
## Theil's Method:            0.5430         1
## Condition Number:         71.1635         1
## 
## 1 --> COLLINEARITY is detected by the test 
## 0 --> COLLINEARITY is not detected by the test

Conclusión. Como κ(x)>30 se considera que la multicolinealidad es severa.

Prueba FG

library(psych)

## Warning: package 'psych' was built under R version 4.5.3

## 
## Adjuntando el paquete: 'psych'

## The following object is masked from 'package:car':
## 
##     logit

options(scipen = 99)
X_mat<-model.matrix(modelo_ventas)
stargazer(head(X_mat,n=6),type="text")

## 
## =========================
##   (Intercept)  C   P   M 
## -------------------------
## 1      1      197 173 110
## 2      1      208 152 107
## 3      1      181 150 99 
## 4      1      194 150 102
## 5      1      192 163 109
## 6      1      196 179 114
## -------------------------

FG_test<-cortest.bartlett(X_mat[,-1])

## R was not square, finding R from data

print(FG_test)

## $chisq
## [1] 71.20805
## 
## $p.value
## [1] 0.000000000000002352605
## 
## $df
## [1] 3

Conclusion Como 0.00000000000000235261 < 0.05. Se rechaza H0, por lo tanto hay evidencia de colinealidad en los regresores por lo tanto hay evidencia de colinealidad en los regresores #### Forma grafica

library(fastGraph)
alpha_sig<-0.05
chi<-qchisq(1-alpha_sig,gl,lower.tail = TRUE)
chi_FG <- FG_test$chisq
shadeDist(chi_FG,ddist = "dchisq",
          parm1 = gl,
          lower.tail = FALSE,xmin=0,
          sub=paste("VC:",round(VC,2)," ","chi_FG:",round(chi_FG,2)))

VIfs

library(car)
VIFs_car<-vif(modelo_ventas)
print(VIFs_car)

##        C        P        M 
## 7.631451 3.838911 9.449210

Las variables M y C tienen un VIF cercano a 10 lo que puede indicar que la varianza del error este inflada por la colinealidad.

Pruebas de heterocedasticidad

Prueba de White

library(stargazer)
# 1. Extrae los residuos del modelo original para analizar su varianza
u_i <- modelo_ventas$residuals

# 2. Une los residuos con las variables explicativas originales
data_prueba_white <- as.data.frame(cbind(u_i, ventas_empresa))

# 3. Regresión auxiliar: u^2 contra variables, cuadrados e interacciones dobles
regresion_auxiliar <- lm(I(u_i^2) ~ C + P + M + 
                        I(C^2) + I(P^2) + I(M^2) +
                        C:P + C:M + P:M, 
                        data = data_prueba_white)

# 4. Obtiene el R^2 y el tamaño de muestra (n) para calcular el estadístico
sumario <- summary(regresion_auxiliar)
n <- nrow(data_prueba_white)
R_2 <- sumario$r.squared

# 5. Calcula el estadístico de White (n * R^2)
LM_w <- n * R_2

# 6. Define grados de libertad (9 términos en la regresión auxiliar)
gl <- length(coef(regresion_auxiliar)) - 1

# 7. Calcula el p-valor (área a la derecha en la Chi-cuadrado)
p_value <- 1 - pchisq(q = LM_w, df = gl)

# 8. Obtiene el Valor Crítico al 95% de confianza para la decisión
VC <- qchisq(p = 0.95, df = gl)

# 9. Consolida resultados en un vector con nombres
salida_white <- c(LM_w, VC, p_value)
names(salida_white) <- c("LMw", "Valor Crítico", "p value")

# 10. Muestra la tabla de resultados con alta precisión decimal
stargazer(salida_white, title = "Resultados de la prueba de White", 
          type = "text", digits = 15)

## 
## Resultados de la prueba de White
## ======================================================
## LMw                 Valor Crítico         p value     
## ------------------------------------------------------
## 7.122650000000000 16.918980000000000 0.624351400000000
## ------------------------------------------------------

Libreria Lmtest

library(lmtest)

## Warning: package 'lmtest' was built under R version 4.5.2

## Cargando paquete requerido: zoo

## Warning: package 'zoo' was built under R version 4.5.2

## 
## Adjuntando el paquete: 'zoo'

## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric

# 1. Asegúrate de que el modelo original esté bien definido
# modelo_ventas <- lm(Ventas ~ C + P + M, data = ventas_empresa)

# 2. Ejecución de la prueba de White completa
# La fórmula expandida incluye: C, P, M, C², P², M², CP, CM, PM
prueba_white <- bptest(modelo_ventas, 
                       varformula = ~ C + P + M + 
                                     I(C^2) + I(P^2) + I(M^2) + 
                                     C:P + C:M + P:M, 
                       data = ventas_empresa)

# 3. Mostrar el resultado
print(prueba_white)

## 
##  studentized Breusch-Pagan test
## 
## data:  modelo_ventas
## BP = 7.1227, df = 9, p-value = 0.6244

Grafica

# =================================================================
# ANÁLISIS INTEGRAL DE HETEROCEDASTICIDAD
# =================================================================

# 1. Gráficos de Diagnóstico Visual
# -----------------------------------------------------------------
par(mfrow = c(1, 2)) # Divide la pantalla para ver dos gráficos

# Gráfico 1: Residuos vs Ajustados (Para ver el patrón de embudo)
plot(modelo_ventas, which = 1, col = "darkblue", pch = 16,
     main = "1. Residuos vs Ajustados", 
     sub = "Busca patrones de abanico o embudo")

# Gráfico 2: Scale-Location (Para ver la tendencia de la varianza)
plot(modelo_ventas, which = 3, col = "darkgreen", pch = 16,
     main = "2. Ubicación-Escala",
     sub = "Una línea ascendente indica heterocedasticidad")

par(mfrow = c(1, 1)) # Regresa la pantalla a la normalidad

# 2. Prueba de White (Cálculos Dinámicos)
# -----------------------------------------------------------------
library(lmtest)
library(fastGraph)

# Ejecutar test
prueba_white <- bptest(modelo_ventas, 
                       ~ C + P + M + I(C^2) + I(P^2) + I(M^2) + C:P + C:M + M:P, 
                       data = ventas_empresa)

# Extraer valores clave
valor_bp        <- as.numeric(prueba_white$statistic)
grados_libertad <- as.numeric(prueba_white$parameter)
p_val           <- as.numeric(prueba_white$p.value)
valor_critico   <- qchisq(p = 0.95, df = grados_libertad)

# 3. Visualización de la Decisión Estadística
# -----------------------------------------------------------------
shadeDist(
  valor_bp, 
  "dchisq", 
  grados_libertad, 
  lower.tail = FALSE, 
  main = "Prueba de White: Estadístico vs Valor Crítico",
  sub = paste("P-Valor =", round(p_val, 5)),
  col = c("black", "red")
)

# Añadir línea del Valor Crítico (VC)
abline(v = valor_critico, col = "blue", lwd = 2, lty = 2)

# Añadir leyenda informativa
legend("topright", 
       legend = c(paste("Estadístico (LMw):", round(valor_bp, 2)), 
                  paste("Valor Crítico (95%):", round(valor_critico, 2))),
       col = c("red", "blue"), 
       lty = c(1, 2), 
       lwd = 2, bty = "n")

# 4. Resultado en Consola
# -----------------------------------------------------------------
cat("\n--- CONCLUSIÓN --- \n")

## 
## --- CONCLUSIÓN ---

if(p_val < 0.05) {
  cat("P-valor < 0.05: SE RECHAZA H0. Hay evidencia de HETEROCEDASTICIDAD.\n")
} else {
  cat("P-valor > 0.05: NO SE RECHAZA H0. Los residuos son HOMOCEDÁSTICOS.\n")
}

## P-valor > 0.05: NO SE RECHAZA H0. Los residuos son HOMOCEDÁSTICOS.

Otra forma de graficarlo

# 1. Definir los datos y el umbral de significancia
alpha <- 0.05
p_val_white <- salida_white["p value"]

# 2. Crear etiqueta dinámica de decisión
conclusion_white <- ifelse(p_val_white < alpha, 
                           "Heterocedasticidad detectada (Varianza No Constante)", 
                           "Homocedasticidad (Varianza Constante)")

# 3. Crear el gráfico
library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.5.3

## 
## Adjuntando el paquete: 'ggplot2'

## The following objects are masked from 'package:psych':
## 
##     %+%, alpha

df_hetero <- data.frame(
  Predichos = modelo_ventas$fitted.values,
  Residuos = modelo_ventas$residuals
)

ggplot(df_hetero, aes(x = Predichos, y = Residuos)) +
  geom_point(color = "steelblue", alpha = 0.7, size = 2) +
  # Línea base en 0
  geom_hline(yintercept = 0, linetype = "dashed", color = "black") +
  # Línea de tendencia para ver el patrón de la varianza
  geom_smooth(method = "loess", color = "red", se = FALSE) +
  labs(
    title = "Diagnóstico de Heterocedasticidad",
    subtitle = paste("P-valor White:", round(p_val_white, 5), "|", conclusion_white),
    caption = paste("Nivel de significancia (Alpha) =", alpha),
    x = "Ventas Predichas (Valores Ajustados)",
    y = "Residuos (u_i)"
  ) +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

# 1. Extraer el p-valor y definir alpha
p_val_white <- salida_white["p value"]
alpha <- 0.05

# 2. Crear una etiqueta dinámica para la conclusión
conclusion <- ifelse(p_val_white < alpha, 
                     "Conclusión: Heterocedasticidad Detectada (Rechazo H0)", 
                     "Conclusión: Homocedasticidad (No se rechaza H0)")

# 3. Graficar con la etiqueta dinámica
library(ggplot2)

datos_grafico <- data.frame(
  ajustados = modelo_ventas$fitted.values,
  residuos_2 = (modelo_ventas$residuals)^2
)

ggplot(datos_grafico, aes(x = ajustados, y = residuos_2)) +
  geom_point(color = "steelblue", alpha = 0.6) +
  geom_smooth(method = "loess", color = "red", se = FALSE, linetype = "dashed") +
  labs(
    title = "Diagnóstico de la Prueba de White",
    subtitle = paste("P-valor:", round(p_val_white, 5), "|", conclusion),
    x = "Ventas Predichas (Valores Ajustados)",
    y = "Residuos al Cuadrado (u²)"
  ) +
  # Añadimos una nota sobre el alpha usado
  annotate("text", x = Inf, y = Inf, label = paste("Alpha =", alpha), 
           hjust = 1.1, vjust = 1.5, size = 4, fontface = "italic") +
  theme_minimal()

## `geom_smooth()` using formula = 'y ~ x'

Prueba de autocorrelacion

Prueba de Durbin Watson

library(lmtest)
dwtest(modelo_ventas,alternative = "two.sided",iterations = 1000)

## 
##  Durbin-Watson test
## 
## data:  modelo_ventas
## DW = 1.2996, p-value = 0.05074
## alternative hypothesis: true autocorrelation is not 0

library(car)
durbinWatsonTest(modelo_ventas,simulate = TRUE,reps = 1000)

##  lag Autocorrelation D-W Statistic p-value
##    1       0.3013888      1.299572   0.048
##  Alternative hypothesis: rho != 0

Conclusion. Como 0.068>0.05 No se rechaza la hipótesis nula, por lo tanto hay evidencia de que la varianza de los residuos es homocedástica.

Los multiplicadores de lagrange

# Carga de librerías necesarias para manipulación y tablas
library(dplyr)

## 
## Adjuntando el paquete: 'dplyr'

## The following object is masked from 'package:car':
## 
##     recode

## The following object is masked from 'package:MASS':
## 
##     select

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidyr)

## Warning: package 'tidyr' was built under R version 4.5.2

library(kableExtra)

## Warning: package 'kableExtra' was built under R version 4.5.3

## 
## Adjuntando el paquete: 'kableExtra'

## The following object is masked from 'package:dplyr':
## 
##     group_rows

# 1. Extraer los residuos (errores) del modelo de regresión original
u_i <- modelo_ventas$residuals

# 2. Construcción del set de datos para la prueba de autocorrelación
data_prueba_BG <- cbind(u_i, ventas_empresa) %>% 
  as.data.frame() %>% 
  
  # 3. Crear variables rezagadas (lags) para detectar autocorrelación de orden 2
  # Lag_1 es el residuo del periodo anterior (t-1)
  # Lag_2 es el residuo de dos periodos atrás (t-2)
  mutate(Lag_1 = dplyr::lag(u_i, 1),
         Lag_2 = dplyr::lag(u_i, 2)) %>% 
  
  # 4. Limpieza de datos: Remplazar los valores NA generados por el rezago con 0
  # Esto evita perder las primeras observaciones de la muestra
  replace_na(list(Lag_1 = 0, Lag_2 = 0))

# 5. Generar una tabla elegante con los primeros 6 datos para verificar la estructura
kable(head(data_prueba_BG, 6)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"))

u_i	V	C	P	M	Lag_1	Lag_2
10.673678	607	197	173	110	0.000000	0.000000
7.372511	590	208	152	107	10.673678	0.000000
-2.435532	543	181	150	99	7.372511	10.673678
-3.322264	558	194	150	102	-2.435532	7.372511
-9.913932	571	192	163	109	-3.322264	-2.435532
8.704039	615	196	179	114	-9.913932	-3.322264

# 1. Regresión Auxiliar: Se regresan los residuos actuales contra las 
# variables originales (X1, X2) y los residuos rezagados (Lag_1, Lag_2).
regresion_auxiliar_BG <- lm(u_i ~ C + P+ M + Lag_1 + Lag_2, data = data_prueba_BG)

# 2. Extracción del R-cuadrado: Obtenemos la capacidad explicativa del modelo auxiliar.
sumario_BG <- summary(regresion_auxiliar_BG)
R_2_BG <- sumario_BG$r.squared

# 3. Cálculo del Estadístico LM (Multiplicador de Lagrange): 
# Se calcula como el tamaño de la muestra (n) por el R² de la regresión auxiliar.
n <- nrow(data_prueba_BG)
LM_BG <- n * R_2_BG

# 4. Definición de Grados de Libertad: Corresponden al número de rezagos 
# incluidos en la prueba (en este caso, 2).
gl = 2

# 5. Cálculo del p-valor: Determina la probabilidad de obtener un estadístico 
# tan extremo bajo la hipótesis de que NO hay autocorrelación.
p_value <- 1 - pchisq(q = LM_BG, df = gl)

# 6. Valor Crítico: Punto de corte en la distribución Chi-cuadrado 
# con un 95% de confianza (alpha = 0.05).
VC <- qchisq(p = 0.95, df = gl)

# 7. Consolidación de resultados: Se agrupan los valores en un vector nombrado.
salida_bg <- c(LM_BG, VC, p_value)
names(salida_bg) <- c("LMbg", "Valor Crítico", "p value")

# 8. Presentación: Genera una tabla en formato HTML (ideal para reportes o blogs) 
# con alta precisión decimal.
stargazer(salida_bg, 
          title = "Resultados de la prueba de Breusch-Godfrey", 
          type = "text", 
          digits = 6)

## 
## Resultados de la prueba de Breusch-Godfrey
## ===============================
## LMbg     Valor Crítico p value 
## -------------------------------
## 3.840869   5.991465    0.146543
## -------------------------------

library(lmtest)
bgtest(modelo_ventas,order = 2)

## 
##  Breusch-Godfrey test for serial correlation of order up to 2
## 
## data:  modelo_ventas
## LM test = 3.8409, df = 2, p-value = 0.1465

Forma grafica

# 1. Preparar los datos de los residuos
residuos_data <- data.frame(
  Tiempo = 1:length(u_i),
  Residuos = u_i
)

# 2. Graficar los residuos a través del tiempo
library(ggplot2)

g1 <- ggplot(residuos_data, aes(x = Tiempo, y = Residuos)) +
  geom_line(color = "darkgreen") +
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  labs(title = "Residuos del Modelo de Ventas a través del Tiempo",
       subtitle = "Si hay ciclos o rachas largas arriba/abajo de cero, hay autocorrelación",
       x = "Observación (Tiempo)",
       y = "Residuo (u_i)") +
  theme_minimal()

print(g1)

# 3. Graficar el Correlograma (ACF) - La verdadera gráfica de la prueba
# Esta gráfica muestra si el Lag 1 y Lag 2 son significativos
acf_plot <- acf(u_i, main = "Correlograma de los Residuos (ACF)", 
                lag.max = 10, plot = TRUE)

Conclsuion. Como p value>0.05 No se rechaza H0, por lo tanto puede concluirse que los residuos del modelo, no siguen autocorrelación de orden “2”.

Sobre la gráfica de líneas (Residuos vs. Tiempo): Esta gráfica nos dice cómo se equivoca el modelo a medida que pasa el tiempo. Aunque se ven algunas “subidas y bajadas” suaves (rachas), los errores no se disparan ni siguen un patrón permanente. En palabras simples: el modelo comete errores, pero estos parecen ser aleatorios y no indican que estemos olvidando algo importante en la secuencia del tiempo.
Sobre el Correlograma (Barras del ACF): Las líneas punteadas azules son los límites que se espera que no se pasen. Si ninguna de las barras negras cruza esas líneas, significa que no hay autocorrelación. Como en tu gráfica todas las barras están dentro de los límites, podemos estar seguros y afirmar que el error de ayer no influye en el de hoy, y el modelo es estadísticamente confiable.

Miguel Lopez Pre examen 2

Miguel Ángel López Ayala

2026-04-28

Pre examen 2

Cargar datos

Modelar el modelo

Modelo de ventas empresa

Normalizar residuos

Forma grafica

Prueba SW

Forma grafica

Prueba KS

VIFS

Pruebas de Colinealidad

Prueba Indice de condición

Prueba FG

VIfs

Pruebas de heterocedasticidad

Prueba de White

Libreria Lmtest

Grafica

Otra forma de graficarlo

Prueba de autocorrelacion

Prueba de Durbin Watson

Los multiplicadores de lagrange

Forma grafica