Variables Aleatorias Continuas

Cargar los datos

datos <- read.csv("D:/Data/database.csv", header = TRUE, sep = ";", dec = ".")

Inferencia: Modelo de probabilidad log-normal para MPG en ciudad

mpg_c <- as.numeric(as.character(datos$Unadjusted.City.MPG..FT1.))
## Warning: NAs introducidos por coerción
mpg_c <- na.omit(mpg_c)
mpg_c <- mpg_c[mpg_c > 0]

Histograma general

hist(mpg_c,
     main = "Histograma general de MPG en ciudad",
     xlab = "MPG (Ciudad)", ylab = "Frecuencia",
     col = "gray", border = "white")

Tabla de frecuencias por intervalo

histograma_total <- hist(mpg_c, plot = FALSE)
breaks <- histograma_total$breaks
frecuencias <- histograma_total$counts
intervalos <- paste0(head(breaks, -1), "-", tail(breaks, -1))
grupo <- c("Pico", rep("Resto", length(frecuencias) - 1))

tabla_frec <- data.frame(
  Intervalo = intervalos,
  Frecuencia = frecuencias,
  Grupo = grupo
)

kable(tabla_frec, format = "markdown", caption = "Tabla. Frecuencias por intervalo del histograma original")
Tabla. Frecuencias por intervalo del histograma original
Intervalo Frecuencia Grupo
0-50 23992 Pico
50-100 131 Resto
100-150 1101 Resto
150-200 3482 Resto
200-250 3686 Resto
250-300 1988 Resto
300-350 742 Resto
350-400 326 Resto
400-450 83 Resto
450-500 40 Resto
500-550 23 Resto
550-600 34 Resto
600-650 18 Resto
650-700 7 Resto
700-750 17 Resto
750-800 3 Resto
800-850 2 Resto
850-900 4 Resto 
umbral <- breaks[2]

1. Análisis de la primera división

mpg_pico <- mpg_c[mpg_c >= breaks[1] & mpg_c < umbral]

histograma_pico <- hist(mpg_pico, freq = FALSE, breaks = 10,
                        main = "Gráfica 1. Pico principal (MPG) subdividido",
                        xlab = "MPG (Ciudad)", ylab = "Densidad de probabilidad",
                        col = "tomato")

log_pico <- log(mpg_pico)
ulog_pico <- mean(log_pico)
sigmalog_pico <- sd(log_pico)

x <- seq(min(mpg_pico), max(mpg_pico), 0.01)
curve(dlnorm(x, ulog_pico, sigmalog_pico), from = min(mpg_pico), to = max(mpg_pico), add = TRUE,
      lwd = 3, col = "darkgreen")

Fo <- histograma_pico$counts
h <- length(Fo)
P <- sapply(1:h, function(i) plnorm(histograma_pico$breaks[i+1], ulog_pico, sigmalog_pico) -
              plnorm(histograma_pico$breaks[i], ulog_pico, sigmalog_pico))
Fe <- P * length(mpg_pico)

Test de bondad de ajuste (MPG)

plot(Fo, Fe, main = "Gráfica 2: Correlación FO vs FE (Pico)",
     xlab = "Frecuencia Observada", ylab = "Frecuencia Esperada", col = "blue3", pch = 19)
abline(lm(Fe ~ Fo), col = "red", lwd = 2)

correlacion_pico <- cor(Fo, Fe) * 100
n <- length(mpg_pico)
Fo_rel <- (Fo / n) * 100
Fe_rel <- P * 100
x2 <- sum((Fe_rel - Fo_rel)^2 / Fe_rel)
gl <- h - 1
umbral_chi <- qchisq(0.95, df = gl)

tabla_pico <- data.frame(
  Variable = "Pico MPG",
  `Test Pearson (%)` = round(correlacion_pico, 2),
  `Chi Cuadrado` = round(x2, 2),
  `Umbral de aceptación` = round(umbral_chi, 2)
)
kable(tabla_pico, format = "markdown", caption = "Tabla. Test de bondad para el pico del histograma (MPG)")
Tabla. Test de bondad para el pico del histograma (MPG)
Variable Test.Pearson…. Chi.Cuadrado Umbral.de.aceptación
Pico MPG 99.68 1.42 15.51

2. Análisis de la segunda división

mpg_c_sub <- mpg_c[mpg_c >= umbral]

histograma_sub <- hist(mpg_c_sub, freq = FALSE,
                       main = "Gráfica 3. Modelo log-normal para segunda división",
                       xlab = "MPG (Ciudad)", ylab = "Densidad de probabilidad",
                       col = "steelblue")

