Plantilla para estaciones hidrometeorolóficas automáticas
Bryan Quispe
2023-02-06
Descarga desde URL
Para la descarga de datos se hizo uso del paquete rvest
permitiendo descargar datos del periodo entre 2018 al 2023.
setwd("C:/Users/bryan/Downloads/MDSA")
años <- rep(2018:2022,12)
meses <- mes <- sort(sprintf("%02d",rep(1:12,5)))
fechas <- sort(paste0(años,meses))
urls <- list()
for (i in fechas) {
urls[i] <- paste0("https://www.senamhi.gob.pe/mapas/mapa-estaciones-2/_dato_esta_tipo02.php?estaciones=4723F1BE&CBOFiltro=",i,"&t_e=M&estado=AUTOMATICA&cod_old=&cate_esta=EMA&alt=1420")
}
data <- list()
for (i in 1:length(urls)) {
data[i]<-html_table(
html_nodes(
read_html(
as.character(urls[i])
), "table"
)[2],
header = TRUE,na.strings = "S/D"
)
}
df <- Reduce(function(...) merge(..., all=TRUE), data)
names(df) <- c("año","hora","temp","pp","hum","wd","ws")
df |> write.xlsx("dataMDSA.xlsx")Tratamiento de datos
Una vez obtenida la data del SENAMHI se procedió a tratar los datos para la generación de tablas resumen y la posterior graficación:
df <- read.xlsx("dataMDSA.xlsx")
df$date <- as.POSIXct(paste(df$año,df$hora, sep = " "),
format="%Y/%m/%d %H:%M")
df$month <- format(df$date, format = "%Y-%m")
df$mes <- format(df$date, format = "%m")
# Temperatura
df1 <- aggregate(temp~month+mes, data = df, FUN = mean)
df2 <- aggregate(temp~mes,data=df1, FUN = mean)
names(df2) <- c("mes","tmean")
df2$tmax <- aggregate(temp~mes, data = df1, FUN = max)[,2]
df2$tmin <- aggregate(temp~mes, data = df1, FUN = min)[,2]
knitr::kable(df2, caption = "Tabla de datos procesados de temperatura")| mes | tmean | tmax | tmin |
|---|---|---|---|
| 01 | 19.04519 | 19.39852 | 18.87463 |
| 02 | 19.35429 | 19.94978 | 18.86447 |
| 03 | 19.26795 | 19.73396 | 18.82778 |
| 04 | 18.56398 | 19.25490 | 18.08708 |
| 05 | 18.26474 | 18.95370 | 17.78669 |
| 06 | 17.65887 | 18.25792 | 16.51043 |
| 07 | 17.75111 | 18.32759 | 17.08261 |
| 08 | 18.08671 | 18.70148 | 17.53280 |
| 09 | 18.15153 | 18.51604 | 17.27983 |
| 10 | 18.65726 | 19.23903 | 18.09314 |
| 11 | 18.65849 | 19.24652 | 18.34427 |
| 12 | 18.93879 | 19.21779 | 18.68073 |
## Graficando
dft <- df2 %>% gather(key = tipo, value = temp,tmax,tmean,tmin) %>%
mutate_if(is.character, as.factor)
df2 %>% ggplot()+
geom_line(aes(group="mes",x=mes,y=tmin), color="blue")+
geom_point(aes(x=mes,y=tmin), color="blue",size=3)+
geom_line(aes(group="mes",x=mes,y=tmean), color="green")+
geom_point(aes(x=mes,y=tmean), color="green",size=3)+
geom_line(aes(group="mes",x=mes,y=tmax), color="red")+
geom_point(aes(x=mes,y=tmax), color="red",size=3)+
geom_point(data=dft, aes(x=mes,y=temp,color=tipo),
size=2) +
theme(panel.grid.minor = element_line(linetype = "blank"),
axis.title = element_text(face = "bold"),
axis.text = element_text(colour = "black"),
plot.title = element_text(family = "serif",
size = 16, face = "bold", hjust = 0.5),
legend.text = element_text(face = "bold.italic"),
panel.background = element_rect(fill = "paleturquoise"),
plot.background = element_rect(fill = "paleturquoise"),
legend.key = element_rect(fill = NA),
legend.background = element_rect(fill = NA),
legend.position = "top", legend.direction = "horizontal") +
labs(title = "Gráfico de temperaturas mensuales",
x = "Meses", y = "Temperaturas (°C)",
colour = NULL) +
scale_color_manual(labels=c("Temperatura máxima",
"Temperatura media",
"Temperatura mínima"),
values = c("red","green","blue"))
# scale_color_hue(labels=c()); sin necesidad de values xd
# Precipitación
dfa <- aggregate(pp~month+mes, data = df, FUN = sum)
dfb <- aggregate(pp~mes,data=dfa, FUN = mean)
names(dfb) <- c("mes","pmean")
dfb$pmax <- aggregate(pp~mes, data = dfa, FUN = max)[,2]
dfb$pmin <- aggregate(pp~mes, data = dfa, FUN = min)[,2]
knitr::kable(dfb, caption = "Tabla de datos procesados de precipitación")| mes | pmean | pmax | pmin |
|---|---|---|---|
| 01 | 9.52 | 33.2 | 0.0 |
| 02 | 13.10 | 33.9 | 0.2 |
| 03 | 1.00 | 4.2 | 0.0 |
| 04 | 0.10 | 0.4 | 0.0 |
| 05 | 0.02 | 0.1 | 0.0 |
| 06 | 0.14 | 0.6 | 0.0 |
| 07 | 0.04 | 0.2 | 0.0 |
| 08 | 0.06 | 0.2 | 0.0 |
| 09 | 0.10 | 0.5 | 0.0 |
| 10 | 0.02 | 0.1 | 0.0 |
| 11 | 0.02 | 0.1 | 0.0 |
| 12 | 1.54 | 7.0 | 0.0 |
# Graficando
dfm <- dfb %>% gather(key = tipo, value = prec,pmax,pmean,pmin) %>%
mutate_if(is.character, as.factor)
dfb %>% ggplot()+
geom_line(aes(group="mes",x=mes,y=pmin), color="yellow")+
geom_point(aes(x=mes,y=pmin), color="yellow",size=1)+
geom_bar(aes(x=mes,y=pmean),fill="darkblue",stat = "identity")+
geom_line(aes(group="mes",x=mes,y=pmax), color="red")+
geom_point(aes(x=mes,y=pmax), color="red",size=1)+
geom_point(data=dfm, aes(x=mes,y=prec,color=tipo),
size=2) +
theme(panel.grid.minor = element_line(linetype = "blank"),
axis.title = element_text(face = "bold"),
axis.text = element_text(colour = "black"),
plot.title = element_text(family = "serif",
size = 16, face = "bold", hjust = 0.5),
legend.text = element_text(face = "bold.italic"),
panel.background = element_rect(fill = "paleturquoise"),
plot.background = element_rect(fill = "paleturquoise"),
legend.key = element_rect(fill = NA),
legend.background = element_rect(fill = NA),
legend.position = "top", legend.direction = "horizontal") +
labs(title = "Gráfico de precipitación mensual",
x = "Meses", y = "Precipitación (mm/mes)",
colour = NULL) +
scale_color_manual(labels=c("Precipitación máxima",
"Precipitación media",
"Precipitación mínima"),
values = c("red","darkblue","yellow"))
# Humedad relativa
dfx <- aggregate(hum~month+mes, data = df, FUN = mean)
dfy <- aggregate(hum~mes,data=dfx, FUN = max)
dfz <- aggregate(hum~mes,data = dfx, FUN = mean)
dfw <- aggregate(hum~mes,data = dfx, FUN = min)
dfxx <- data.frame(mes=dfy$mes,hmax=dfy$hum,
hmean=dfz$hum,hmin=dfw$hum)
knitr::kable(dfxx, caption = "Tabla de datos procesados de humedad relativa")| mes | hmax | hmean | hmin |
|---|---|---|---|
| 01 | 78.89907 | 70.85194 | 65.10526 |
| 02 | 73.90560 | 71.02212 | 69.21457 |
| 03 | 67.37037 | 64.16225 | 60.95413 |
| 04 | 63.18993 | 62.64399 | 62.09804 |
| 05 | 51.18145 | 50.49261 | 49.80377 |
| 06 | 39.60417 | 38.88674 | 38.16932 |
| 07 | 35.91790 | 33.11444 | 30.31098 |
| 08 | 33.11590 | 30.53414 | 27.95238 |
| 09 | 44.58482 | 42.40640 | 40.22797 |
| 10 | 48.85650 | 48.06560 | 47.27470 |
| 11 | 59.23579 | 58.65828 | 58.08078 |
| 12 | 67.67886 | 61.94256 | 56.20625 |
# Graficando
dfn <- dfxx %>% gather(key = tipo, value = hum,hmax,hmean,hmin) %>%
mutate_if(is.character, as.factor)
dfxx %>% ggplot()+
geom_line(aes(group="mes",x=mes,y=hmin), color="yellow")+
geom_point(aes(x=mes,y=hmin), color="yellow",size=1)+
geom_line(aes(group="mes",x=mes,y=hmean), color="green")+
geom_point(aes(x=mes,y=hmean), color="green",size=1)+
geom_line(aes(group="mes",x=mes,y=hmax), color="red")+
geom_point(aes(x=mes,y=hmax), color="red",size=1)+
geom_point(data=dfn, aes(x=mes,y=hum,color=tipo),
size=2) +
theme(panel.grid.minor = element_line(linetype = "blank"),
axis.text = element_text(face = "bold"),
plot.title = element_text(family = "serif",
size = 16, face = "bold", hjust = 0.5),
legend.text = element_text(face = "bold"),
panel.background = element_rect(fill = "paleturquoise"),
plot.background = element_rect(fill = "paleturquoise"),
legend.key = element_rect(fill = NA),
legend.background = element_rect(fill = NA),
legend.position = "top", legend.direction = "horizontal") +
labs(title = "Gráfico de Humedad Relativa",
x = "Mes", y = "Humedad Relativa (%)",color=NULL) +
scale_color_manual(labels=c("Humedad máxima",
"Humedad media",
"Humedad mínima"),
values = c("red","green","yellow"))
Dirección y velocidad del viento
Se realizó un gráfico de Rosa de viento usando el paquete
Openaira partir de la data con fechas por hora. el
resultado es el siguiente:
windRose(df,paddle = F,cols = "viridis",title="Rosa de viento")