Relación entre Radiación Solar y la precipitación en el Antisana

1 Carga de datos

library(readr)
dataANTISANA <- read_delim("C:/Users/Usuario/Desktop/TRABAJO DE ESTADISTICA/PDF-EXCEL-QGIS/dataANTISANA.csv", delim = ";", escape_double = FALSE, trim_ws = TRUE)
## Rows: 366 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ";"
## chr (1): Date
## dbl (9): Longitude, Latitude, Elevation, Max Temperature, Min Temperature, P...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

2 Tabla de pares de valores

Se comparan variables por causa y efecto

x <- dataANTISANA$Solar
y <- dataANTISANA$Precipitation

tabla_pares <- data.frame(
  Rad_Solar = x, 
  Precipitacion = y
)

print("Tabla de Pares: Radiación Solar (x) y Precipitación (y)")
## [1] "Tabla de Pares: Radiación Solar (x) y Precipitación (y)"
head(tabla_pares)
##   Rad_Solar Precipitacion
## 1     15.98          8.49
## 2     12.25         35.44
## 3      4.58         41.53
## 4      4.32         15.48
## 5      3.86         28.71
## 6      9.57         25.19

3 Gráfica de nubes de puntos

library(ggplot2)

ggplot(dataANTISANA, aes(x = Solar, y = Precipitation)) +
  geom_point(color = "darkblue", alpha = 0.6, size = 2) + 
  theme_minimal() +                                      
  labs(title = "Gráfica No.1: Disperción entre la Radiación Solar(x)
              y la Precipitación(y)",
       subtitle = "Estudio: Datos Antisana",
       x = "Rad. Solar (MJ/m²)",
       y = "Precipitación (mm)") +
  theme(plot.title = element_text(hjust = 0.6, face = "bold"))

4 Conjetura de un Modelo Potencial y Cálculo de parámetros

# 1. Definición de variables
x_pot <- dataANTISANA$Solar
y_pot <- dataANTISANA$Precipitation

# 2. CREACIÓN DEL MODELO (Esta es la línea que faltaba)
# Aplicamos logaritmos para linealizar la curva potencial y +0.0001 para evitar errores con ceros
modelo_potencial <- lm(log(y_pot + 0.0001) ~ log(x_pot + 0.0001))

# 3. Extracción de Parámetros
# Ahora sí, podemos usar 'modelo_potencial' para sacar los coeficientes
b_pot <- coef(modelo_potencial)[2]
a_pot <- exp(coef(modelo_potencial)[1])

# 4. Formateo de texto para la salida
a_txt <- format(a_pot, scientific = FALSE, digits = 6)
b_txt <- round(b_pot, 5)

cat("      PARÁMETROS DEL MODELO POTENCIAL\n",
    "Parámetro a (constante): ", a_txt, "\n",
    "Parámetro b (exponente): ", b_txt, "\n",
    "La ecuación es: y =", a_txt, "* x ^ (", b_txt, ")\n")
##       PARÁMETROS DEL MODELO POTENCIAL
##  Parámetro a (constante):  831.767 
##  Parámetro b (exponente):  -1.99211 
##  La ecuación es: y = 831.767 * x ^ ( -1.99211 )

5 Sobre escritura del modelo potencial sobre la nube de puntos

library(ggplot2)
library(ggtext)


a_vis <- format(a_pot, scientific = FALSE, digits = 5)
b_vis <- round(b_pot, 4)

sub_pot <- paste0("Modelo Potencial: <span style='color:#9b59b6;'>**y = ", 
                  a_vis, " · x<sup>", b_vis, "</sup>**</span>")

ggplot(dataANTISANA, aes(x = Solar, y = Precipitation)) +
  geom_point(color = "#2c3e50", alpha = 0.5, size = 2) +
  
  stat_function(fun = function(x) { a_pot * x^b_pot }, 
                color = "#9b59b6", size = 1.3) +
  
  theme_minimal() +
  labs(title = "Gráfica No.2: Comparación realidad y modelo de la
              Radiación Solar y la Precipitación)",
       subtitle = sub_pot,
       x = "Radiación Solar (MJ/m²)",
       y = "Precipitación (mm)") +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold", size = 14),
    plot.subtitle = element_markdown(hjust = 0.5, size = 11),
    axis.title = element_text(face = "bold")
  )

