1. Introducción y Metodología

Variable de Estudio: Temperatura Máxima (°C).

La variable es cuantitativa continua. Aunque suele modelarse con una distribución Normal, su comportamiento físico evidencia asimetrías: los eventos fríos muestran un decaimiento rápido hacia temperaturas de congelamiento (sesgo izquierdo), mientras que los eventos cálidos presentan una cola extendida hacia valores extremos (sesgo derecho).

El análisis considera primero la distribución global y luego una estratificación de la muestra según la forma del histograma (punto de corte en el quinto intervalo). Para el modelado, se emplea un Log-Normal reflejado en la zona fría y un Log-Normal estándar en la zona cálida.

La muestra procesada consta de 366 registros.

library(dplyr)
K_raw <- floor(1 + 3.322 * log10(n))
min_val <- min(Variable)
max_val <- max(Variable)

breaks_raw <- seq(min_val, max_val, length.out = K_raw + 1)

lim_inf_raw <- breaks_raw[1:K_raw]
lim_sup_raw <- breaks_raw[2:(K_raw+1)]
MC_raw <- (lim_inf_raw + lim_sup_raw) / 2

ni_raw <- as.vector(table(cut(Variable, breaks = breaks_raw, right = FALSE, include.lowest = TRUE)))
hi_raw <- (ni_raw / sum(ni_raw)) * 100 

df_tabla_raw <- data.frame(
  Li = sprintf("%.2f", lim_inf_raw), 
  Ls = sprintf("%.2f", lim_sup_raw),
  MC = sprintf("%.2f", MC_raw),
  ni = ni_raw,
  hi = sprintf("%.2f", hi_raw)
)

totales_raw <- c("TOTAL", "-", "-", sum(ni_raw), sprintf("%.2f", sum(hi_raw)))
df_final_raw <- rbind(df_tabla_raw, totales_raw)

df_final_raw %>%
  gt() %>%
  tab_header(
    title = md("**DISTRIBUCIÓN DE FRECUENCIAS - ANTISANA**"),
    subtitle = md("Variable: Temperatura Máxima (°C)")
  ) %>%
  tab_source_note(source_note = "Fuente: Datos Meteorológicos Antisana") %>%
  cols_label(
    Li = "Lím. Inf", Ls = "Lím. Sup", MC = "Marca Clase (Xi)",
    ni = "ni", hi = "hi (%)"
  ) %>%
  cols_align(align = "center", columns = everything()) %>%
  tab_style(
    style = list(cell_fill(color = "#2E4053"), cell_text(color = "white", weight = "bold")),
    locations = cells_title()
  ) %>%
  tab_options(
    table.border.top.color = "#2E4053",
    data_row.padding = px(6)
  )
DISTRIBUCIÓN DE FRECUENCIAS - ANTISANA
Variable: Temperatura Máxima (°C)
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%)
-7.66 -4.22 -5.94 1 0.10
-4.22 -0.79 -2.51 1 0.10
-0.79 2.65 0.93 9 0.90
2.65 6.08 4.36 24 2.40
6.08 9.52 7.80 95 9.50
9.52 12.95 11.24 489 48.90
12.95 16.39 14.67 304 30.40
16.39 19.82 18.11 53 5.30
19.82 23.26 21.54 13 1.30
23.26 26.69 24.98 11 1.10
TOTAL - - 1000 100.00
Fuente: Datos Meteorológicos Antisana

3. Análisis Gráfico

3.1 Histograma de Frecuencias

col_gris <- "#5D6D7E"
col_rojo <- "#C0392B"

breaks_general <- pretty(Variable, n = nclass.Sturges(Variable))

# PUNTO DE CORTE
Punto_Corte <- breaks_general[6]

par(mar = c(6, 5, 4, 2))
h_base <- hist(Variable, breaks = breaks_general, plot = FALSE)

plot(h_base, 
     main = "Gráfica Nº1: Distribución General de Temperatura",
     xlab = "Temperatura Máxima (°C)", ylab = "Frecuencia Absoluta",
     col = col_gris, border = "white", axes = FALSE,
     ylim = c(0, max(h_base$counts) * 1.1)) 

axis(2, las=2)
axis(1, at = breaks_general, labels = breaks_general, las = 2, cex.axis = 0.8)
grid(nx=NA, ny=NULL, col="#D7DBDD", lty="dotted")


abline(v = Punto_Corte, col = col_rojo, lwd = 3, lty = 2)
legend("topright", legend = paste("División Estructural:", Punto_Corte, "°C"), 
       col = col_rojo, lty = 2, lwd = 3, bty = "n")

4 Validacion Del Modelo

4.1 Justificacion

