Relación entre Velocidad del Viento y Humedad Relativa 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$Wind
y <- dataANTISANA$`Relative Humidity`

tabla_pares <- data.frame(
  Viento = x, 
  Hume_Rela = y
)

print("Tabla de Pares: Velocidad del Viento (x) y Humedad Relativa (y)")
## [1] "Tabla de Pares: Velocidad del Viento (x) y Humedad Relativa (y)"
head(tabla_pares)
##   Viento Hume_Rela
## 1   1.76      0.93
## 2   1.86      0.96
## 3   1.74      0.98
## 4   1.48      0.99
## 5   1.49      0.98
## 6   1.51      0.97

3 Gráfica de nubes de puntos

library(ggplot2)

ggplot(dataANTISANA, aes(x = Wind, y = `Relative Humidity`)) +
  geom_point(color = "darkblue", alpha = 0.6, size = 2) + 
  theme_minimal() +                                      
  labs(title = "Gráfica No.1: Disperción entre la  Velocidad del Viento(x) y la Humedad Relativa(y)",
       subtitle = "Estudio: Datos Antisana",
       x = "Velo. Viento (m/s)",
       y = "Hum. Relativa (0-1)") +
  theme(plot.title = element_text(hjust = 0.6, face = "bold"))

4 Conjeturacion de un Modelo Polinómico de segundo grado y Cálculo de Parámetros

modelo_poly2 <- lm(y ~ poly(x, 2, raw = TRUE))

coeffs2 <- coef(modelo_poly2)
b0 <- coeffs2[1] 
b1 <- coeffs2[2] 
b2 <- coeffs2[3]
r2_poly2 <- summary(modelo_poly2)$r.squared

b0_f <- format(round(b0, 4), scientific = FALSE)
b1_f <- format(round(b1, 4), scientific = FALSE)
b2_f <- format(round(b2, 4), scientific = FALSE)

cat("      RESULTADOS MODELO POLINOMICO (GRADO 2)        \n",
    " Beta 0 (Constante): ", b0_f, "\n",
    " Beta 1 (Lineal):    ", b1_f, "\n",
    " Beta 2 (Cuadratico):", b2_f, "\n",
    " Coeficiente de determinación: R² =", round(r2_poly2, 4), "\n",
    "----------------------------------------------------\n",
    " La ecuacion es: \n",
    " y =", b0_f, " + (", b1_f, " * x) + (", b2_f, " * x²)\n")
##       RESULTADOS MODELO POLINOMICO (GRADO 2)        
##   Beta 0 (Constante):  0.8875 
##   Beta 1 (Lineal):     0.2109 
##   Beta 2 (Cuadratico): -0.1096 
##   Coeficiente de determinación: R² = 0.6399 
##  ----------------------------------------------------
##   La ecuacion es: 
##   y = 0.8875  + ( 0.2109  * x) + ( -0.1096  * x²)

5 Sobreescritura de la recta sobre la nube de puntos

library(ggplot2)
library(ggtext) 

b0_l <- format(round(coeffs2[1], 4), scientific = FALSE)
b1_l <- format(round(coeffs2[2], 4), scientific = FALSE)
b2_l <- format(round(coeffs2[3], 4), scientific = FALSE)

sub_poly2 <- paste0("Modelo Cuadrático: <span style='color:#e74c3c;'>**y = ", 
                    b0_l, " + (", b1_l, " · x) + (", b2_l, " · x<sup>2</sup>)**</span>")

ggplot(dataANTISANA, aes(x = Wind, y = `Relative Humidity`)) +
  geom_point(color = "darkblue", alpha = 0.4, size = 2.5) +
  
  stat_function(fun = function(x) { 
    coeffs2[1] + coeffs2[2]*x + coeffs2[3]*x^2 
  }, color = "#e74c3c", size = 1.3) +
  
  theme_minimal() +
  labs(title = "Gráfica No.2: Comparación realidad y modelo de la Velocidad del Viento y la Humedad Relativa",
       subtitle = sub_poly2,
       x = "Velocidad del Viento (m/s)",
       y = "Humedad Relativa (0-1)") +
  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

# 1. Obtener los valores que predice el modelo (y estimados)
y_predichos2 <- predict(modelo_poly2)