log_sub <- log(mpg_c_sub)
ulog <- mean(log_sub)
sigmalog <- sd(log_sub)

x <- seq(min(mpg_c_sub), max(mpg_c_sub), 0.01)
curve(dlnorm(x, ulog, sigmalog), from = min(mpg_c_sub), to = max(mpg_c_sub),
      add = TRUE, lwd = 3, col = "darkgreen")

Fo <- histograma_sub$counts
h <- length(Fo)
P <- sapply(1:h, function(i) plnorm(histograma_sub$breaks[i+1], ulog, sigmalog) -
              plnorm(histograma_sub$breaks[i], ulog, sigmalog))
Fe <- P * length(mpg_c_sub)

Test de bondad de ajuste (MPG)

plot(Fo, Fe, main = "Gráfica 4: Correlación FO vs FE (segunda división)",
     xlab = "Frecuencia Observada", ylab = "Frecuencia Esperada", col = "blue3", pch = 19)
abline(lm(Fe ~ Fo), col = "red", lwd = 2)

correlacion_sub <- cor(Fo, Fe) * 100
n <- length(mpg_c_sub)
Fo_rel <- (Fo / n) * 100
Fe_rel <- P * 100
x2 <- sum((Fe_rel - Fo_rel)^2 / Fe_rel)
gl <- h - 1
umbral <- qchisq(0.95, df = gl)

tabla_sub <- data.frame(
  Variable = "MPG ciudad (segunda división)",
  `Test Pearson (%)` = round(correlacion_sub, 2),
  `Chi Cuadrado` = round(x2, 2),
  `Umbral de aceptación` = round(umbral, 2)
)
kable(tabla_sub, format = "markdown", caption = "Tabla. Test log-normal para segunda división de MPG")
Tabla. Test log-normal para segunda división de MPG
Variable Test.Pearson…. Chi.Cuadrado Umbral.de.aceptación
MPG ciudad (segunda división) 99.17 10.35 26.3

Probabilidad entre 100 y 200 MPG (segunda división)

lim_inf <- 100
lim_sup <- 200
probabilidad_intervalo <- plnorm(lim_sup, ulog, sigmalog) - plnorm(lim_inf, ulog, sigmalog)
paste("Probabilidad de que el MPG esté entre", lim_inf, "y", lim_sup, ":", round(probabilidad_intervalo * 100, 2), "%")
## [1] "Probabilidad de que el MPG esté entre 100 y 200 : 40.78 %"
x <- seq(min(mpg_c_sub), max(mpg_c_sub), by = 0.01)
y <- dlnorm(x, ulog, sigmalog)

plot(x, y, type = "l", col = "darkgreen", lwd = 2,
     main = paste("Gráfica 5. Probabilidad entre", lim_inf, "y", lim_sup, "MPG"),
     xlab = "MPG", ylab = "Densidad de probabilidad")

x_fill <- seq(lim_inf, lim_sup, by = 0.01)
y_fill <- dlnorm(x_fill, ulog, sigmalog)
polygon(c(x_fill, rev(x_fill)), c(y_fill, rep(0, length(y_fill))),
        col = rgb(1, 0, 0, 0.4))

legend("topright", legend = c("Modelo Log-normal", paste("Área entre", lim_inf, "y", lim_sup)),
       col = c("darkgreen", "red"), lwd = 2, pch = c(NA, 15))

Intervalo de confianza para la media poblacional (MPG completo)

media_muestral <- mean(mpg_c)
sigma_muestral <- sd(mpg_c)
e <- sigma_muestral / sqrt(length(mpg_c))
li <- media_muestral - 2 * e
ls <- media_muestral + 2 * e

tabla_ic <- data.frame(
  `Límite inferior` = round(li, 2),
  Variable = "MPG en ciudad",
  `Límite superior` = round(ls, 2),
  `Error estándar` = round(e, 2)
)
kable(tabla_ic, format = "markdown", caption = "Tabla. Intervalo de confianza para la media poblacional")
Tabla. Intervalo de confianza para la media poblacional
Límite.inferior Variable Límite.superior Error.estándar
87.45 MPG en ciudad 89.67 0.55 
# Conclusión MPG


La variable de MPG en ciudad se explica con un modelo de probabilidad log-normal de media 88.56 y una desviación estándar de 104.42; donde la media aritmética poblacional se encuentra entre 87.45 y 89.67, lo que afirmamos con un 95% de confianza.