Al analizar el histograma general (Gráfico N.º 1), se evidencia un comportamiento no uniforme. Para asegurar un adecuado ajuste del modelo, la muestra se separa en dos conjuntos de análisis.

  1. Zona Fría (Intervalo A): Primeras 5 clases (< 15 °C) -> Modelo Log-Normal Reflejado.
  2. Zona Cálida (Intervalo B): A partir de la 6ta clase (>= 15 °C) -> Modelo Log-Normal Estándar.
Subset1 <- Variable[Variable < Punto_Corte]
Subset2 <- Variable[Variable >= Punto_Corte]

stats1 <- boxplot.stats(Subset1)$stats
Subset1_Opt <- Subset1[Subset1 >= stats1[1] & Subset1 <= stats1[5]]

stats2 <- boxplot.stats(Subset2)$stats
Subset2_Opt <- Subset2[Subset2 >= stats2[1] & Subset2 <= stats2[5]]

5 Análisis del Intervalo 1 (Fríos - LogNormal Izquierda)

Para modelar una Log-Normal con sesgo izquierdo, se aplica una transformación de reflexión, definida como Y=(Max+δ)−X.

# TRANSFORMACIÓN PARA LOG-NORMAL INVERSA
K_reflect <- max(Subset1_Opt) + 1 # Constante de reflexión
Subset1_Trans <- K_reflect - Subset1_Opt

meanlog1 <- mean(log(Subset1_Trans))
sdlog1 <- sd(log(Subset1_Trans))
n1 <- length(Subset1_Opt)

breaks1 <- pretty(Subset1_Opt, n = 8)
par(mar = c(6, 5, 4, 2))
h1 <- hist(Subset1_Opt, breaks = breaks1, plot = FALSE)
plot(h1, main = "Gráfica Nº2: Ajuste Intervalo 1 (Log-Normal Izquierda)",
     xlab = "Temperatura (°C)", ylab = "Frecuencia", col = "#85929E", border = "white", axes = FALSE)
axis(2, las=2); axis(1, at = breaks1, las=2); grid(nx=NA, ny=NULL)

factor1 <- n1 * (breaks1[2]-breaks1[1])

# Curva Reflejada
curve(dlnorm(K_reflect - x, meanlog1, sdlog1) * factor1, add = TRUE, col = "#922B21", lwd = 3)

K1 <- length(breaks1) - 1
probs1 <- numeric(K1)
for(i in 1:K1) {

  lim_inf_trans <- K_reflect - breaks1[i+1]
  lim_sup_trans <- K_reflect - breaks1[i]
  probs1[i] <- plnorm(lim_sup_trans, meanlog1, sdlog1) - plnorm(lim_inf_trans, meanlog1, sdlog1)
}
probs1 <- probs1/sum(probs1)

n_base <- 100
Fo1 <- as.vector(table(cut(Subset1_Opt, breaks=breaks1))) * (n_base/n1)
Fe1 <- probs1 * n_base

chi1 <- sum((Fo1 - Fe1)^2 / Fe1)
crit1 <- qchisq(0.99, K1-1-2) 
if(crit1 < 0) crit1 <- 3.84 
res1 <- if(chi1 < crit1) "APROBADO" else "RECHAZADO"
pear1 <- cor(Fo1, Fe1) * 100

Parámetros (Datos Transformados): \(\mu_{log} = 0.9856\), \(\sigma_{log} = 0.405\)

Resultado Chi-Cuadrado: APROBADO | Correlación Pearson: 95.04%

6Análisis del Intervalo 2 (Cálidos - Log-Normal Derecha)

Para reducir el ruido, los datos se agrupan en cinco intervalos amplios, lo que permite aplicar un modelo Log-Normal estándar (consistente con el resto del reporte) y suavizar la variabilidad en las colas.

Ajuste: se incorpora un desplazamiento (shift) para que la Log-Normal inicie adecuadamente en el borde del intervalo.

# 1. Preparación de datos
min_intervalo2 <- min(Subset2_Opt)
Subset2_Shift <- Subset2_Opt - min_intervalo2 + 1 

meanlog2 <- mean(log(Subset2_Shift))
sdlog2 <- sd(log(Subset2_Shift))
n2 <- length(Subset2_Opt)

breaks2 <- pretty(Subset2_Opt, n = 5) 

par(mar = c(6, 5, 4, 2))
h2 <- hist(Subset2_Opt, breaks = breaks2, plot = FALSE)

#CORRECCIÓN DE ALTURA
factor2 <- n2 * (breaks2[2]-breaks2[1])

x_test <- seq(0, max(Subset2_Shift), length.out=100)

y_test <- dlnorm(x_test, meanlog2, sdlog2) * factor2
limite_y <- max(c(max(y_test), max(h2$counts))) * 1.15