# 2. Realizar el test de Pearson (Observados vs Predichos)
test_p2 <- cor.test(y, y_predichos2, method = "pearson")

# 3. Extraer y preparar valores para la salida
r_val <- as.numeric(test_p2$estimate)
r2_pct <- (r_val^2) * 100

cat(    "    PEARSON PARA EL MODELO POLINOMICO (GRADO 2)     \n",
    " Coeficiente de correlacion (r):", round(r_val, 4), "\n",
    " Porcentaje de relacion lineal: ", round(r_val * 100, 2), "%\n",
    " Porcentaje de determinación:   ", round(r2_pct, 2), "%\n")
##     PEARSON PARA EL MODELO POLINOMICO (GRADO 2)     
##   Coeficiente de correlacion (r): 0.8 
##   Porcentaje de relacion lineal:  80 %
##   Porcentaje de determinación:    63.99 %

6.1 Tabla resumen

6.2 Tabla resumen con R²

library(gt)
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
r_etiqueta <- case_when(
  abs(r_val) < 0.3 ~ "Baja",
  abs(r_val) < 0.7 ~ "Media",
  TRUE ~ "Alta"
)

r_cuadrado <- r_val^2

test_status <- if_else(test_p2$p.value < 0.05, 
                       paste0("Aprobado (r = ", round(r_val * 100, 2), "%)"), 
                       paste0("No Aprobado (r = ", round(r_val * 100, 2), "%)"))

resumen_df <- data.frame(
  conjetura = "Polinómico Grado 2",
  ecuacion = sprintf("y = %.4f + (%.4f)x + (%.4f)x²", coeffs2[1], coeffs2[2], coeffs2[3]),
  test = test_status,
  determinacion = sprintf("%.4f (%s)", r_cuadrado, r_etiqueta)
)

resumen_df %>%
  gt() %>%
  tab_header(
    title = md("**CONCLUSIONES Y ESTADÍSTICOS**"),
    subtitle = "Comparación: Velocidad del Viento y Humedad Relativa (Antisana)"
  ) %>%
  cols_label(
    conjetura = "Conjetura del Modelo",
    ecuacion = html("Ecuación (y&#770; = &beta;<sub>0</sub> + &beta;<sub>1</sub>x + &beta;<sub>2</sub>x<sup>2</sup>)"),
    test = "Test de Pearson",
    determinacion = html("Coeficiente de Determinación (R<sup>2</sup>)")
  ) %>%
  tab_source_note(source_note = "Autor: Grupo 3") %>%
  tab_options(
    heading.background.color = "#2c3e50", 
    heading.title.font.size = px(22),
    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") %>%
  # Estilo verde para cuando el test es Aprobado
  tab_style(
    style = cell_text(color = "#27ae60", weight = "bold"),
    locations = cells_body(
      columns = c(test, determinacion),
      rows = grepl("Aprobado", test)
    )
  )
CONCLUSIONES Y ESTADÍSTICOS
Comparación: Velocidad del Viento y Humedad Relativa (Antisana)
Conjetura del Modelo Ecuación (ŷ = β0 + β1x + β2x2) Test de Pearson Coeficiente de Determinación (R2)
Polinómico Grado 2 y = 0.8875 + (0.2109)x + (-0.1096)x² Aprobado (r = 80%) 0.6399 (Alta)
Autor: Grupo 3

7 Conclusiones

Entre la Velocidad del Viento y la Humedad Relativa en el Antisana existe una alta relación de tipo Polinómico Grado 2, cuya ecuación matemática está representada por \(\hat{y} = 0.8875 + (0.2109)x + (-0.1096)x^2\), siendo ‘x’ la velocidad del viento en \(m/s\) y ‘y’ la humedad relativa estimada.

El coeficiente de correlación de Pearson es de 80%, lo que confirma un ajuste robusto para los datos recolectados en la estación.

Restricción: Es importante destacar que la aplicación de este modelo es funcional únicamente dentro del rango físico en el que la humedad relativa se mantiene en valores de 0 a 1 (0% a 100%), evitando extrapolaciones fuera de los límites reales de la variable.

Por ejemplo, para una velocidad del viento de 2 m/s, se estima una humedad relativa (\(\hat{y}\)) de 0.87, valor que se encuentra dentro del rango operativo del modelo.