CASO Modelo de REGRESION POTENCIAL con datos de precios y cantidad de demanda
Rubén Pizarro Gurrola
2026-04-09
Contexto
Se trata de un conjunto de datos de dos mil registros que simulan el comportamiento de la curva de demanda en economía, los datos son simulados relacionando la demanda de cualquier negocio que venda y distribuya algún producto o servicio.
Las variables de interés son:
- variable independiente es el precio del producto o servicio precio
- variable dependiente es la cantidad demandada del producto o servicio cantidad
Objetivo
Implementar, evaluar un modelo de regresión potencial con otros modelos de regresión con datos de precio y cantidad demandada usando librerías y funciones en programación R
Se verificarán los postulados a los modelos de regresión potencial, lineal simple, polinomial de segundo grado, polinomial de quinto grado, logarítmico y exponencial.
Se comparará el modelo potencial contra los otros cinco modelos siendo seis en total calculando los estadístico r square y RMSE.
El parámetro para determinar y concluir un rendimiento predictivo óptimo y aceptable del modelo es que el valor de r square debes estar igual o por encima del 70%.
Al final el caso de estudio interpretará cuál es el mejor modelo en términos de calidad predictiva.
Descripción
Cargar librerías
# install.packages("readr")
# install.packages("tidyverse")
# install.packages("psych")
# install.packages("dplyr")
# install.packages("ggplot2")
# install.packages("caret")
# install.packages("broom")
# install.packages("lmtest")
# install.packages("car")
# install.packages("stats")
# install.packages("flextable")
# install.packages("officer")
# install.packages("patchwork")
# install.packages("performance")
# install.packages("see")
# install.packages("car")
# install.packages("nortest")
# install.packages("lmtest")
library(readr) # cargar datos datos
library(tidyverse) # Para manipular
library (psych) # Para descriobir datos
library(dplyr) # Manipulación de datos
library(ggplot2) # gráficos
library(caret) # partición de datos
library(broom) # tidy modelos
library(lmtest) # Durbin-Watson
library(car) # VIF y diagnóstico
library(stats) # lm, shapiro.test
library(patchwork) # Graficos organizados en columnas renglones
# Tablas compatibles con Word
library(flextable)
library(officer)
library(performance) # Para evaluar postulados de modelos
library(see) # Para evaluar postulados de modelos dependencia de performance
library(car) # Para verificar postulados de los modelos
library(nortest) # Para pruebas de normalidad Anderson Darlin
library(lmtest) # Para pruebas de homocedasticidad Breusch–Pagan y prueba de White cargar funciones
Las funciones se encuentra en la url: https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/R%20MarkDown/funciones/funciones%20para%20potencial%20RPot.R
# Local
# source("../funciones/funciones para potencial Rpot.R")
# URL
source("https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/R%20MarkDown/funciones/funciones%20para%20potencial%20RPot.R")Cargar datos
Los datos se encuentran en el enlace siguiente: https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/datos/datos_precio_demanda.csv
datos <- f_cargar_datos("https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/datos/datos_precio_demanda.csv")Visualización de datos
Se presentan los primeros y últimos registro del conjunto de datos original de precios y cantidad de demanda.
f_visualizar_head_tail_reducido_word(datos)precio | cantidad |
|---|---|
72.88 | 14.25 |
60.09 | 13.75 |
22.61 | 36.37 |
35.72 | 18.53 |
59.98 | 14.26 |
12.26 | 61.61 |
51.96 | 14.93 |
87.49 | 7.66 |
32.73 | 20.03 |
62.27 | 11.85 |
... | ... |
95.12 | 7.32 |
20.05 | 32.19 |
32.87 | 25.58 |
11.39 | 71.42 |
70.59 | 8.32 |
14.64 | 55.75 |
78.35 | 6.81 |
51.07 | 6.5 |
99.11 | 2.03 |
99.11 | 6.1 |
Descripión estadística
La media aritmética \(\mu\) de la variable precio es de aproximadamente 54.81 con desviación estándar \(\sigma\) de 25.85; por otra parte, la media aritmética \(\mu\) de la variable cantidad es de aproximadamente 18.01 con desviación estándar \(\sigma\) de 14.87.
f_describir_datos(datos)## $describe
## vars n mean sd median trimmed mad min max range skew
## precio 1 2000 54.81 25.85 54.97 54.74 33.17 10.07 99.97 89.90 0.02
## cantidad 2 2000 18.01 14.87 12.75 15.21 8.24 0.10 83.57 83.47 1.84
## kurtosis se
## precio -1.20 0.58
## cantidad 3.32 0.33
##
## $structure
## [1] "'data.frame':\t2000 obs. of 2 variables:\n $ precio : num 72.9 60.1 22.6 35.7 60 ...\n $ cantidad: num 14.2 13.8 36.4 18.5 14.3 ..."Desarrollo
Datos de entrenamiemnto y validación
Cotinuando con la metodología sugerida, se parten los datos originales para 70% datos de entrenamiento y 30% en datos de validación, usando la función f_particionar_datos():
datos de entrenamiento 70%
datos de validación 30%
particion <- f_particionar_datos(datos)
datos_entrenamiento <- particion$datos_entrenamiento
datos_validacion <- particion$datos_validacionSe presentan los primeros y últimos seis registros de los datos de entrenamiento:
f_visualizar_head_tail_reducido_word(datos_entrenamiento, n=6)precio | cantidad |
|---|---|
27.97 | 26.96 |
41.8 | 19.8 |
70.42 | 9.15 |
88.31 | 6.67 |
11.27 | 69.81 |
86.86 | 10.24 |
... | ... |
46.2 | 15.41 |
32.42 | 22.44 |
74.76 | 8.06 |
41.06 | 16.23 |
41.69 | 17.28 |
13.61 | 54.12 |
Ahora los datos de validación
f_visualizar_head_tail_reducido_word(datos_validacion, n=6)precio | cantidad |
|---|---|
72.88 | 14.25 |
22.61 | 36.37 |
30.8 | 19.72 |
23.85 | 29.9 |
42.11 | 12.68 |
59.07 | 11.29 |
... | ... |
19.11 | 42.71 |
30.85 | 25.2 |
77.81 | 3.83 |
79.69 | 7.37 |
95.12 | 7.32 |
99.11 | 6.1 |
Modelo potencial
Con los datos de entrenamiento se construye el modelo de regresión potencial, la función f_construir_modelo_pot() y con los argumentos adecuados que incluye los datos y las variables independiente y dependiente, construye el modelo.
La sintaxis en programación R que encapsula la construcción del modelo es con la función lm(): modelo_pot <- lm(log(x) ~ log(y), data = datos).
Los coeficientes se interpretan de la siguiente manera: Si el precio aumenta 1%, la cantidad demandada disminuye aproximadamente 1.1778%. Dado que \(b<0\) es una relación inversa o elasticidad negativa ya que un incremento porcentual en el precio genera una disminución proporcional mayor en la cantidad demandada.
modelo_pot <- f_construir_modelo_pot(datos_entrenamiento, "precio", "cantidad")
summary(modelo_pot)##
## Call:
## lm(formula = log(cantidad) ~ log(precio), data = datos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3279 -0.1008 0.0259 0.1769 0.8891
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.14742 0.06659 107.33 <2e-16 ***
## log(precio) -1.17780 0.01703 -69.15 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3642 on 1398 degrees of freedom
## Multiple R-squared: 0.7738, Adjusted R-squared: 0.7736
## F-statistic: 4782 on 1 and 1398 DF, p-value: < 2.2e-16f_ecuaciones_modelos( modelos = list(modelo_pot),
nombres = c("Modelo Potencial"))##
## ============================
## Modelo Potencial
## ============================
##
## Coeficientes:
## (Intercept) log(precio)
## 7.1474 -1.1778
##
## Ecuación:
## ŷ = 1270.8271 * precio^(-1.1778)Modelos Exponencial, logaritmico, Polinómicos de grado 1, 2 y 5
Se mandan llamar las funciones respectivas para construir cinco modelos de regresión: exponencial, logarítmico, polinomiales de grado 1, 2 y 5 respectivamente, estos modelos, que servirán de comparación con el modelo potencial.
modelo_exp <- f_construir_modelo_exp(datos_entrenamiento, "precio", "cantidad")
modelo_RL <- f_construir_modelo_log(datos_entrenamiento, "precio", "cantidad")
modelo_RP1 <- f_construir_modelo(datos_entrenamiento, "precio", "cantidad" , 1)
modelo_RP2 <- f_construir_modelo(datos_entrenamiento, "precio", "cantidad" , 2)
modelo_RP5 <- f_construir_modelo(datos_entrenamiento, "precio", "cantidad", 5)Supuestos del modelo
Linealidad
Con respecto al supuesto de linealidad, en la gráfica se observa que los modelos que mejor visualizan la tendencia son el potencial y el polinomial de quinto grado; de estos dos modelos, el polinomial de quinto grado tiene mejor representatividad de la variable dependiente con un valor de \(\text{r square}=0.95\). Con los datos de entrenamiento todos los modelos superan el valor de r square igual o superior al 70%, excepto el modelo lineal simple o polinomial de primer orden.
modelos <- list(modelo_pot, modelo_exp, modelo_RL, modelo_RP1, modelo_RP2, modelo_RP5)
nombres <- c(
"Potencial",
"Exponencial",
"Logarítmico",
"Polinomial 1",
"Polinomial 2",
"Polinomial 5"
)
f_matriz_dispersion_modelos_tendencia(modelos, datos_entrenamiento, "precio", "cantidad", nombres)
Utilizando el siguiente código que usa la función extraer_plot() y la función check_model(modelo, check = “linearity”) del paquete “performance” con dependencia del paquete “see”, se puede para verificar linealidad de modelos de regresión.
En la gráfica se observa que los mejores modelos que cumplen con el supuesto de linealidad son el potencial, el exponencial y de manera moderada el polinomial de quinto grado.
#-----------------------------------------
# FUNCIÓN para detectar postulado de linealidad en los modelos de regresión
extraer_plot <- function(modelo){
# abrir dispositivo temporal invisible
grDevices::png(filename = tempfile())
p <- plot(check_model(modelo, check = "linearity"))
dev.off()
return(p[[1]])
}
#-----------------------------------------
# Generar gráficos
#-----------------------------------------
g1 <- extraer_plot(modelo_pot) + ggtitle("Potencial")
g2 <- extraer_plot(modelo_exp) + ggtitle("Exponencial")
g3 <- extraer_plot(modelo_RL) + ggtitle("Logarítmico")
g4 <- extraer_plot(modelo_RP1) + ggtitle("Polinomial 2")
g5 <- extraer_plot(modelo_RP2) + ggtitle("Polinomial 2")
g6 <- extraer_plot(modelo_RP5) + ggtitle("Polinomial 5")
#-----------------------------------------
# PANEL FINAL
#-----------------------------------------
(g1 | g2 | g3) / (g4 | g5 | g6) +
plot_annotation(title = "Evaluación de linealidad de modelos")
Como una alternativa para verificar el postulado de lienalidad en los modelos, se puede utilizar la función residualPlots(modelo) del paquete “car”. En la figura se observa que solo el modelo potencial presenta una clara definición lineal de los residuos con respeto a los valores ajustados o estimados..
par(mfrow = c(2,3))
plot(fitted(modelo_pot), residuals(modelo_pot), main = "Potencial")
abline(h=0,col="red")
plot(fitted(modelo_exp), residuals(modelo_exp), main = "Exponencial")
abline(h=0,col="red")
plot(fitted(modelo_RL), residuals(modelo_RL), main = "Logarítmico")
abline(h=0,col="red")
plot(fitted(modelo_RP1), residuals(modelo_RP1), main = "Polinomial 1")
abline(h=0,col="red")
plot(fitted(modelo_RP2), residuals(modelo_RP2), main = "Polinomial 2")
abline(h=0,col="red")
plot(fitted(modelo_RP5), residuals(modelo_RP5), main = "Polinomial 5")
abline(h=0,col="red")
par(mfrow = c(1,1))Una alternativa más completa en R para evaluar el postulado de linealidad de residuos modelos de regresión, es haciendo la prueba de Tukey como estadístico y tener mayor certeza la linealidad en los residuos. La gráfica muestra la linealidad o posible curvatura de los residuos de los modelos, además subtitula el valor de p-value, aquellos mayores a 0.05 son los que se considera residuos lineales para cada modelo; también se observa la interpretación de la linealidad, al final sólo el modelo potencial presenta linealidad.
modelos <- list(modelo_pot, modelo_exp, modelo_RL, modelo_RP1, modelo_RP2, modelo_RP5)
nombres <- c(
"Potencial",
"Exponencial",
"Logarítmico",
"Polinomial 1",
"Polinomial 2",
"Polinomial 5"
)
f_linealidad_residuos(modelos, nombres)## Test stat Pr(>|Test stat|)
## log(precio) -1.7224 0.08521 .
## Tukey test -1.7224 0.08499 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Test stat Pr(>|Test stat|)
## precio 15.325 < 2.2e-16 ***
## Tukey test 15.325 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Test stat Pr(>|Test stat|)
## log(precio) 56.173 < 2.2e-16 ***
## Tukey test 56.173 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Test stat Pr(>|Test stat|)
## poly(precio, 1, raw = TRUE) 47.129 < 2.2e-16 ***
## Tukey test 47.129 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Test stat Pr(>|Test stat|)
## poly(precio, 2, raw = TRUE)
## Tukey test 46.186 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## Test stat Pr(>|Test stat|)
## poly(precio, 5, raw = TRUE)
## Tukey test 9.1952 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Homocedasticidad
El análisis gráfico de los residuos indica que ninguno de los modelos verificados cumple estrictamente con el supuesto de homocedasticidad. Sin embargo, el modelo potencial y polinomial de quinto grado presenta de madera moderada la mejor aproximación en comparación con los demás modelos.
modelos <- list(modelo_pot, modelo_exp, modelo_RL, modelo_RP1, modelo_RP2, modelo_RP5)
nombres <- c(
"Potencial",
"Exponencial",
"Logarítmico",
"Polinomial 1",
"Polinomial 2",
"Polinomial 5"
)
f_matriz_verificar_homocedasticidad(
modelos,
datos_entrenamiento,
"precio",
"cantidad",
nombres
)
Utilizando la función check_model(modelo, check = “homogeneity) del paquete “performance” y “see” el mejor modelo que cumple con el postulado de homocedasticidad es el polinomial de quinto grado, tal vez de manera parcial el potencial y exponencial.
#-----------------------------------------
# FUNCIÓN para detectar postulado de homocedasticidad en los modelos de regresión
extraer_plot <- function(modelo){
# abrir dispositivo temporal invisible
grDevices::png(filename = tempfile())
p <- plot(check_model(modelo, check = "homogeneity"))
dev.off()
return(p[[1]])
}
#-----------------------------------------
# Generar gráficos
#-----------------------------------------
g1 <- extraer_plot(modelo_pot) + ggtitle("Potencial")
g2 <- extraer_plot(modelo_exp) + ggtitle("Exponencial")
g3 <- extraer_plot(modelo_RL) + ggtitle("Logarítmico")
g4 <- extraer_plot(modelo_RP1) + ggtitle("Polinomial 2")
g5 <- extraer_plot(modelo_RP2) + ggtitle("Polinomial 2")
g6 <- extraer_plot(modelo_RP5) + ggtitle("Polinomial 5")
#-----------------------------------------
# PANEL FINAL
#-----------------------------------------
(g1 | g2 | g3) / (g4 | g5 | g6) +
plot_annotation(title = "Evaluación de linealidad de modelos")
Se hacen las pruebas de homocedasticidad de Breusch-Pagan y White en los modelos con la función previamente preparada f_pruebas_homocedasticidad(). La sintaxis que está encapsulada en el código de la función es incorporando bptest() del paquete “lmtest”.
# Breusch-Pagan
modelo <- modelo_pot # Cualquier modelo
bp <- bptest(modelo)
# White
y_hat <- fitted(modelo)
df_aux <- data.frame(y_hat = y_hat)
white <- bptest(modelo, ~ y_hat + I(y_hat^2), data = df_aux)En la tabla se muestra el resultado de las pruebas de Breusch-Pagan y White ya que el estadístico p-value es mayor que el valor de significancia de 0.05 en ambas pruebas; Al comparar las pruebas en todos los modelos, sólo el modelo de polinomial de quinto grado pasa la prueba de homocedasticidad de Breusch-Pegan con \(p-value=0.2507\) pero no la prueba mas robusta de White con \(p-value=0.0442\) en comparación con los demás modelos.
modelos <- list(modelo_pot, modelo_exp, modelo_RL, modelo_RP1, modelo_RP2, modelo_RP5)
nombres <- c(
"Potencial",
"Exponencial",
"Logarítmico",
"Polinomial 1",
"Polinomial 2",
"Polinomial 5"
)
f_pruebas_homocedasticidad(modelos, nombres)Normalidad
De acuerdo a la visualización gráfica utilizando la función f_matriz_verificar_normalidad() solo el modelo potencial cumple, con el supuesto de normalidad. Se acaerva mucho el polinomial de quinto orden.
modelos <- list(modelo_pot, modelo_exp, modelo_RL, modelo_RP1, modelo_RP2, modelo_RP5)
nombres <- c(
"Potencial",
"Exponencial",
"Logarítmico",
"Polinomial 1",
"Polinomial 2",
"Polinomial 5"
)
f_matriz_verificar_normalidad (
modelos,
datos_entrenamiento,
"precio",
"cantidad",
nombres
)
Prueba Shpairo-Wilks
Ahora bien utilizando utilizando la función previamente codificada f_shapiro_residuos_modelos() la cual recibe los modelos y con la función shapiro.test() evalúa la normalidad de los residuos de cada modelo bajo la prueba Shapiro-Wilks; se devuelve tabla con los resultados de la prueba.
resultados <- f_shapiro_residuos_modelos(
modelos = modelos,
datos = datos_entrenamiento,
x = "precio",
y = "cantidad",
nombres = nombres
)
resultadosPrueba de normalidad de residuos Anderson-Darling
Haciendo la prueba de normalidad de residuos a los modelos implementados para estos datos, los únicos que pasan la prueba de Anderson-Darling son el polinomial de quinto orden y el potencial.
resultados <- f_anderson_residuos_modelos(
modelos = modelos,
datos = datos_entrenamiento,
x = "precio",
y = "cantidad",
nombres = nombres
)
resultadosPrueba de normalidad de residuos Kolmogorov-Smirnov
Haciendo la prueba de normalidad de residuos con la técnica de Kolmogorov-Smirnov los únicos que pasan la prueba son el modelo polinomial y e potencial par estos datos y con estos modelos de regresión implementados.
resultados <- f_kolmogorov_residuos_modelos(
modelos = modelos,
datos = datos_entrenamiento,
x = "precio",
y = "cantidad",
nombres = nombres
)## Warning in ks.test.default(z, "pnorm"): ties should not be present for the
## one-sample Kolmogorov-Smirnov testresultadosResumen de prueba de normalidad
f_normalidad_residuos_modelos_plot(modelos, nombres)##
## =============================
## Potencial
## =============================
##
## =============================
## Exponencial
## =============================
##
## =============================
## Logarítmico
## =============================
##
## =============================
## Polinomial 1
## =============================
##
## =============================
## Polinomial 2
## =============================
##
## =============================
## Polinomial 5
## =============================
## [[1]]
## Prueba Estadistico p_value Decision
## 1 Shapiro-Wilk 0.8161244 2.973981e-37 ✖ No normal
## 2 Anderson-Darling 46.4883228 3.700000e-24 ✖ No normal
## 3 Kolmogorov-Smirnov 0.1512016 3.165082e-28 ✖ No normal
##
## [[2]]
## Prueba Estadistico p_value Decision
## 1 Shapiro-Wilk 0.90386182 8.576273e-29 ✖ No normal
## 2 Anderson-Darling 16.43047431 3.700000e-24 ✖ No normal
## 3 Kolmogorov-Smirnov 0.08822328 6.859454e-10 ✖ No normal
##
## [[3]]
## Prueba Estadistico p_value Decision
## 1 Shapiro-Wilk 0.94519800 2.200234e-22 ✖ No normal
## 2 Anderson-Darling 11.70974820 3.700000e-24 ✖ No normal
## 3 Kolmogorov-Smirnov 0.06156873 4.913997e-05 ✖ No normal
##
## [[4]]
## Prueba Estadistico p_value Decision
## 1 Shapiro-Wilk 0.87414129 3.612303e-32 ✖ No normal
## 2 Anderson-Darling 34.54576946 3.700000e-24 ✖ No normal
## 3 Kolmogorov-Smirnov 0.09621876 1.104115e-11 ✖ No normal
##
## [[5]]
## Prueba Estadistico p_value Decision
## 1 Shapiro-Wilk 0.94599344 3.146068e-22 ✖ No normal
## 2 Anderson-Darling 8.35618087 2.495547e-20 ✖ No normal
## 3 Kolmogorov-Smirnov 0.05536525 3.745728e-04 ✖ No normal
##
## [[6]]
## Prueba Estadistico p_value Decision
## 1 Shapiro-Wilk 0.9983541 0.1939714 ✔ Normal
## 2 Anderson-Darling 0.5016581 0.2064468 ✔ Normal
## 3 Kolmogorov-Smirnov 0.0184414 0.7277884 ✔ NormalIndependencia de residuos
Al ejecutar la función f_matriz_verificar_independencia_residuos() el resultado es que todos los modelos cumplen conel postulado de indepdeneic a de residuos, los valores del estadístico DW son cercanos a 2 y los valoes de p-value para todos los modelos son mayores a 0.05 por lo que no se rechaza la \(H_0\) de independencia de residuos.
resultados <- f_matriz_verificar_independencia_residuos(
modelos = modelos,
datos = datos_entrenamiento,
x = "precio",
y = "cantidad",
nombres = nombres
)
resultadosEcuaciones de los modelos
modelos <- list(modelo_pot, modelo_exp, modelo_RL, modelo_RP1, modelo_RP2, modelo_RP5)
nombres <- c(
"Potencial",
"Exponencial",
"Logarítmico",
"Polinomial 1",
"Polinomial 2",
"Polinomial 5"
)
f_ecuaciones_modelos(modelos, nombres)##
## ============================
## Potencial
## ============================
##
## Coeficientes:
## (Intercept) log(precio)
## 7.1474 -1.1778
##
## Ecuación:
## ŷ = 1270.8271 * precio^(-1.1778)
##
## ============================
## Exponencial
## ============================
##
## Coeficientes:
## (Intercept) precio
## 3.9888 -0.0254
##
## Ecuación:
## ŷ = 53.9894 * e^(-0.0254 * precio)
##
## ============================
## Logarítmico
## ============================
##
## Coeficientes:
## (Intercept) log(precio)
## 106.8223 -23.0560
##
## Ecuación:
## ŷ = 106.8223 - 23.056 * lnprecio
##
## ============================
## Polinomial 1
## ============================
##
## Coeficientes:
## (Intercept) poly(precio, 1, raw = TRUE)
## 42.2991 -0.4480
##
## Ecuación:
## ŷ = 42.2991 - 0.448 * polyprecio, 1, raw = TRUE
##
## ============================
## Polinomial 2
## ============================
##
## Coeficientes:
## (Intercept) poly(precio, 2, raw = TRUE)1
## 69.4515 -1.6942
## poly(precio, 2, raw = TRUE)2
## 0.0112
##
## Ecuación:
## ŷ = 69.4515 - 1.6942 * polyprecio, 2, raw = TRUE1 + 0.0112 * polyprecio, 2, raw = TRUE2
##
## ============================
## Polinomial 5
## ============================
##
## Coeficientes:
## (Intercept) poly(precio, 5, raw = TRUE)1
## 151.7066 -10.6004
## poly(precio, 5, raw = TRUE)2 poly(precio, 5, raw = TRUE)3
## 0.3393 -0.0055
## poly(precio, 5, raw = TRUE)4 poly(precio, 5, raw = TRUE)5
## 0.0000 0.0000
##
## Ecuación:
## ŷ = 151.7066 - 10.6004 * polyprecio, 5, raw = TRUE1 + 0.3393 * polyprecio, 5, raw = TRUE2 - 0.0055 * polyprecio, 5, raw = TRUE3 + 0 * polyprecio, 5, raw = TRUE4 - 0 * polyprecio, 5, raw = TRUE5Evaluación de los modelos
Se evalúan los modelos con los datos de validaci[on ejecutando la funció previamente codificada llamada f_evaluar_modelos_varios() que recibe la lista de modelos como argumentos los datos de validació, la variable dependiente cantidad y los nombres de los modelos; a su vez esta función manda llamar f_evaluar_modelos() que evalúa cob los estadísticos r square y *RMSE** la calidad de los modelos; finalmente se devuelve una tabla con los resultados.
La función implementada permite evaluar modelos de regresión considerando correctamente la ecuación de cada modelo, garantizando que las predicciones sean transformadas a la escala original antes de calcular las métricas de desempeño.
Los resultados de la evaluacuión de los modelos, indican que el mejor modelo en término de calidad predictiva es el modelo de regresión polinomial de quinto orden con un valor de r square de 0.9662 y RMSE de 2.9490, seguido del modelo potencial con r square de 0.9646 y RMSE de 3.0184.
Al principio del caso de estudio, se estableció como parámetro el 70% en valor de r square para se considerado modelo óptimo en términos de calidad predictiva para estos datos; todos los modelos sobrepasan el 70% excepto el modelo de regresión lineal simple o de primer orden.
nombres <- c(
"Potencial",
"Exponencial",
"Logarítmico",
"Polinomial 1",
"Polinomial 2",
"Polinomial 5"
)
options(scipen = 999) # Para notación no científica
resultados <- f_evaluar_modelos_varios(modelos, datos_validacion, "cantidad", nombres)
resultadosInterpretación del caso
Este caso de estudio implementa seis modelos de regresión con datos bivariados, estos modelos fueron el potencial, exponencial, logarítmico, polinomial de quinto, segundo y primer orden.
El caso de estudio se encuientra para su reproducción en el servico rpubs.com en el espacio del autor: https://rpubs.com/rpizarrog/1424365
El caso de estudio sigue la metodología propuesta del capítulo tres de este libro; se cargaron librerías y funciones necesarias para la adecuada ejecución del caso; estas funciones se encuentran de manera digital en el estpacio de gitub.com del autor: https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/R%20MarkDown/funciones/funciones%20para%20potencial%20RPot.R.
Los datos que se utilizaron se encuentran para su descarga en el espacio de gituh.com del autor: https://raw.githubusercontent.com/rpizarrog/Libro-Aprendizaje-Automatico.-Casos-de-Estudio-con-R-y-Python/refs/heads/main/datos/datos_precio_demanda.csv. Las variable de estudio fueron precio y cantidad de demanda y fueron alrededor de dos mil registros y se utilizó la partición de datos al 70% para datos de entrenamiento y 30% para datos de validación.
El caso de estudio valida los modelos bajos los supuestos de linealidad, homocedasticidad, normalidad, e independencia de residuos.
Con respecto a la linealidad además de observar tendencia, lo valida con la prueba de Tukey, sólo el modelo potencial cumple con este postulado de linealidad con estos datos.
Con respecto a la homocedasticidad de manera visual solo el modelo potencial y de manera parcial el modelo polinomial de quinto orden cumplen con este supuesto. Habiendo hecho las pruebas de Breusch-Pegan y White solo el modelo polinomial de quinto orden cumple con la prueba de Breusch-Peganno así la prueba de White.
En relación a la normalidad se hicieron las pruebas por distintas alternativas arrojando que los únicos modelos que pasan las pruebas de Shapiro-Wilks, Anderson-Darling y Kolmogorov-Smirnov son los modelos polinomial de quinto orden y potencial.
Todos los modelos cumplen con el supuesto de independencia de residuos.
EL mejor modelo en términos de calidad predictiva es el modelo polinomial de quinto orden, solo el modelo lineal simple no tiene un rendimiento optimo en términos de capacidad predictiva en comparación con todos los demás.