Codigo del Proyecto

Codigo Del Proyecto

# Paquetes y carga de la base
#-------------------------------------------------

library(tidyverse)

datos <- read.csv(file.choose(), check.names = FALSE)

# Renombrar columnas según el orden del formulario
names(datos) <- c("timestamp", "sexo", "edad",
                  "q0", "q3000", "q6000", "q9000", "q12000", "q15000")

# Crear un ID por persona (opcional pero útil)
datos <- datos %>% mutate(id = row_number())

#-------------------------------------------------
# Preparar datos
#-------------------------------------------------

datos_long <- datos %>%
  pivot_longer(
    cols = starts_with("q"),   # q0, q3000, q6000, ...
    names_to  = "precio_label",
    values_to = "Q"
  ) %>%
  mutate(
    # Precio asociado a cada columna
    P = case_when(
      precio_label == "q0"     ~ 0,
      precio_label == "q3000"  ~ 3000,
      precio_label == "q6000"  ~ 6000,
      precio_label == "q9000"  ~ 9000,
      precio_label == "q12000" ~ 12000,
      precio_label == "q15000" ~ 15000
    ),
    
    # Dummy de sexo: 1 = hombre, 0 = mujer
    sexo_dummy = if_else(sexo == "Masculino", 1, 0)
  )

# Ajuste para evitar log(0): Q* = Q - min(Q) + 1, P* = P - min(P) + 1
datos_long <- datos_long %>%
  mutate(
    Q_adj  = Q - min(Q) + 1,  
    P_adj  = P - min(P) + 1,   
    lnQ    = log(Q_adj),
    lnP    = log(P_adj),
    lnEdad = log(edad),
    
    # Estandarización (puntaje z) solo para variables continuas
    ZQ    = as.numeric(scale(Q_adj)),
    ZP    = as.numeric(scale(P_adj)),
    ZEdad = as.numeric(scale(edad))
  )
#-------------------------------------------------
# BLOQUE 3: Estimar los 7 modelos de la Parte I
#-------------------------------------------------

# 1) Modelo lineal estándar
#    Q = β0 + β1 P + β2 Edad + β3 Sexo + ε
m1 <- lm(Q ~ P + edad + sexo_dummy, data = datos_long)

# 2) Modelo log-log
#    lnQ = β0 + β1 lnP + β2 lnEdad + β3 Sexo + ε
m2 <- lm(lnQ ~ lnP + lnEdad + sexo_dummy, data = datos_long)

# 3) Modelo lin-log
#    Q = β0 + β1 lnP + β2 lnEdad + β3 Sexo + ε
m3 <- lm(Q ~ lnP + lnEdad + sexo_dummy, data = datos_long)

# 4) Modelo log-lin
#    lnQ = β0 + β1 P + β2 Edad + β3 Sexo + ε
m4 <- lm(lnQ ~ P + edad + sexo_dummy, data = datos_long)

# 5) Modelo cuadrático
#    Q = β0 + β1 P + β2 P^2 + β3 Edad + β4 Sexo + ε
m5 <- lm(Q ~ P + I(P^2) + edad + sexo_dummy, data = datos_long)

# 6) Modelo cúbico
#    Q = β0 + β1 P + β2 P^2 + β3 P^3 + β4 Edad + β5 Sexo + ε
m6 <- lm(Q ~ P + I(P^2) + I(P^3) + edad + sexo_dummy, data = datos_long)

# 7) Modelo estandarizado
#    Z(Q) = β0 + β1 Z(P) + β2 Z(Edad) + β3 Sexo + ε
m7 <- lm(ZQ ~ ZP + ZEdad + sexo_dummy, data = datos_long)

# Para revisar rápido:
summary(m1)
summary(m2)
summary(m3)
summary(m4)
summary(m5)
summary(m6)
summary(m7)

#-------------------------------------------------
# BLOQUE 4: Métricas de ajuste para cada modelo
#-------------------------------------------------

# Lista con los modelos estimados
modelos <- list(
  "Lineal"        = m1,
  "Log-Log"       = m2,
  "Lin-Log"       = m3,
  "Log-Lin"       = m4,
  "Cuadrático"    = m5,
  "Cúbico"        = m6,
  "Estandarizado" = m7
)

# Calcular R2, R2 ajustado, F, p-valor(F), RMSE y AIC
tabla_metricas <- purrr::map_dfr(names(modelos), function(nm) {
  mod <- modelos[[nm]]
  s   <- summary(mod)
  f   <- s$fstatistic 
  
  tibble(
    Modelo      = nm,
    R2          = s$r.squared,
    R2_ajustado = s$adj.r.squared,
    F           = unname(f["value"]),
    p_F         = pf(f["value"], f["numdf"], f["dendf"],
                     lower.tail = FALSE),
    RMSE        = sqrt(mean(residuals(mod)^2)),
    AIC         = AIC(mod)
  )
})

tabla_metricas

#-------------------------------------------------
# Prueba de Box–Cox
#  Modelo en niveles: Q ~ P + Edad + Sexo
#  (Usamos Q_adj para que todo sea > 0)
#-------------------------------------------------

library(MASS)

# Modelo en niveles con Q ajustada
m_box <- lm(Q_adj ~ P + edad + sexo_dummy, data = datos_long)

# Box–Cox sobre ese modelo
bc <- boxcox(m_box, lambda = seq(-2, 2, by = 0.1))

# Lambda óptimo
lambda_opt <- bc$x[which.max(bc$y)]
lambda_opt

#-------------------------------------------------
#Prueba de Ramsey RESET
#-------------------------------------------------

library(lmtest)

reset_m1 <- resettest(m1, power = 2:3)  # agrega P^2, P^3, etc.
reset_m1