6 Test de Pearson

test_p_pot <- cor.test(log(x_pot), log(y_pot), method = "pearson")

r_pot <- as.numeric(test_p_pot$estimate)
r2_pot_val <- r_pot^2

cat("      VALIDACION ESTADISTICA: MODELO POTENCIAL\n",
    "Coeficiente de correlacion (r): ", round(r_pot, 4), "\n",
    "Relacion porcentual:            ", round(r_pot * 100, 2), "%\n",
    "Coeficiente de determinacion:   ", round(r2_pot_val, 4), "\n")
##       VALIDACION ESTADISTICA: MODELO POTENCIAL
##  Coeficiente de correlacion (r):  -0.638 
##  Relacion porcentual:             -63.8 %
##  Coeficiente de determinacion:    0.407

Debido a un bajo Coeficiente de Correlación se aplicará optimización a los datos para aumentar el porcentaje del test.

7 Optimización y omisión temporal de outliers para mejorar el test

Primero, visualizamos la distribución de la precipitación para identificar los eventos extremos que afectan la tendencia del modelo potencial.

boxplot(dataANTISANA$Precipitation, 
        main = "Distribución de Precipitación",
        xlab = "Precipitación (mm)",
        col = "lightblue",
        border = "darkblue",
        horizontal = TRUE) # Orientación horizontal solicitada

stats_p <- boxplot.stats(dataANTISANA$Precipitation)
cat("Número de valores atípicos detectados:", length(stats_p$out))
## Número de valores atípicos detectados: 10

7.1 Aplicación del filtro y nuevo cálculo

Una vez identificados los valores extremos que superan el límite estadístico del “bigote” superior, procedemos a su omisión temporal para optimizar el ajuste del modelo entre Radiación Solar y Precipitación.

library(dplyr)
## 
## Adjuntando el paquete: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
limite_sup <- stats_p$stats[5]
data_optimizada <- dataANTISANA %>% 
  filter(Precipitation <= limite_sup)

x_opt <- data_optimizada$Solar
y_opt <- data_optimizada$Precipitation

modelo_opt <- lm(log(y_opt + 0.0001) ~ log(x_opt + 0.0001))
r_opt <- as.numeric(cor.test(log(x_opt + 0.0001), log(y_opt + 0.0001))$estimate)

cat("      RESULTADOS TRAS OPTIMIZACIÓN DE OUTLIERS      \n",
    " Nuevo Coeficiente r:       ", round(r_opt, 4), "\n",
    " Relación Porcentual:       ", round(r_opt * 100, 2), "%\n",
    " Nuevo R² (Determinación):  ", round(r_opt^2, 4), "\n")
##       RESULTADOS TRAS OPTIMIZACIÓN DE OUTLIERS      
##   Nuevo Coeficiente r:        -0.6299 
##   Relación Porcentual:        -62.99 %
##   Nuevo R² (Determinación):   0.3967

Contrario a lo esperado, la eliminación de outliers debilitó el ajuste del modelo en aproximadamente un 1%. Dado que estos valores extremos sustentan la tendencia descendente observada, se optó por conservar la totalidad de los datos originales, garantizando así un análisis que capture la verdadera variabilidad de la precipitación respecto a la radiación solar.

7.2 Tabla resumen - Modelo Potencial

library(gt)

r_abs <- abs(r_pot)

fuerza_label <- case_when(
  r_abs >= 0.7 ~ "Alta",
  r_abs >= 0.3 ~ "Moderada",
  TRUE ~ "Baja"
)


test_status <- case_when(
  test_p_pot$p.value < 0.05 & r_abs >= 0.7 ~ "Aprobado (Fuerte)",
  test_p_pot$p.value < 0.05 & r_abs >= 0.4 ~ "Semi-Aprobado con Observaciones",
  test_p_pot$p.value < 0.05 & r_abs < 0.4 ~ "Aprobación Parcial / Débil",
  TRUE ~ "No Significativo"
)

color_semaforo <- case_when(
  test_status == "Aprobado (Fuerte)" ~ "#27ae60",   
  test_status == "Semi-Aprobado con Observaciones" ~ "#f1c40f", 
  test_status == "Aprobación Parcial / Débil" ~ "#FFA500", 
  TRUE ~ "#e74c3c"                                     
)