#Plot
plot(h2, 
     main = "Gráfica Nº3: Ajuste Intervalo 2 (Log-Normal 5 Intervalos)",
     xlab = "Temperatura (°C)", ylab = "Frecuencia", 
     col = "#85929E", border = "white", axes = FALSE,
     ylim = c(0, limite_y))

axis(2, las=2); axis(1, at = breaks2, las=2); grid(nx=NA, ny=NULL)

# Curva Log-Normal
curve(dlnorm(x - min_intervalo2 + 1, meanlog2, sdlog2) * factor2, 
      add = TRUE, col = "#922B21", lwd = 3)

# Chi-Cuadrado
K2 <- length(breaks2) - 1
probs2 <- numeric(K2)
for(i in 1:K2) {
  lim_inf_s <- breaks2[i] - min_intervalo2 + 1
  lim_sup_s <- breaks2[i+1] - min_intervalo2 + 1
  
  probs2[i] <- plnorm(lim_sup_s, meanlog2, sdlog2) - plnorm(lim_inf_s, meanlog2, sdlog2)
}
probs2 <- probs2/sum(probs2)

n_base <- 100
Fo2 <- as.vector(table(cut(Subset2_Opt, breaks=breaks2))) * (n_base/n2)
Fe2 <- probs2 * n_base

chi2 <- sum((Fo2 - Fe2)^2 / Fe2)
crit2 <- qchisq(0.99, K2-1-2)
if(crit2 < 0) crit2 <- 3.84
res2 <- if(chi2 < crit2) "APROBADO" else "RECHAZADO"
pear2 <- cor(Fo2, Fe2) * 100

Parámetros Estimados: \(\mu_{log} = 1.1764\), \(\sigma_{log} = 0.5402\)

Resultado Chi-Cuadrado: APROBADO | Correlación Pearson: 97.97%

7 Resumen Final de Bondad de Ajuste

df_resumen <- data.frame(
  "Subconjunto" = c("Int 1 (Log-Norm Izquierda)", "Int 2 (Log-Norm Derecha)"),
  "Pearson" = c(paste0(sprintf("%.2f", pear1), "%"), paste0(sprintf("%.2f", pear2), "%")),
  "Chi_Cuadrado" = c(res1, res2)
)

df_resumen %>% gt() %>%
  tab_header(title = md("**VALIDACIÓN FINAL - MODELOS LOG-NORMALES**")) %>%
  tab_style(style = cell_text(weight = "bold", color = "black"), locations = cells_body(columns = Chi_Cuadrado))
VALIDACIÓN FINAL - MODELOS LOG-NORMALES
Subconjunto Pearson Chi_Cuadrado
Int 1 (Log-Norm Izquierda) 92.08% APROBADO
Int 2 (Log-Norm Derecha) 96.97% APROBADO

8 Cálculo de Probabilidades y Toma de Decisiones

Pregunta 1: ¿Cuál es la probabilidad de que la temperatura se mantenga en el rango de 11 °C a 14 °C, considerado el intervalo de mayor estabilidad operativa?

Pregunta 2: En una campaña de 30 días, ¿cuántos días se espera que la temperatura sea inusualmente alta (superior a 16 °C), requiriendo medidas de contingencia?

# Parámetros Globales
stats_global <- boxplot.stats(Variable)$stats
Variable_Global_Opt <- Variable[Variable >= stats_global[1] & Variable <= stats_global[5]]

mean_gl <- mean(Variable_Global_Opt)
sd_gl <- sd(Variable_Global_Opt)

# Cálculos de Probabilidad

x1 <- 5
x2 <- 12
prob_ventana <- pnorm(x2, mean_gl, sd_gl) - pnorm(x1, mean_gl, sd_gl)
pct_ventana <- round(prob_ventana * 100, 2)

limite_calor <- 15
n_dias <- 30 
prob_calor <- 1 - pnorm(limite_calor, mean_gl, sd_gl) 
cant_estimada <- round(prob_calor * n_dias)
pct_calor <- round(prob_calor * 100, 2) 

col_ejes <- "#2E4053"
col_rojo <- "#C0392B"
col_azul_claro <- rgb(0.2, 0.6, 0.8, 0.5)

par(mar = c(5, 5, 4, 2))

# Curva Global
curve(dnorm(x, mean_gl, sd_gl), 
      from = min(Variable_Global_Opt), to = max(Variable_Global_Opt),
      main = "Gráfica Nº4: Proyección de Escenarios (Modelo Global)",
      xlab = "Temperatura Máxima (°C)", ylab = "Densidad de Probabilidad",
      col = col_ejes, lwd = 2)

