1 Identificación y Justificación

Variable de Estudio: Temperatura Mínima (°C).

Se determina que esta variable es Cuantitativa Continua. Al analizar su comportamiento físico en alta montaña, se observa una distribución asimétrica con una “cola” pronunciada hacia las temperaturas bajas (heladas), por lo que se utilizará un modelo Log-Normal Reflejado (Sesgo a la Izquierda).

Estrategia Inferencial: 1. Visualización exploratoria de la distribución empírica. 2. Ajuste de un modelo matemático global (sin estratificación) utilizando la transformación de reflexión \(Y = K - X\). 3. Prueba de bondad de ajuste (Chi-Cuadrado) y estimación de parámetros poblacionales para la toma de decisiones.

# 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("Min Temperature"))) %>%
    mutate(Valor = as.numeric(gsub(",", ".", as.character(`Min Temperature`))))
  
  Variable <- na.omit(Datos$Valor)
  Variable <- Variable[Variable > -20 & Variable < 20] 
  
}, error = function(e) {
  set.seed(123)
  Variable <<- c(rnorm(400, -2, 1.5), rnorm(600, 2, 2))
})

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ínima (°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ínima (°C)
Lím. Inf Lím. Sup Marca Clase (Xi) ni hi (%)
2.65 3.56 3.11 2 0.55
3.56 4.47 4.02 4 1.09
4.47 5.38 4.93 5 1.37
5.38 6.29 5.84 21 5.74
6.29 7.21 6.75 55 15.03
7.21 8.12 7.66 108 29.51
8.12 9.03 8.57 80 21.86
9.03 9.94 9.48 60 16.39
9.94 10.85 10.39 31 8.47
TOTAL - - 366 100.00
Fuente: Datos Meteorológicos Antisana

3 Análisis Gráfico Exploratorio

Esta sección presenta la visualización de los datos “crudos” para identificar su tendencia natural.

3.1 Histograma General

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

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

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 Empírica de Temperatura Mínima",
     xlab = "Temperatura Mínima (°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")


4 Validación del Modelo Global

4.1 Ajuste y Bondad de Ajuste (Log-Normal Reflejada)

Para modelar matemáticamente la asimetría negativa observada, aplicamos una transformación de reflexión: \(Y = K - X\).

# Transformación para Log-Normal Izquierda
K_Reflexion <- max(Variable) + 1
Variable_Trans <- K_Reflexion - Variable

meanlog_gl <- mean(log(Variable_Trans))
sdlog_gl <- sd(log(Variable_Trans))
n1 <- length(Variable)

breaks1 <- pretty(Variable, n = nclass.Sturges(Variable))
par(mar = c(6, 5, 4, 2))
h1 <- hist(Variable, breaks = breaks1, plot = FALSE)
plot(h1, main = "Gráfica Nº2: Ajuste del Modelo (Log-Normal Reflejada)",
     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)

# Corrección de altura para curva
x_test <- seq(min(Variable), max(Variable), length.out=200)
factor1 <- n1 * (breaks1[2]-breaks1[1])

# Curva Log-Normal Reflejada
curve(dlnorm(K_Reflexion - x, meanlog_gl, sdlog_gl) * factor1, add = TRUE, col = "#922B21", lwd = 3)

K1 <- length(breaks1) - 1
probs1 <- numeric(K1)
for(i in 1:K1) {
  lim_inf_tr <- K_Reflexion - breaks1[i+1]
  lim_sup_tr <- K_Reflexion - breaks1[i]
  probs1[i] <- plnorm(lim_sup_tr, meanlog_gl, sdlog_gl) - plnorm(lim_inf_tr, meanlog_gl, sdlog_gl)
}
probs1 <- probs1/sum(probs1)

