Estos gráficos son interactivos y permiten muchas funciones especiales como hacer zoom, pan(desplazamiento en el lienzo), descargar como png, entre otras funcionalidades.
Reading layer `microcuenca' from data source
`C:\Users\bryan\Documents\HOBOware\Data_febrero\shp\microcuenca.shp'
using driver `ESRI Shapefile'
Simple feature collection with 1 feature and 6 fields
Geometry type: POLYGON
Dimension: XY
Bounding box: xmin: 330406.8 ymin: 8107110 xmax: 346794.6 ymax: 8119314
Projected CRS: WGS 84 / UTM zone 19S---
title: "Estación pluviométrica de Asana"
author: "Equipo MRSE"
date: "`r Sys.Date()`"
output:
flexdashboard::flex_dashboard:
logo: images/agua_fix.png
orientation: columns
vertical_layout: fill
source: embed
theme: cosmo
editor_options:
chunk_output_type: console
---
```{r setup, include=FALSE, warning=FALSE, message=FALSE}
knitr::opts_chunk$set(echo = FALSE, fig.align = "center")
library(flexdashboard)
library(tidyverse)
library(plotly)
library(leaflet)
library(leafem)
library(magick)
library(DT)
library(sf)
library(xaringanExtra)
library(xaringan)
library(openair)
library(openxlsx)
library(ggpubr)
library(xaringanthemer)
```
# Datos estadísticos {data-icon="fa-chart-bar"}
Column {data-width=190}
-----------------------------------------------------------------------
### TABLA DE DATOS
```{r}
df <- read.csv("Estacion1_1.csv", header = T, sep = ",",
skip = 23)[,-1]
dfn <- read.csv("estación2_fin.csv", header = T, sep = ",",
skip=1)[,-1]
# dfn$fecha <- gsub("[ AM]","",dfn$fecha)
names(df) <- c("fecha","precip")
names(dfn) <- c("fecha","precip")
df$fecha <- as.POSIXct(df$fecha, format="%Y/%m/%d %H:%M")
dfn$fecha <- as.POSIXct(dfn$fecha, format="%y/%m/%d %H:%M")
dfx <- rbind(df,dfn)
# gráfico con 2 ejes "y"
g0 <- dfx %>% ggplot(aes(x=factor(precip)))+
geom_histogram(color="black",fill="black", stat = "count", alpha=0.5)+
labs(x="Categorías de precipitación (mm)",
y="Conteos",
title = "Distribución de datos en la Estación\n pluviométrica de Asana (mes de febrero)",
subtitle = "Estación automática con intervalo de registro de 10 minutos",
caption = "Fuente: EPS ILO S.A.")+
scale_y_continuous(sec.axis = sec_axis(~./length(dfx$precip),
name = "Conteos (%)",
labels = scales::percent,
breaks = seq(0,1.2,0.2)))
g1 <- dfx %>% ggplot(aes(x=factor(precip)))+
geom_histogram(color="black",fill="black", stat = "count", alpha=0.5)+
scale_y_continuous(labels = scales::
percent_format(accuracy = NULL,
scale = 100/length(dfx$precip))) + theme(panel.grid.major = element_line(colour = "gray70"),
panel.grid.minor = element_line(colour = "gray70",
linetype = "blank"), axis.title = element_text(face = "bold"),
panel.background = element_rect(fill = "white"),
plot.background = element_rect(fill = "white")) +
labs(x = "Categorías de precipitación (mm)",
y = "Conteos (%)")
dfz <- dfx
names(dfz) <- c("Fecha","Precipitación (mm)")
dfz$Fecha<- as.character(format(dfz$Fecha,format = "%Y-%m-%d %H:%M"))
datatable(dfz, extensions = 'Buttons',
options = list(pageLength=1000,
autowidth = TRUE,
dom = 'Bfrtip',buttons =
list('copy', 'print', list(
extend = 'collection',
buttons = c('csv', 'excel', 'pdf'),
text = 'Download'
))),
caption = "Tabla 1: Datos de la estación pluviométrica")
dfy <- dfx
dfy$prec <- factor(dfy$prec)
tab <- dfy %>% select(prec) %>% group_by(prec) %>%
count(prec)
tab$cases <- round(tab$n/length(dfy$precip)*100,2)
t0 <- tab %>% ggplot(aes(x=prec,y=cases))+
geom_bar(stat="identity", color="black",alpha=0.5)+
scale_y_continuous(sec.axis = sec_axis(~.*length(df$precip)))
t1 <- tab %>% ggplot(aes(x=prec,y=cases))+
geom_bar(stat="identity", color="black",alpha=0.5)+
labs(x="Precipitación (mm)",y="Total de casos (%)")+
theme_minimal()
```
Column {data-width=550}
-----------------------------------------------------------------------
Estos gráficos son interactivos y permiten muchas funciones especiales como hacer **zoom, pan(desplazamiento en el lienzo), descargar como png, entre otras funcionalidades.**
### DISTRIBUCIÓN DE LOS DATOS
```{r}
t2 <- tab %>% ggplot()+
geom_bar(aes(x=prec,y=cases),
stat="identity", color="black",alpha=0.5)+
scale_y_continuous(sec.axis = sec_axis(~.*31.36))+
labs(x="Precipitación (mm)",y="Total de casos (%)")+
theme_minimal()
ggplotly(p=t2,dynamicTicks = TRUE)
```
### GRÁFICO DE PRECIPITACIÓN VS TIEMPO
```{r}
graf <- dfx %>% ggplot(aes(x=fecha,y=precip))+
geom_line(color="deepskyblue")+
labs(x="Fecha",y="Precipitación (mm)") +
theme_minimal()
ggplotly(graf, dynamicTicks = TRUE)
```
```{r eval=FALSE}
# Diapositivas
#<iframe width="100%" height="100%" src="https://rstudio-pubs-static.s3.amazonaws.com/1011195_fdc7c4039ab2433784f29e93e1e4d929.html" frameborder="0" allowfullscreen></iframe>
# Diapos2
#<div class="shareagain" style="min-width:300px;margin:1em auto;" data-exeternal="1"> <iframe src="https://rstudio-pubs-static.s3.amazonaws.com/1011195_fdc7c4039ab2433784f29e93e1e4d929.html" width="1600" height="900" style="border:2px solid currentColor;" loading="lazy" allowfullscreen></iframe> <script>fitvids('.shareagain', {players: 'iframe'});</script>3</div>
#```{r eval=FALSE}
#xaringanExtra::embed_xaringan(
#url = "https://rstudio-pubs-static.s3.amazonaws.com/1011195_fdc7c4039ab2433784f29e93e1e4d929.html",
# ratio = "16:9")
```
# Presentación {data-icon="fa-chart-pie"}
Column {data-width=400}
-----------------------------------------------------------------------
### Presentación
```{r}
embed_xaringan(url = "https://mrse-info.netlify.app"
,border = "none")
```
### Calendar Plot
```{r}
df <- dfx
df$fecha <- as.POSIXct(df$fecha, format="%Y-%m-%d %H:%M")
names(df) <- c("date","pp")
calendarPlot(df, pollutant = "pp",
statistic = "sum",
main = "Estación Asana\nPrecipitación acumulada diaria (mm)",
cols = "Blues")
```
Column {data-width=400}
-----------------------------------------------------------------------
### Gráfico lineal
```{r}
dfx %>% ggplot(aes(x=fecha,y=precip))+
geom_smooth(method="lm")+
geom_point(alpha=0.5, size=2, color="blue")
```
```{r eval=FALSE}
## Calibración del equipo
dc <- read.xlsx("calibracion.xlsx")
l1 <- lm(patron~cliente, data = dc)
dc %>% ggplot(aes(x=cliente,y=patron))+
geom_smooth(method = "lm")+
geom_point(color="purple",size=3, alpha=0.5)+
scale_x_continuous(breaks = seq(0,6,0.4))+
scale_y_continuous(breaks = seq(0,5,0.4))+
stat_regline_equation(label.x = 0.4,label.y = 3.4,
aes(label=paste(eq.label,
..adj.rr.label..,
sep="~~~~~")),
color="blue")+theme_minimal()
```
### Ubicación de la estación pluviométrica
```{r warning=FALSE, message=FALSE}
# lng=-70.520806,lat=-17.062286
im <- "https://www.epsilo.com.pe/uploads/Logos/nuevoLogoEpsilo2.png"
svg1 <- image_convert(image_read("images/agua_ilo.png"),
format = "svg")
image_write(svg1, "images/agua1.svg")
# foto de estación
img_01 <- paste0("<center><img src='https://raw.githubusercontent.com/Bryan1qr/ggplot2_graphics/main/Estaci%C3%B3n.jpeg' width=150 height=200></center>")
img_02 <- paste0("<center><img src='https://imgs.search.brave.com/_urNEC00koyHwzUtjZQGAuh_Zqu16E7u5xr2vheNB1M/rs:fit:474:355:1/g:ce/aHR0cHM6Ly9wcmVu/c2FyZWdpb25hbC5w/ZS93cC1jb250ZW50/L3VwbG9hZHMvMjAx/OC8wNy9FcHMtSWxv/LTAyLmpwZw' width=150 height=200></center>")
inf <- data.frame(este=c(266582, 254797), norte=c(8057162,8049438)) %>%
st_as_sf(coords=c("este","norte"), crs=32719)
inf2 <- st_transform(inf,crs = 4326) %>% as.data.frame()
#im <- "https://www.epsilo.com.pe/uploads/Logos/nuevoLogoEpsilo2.png"
polig <- st_read("shp/microcuenca.shp")
# Forma con imagen local
pluv <- leaflet() %>%
addTiles() %>% leafem::addLogo(im,src ="remote",
url="https://www.epsilo.com.pe/",
position = "bottomright", width = 160,
height = 60) %>%
addMarkers(lat=-17.062286,lng=-70.520806,
popup = paste(sep="<br>","<b>Lugar:</b>","Estación pluviométrica","<b>Latitud:</b>","-17.062286","<b>Longitud:</b>"
,"-70.520806","<b>Imagen:</b>",img_01)) %>%
addCircleMarkers(lat=c(-17.062286,-17.630402),
lng=c(-70.520806,-71.335089), radius = 40,
color="deepskyblue") %>%
addMarkers(lat=-17.630402,lng=-71.335089,
popup = paste(sep="<br>","<b>Lugar:</b>","EPS ILO S.A.","<b>Latitud:</b>","-17.630402","<b>Longitud:</b>",
"-71.19908","<b>Imagen:</b>",img_02)) %>%
addPolygons(data=st_transform(polig,crs = 4326),
label = "Microcuenca Asana",
popup = "Comunidad de Asana")
pluv
```
Column {data-width=400}
-----------------------------------------------------------------------
### Precipitación acumulada total
```{r}
valueBox(paste0(sum(dfx$precip, na.rm=T), " milímetros"), icon = "fa-pencil")
```
### Cantidad de meses colectadoss
```{r}
gauge(paste0(2, "meses"), min = 0, max = 12, gaugeSectors(
danger = c(0, 2), warning = c(3, 6), success = c(7, 10)
))
```