Inferencia: Modelo de probabilidad normal para Costo Anual de Combustible

c_anual <- as.numeric(as.character(datos$Annual.Fuel.Cost..FT1.))
c_anual <- na.omit(c_anual)
c_anual <- c_anual[c_anual > 0]

histograma_c <- hist(c_anual, freq = FALSE,
                     main = "Gráfica 4. Modelo de probabilidad normal para Costo Anual",
                     xlab = "Costo Anual", ylab = "Densidad de probabilidad",
                     col = "steelblue",
                     yaxt = "n")
axis(2, at = pretty(density(c_anual)$y), labels = format(pretty(density(c_anual)$y), scientific = FALSE))

mu <- mean(c_anual)
sigma <- sd(c_anual)

x_c <- seq(min(c_anual), max(c_anual), 1)
y_c <- dnorm(x_c, mu, sigma)
lines(x_c, y_c, col = "darkgreen", lwd = 3)

Fo_c <- histograma_c$counts
h_c <- length(Fo_c)
P_c <- c()
for (i in 1:h_c) {
  P_c[i] <- pnorm(histograma_c$breaks[i+1], mu, sigma) - pnorm(histograma_c$breaks[i], mu, sigma)
}
Fe_c <- P_c * length(c_anual)

Test de bondad de ajuste (Costo Anual)

plot(Fo_c, Fe_c, main = "Gráfica 5: Correlación entre frecuencias observadas y esperadas",
     xlab = "Frecuencia Observada", ylab = "Frecuencia Esperada", col = "blue3")
abline(lm(Fe_c ~ Fo_c), col = "red", lwd = 2)

correlacion_c <- cor(Fo_c, Fe_c) * 100
alpha <- 0.05
n_c <- length(c_anual)
x2_c <- sum((Fe_c - Fo_c)^2 / Fe_c)
umbral_c <- qchisq(1 - alpha, h_c - 1)

Variable <- c("Costo Anual")
tabla_resumen_c <- data.frame(Variable, round(correlacion_c, 2), round(x2_c, 2), round(umbral_c, 2))
colnames(tabla_resumen_c) <- c("Variable", "Test Pearson (%)", "Chi Cuadrado", "Umbral de aceptación")
kable(tabla_resumen_c, format = "markdown", caption = "Tabla. Test de bondad de ajuste para modelo normal")
Tabla. Test de bondad de ajuste para modelo normal
Variable Test Pearson (%) Chi Cuadrado Umbral de aceptación
Costo Anual 98.19 38203063488 19.68

Probabilidad entre 1500 y 2500 (Costo Anual)

probabilidad_c <- pnorm(2500, mu, sigma) - pnorm(1500, mu, sigma)
probabilidad_c * 100
## [1] 64.98101
x_c <- seq(min(c_anual), max(c_anual), 1)
y_c <- dnorm(x_c, mu, sigma)
plot(x_c, y_c, type = "l", col = "darkgreen", lwd = 2,
     main = "Gráfica 6. Cálculo de probabilidades", xlab = "Costo Anual", ylab = "Densidad de probabilidad")

x_fill_c <- seq(1500, 2500, by = 1)
y_fill_c <- dnorm(x_fill_c, mu, sigma)
polygon(c(x_fill_c, rev(x_fill_c)), c(y_fill_c, rep(0, length(y_fill_c))), col = rgb(1, 0, 0, 0.4))
legend("topright", legend = c("Modelo Normal", "Área entre 1500 y 2500"),
       col = c("darkgreen", "red"), lwd = 2, pch = c(NA, 15))

Intervalo de confianza para la media (Costo Anual)

e_c <- sigma / sqrt(n_c)
li_c <- mu - 2 * e_c
ls_c <- mu + 2 * e_c

tabla_ic_c <- data.frame(round(li_c, 2), Variable, round(ls_c, 2), round(e_c, 2))
colnames(tabla_ic_c) <- c("Límite inferior", "Variable", "Límite superior", "Error estándar")
kable(tabla_ic_c, format = "markdown", caption = "Tabla. Intervalo de confianza para la media poblacional (Costo Anual)")
Tabla. Intervalo de confianza para la media poblacional (Costo Anual)
Límite inferior Variable Límite superior Error estándar
1953.45 Costo Anual 1964.74 2.82

Conclusión Costo Anual

La variable de costo anual de combustible se explica con un modelo de probabilidad de distribución normal de media 1949.10 y una desviación estándar de 533.63; donde la media aritmética poblacional se encuentra entre 1953 y 1964, lo que afirmamos con un 95% de confianza.