Datos

  • Lugar: RESERVA NACIONAL PAMPA GALERAS
  • Ubicación: AYACUCHO - Perú
  • Latitud: -14.693
  • Longitud: -74.369
library(leaflet)
# Coordenadas:
lat <- -14.693   # Latitud
lng <- -74.369  # Longitud
# Mapa
leaflet() %>%
  addTiles() %>%  # Agregar mapa base
  addMarkers(lng = lng, lat = lat, popup = "RESERVA NACIONAL PAMPA GALERAS")

Parámetros a estudiar:

  • Precipitación corregida (mm/day)
  • Temperatura °C a 2 metros
  • Humedad % Relativa a 2 metros
  • Años de estudio (2000-2022)

Lectura y Limpieza de datos

#Lectura
library(readr)
datos <- read_csv("DatosPAMPAG.csv", skip =11 )
## Rows: 63 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (1): PARAMETER
## dbl (14): YEAR, JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEP, OCT, NOV, DEC, ANN
## 
## ℹ 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.
#head(datos[,2:14])

#Limpieza
# Temperatura
temperatura<-datos[43:63,-c(1,15)]
años <- temperatura[[1]]
# Matriz con solo los valores numéricos
Temp <- as.matrix(temperatura[, -1])  # Excluyendo la columna "años"
# Pasando años de numeric a characte
rownames(Temp) <-as.character(años)

# Precipitación
precipitacion<-datos[1:21,-c(1,15)]
Precip<-as.matrix(precipitacion[, -1]) 
row.names(Precip)<-as.character(años)

# Humedad
humedad<-datos[22:42,-c(1,15)]
Hum<-as.matrix(humedad[, -1]) 
row.names(Hum)<-as.character(años)

Precipitación ~ Temperatura

Construcción de curvas funcionales

library(fda)
# Base spline para X (Temp)
nbasis <-7
basis <- create.bspline.basis(rangeval = c(1, 12), nbasis = nbasis)
# Suavizar cada curva
fdX <- Data2fd(argvals = 1:12, y = t(Temp), basisobj = basis)
# Visualizar las curvas
plot(fdX, main = "Curvas suavizadas con fda - Temperatura",
     ylab = "Temperatura", xlab = "Años")

## [1] "done"

Regresión Funcional Precipitación ~ Temperatura

# Regresión funcional
# Definir Y
Y<- apply(Precip,1,sum)
# Usamos fRegress
regre <- fRegress(Y ~ fdX)
# Ver coeficiente funcional estimado
plot(regre$betaestlist$fdX$fd, 
     main = "Coeficiente funcional beta para Temperatura")

## [1] "done"

Comparación entre valores observados y predichos

Gráfico

