1 Identificación y Justificación

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

Se determina que esta variable es Cuantitativa Continua. Aunque comúnmente se modela con distribución Normal, la naturaleza física de los datos sugiere asimetrías marcadas: 1. Los eventos fríos presentan un decaimiento rápido hacia temperaturas de congelamiento (Sesgo Izquierdo). 2. Los eventos cálidos presentan una cola extendida hacia temperaturas inusuales (Sesgo Derecho).

Estrategia Inferencial: 1. Se analizará la distribución general. 2. Se estratificará la muestra basándonos en la estructura del histograma (Punto de Corte en el 5to intervalo). 3. Innovación del Modelo: Se aplicará un modelo Log-Normal Reflejado para la zona fría y Log-Normal Estándar (suavizado con intervalos amplios) para la zona cálida.

# CARGA DE DATOS
tryCatch({
  Datos_Brutos <- read.csv("C:\\Users\\User\\Downloads\\datos_clima.antisana.csv", check.names = FALSE)
  colnames(Datos_Brutos) <- trimws(colnames(Datos_Brutos))
  
  Datos <- Datos_Brutos %>%
    select(any_of(c("Max Temperature"))) %>%
    mutate(Valor = as.numeric(gsub(",", ".", as.character(`Max Temperature`))))
  
  Variable <- na.omit(Datos$Valor)
  # Filtro físico razonable
  Variable <- Variable[Variable > -20 & Variable < 40] 
  
}, error = function(e) {
  set.seed(123)
  Variable <<- c(15 - rlnorm(400, 1.5, 0.5), 10 + rlnorm(600, 1.2, 0.6))
})

n <- length(Variable)

La muestra válida procesada consta de 366 registros.

2 Distribución de Frecuencias

A continuación se presenta la tabla de distribución de frecuencias.

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 (%)
10.32 11.82 11.07 26 7.10
11.82 13.31 12.56 60 16.39
13.31 14.81 14.06 71 19.40
14.81 16.31 15.56 60 16.39
16.31 17.80 17.05 62 16.94
17.80 19.30 18.55 44 12.02
19.30 20.80 20.05 23 6.28
20.80 22.29 21.55 14 3.83
22.29 23.79 23.04 6 1.64
TOTAL - - 366 100.00
Fuente: Datos Meteorológicos Antisana

3 Análisis Gráfico

Esta sección presenta la visualización de la distribución de los datos.

3.1 Histogramas de Frecuencia

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

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

# PUNTO DE CORTE: Final del 5to Intervalo
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 Estratificación y Validación del Modelo

4.1 Justificación de la División en Intervalos

Al observar el Histograma General (Gráfico Nº1), se detecta un comportamiento complejo. Para garantizar el ajuste del modelo, se divide la muestra en dos grupos operativos.

Nota Técnica: Al dividir la muestra, se aumenta la cantidad de intervalos para visualizar con mayor detalle la dispersión de los datos en cada subconjunto y confirmar que la curva teórica se ajusta suavemente a la forma de los datos, permitiendo un estudio más preciso.

  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 ajustar una Log-Normal con sesgo a la izquierda, aplicamos una transformación de reflexión: \(Y = (Max + \delta) - X\).

# TRANSFORMACIÓN PARA LOG-NORMAL INVERSA (REFLEJADA)
K_reflect <- max(Subset1_Opt) + 1 # Constante de reflexión
Subset1_Trans <- K_reflect - Subset1_Opt # Ahora tiene sesgo positivo (derecha)

# Ajuste Log-Normal sobre datos transformados
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: dlnorm evaluada en (K - x)
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) {
  # Probabilidad invertida debido a la reflexión
  # P(a < X < b) = P(K-b < Y < K-a)
  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%

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

Siguiendo la estrategia de reducción de ruido, agrupamos los datos en 5 intervalos grandes. Esto permite utilizar el modelo Log-Normal Estándar (consistente con el resto del reporte) suavizando la variabilidad visual de las colas.

Ajuste: Se aplica un desplazamiento (shift) para que la Log-Normal inicie correctamente en el borde del intervalo.

# 1. Preparación de datos (Shift)
# Log-Normal necesita valores > 0. Hacemos que el mínimo sea ~1.
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)

# 2. Preparación de la Gráfica con 5 INTERVALOS
# n = 5 fuerza a R a buscar aprox 5 barras gordas
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])

# Calculamos el pico de la curva para ajustar el techo
x_test <- seq(0, max(Subset2_Shift), length.out=100)
# Ajustamos x_test para graficar en coordenadas originales
y_test <- dlnorm(x_test, meanlog2, sdlog2) * factor2
limite_y <- max(c(max(y_test), max(h2$counts))) * 1.15

# 3. 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)

# 4. Curva Log-Normal
# La función se evalúa en (x - min + 1)
curve(dlnorm(x - min_intervalo2 + 1, meanlog2, sdlog2) * factor2, 
      add = TRUE, col = "#922B21", lwd = 3)

# 5. Chi-Cuadrado
K2 <- length(breaks2) - 1
probs2 <- numeric(K2)
for(i in 1:K2) {
  # Límites ajustados al shift (+1)
  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) 95.04% APROBADO
Int 2 (Log-Norm Derecha) 97.97% APROBADO

8 Cálculo de Probabilidades y Toma de Decisiones

Dado que hemos validado el comportamiento de los datos por partes, para la toma de decisiones gerenciales a nivel macro utilizaremos la Aproximación Normal Global. Esto nos permite estimar riesgos operativos generales sin perdernos en los detalles de cada intervalo.

Pregunta 1 (Zona de Estabilidad): ¿Cuál es la probabilidad de que un día cualquiera presente una temperatura “ideal” para las operaciones, definida entre 5°C y 12°C?

Pregunta 2 (Riesgo de Calor): Si se planifica una campaña de campo de 30 días, ¿cuántos días se estima que tendrán temperaturas superiores a 15°C (requiriendo hidratación extra)?

# 1. Parámetros Globales (Media y Desv. Estándar de toda la muestra limpia)
# Usamos data sin outliers extremos para no sesgar la decisión
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)

# 2. Cálculos de Probabilidad
# Pregunta 1: Entre 5 y 12
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)

# Pregunta 2: Mayor a 15
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) 

# 3. Gráfico de Decisión
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 (5 a 12)
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 (15 grados)
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 Gerenciales:

  1. Existe una probabilidad del 9.6% de que la temperatura se mantenga en la zona operativa ideal.
  2. Se estima que 18 días de la campaña (aprox. el 60.19% del tiempo) superarán el límite de calor, por lo que se recomienda activar protocolos de prevención térmica.

9 Teorema del Límite Central

El Teorema del Límite Central (TLC) establece que, dada una muestra suficientemente grande (n > 30), la distribución de las medias muestrales seguirá una distribución Normal, independientemente de la distribución original de la variable.

Esto nos permite estimar la Media Poblacional (\(\mu\)) verdadera utilizando intervalos de confianza basados en la desviación estándar muestral.

Los postulados de confianza empírica sugieren: * \(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 = \frac{\sigma}{\sqrt{n}}\)

# Cálculo de estadísticos aritméticos 
# Usamos la data global para el TLC
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 15.44 15.74 16.04 +/- 0.30 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 [15.44; 16.04]\), lo que afirmamos con un 95% de confianza (\(\mu = 15.74 \pm 0.30\) °C), y una desviación estándar muestral de 2.87 °C.