resumen_pot_df <- data.frame(
  conjetura = "Potencial",
  ecuacion = sprintf("y = %.4f * x ^ (%.4f)", a_pot, b_pot),
  test = test_status,
  determinacion = sprintf("%.4f (%s)", r_pot^2, fuerza_label)
)

resumen_pot_df %>%
  gt() %>%
  tab_header(
    title = md("**CONCLUSIONES Y ESTADÍSTICOS: MODELO POTENCIAL**"),
    subtitle = "Variables: Radiación Solar y Precipitación (Antisana)"
  ) %>%
  cols_label(
    conjetura = "Conjetura del Modelo",
    ecuacion = html("Ecuación (y&#770; = ax<sup>b</sup>)"),
    test = "Test de Pearson",
    determinacion = html("Coeficiente de Determinación (R<sup>2</sup>)")
  ) %>%
  tab_source_note(source_note = "Autor: Grupo 3") %>%
  tab_style(
    style = cell_text(color = color_semaforo, weight = "bold"),
    locations = cells_body(columns = c(test, determinacion))
  ) %>%
  tab_options(
    heading.background.color = "#2c3e50",
    column_labels.font.weight = "bold",
    table.width = pct(100)
  ) %>%
  tab_style(
    style = cell_text(color = "white"),
    locations = cells_title(groups = c("title", "subtitle"))
  ) %>%
  cols_align(align = "center")
CONCLUSIONES Y ESTADÍSTICOS: MODELO POTENCIAL
Variables: Radiación Solar y Precipitación (Antisana)
Conjetura del Modelo Ecuación (ŷ = axb) Test de Pearson Coeficiente de Determinación (R2)
Potencial y = 831.7669 * x ^ (-1.9921) Semi-Aprobado con Observaciones 0.4070 (Moderada)
Autor: Grupo 3

8 Conclusiones

x_ejemplo <- 15 
y_estimada <- a_pot * (x_ejemplo^b_pot)

# 2. Generar el texto dinámico optimizado
cat(paste0(
  "Entre la Radiación Solar y la Precipitación en el Antisana existe una **moderada** relación de tipo **Potencial**, cuya ecuación matemática está ",
  "representada por $\\hat{y} = ", format(a_pot, scientific = FALSE, digits = 5), " \\cdot x^{", round(b_pot, 4), "}$, ",
  "donde 'x' es la radiación solar ($MJ/m^2$) y 'y' la precipitación estimada ($mm$).\n\n",
  
  "El coeficiente de correlación de Pearson de **", round(r_pot * 100, 2), "%** confirma una tendencia inversa significativa. ",
  "Es fundamental señalar que el modelo presenta una **restricción de validez operativa**: su aplicación es confiable únicamente dentro del rango de valores observados en la estación, evitando valores de radiación cercanos a cero donde la función tiende al infinito, y asegurando que la precipitación estimada se mantenga en niveles físicamente posibles ($y \\ge 0$).\n\n",
  
  "A pesar de que la omisión de outliers reducía la fuerza del ajuste en un 1%, se optó por trabajar con la serie completa para no ignorar la variabilidad natural del sector. ",
  "Por ejemplo, para una radiación de **", x_ejemplo, " $MJ/m^2$**, se estima una precipitación de **", round(y_estimada, 2), " mm**.\n\n"
))

Entre la Radiación Solar y la Precipitación en el Antisana existe una moderada relación de tipo Potencial, cuya ecuación matemática está representada por \(\hat{y} = 831.77 \cdot x^{-1.9921}\), donde ‘x’ es la radiación solar (\(MJ/m^2\)) y ‘y’ la precipitación estimada (\(mm\)).

El coeficiente de correlación de Pearson de -63.8% confirma una tendencia inversa significativa. Es fundamental señalar que el modelo presenta una restricción de validez operativa: su aplicación es confiable únicamente dentro del rango de valores observados en la estación, evitando valores de radiación cercanos a cero donde la función tiende al infinito, y asegurando que la precipitación estimada se mantenga en niveles físicamente posibles (\(y \ge 0\)).

A pesar de que la omisión de outliers reducía la fuerza del ajuste en un 1%, se optó por trabajar con la serie completa para no ignorar la variabilidad natural del sector. Por ejemplo, para una radiación de 15 \(MJ/m^2\), se estima una precipitación de 3.78 mm.