pred <- predict(regre)
#summary(Y)
xy <- data.frame(Y,pred)
head(xy)
##          Y      pred
## 2000  8.93 11.444365
## 2001  7.02  8.574920
## 2002 10.70  9.063128
## 2003 10.01  9.816697
## 2004  9.07  6.993585
## 2005  7.08  8.812703
plot(años,xy$Y,pch=19, col="blue",main = "Valores Observados vs Predichos 
     Precipitación ~ Temperatura 2000-2022") #valores observados 
lines(años,Y)
points(años,pred,col="red",pch=19) #Valores predichos
lines(años,pred,col="red")

Evaluando la calidad del ajuste

# Coeficiente de determinación (R-cuadrado)
SSE <- sum((Y - pred)^2)
SST <- sum((Y - mean(Y))^2)
R2 <- 1 - SSE/SST
cat("R-cuadrado:", R2, "\n")
## R-cuadrado: 0.6319766
  • El modelo funcional explica solo el 63.2% de la variabilidad total.

Evaluación estadística del modelo Precipitación ~ Temperatura

# SSE total (SST): Variabilidad total de Y (Precipitación total anual)
SSE0 <- sum((Y - mean(Y))^2)

# SSE del modelo: error cuadrático de los residuos (observado - predicho)
error <- Y - pred
SSE1 <- sum(error^2)

# R-cuadrado manual (verifica que coincide con el cálculo anterior)
R2 <- (SSE0 - SSE1) / SSE0
cat("R-cuadrado (manual):", R2, "\n")
## R-cuadrado (manual): 0.6319766
# Prueba F para evaluar si el modelo explica significativamente la variabilidad 

n.obs <- length(Y)  # Número de observaciones (años)
gl.num <- nbasis    # Grados de libertad del numerador 
gl.den <- n.obs - 1 - gl.num  # Grados de libertad del denominador

Fratio <- ((SSE0 - SSE1) / gl.num) / (SSE1 / gl.den)
p.valor <- 1 - pf(Fratio, gl.num, gl.den)

cat("F-ratio:", Fratio, "\n")
## F-ratio: 3.18912
cat("p-valor:", p.valor, "\n")
## p-valor: 0.03391955
  • El modelo explica aproximadamente el 63.2% de la variabilidad en la precipitación anual.
  • F-ratio: 3.189
  • p-valor: 0.0339
    Significativo al 5%, lo que indica que la relación funcional entre la temperatura y la precipitación es estadísticamente significativa para esta zona.

En Pampa Galeras, la temperatura mensual tiene una fuerte influencia explicativa sobre la precipitación anual.

Precipitación ~ Humedad

Construcción de Curvas Funcionales

# Precipitación~Humedad
fdXh <- Data2fd(argvals = 1:12, y = t(Hum), basisobj = basis)
plot(fdXh, main = "Curvas suavizadas (fda) - Humedad")

## [1] "done"

Regresión Funcional Precipitación ~ Humedad

fregh <- fRegress(Y ~ fdXh)
plot(fregh$betaestlist$fdXh$fd, main = "Coeficiente funcional beta(t) Precipitación ~ Humedad")

## [1] "done"
predh <- predict(fregh)
#summary(Y)
xyh <- data.frame(Y,predh)
head(xyh)
##          Y     predh
## 2000  8.93 11.391241
## 2001  7.02  7.299067
## 2002 10.70 11.544394
## 2003 10.01 10.593278
## 2004  9.07  8.645891
## 2005  7.08  6.666908

Comparación entre valores observados y predichos

Gráfico

plot(años,xyh$Y,pch=19, col="blue",lwd = 1, 
     main = "Valores Observados vs Predichos 
     Precipitación ~ Humedad 2000-2022") #valores observados 
lines(años,Y)
points(años,predh,col="orange",pch=19) #Valores predichos
lines(años,predh,col="orange")

Calidad del ajuste

# Coeficiente de determinación (R-cuadrado)
SSE <- sum((Y - predh)^2)
SST <- sum((Y - mean(Y))^2)
R2 <- 1 - SSE/SST
cat("R-cuadrado:", R2, "\n")
## R-cuadrado: 0.7269204
  • El modelo funcional explica solo el 72.7% de la variabilidad total.

Evaluación estadística del modelo Precipitación ~ Humedad

# SSE total (SST): Variabilidad total de Y (Precipitación total anual)
SSE0 <- sum((Y - mean(Y))^2)

# SSE del modelo: error cuadrático de los residuos (observado - predicho)
error <- Y - predh
SSE1 <- sum(error^2)

# R-cuadrado manual (verifica que coincide con el cálculo anterior)
R2 <- (SSE0 - SSE1) / SSE0
cat("R-cuadrado (manual):", R2, "\n")
## R-cuadrado (manual): 0.7269204
# Prueba F para evaluar si el modelo explica significativamente la variabilidad 

n.obs <- length(Y)  # Número de observaciones (años)
gl.num <- nbasis    # Grados de libertad del numerador 
gl.den <- n.obs - 1 - gl.num  # Grados de libertad del denominador

Fratio <- ((SSE0 - SSE1) / gl.num) / (SSE1 / gl.den)
p.valor <- 1 - pf(Fratio, gl.num, gl.den)

cat("F-ratio:", Fratio, "\n")
## F-ratio: 4.943595
cat("p-valor:", p.valor, "\n")
## p-valor: 0.006458682

  • R-cuadrado (R²): 0.727

  • El modelo explica el 72.7% de la variabilidad en la precipitación anual.Es un ajuste fuerte.

  • F-ratio: 4.944

  • p-valor: 0.0065 Esto es muy significativo (menor que 0.01), entonces la humedad tiene una relación funcional significativa con la precipitación en Pampa Galeras.

Conclusión:
La humedad relativa mensual es un mejor predictor funcional que la temperatura en esta zona. Puede tener que ver con que la humedad refleja mejor el contenido de vapor en el aire, lo cual está directamente relacionado con la formación de lluvias, sobre todo en zonas altoandinas.