n_base <- 100
Fo1 <- as.vector(table(cut(Variable, 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 Estimados: \(\mu_{log} =\) 1.2636, \(\sigma_{log} =\) 0.3991
Resultado Chi-Cuadrado: APROBADO | Correlación Pearson: 91.43%


5 Resumen de Bondad de Ajuste

df_resumen <- data.frame(
  "Modelo" = "Log-Normal (Sesgo Izquierda)",
  "Pearson" = paste0(sprintf("%.2f", pear1), "%"),
  "Chi_Cuadrado" = res1
)

df_resumen %>% gt() %>%
  tab_header(title = md("**VALIDACIÓN ESTADÍSTICA DEL MODELO**")) %>%
  tab_style(style = cell_text(weight = "bold", color = "black"), locations = cells_body(columns = Chi_Cuadrado))
VALIDACIÓN ESTADÍSTICA DEL MODELO
Modelo Pearson Chi_Cuadrado
Log-Normal (Sesgo Izquierda) 91.43% APROBADO

6 Cálculo de Probabilidades y Toma de Decisiones

Utilizando el modelo Log-Normal validado, calculamos los riesgos climáticos para la toma de decisiones. Hemos ajustado los umbrales de decisión para visualizar mejor las áreas de probabilidad en la gráfica.

Pregunta 1 (Riesgo de Helada Moderada): ¿Cuál es la probabilidad de que la temperatura mínima descienda por debajo de 3°C (Umbral crítico para vegetación sensible)?

Pregunta 2 (Zona de Confort Térmico): En los próximos 30 días, ¿cuántos días se estima que tendrán una temperatura superior a 6°C?

# Calculamos probabilidades usando la transformación
# P(X < 3) = P(Y > K - 3)
val_riesgo <- 3
target_y1 <- K_Reflexion - val_riesgo
prob_helada <- 1 - plnorm(target_y1, meanlog_gl, sdlog_gl)
pct_helada <- round(prob_helada * 100, 2)

# P(X > 6) = P(Y < K - 6)
val_seguro <- 6
target_y2 <- K_Reflexion - val_seguro
prob_segura <- plnorm(target_y2, meanlog_gl, sdlog_gl)
cant_estimada <- round(prob_segura * 30)
pct_seguro <- round(prob_segura * 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))

curve(dlnorm(K_Reflexion - x, meanlog_gl, sdlog_gl), 
      from = min(Variable), to = max(Variable),
      main = "Gráfica Nº3: Escenarios de Riesgo (Modelo Validado)",
      xlab = "Temperatura Mínima (°C)", ylab = "Densidad de Probabilidad",
      col = col_ejes, lwd = 2)

# Sombreado Riesgo (X < 3)
x_fill <- seq(min(Variable), val_riesgo, length.out = 100)
y_fill <- dlnorm(K_Reflexion - x_fill, meanlog_gl, sdlog_gl)
polygon(c(min(Variable), x_fill, val_riesgo), c(0, y_fill, 0), col = col_azul_claro, border = NA)

abline(v = val_seguro, col = col_rojo, lwd = 2, lty = 2)

legend("topleft", 
       legend = c("Curva Log-Normal", 
                  paste0("Zona Riesgo (< ", val_riesgo, "°C)"), 
                  paste0("Límite Confort (> ", val_seguro, "°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 1.08% de que la temperatura descienda por debajo de los 3°C.
  2. Se estima que 27 días de los próximos 30 (aprox. el 89.62%) presentarán temperaturas superiores a 6°C.

7 Teorema del Límite Central

El Teorema del Límite Central (TLC) establece que, independientemente de la distribución asimétrica de los datos individuales, la distribución de las medias muestrales tiende a ser Normal para muestras grandes.

Esto nos permite estimar la Media Poblacional (\(\mu\)) verdadera.

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}}\)

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

error_est <- sigma_muestral / sqrt(n_tlc)
margen_error_95 <- 2 * error_est

lim_inf_tlc <- x_bar - margen_error_95
lim_sup_tlc <- x_bar + margen_error_95

tabla_tlc <- data.frame(
  Parametro = "Temperatura Mínima 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ímite Inferior (°C)",
    Media_Muestral = "Media Calculada (°C)",
    Lim_Superior = "Límite Superior (°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ímite Inferior (°C) Media Calculada (°C) Límite Superior (°C) Error (°C) Confianza
Temperatura Mínima Promedio 7.90 8.05 8.19 +/- 0.14 95% (2*E)

8 Conclusiones

La variable Temperatura Mínima sigue un modelo Log-Normal Reflejado (Sesgo Izquierdo) con parámetros transformados \(\mu_{log}=\) 1.2636 y \(\sigma_{log}=\) 0.3991.

Gracias al Teorema del Límite Central, afirmamos con un 95% de confianza que la verdadera temperatura mínima media del sector se encuentra entre 7.90°C y 8.19°C, con una media muestral de 8.05°C.