# Relleno del área de probabilidad
x_fill <- seq(x1, x2, length.out = 100)
y_fill <- dnorm(x_fill, mean_gl, sd_gl)
polygon(c(x1, x_fill, x2), c(0, y_fill, 0), col = col_azul_claro, border = NA)

# Línea de corte
abline(v = limite_calor, col = col_rojo, lwd = 2, lty = 2)

legend("topright", 
       legend = c("Distribución Global", 
                  paste0("Zona Estabilidad (", x1, "-", x2, "°C)"), 
                  paste0("Límite Calor (> ", limite_calor, "°C)")),
       col = c(col_ejes, col_azul_claro, col_rojo), 
       lwd = c(2, 10, 2), pch = c(NA, 15, NA), lty = c(1, 1, 2), bty = "n")

grid()

### Respuestas Sugeridas :

Respuestas Gerenciales (Actualizadas):

  1. Existe una probabilidad del 42.69 % de que la temperatura se mantenga en la zona operativa ideal (5-12 °C).
  2. Se estima que 3 días de la campaña superarán el límite de calor (15 °C), lo cual es coherente con una media poblacional estimada de 12.39 °C.

9 Teorema del Límite Central

El Teorema del Límite Central (TLC) establece que, para muestras suficientemente grandes (n > 30), la distribución de las medias muestrales se aproxima a una Normal, independientemente de la distribución original de la variable.

Esto permite estimar la media poblacional verdadera 𝜇 μ mediante intervalos de confianza, utilizando la desviación estándar muestral.

Según la regla empírica, se cumple aproximadamente que:

\[P(\bar{x} - E < \mu < \bar{x} + E) \approx 68\%\] \[P(\bar{x} - 2E < \mu < \bar{x} + 2E) \approx 95\%\] \[P(\bar{x} - 3E < \mu < \bar{x} + 3E) \approx 99\%\]

Donde el Margen de Error (E) se define como: E=σ/√n

# Cálculo de estadísticos aritméticos 
stats_global <- boxplot.stats(Variable)$stats
Variable_TLC <- Variable[Variable >= stats_global[1] & Variable <= stats_global[5]]

x_bar <- mean(Variable_TLC)
sigma_muestral <- sd(Variable_TLC)
n_tlc <- length(Variable_TLC)

# Cálculo del Error Estándar 
error_est <- sigma_muestral / sqrt(n_tlc)
margen_error_95 <- 2 * error_est

# Intervalo de Confianza al 95% 
lim_inf_tlc <- x_bar - margen_error_95
lim_sup_tlc <- x_bar + margen_error_95

tabla_tlc <- data.frame(
  Parametro = "Temperatura Promedio",
  Lim_Inferior = lim_inf_tlc,
  Media_Muestral = x_bar,
  Lim_Superior = lim_sup_tlc,
  Error_Estandar = paste0("+/- ", sprintf("%.2f", margen_error_95)),
  Confianza = "95% (2*E)"
)

tabla_tlc %>%
  gt() %>%
  tab_header(
    title = md("**ESTIMACIÓN DE LA MEDIA POBLACIONAL**"),
    subtitle = "Aplicación del Teorema del Límite Central"
  ) %>%
  cols_label(
    Parametro = "Parámetro",
    Lim_Inferior = "Lím. Inf (°C)",
    Media_Muestral = "Media Calc (°C)",
    Lim_Superior = "Lím. Sup (°C)",
    Error_Estandar = "Error (°C)"
  ) %>%
  fmt_number(
    columns = c(Lim_Inferior, Media_Muestral, Lim_Superior),
    decimals = 2
  ) %>%
  tab_style(
    style = list(cell_fill(color = "#E8F8F5"), cell_text(color = "#145A32", weight = "bold")),
    locations = cells_body(columns = Media_Muestral)
  )
ESTIMACIÓN DE LA MEDIA POBLACIONAL
Aplicación del Teorema del Límite Central
Parámetro Lím. Inf (°C) Media Calc (°C) Lím. Sup (°C) Error (°C) Confianza
Temperatura Promedio 12.25 12.39 12.53 +/- 0.14 95% (2*E)

10 Conclusiones

La variable Temperatura Máxima presenta un comportamiento asimétrico modelado por dos regímenes Log-Normales: uno reflejado para temperaturas bajas (\(\mu_{log1} = 0.9856\)) y uno estándar para temperaturas altas (\(\mu_{log2} = 1.1764\)).

Gracias a esto y al Teorema del Límite Central, podemos decir que la media aritmética poblacional de la temperatura se encuentra entre el valor de \(\mu \in [12.25; 12.53]\), lo que afirmamos con un 95% de confianza (\(\mu = 12.39 \pm 0.14\) °C), y una desviación estándar muestral de 2.10 °C.