42 |
43 | 
44 |
45 |
46 |
47 |
--------------------------------------------------------------------------------
/lang/portugues/README.md:
--------------------------------------------------------------------------------
1 | [](https://www.tidyverse.org/lifecycle/#experimental)
2 | [](https://choosealicense.com/)
3 |
4 |
41 |

42 |
43 | 
44 |
45 |
--------------------------------------------------------------------------------
/man/aggregateChirpsTS.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/aggregateChirpsTS.R
3 | \name{aggregateChirpsTS}
4 | \alias{aggregateChirpsTS}
5 | \title{Aggregate Chirps Time Series by year, month}
6 | \usage{
7 | aggregateChirpsTS(
8 | chirpsStack,
9 | month,
10 | inicialYear,
11 | finalYear,
12 | fun,
13 | group_by,
14 | cores = NULL
15 | )
16 | }
17 | \arguments{
18 | \item{chirpsStack}{spatRaster. spatRaster stack with chirps daily chirps data (output from \code{\link[=downloadChirpsRainfall]{downloadChirpsRainfall()}})}
19 |
20 | \item{month}{numeric; indicates the month when the water year begins. The default is
21 | 1 (use civil year).}
22 |
23 | \item{inicialYear}{numeric; filters the time series to begin on this year (inclusive).
24 | If you choose to use water year instead of civil year, e.g., month = 6,
25 | the first observation used is from the date "01-06-\code{inicialYear}".}
26 |
27 | \item{finalYear}{numeric; filters the time series to end on this year (inclusive).
28 | If you choose to use water year instead of civil year, e.g., month = 6,
29 | the last observation used is from the date "31-05-\code{finalYear}".}
30 |
31 | \item{fun}{function to be applied. The following functions have been are implemented "sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first".}
32 |
33 | \item{group_by}{character. One of the following values: "years", "months", "yearmonths" which daily data will be grouped.}
34 |
35 | \item{cores}{positive integer. cores to be used for a 'parallel' processing.}
36 | }
37 | \value{
38 | spatRaster object with aggregated rainfall data.
39 | }
40 | \description{
41 | Aggregate Chirps Rainfall Times Series by year, month or yearmonth
42 | }
43 | \examples{
44 |
45 | \dontrun{
46 |
47 | require(terra)
48 |
49 | area_of_interest = vect("./paracatu.shp")
50 |
51 |
52 | downloadChirpsRainfall(dir_out = "./temp/chirpsRainfall",
53 | years = c(1990:2019),
54 | aoi = area_of_interest)
55 |
56 |
57 | chirpsStackAoi= list.files("./temp/chirpsRainfall", full.names = T) \%>\%
58 | terra::rast()
59 |
60 |
61 | #Annual mean rainfall
62 | chirpsYear = aggregateChirpsTS(chirpsStack = chirpsStackAoi,
63 | month = 11,
64 | inicialYear = 1990,
65 | finalYear = 2019,
66 | fun = "sum",
67 | group_by = "years",
68 | cores = 23)
69 |
70 |
71 | }
72 |
73 |
74 | }
75 |
--------------------------------------------------------------------------------
/man/inventory.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/inventory.R
3 | \encoding{UTF-8}
4 | \name{inventory}
5 | \alias{inventory}
6 | \title{Retrieves stations inventory from ANA web API.}
7 | \usage{
8 | inventory(states, stationType = "plu", as_sf = F, aoi = NULL)
9 | }
10 | \arguments{
11 | \item{states}{character vector; state(s) name(s) that you wish to download
12 | data for. Example: \dQuote{MINAS GERAIS}, \dQuote{DISTRITO FEDERAL},
13 | \dQuote{GOIÁS}, etc. Ignored if argument \code{aoi} is passed.}
14 |
15 | \item{stationType}{character; indicates what type of stations
16 | to download. Supported values are \dQuote{flu} (fluviometric)
17 | and \dQuote{plu} (pluviometric). The default is \dQuote{plu}.}
18 |
19 | \item{as_sf}{logical; should inventory be returned as \code{sf} object?
20 | The default is FALSE}
21 |
22 | \item{aoi}{object of class \code{sf} (polygon). Provides the boundaries
23 | where stations should be limited to (optional). Overrides \code{states} argument.}
24 | }
25 | \value{
26 | A data frame (either a \code{tibble} or a \code{sf}) containing the
27 | following columns:
28 | state: state name (chr).
29 | station_code: station unique identifier (chr).
30 | lat: latitude (dbl).
31 | long: longitude (dbl).
32 | stationType: station type (chr).
33 | }
34 | \description{
35 | Downloads pluviometric and fluviometric stations inventory from
36 | the Brazilian National Water Agency (ANA) and returns a tidy
37 | data frame \code{\link[tibble:tibble]{tibble::tibble()}} object. The inventory is optionally
38 | returned as simple features \code{\link[sf:st_as_sf]{sf::st_as_sf()}} object (CRS: WGS84).
39 | The user can alternatively provide an area of interest to download all
40 | stations within its boundaries.
41 | }
42 | \examples{
43 | \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
44 | # Fetch pluviometric "plu" stations for the states of "GOIÁS" and "MINAS GERAIS"
45 |
46 | \dontrun{
47 | inventory(
48 | states = c("GOIÁS", "MINAS GERAIS"),
49 | stationType = "plu",
50 | as_sf = TRUE,
51 | aoi = NULL
52 | )
53 |
54 | }
55 | \dontshow{\}) # examplesIf}
56 | }
57 | \references{
58 | Dados Abertos da Agência Nacional de Águas e Saneamento Básico.
59 |
60 | \url{https://dadosabertos.ana.gov.br/}
61 |
62 | HIDRO - Inventário pluviométrico/fluviométrico atualizado.
63 |
64 | \url{https://dadosabertos.ana.gov.br/documents/ae318ebacb4b41cda37fbdd82125078b/about}
65 | }
66 |
--------------------------------------------------------------------------------
/man/downloadTerraClimate.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/downloadTerraClimate.R
3 | \name{downloadTerraClimate}
4 | \alias{downloadTerraClimate}
5 | \title{Download terraClimate monthly data}
6 | \usage{
7 | downloadTerraClimate(dir_out, variable, years, aoi)
8 | }
9 | \arguments{
10 | \item{dir_out}{character. Directory where you want to save the raster images that you are going to download.}
11 |
12 | \item{variable}{character. Variable to download. See details for more information}
13 |
14 | \item{years}{numeric. The period in years that the function should download images.}
15 |
16 | \item{aoi}{spatVector or sf object. Provides the boundaries where terraClimate data should be limited to.}
17 | }
18 | \value{
19 | raster files of each year containing 12 layers each (1 for each month of given year).
20 | }
21 | \description{
22 | Download TerraClimate monthly data based on area of interest
23 | }
24 | \details{
25 | \itemize{
26 | \item Variable descriptions:
27 | }
28 |
29 | aet (Actual Evapotranspiration, monthly total), units = mm
30 |
31 | def (Climate Water Deficit, monthly total), units = mm
32 |
33 | pet (Potential evapotranspiration, monthly total), units = mm
34 |
35 | ppt (Precipitation, monthly total), units = mm
36 |
37 | q (Runoff, monthly total), units = mm
38 |
39 | soil (Soil Moisture, total column - at end of month), units = mm
40 |
41 | srad (Downward surface shortwave radiation), units = W/m2
42 |
43 | swe (Snow water equivalent - at end of month), units = mm
44 |
45 | tmax (Max Temperature, average for month), units = C
46 |
47 | tmin (Min Temperature, average for month), units = C
48 |
49 | vap (Vapor pressure, average for month), units = kPa
50 |
51 | ws (Wind speed, average for month), units = m/s
52 |
53 | vpd (Vapor Pressure Deficit, average for month), units = kpa
54 |
55 | PDSI (Palmer Drought Severity Index, at end of month), units = unitless
56 | }
57 | \examples{
58 |
59 | \dontrun{
60 |
61 | require(terra)
62 |
63 | area_of_interest = vect("./paracatu.shp")
64 |
65 |
66 | downloadTerraClimate(dir_out = "./temp/terraClimate",
67 | variable = "ppt",
68 | years = c(1990:2000),
69 | aoi = area_of_interest)
70 |
71 | }
72 |
73 |
74 |
75 | }
76 | \references{
77 | adapted from download_terraclimate function of cropDemand package.
78 |
79 | https://search.r-project.org/CRAN/refmans/cropDemand/html/00Index.html
80 |
81 | Abatzoglou, J.T., S.Z. Dobrowski, S.A. Parks, K.C. Hegewisch, 2018, Terraclimate, a high-resolution global dataset of monthly climate and climatic water balance from 1958-2015, Scientific Data,
82 | }
83 |
--------------------------------------------------------------------------------
/man/stationsData.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/stationsData.R
3 | \encoding{UTF-8}
4 | \name{stationsData}
5 | \alias{stationsData}
6 | \title{Retrieves raw data for the stations inventory from ANA web API}
7 | \usage{
8 | stationsData(inventoryResult, deleteNAstations = TRUE, waterLevel = FALSE)
9 | }
10 | \arguments{
11 | \item{inventoryResult}{tibble data frame; provides the station inventory (output
12 | from \code{\link[=inventory]{inventory()}} function) for which to download data for.}
13 |
14 | \item{deleteNAstations}{logical; should stations with no data be removed?
15 | The default is TRUE.}
16 |
17 | \item{waterLevel}{logical. if param "station_type" in \code{\link[=inventory]{inventory()}}, get waterLevel data of fluviometric stations?
18 | Use FALSE for streamflow data. TRUE for water level data. Default is FALSE.}
19 | }
20 | \value{
21 | A list containing a data frame \code{\link[tibble:tibble]{tibble::tibble()}} object for each station.
22 | The data frame format is identical to the format provided by ANA.
23 | }
24 | \description{
25 | Takes as input an inventory of stations (output from
26 | \code{\link[=inventory]{inventory()}}) or data.frame/tibble object with station_code and stationType
27 | columns and downloads raw stations data from the Brazilian
28 | National Water Agency (ANA). The user can choose wether to maintain
29 | stations with missing data.
30 | }
31 | \details{
32 | Improvement of the code developed by Artur Lourenço
33 | (https://github.com/ArturLourenco/HidroWebFix)
34 | }
35 | \examples{
36 | \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
37 | # Fech a inventory of fluviometric stations for the state of Minas Gerais
38 |
39 | \dontrun{
40 | inv <- inventory(
41 | states = "MINAS GERAIS",
42 | stationType = "flu",
43 | as_sf = TRUE,
44 | aoi = NULL
45 | )
46 |
47 | # Download the first 10 stations from the inventory
48 |
49 | s_data <- stationsData(
50 | inventoryResult = inv[1:10,],
51 | deleteNAstations = TRUE
52 | )
53 |
54 | #######
55 |
56 | #create data.frame with station_code and stationType columns
57 |
58 | stations_code = data.frame(station_code = c("42600000","42690001"),
59 | stationType = "fluviometric")
60 |
61 | s_data = stationsData(stations_code)
62 |
63 | }
64 |
65 |
66 |
67 | \dontshow{\}) # examplesIf}
68 | }
69 | \references{
70 | Dados Abertos da Agência Nacional de Águas e Saneamento Básico.
71 |
72 | \url{https://dadosabertos.ana.gov.br/}
73 |
74 | HIDRO - Inventário pluviométrico/fluviométrico atualizado.
75 |
76 | \url{https://dadosabertos.ana.gov.br/documents/fb3426be2d4a4f9abfa90fb87b30bd4f/about}
77 | }
78 |
--------------------------------------------------------------------------------
/man/lag1AutocorrelationAll.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/lag1AutoCorrelationAll.R
3 | \name{lag1AutocorrelationAll}
4 | \alias{lag1AutocorrelationAll}
5 | \title{Lag 1 AutoCorrelation considering all hydrological years months begin}
6 | \usage{
7 | lag1AutocorrelationAll(
8 | selectStationsAllmonthsRDSfolder,
9 | statistics = "Qmean",
10 | permanence = 95
11 | )
12 | }
13 | \arguments{
14 | \item{selectStationsAllmonthsRDSfolder}{character. folder path with 12 Rdata files generated with \link{selectStationsAllMonths}.}
15 |
16 | \item{statistics}{character; indicates statistics.
17 | \itemize{
18 | \item The supported statistics for streamflow are:
19 | (1) mean stream flow (Qmean); (2) minimum of seven-day moving average of daily stream flow (Q7);
20 | (3) stream flow associated with a percentage of time (Qperm); (4) maximum stream flow (Qmax);
21 | and (5) minimum stream flow (Qmin).
22 | \item The supported statistics are: (1) total rainfall (Rtotal); (2) maximum rainfall (Rmax);
23 | (3) rainy days (Rdays).
24 | \item The default value is "Qmean".
25 | }}
26 |
27 | \item{permanence}{numeric; percentage of time if "Qperm" is choose as statistic parameter.
28 | The default is 95 percent.}
29 | }
30 | \value{
31 | list with 12 tibble objects. Each tibble contatin autocorrelation for all stations for respective hydrological month begin.
32 | }
33 | \description{
34 | Same processing done at \link{lag1AutoCorrelation} but considering all 12 months possible to start hydrological year
35 | Function idealized to assistant hydrological year definition.
36 | }
37 | \examples{
38 |
39 |
40 | \dontrun{
41 |
42 | # Fech a inventory of fluviometric stations for the state of Minas Gerais.
43 |
44 | inv <- inventory(
45 | states = "MINAS GERAIS",
46 | stationType = "flu",
47 | as_sf = TRUE,
48 | aoi = NULL
49 | )
50 |
51 | # Download the first 10 stations from the inventory
52 |
53 | s_data <- stationsData(
54 | inventoryResult = inv[1:10,],
55 | deleteNAstations = TRUE
56 | )
57 |
58 | # Organize the data for the stations
59 |
60 | org_data <- organize(
61 | stationsDataResult = s_data
62 | )
63 |
64 | # Filter the data for desired period and quality contorl
65 |
66 | selectStationsAllMonths(
67 | organizeResult = org_data,
68 | mode = "yearly",
69 | maxMissing = 10,
70 | minYears = 15,
71 | iniYear = NULL,
72 | finYear = NULL,
73 | consistedOnly = FALSE,
74 | folderPathWithNameDescription = "./loop/selecStation_15years_5porc",
75 | plot = TRUE
76 | )
77 |
78 | #autocorrelation for Qmean series for all hydrological year month begin
79 |
80 | autoCorQmld = autocorrelationAll(selectStationsAllmonthsRDSfolder = "./loop", statistics = "Qmean")
81 |
82 | }
83 | }
84 |
--------------------------------------------------------------------------------
/R/demProducts.R:
--------------------------------------------------------------------------------
1 | #' Digital elevation model sub-products
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Obtain digital elevation model sub-products. All inputs must be projected.
6 | #'
7 | #'
8 | #' @param demP character vector. Input DEM raster file path.
9 | #' @param streamP character vector. Input stream shapefile path.
10 | #' @param outputDir character vector. Output rasters file path.
11 | #'
12 | #'
13 | #' @details DEM must be in metric coordinates (projected)
14 | #'
15 | #' @return Create eigth DEM subproducts:
16 | #' (1) DEM aspect;
17 | #' (2) DEM burned by streams;
18 | #' (3) DEM Sinks;
19 | #' (4) DEM slope in degrees;
20 | #' (5) DEM slope in porcent;
21 | #' (6) DEM burned by streans filled;
22 | #' (7) Flow Accumulation based on (6);
23 | #' (8) Flow Direction based on (6).
24 | #'
25 | #'
26 | #' @references
27 | #' whitetoolbox package (https://cran.r-project.org/web/packages/whitebox/index.html)
28 | #'
29 | #'
30 | #' @examplesIf interactive()
31 | #'
32 | #' #
33 | #'
34 | #' demProducts("./dem.tif", "./streams.shp", "./demProducts")
35 | #'
36 | #'
37 | #' @export
38 | demProducts = function(demP, streamP, outputDir){
39 |
40 | if (dir.exists(outputDir) == FALSE){
41 | dir.create(outputDir, recursive = TRUE)
42 | }
43 |
44 | print(whitebox::wbt_slope(demP,
45 | paste(outputDir, "/01DEM_slope_porcent.tif", sep = ""),
46 | units = "percent"))
47 |
48 | print(whitebox::wbt_slope(demP,
49 | paste(outputDir, "/01DEM_slope_dregrees.tif", sep = ""),
50 | units = "degrees"))
51 |
52 | print(whitebox::wbt_aspect(demP,
53 | paste(outputDir, "/01DEM_aspect.tif", sep = "")))
54 |
55 | print(whitebox::wbt_sink(demP,
56 | paste(outputDir, "/01DEM_Sinks.tif", sep = ""),
57 | zero_background = TRUE))
58 |
59 |
60 | print(whitebox::wbt_fill_burn(demP,
61 | streamP,
62 | paste(outputDir, "/01DEM_Burned.tif", sep = "")))
63 |
64 |
65 | print(whitebox::wbt_fill_depressions(paste(outputDir, "/01DEM_Burned.tif", sep = ""),
66 | paste(outputDir, "/02DEM_Burned_Fill.tif", sep = "")))
67 |
68 |
69 | print(whitebox::wbt_d8_flow_accumulation(paste(outputDir, "/02DEM_Burned_Fill.tif", sep = ""),
70 | paste(outputDir, "/03flowAccumulation.tif", sep = ""),
71 | out_type = "cells"))
72 |
73 |
74 | print(whitebox::wbt_d8_pointer(paste(outputDir, "/02DEM_Burned_Fill.tif", sep = ""),
75 | paste(outputDir, "/03flowDirection.tif", sep = "")))
76 |
77 | }
78 |
--------------------------------------------------------------------------------
/R/Q7Tempiric.R:
--------------------------------------------------------------------------------
1 | #' Compute Q7 associated to desired return period based on empirical distribution
2 | #' (function design for package internal use. See [hydrobr::historicalStatistics] for
3 | #' general use)
4 | #'
5 | #' @encoding UTF-8
6 | #'
7 | #' @description Takes as input a vector of Q7 series and Compute Q7 associated to
8 | #' desired return period.
9 | #'
10 | #' @param vectorSerieQ7 numeric vector.
11 | #'
12 | #'
13 | #' @param pReturn numeric, desired period of return.
14 | #'
15 | #' @return numeric vector.
16 | #'
17 | #' @details frequency evaluated with Kimbal method.
18 | #'
19 | #' @examplesIf interactive()
20 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
21 | #'
22 | #' inv <- inventory(
23 | #' states = "MINAS GERAIS",
24 | #' stationType = "flu",
25 | #' as_sf = TRUE,
26 | #' aoi = NULL
27 | #' )
28 | #'
29 | #' # Download the first 10 stations from the inventory
30 | #'
31 | #' s_data <- stationsData(
32 | #' inventoryResult = inv[1:10,],
33 | #' deleteNAstations = TRUE
34 | #' )
35 | #'
36 | #' # Organize the data for the stations
37 | #'
38 | #' org_data <- organize(
39 | #' stationsDataResult = s_data
40 | #' )
41 | #'
42 | #' # Filter the data for desired period and quality contorl
43 | #'
44 | #' final_data <- selectStations(
45 | #' stationsDataResult = org_data,
46 | #' mode = "yearly",
47 | #' maxMissing = 10,
48 | #' minYears = 15,
49 | #' month = 1,
50 | #' iniYear = NULL,
51 | #' finYear = NULL,
52 | #' consistedOnly = FALSE,
53 | #' plot = TRUE
54 | #' )
55 | #'
56 | #' # annual mean stream flow serie for each station
57 | #' Q7_years = seriesStatistics(final_data, statistics = "Q7")
58 | #'
59 | #' # Q7 associated with return period of 10 years for first station
60 | #' Q7.10 = vectorSerieQ7(final_data$series[[1]] %>% pull(3), statistics = "Q7")
61 | #'
62 | #' @export
63 | #' @importFrom rlang .data
64 | #' @importFrom rlang :=
65 |
66 |
67 | Q7Tempiric = function(vectorSerieQ7, pReturn = 10){
68 |
69 | #frequency computation based on Kendal formula
70 |
71 | fobs <- (1:length(vectorSerieQ7))/(length(vectorSerieQ7)+1)
72 |
73 | #dataframe with Q7 serie and probability associated
74 | df =data.frame(vazao = sort(vectorSerieQ7),
75 | fobs = fobs)
76 |
77 | #if any probability in data.frame match with desired probability (1/T)
78 |
79 | if(sum(unique(df[,2])==1/pReturn) == 1){
80 |
81 | #get matched Q7
82 | Q = df[df$fobs == .1,1]
83 |
84 | } else {
85 |
86 | #evaluate Q7 based on interpolation of frequency
87 |
88 | high = df %>% dplyr::filter(fobs>=1/pReturn) %>% dplyr::slice(1)
89 |
90 | low = df %>% dplyr::filter(fobs<1/T) %>% dplyr::slice(nrow(.))
91 |
92 | Q = (high$vazao-low$vazao)/(high$fobs-low$fobs)*(1/T - low$fobs) + low$vazao
93 |
94 | }
95 |
96 | return(Q)
97 |
98 | }
99 |
--------------------------------------------------------------------------------
/man/PettittBootTest.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/PettittBootTest.R
3 | \encoding{UTF-8}
4 | \name{PettittBootTest}
5 | \alias{PettittBootTest}
6 | \title{Bootstrap Pettitt trend test}
7 | \usage{
8 | PettittBootTest(
9 | dfSeriesFromFillorSerieStatisticsFunc,
10 | byMonth = FALSE,
11 | plotGraph = TRUE,
12 | dirSub = "./pettittTestGraph",
13 | ylab,
14 | legendlabel
15 | )
16 | }
17 | \arguments{
18 | \item{dfSeriesFromFillorSerieStatisticsFunc}{tibble containing annual or monthly series of all stations;}
19 |
20 | \item{byMonth}{logical. if byMounth = TRUE, Pettitt test is performed for each month;}
21 |
22 | \item{plotGraph}{logical. defalt = FALSE;}
23 |
24 | \item{dirSub}{string. directory path to save plots. default = "./pettittTestGraph";}
25 |
26 | \item{ylab}{character. ylab description, i.e, 'Qmean (m³/s)';}
27 |
28 | \item{legendlabel}{character. Legend label, i.e, 'Annual mean streamflow'.}
29 | }
30 | \value{
31 | p-value for each continuous stations data
32 | }
33 | \description{
34 | Performs the Bootstrap Pettitt trend test for annual or monthly rainfall (or streamflow) times series
35 | }
36 | \examples{
37 | \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
38 |
39 | # Fech a inventory of fluviometric stations for the state of Minas Gerais
40 |
41 | inv <- inventory(
42 | states = "MINAS GERAIS",
43 | stationType = "flu",
44 | as_sf = TRUE,
45 | aoi = NULL)
46 |
47 | # Download the first 10 stations from the inventory
48 |
49 | s_data <- stationsData(
50 | inventoryResult = inv[1:10,],
51 | deleteNAstations = TRUE)
52 |
53 | # Organize the data for the stations
54 |
55 | org_data <- organize(
56 | stationsDataResult = s_data
57 | )
58 |
59 | # Filter the data for desired period and quality contorl
60 |
61 | final_data <- selectStations(
62 | stationsDataResult = org_data,
63 | mode = "yearly",
64 | maxMissing = 10,
65 | minYears = 15,
66 | month = 1,
67 | iniYear = NULL,
68 | finYear = NULL,
69 | consistedOnly = FALSE,
70 | plot = TRUE
71 | )
72 |
73 | # Annual mean stream flow serie for each station
74 | Qmean_years = seriesStatistics(final_data, statistics = "Qmean")
75 |
76 | #Bootstrap pettitt test
77 | PettittBootTest(dfSeriesFromFillorSerieStatisticsFunc = Qmean_years$df_series,
78 | byMonth = FALSE,
79 | plotGraph = FALSE,
80 | dirSub = "./petitTestGraph",
81 | ylab = "Qmean (m³/s)",
82 | legendlabel = "Annual mean streamflow")
83 |
84 | \dontshow{\}) # examplesIf}
85 | }
86 | \references{
87 | Based on "https://github.com/fabiobayer/bootpettitt"
88 |
89 | Bootstrap Pettitt test for detecting change points in hydroclimatological data: case study of Itaipu Hydroelectric Plant, Brazil
90 | (https://www.tandfonline.com/doi/full/10.1080/02626667.2019.1632461)
91 | }
92 |
--------------------------------------------------------------------------------
/man/historicalStatisticsSazonal.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/historicalStatisticsSazonal.R
3 | \name{historicalStatisticsSazonal}
4 | \alias{historicalStatisticsSazonal}
5 | \title{Historical Statistics for sazonal period (underdevelopment. available for streamdflow and annual series)}
6 | \usage{
7 | historicalStatisticsSazonal(
8 | selectStationsResultSeries,
9 | statistics = "Qmean",
10 | permanence = 95,
11 | pReturn = 10
12 | )
13 | }
14 | \arguments{
15 | \item{selectStationsResultSeries}{list, tibble data frame; provides a list containing
16 | the data frames of filtered records for each station
17 | (series output from \code{\link[=selectStations]{selectStations()}} function).}
18 |
19 | \item{statistics}{character; indicates statistics.
20 | \itemize{
21 | \item The supported statistics for streamflow are:
22 | (1) mean stream flow (Qmean);
23 | (2) minimum of seven-day moving average of daily stream flow associated with return period (Q7T);
24 | (3) stream flow associated with a percentage of time (Qperm);
25 | (4) maximum stream flow (Qmax);
26 | (5) minimum stream flow (Qmin).
27 | \item The supported statistics are:
28 | (1) total rainfall (Rtotal);
29 | (2) maximum rainfall (Rmax);
30 | (3) rainy days (Rdays).
31 | \item The default value is "Qmean".
32 | }}
33 |
34 | \item{permanence}{numeric; percentage of time if "Qperm" is choose as statistic parameter.
35 | The default is 95 percent.}
36 |
37 | \item{pReturn}{numeric; return period if "Q7T" is choose as statistic parameter.
38 | The default is 10 year.}
39 | }
40 | \value{
41 | tibble object containing desired statistics for boths period and the ratio (porcentage) between
42 | historicalStatistics and sazonal historic statistics
43 | }
44 | \description{
45 | Historical series is splitted in two (six months each) and \link{historicalStatistics} is computed for both period.
46 | }
47 | \examples{
48 |
49 |
50 | \dontrun{
51 |
52 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais.
53 |
54 | inv <- inventory(
55 | states = "MINAS GERAIS",
56 | stationType = "flu",
57 | as_sf = TRUE,
58 | aoi = NULL
59 | )
60 |
61 | # Download the first 10 stations from the inventory
62 |
63 | s_data <- stationsData(
64 | inventoryResult = inv[1:10,],
65 | deleteNAstations = TRUE
66 | )
67 |
68 | # Organize the data for the stations
69 |
70 | org_data <- organize(
71 | stationsDataResult = s_data
72 | )
73 |
74 | # Filter the data for desired period and quality contorl
75 |
76 | final_data <- selectStations(
77 | stationsDataResult = org_data,
78 | mode = "yearly",
79 | maxMissing = 10,
80 | minYears = 15,
81 | month = 1,
82 | iniYear = NULL,
83 | finYear = NULL,
84 | consistedOnly = FALSE,
85 | plot = TRUE
86 | )
87 |
88 | # annual mean stream flow serie for each station
89 | QmeanS = historicalStatisticsSazonal(final_data$series, statistics = "Qmean")
90 |
91 |
92 |
93 | }
94 | }
95 |
--------------------------------------------------------------------------------
/man/historicalStatisticsSazonalAll.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/historicalStatisticsSazonalAll.R
3 | \name{historicalStatisticsSazonalAll}
4 | \alias{historicalStatisticsSazonalAll}
5 | \title{Historical Statistics for sazonal period considering all hydrological years months begin (underdevelopment. available for streamdflow and annual series)}
6 | \usage{
7 | historicalStatisticsSazonalAll(
8 | selectStationsAllmonthsRDSfolder,
9 | statistics = "Qmean",
10 | permanence = 95,
11 | pReturn = 10
12 | )
13 | }
14 | \arguments{
15 | \item{selectStationsAllmonthsRDSfolder}{character. folder path with 12 Rdata files generated with \link{selectStationsAllMonths}.}
16 |
17 | \item{statistics}{character; indicates statistics.
18 | \itemize{
19 | \item The supported statistics for streamflow are:
20 | (1) mean stream flow (Qmean);
21 | (2) minimum of seven-day moving average of daily stream flow associated with return period (Q7T);
22 | (3) stream flow associated with a percentage of time (Qperm);
23 | (4) maximum stream flow (Qmax);
24 | (5) minimum stream flow (Qmin).
25 | \item The supported statistics are:
26 | (1) total rainfall (Rtotal);
27 | (2) maximum rainfall (Rmax);
28 | (3) rainy days (Rdays).
29 | \item The default value is "Qmean".
30 | }}
31 |
32 | \item{permanence}{numeric; percentage of time if "Qperm" is choose as statistic parameter.
33 | The default is 95 percent.}
34 |
35 | \item{pReturn}{numeric; return period if "Q7T" is choose as statistic parameter.
36 | The default is 10 year.}
37 | }
38 | \value{
39 | list with 12 tibble objects. Each one containing desired statistics for boths period and the ratio (porcentage) between
40 | historicalStatistics and sazonal historic statistics
41 | }
42 | \description{
43 | Same processing done at \link{historicalStatisticsSazonal} but considering all 12 months possible to start hydrological year
44 | }
45 | \examples{
46 | #'
47 | \dontrun{
48 |
49 | # Fech a inventory of fluviometric stations for the state of Minas Gerais.
50 |
51 | inv <- inventory(
52 | states = "MINAS GERAIS",
53 | stationType = "flu",
54 | as_sf = TRUE,
55 | aoi = NULL
56 | )
57 |
58 | # Download the first 10 stations from the inventory
59 |
60 | s_data <- stationsData(
61 | inventoryResult = inv[1:10,],
62 | deleteNAstations = TRUE
63 | )
64 |
65 | # Organize the data for the stations
66 |
67 | org_data <- organize(
68 | stationsDataResult = s_data
69 | )
70 |
71 | # Filter the data for desired period and quality contorl
72 |
73 | selectStationsAllMonths(
74 | organizeResult = org_data,
75 | mode = "yearly",
76 | maxMissing = 10,
77 | minYears = 15,
78 | iniYear = NULL,
79 | finYear = NULL,
80 | consistedOnly = FALSE,
81 | folderPathWithNameDescription = "./loop/selecStation_15years_5porc",
82 | plot = TRUE
83 | )
84 |
85 | # annual mean stream flow serie for each station
86 |
87 | hsQmean = historicalStatisticsSazonalAll("./loop", statistics = "Qmean")
88 |
89 |
90 | }
91 |
92 |
93 | }
94 |
--------------------------------------------------------------------------------
/man/fillGaps.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/fillGaps.R
3 | \encoding{UTF-8}
4 | \name{fillGaps}
5 | \alias{fillGaps}
6 | \title{(UNDER DEVELOPMENT) Fill gaps at monthly or annual time series}
7 | \usage{
8 | fillGaps(StatisticsResult, minimumCor = 0.84, minimunObsPairs = 10)
9 | }
10 | \arguments{
11 | \item{StatisticsResult}{list, tibble data frame; A list containing statistic data frame \code{\link[tibble:tibble]{tibble::tibble()}} object
12 | for each station (output from \code{\link[=seriesStatistics]{seriesStatistics()}}).}
13 |
14 | \item{minimumCor}{value; minimum correlation between stations. default = 0.84}
15 |
16 | \item{minimunObsPairs}{value; minimum of observation pairwise between stations to be filled with.
17 | If 'StatisticsResult' is annual time series, minimunObsPairs is equal to number of commom years.
18 | If 'StatisticsResult' is monthly time series, minimunObsPairs is equal to number of common months.}
19 | }
20 | \value{
21 | A list containing 4 objects:
22 | \itemize{
23 | \item a list containing statistic a data frame \code{\link[tibble:tibble]{tibble::tibble()}} object for each station.
24 | gap filled.
25 | \item a data frame \code{\link[tibble:tibble]{tibble::tibble()}} with statistic of all stations in wide format
26 | \item a data frame \code{\link[tibble:tibble]{tibble::tibble()}} with statistic of all stations in longer format
27 | \item a failureMatrix indicating if the gap was filled (TRUE) or not (FALSE)
28 | \item the saved plot.
29 | }
30 | }
31 | \description{
32 | Takes as input a list containing annual or monthly time series statistic
33 | for each station (output from \code{\link[=seriesStatistics]{seriesStatistics()}})
34 | and try to fill gaps based on linear regression among them.
35 | }
36 | \examples{
37 | \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
38 | # Fech a inventory of fluviometric stations for the state of Minas Gerais
39 |
40 | inv <- inventory(
41 | states = "MINAS GERAIS",
42 | stationType = "flu",
43 | as_sf = TRUE,
44 | aoi = NULL
45 | )
46 |
47 | # Download the first 10 stations from the inventory
48 |
49 | s_data <- stationsData(
50 | inventoryResult = inv[1:10,],
51 | deleteNAstations = TRUE
52 | )
53 |
54 | # Organize the data for the stations
55 |
56 | org_data <- organize(
57 | stationsDataResult = s_data
58 | )
59 |
60 | # Filter the data for desired period and quality contorl
61 |
62 | final_data <- selectStations(
63 | stationsDataResult = org_data,
64 | mode = "yearly",
65 | maxMissing = 10,
66 | minYears = 15,
67 | month = 1,
68 | iniYear = NULL,
69 | finYear = NULL,
70 | consistedOnly = FALSE,
71 | plot = TRUE
72 | )
73 |
74 | # Annual mean stream flow serie for each station
75 | Qmean_years = flowStatistics(final_data, statistics = "Qmean")
76 |
77 | #fill Gaps of Annual time series
78 |
79 | Qmean_years_filled = fillGaps(StatisticsResult = Qmean_years,
80 | minimumCor = 0.84,
81 | minimunObsPairs = 10)
82 | \dontshow{\}) # examplesIf}
83 | }
84 |
--------------------------------------------------------------------------------
/man/watershedDelineation.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/watershedDelineation.R
3 | \encoding{UTF-8}
4 | \name{watershedDelineation}
5 | \alias{watershedDelineation}
6 | \title{Watershed delineation based on pour points}
7 | \usage{
8 | watershedDelineation(
9 | stationsPath,
10 | flowAcumPath,
11 | flowDir8Path,
12 | bufferSearch = 1000,
13 | outputDirPath
14 | )
15 | }
16 | \arguments{
17 | \item{stationsPath}{character vector. Shapefile path of ANA fluviometric stations}
18 |
19 | \item{flowAcumPath}{character vector. Flow Accumulation raster path}
20 |
21 | \item{flowDir8Path}{character vector. Flow direction raster path}
22 |
23 | \item{bufferSearch}{value. Search radius in meters to snap pour points}
24 |
25 | \item{outputDirPath}{character vector. Output directory path}
26 | }
27 | \value{
28 | \itemize{
29 | \item nested and unested watersheds in raster and shape format
30 | \item snapped pour points
31 | }
32 | }
33 | \description{
34 | This function delineates watershed boundaries. See details.
35 | }
36 | \details{
37 | The stations shapefile MUST INCLUDE a 'sttn_cd' column containing numerical identifiers for stations.
38 |
39 | Shapefiles and rasters MUST BE in the same projection coordinate system (metric).
40 |
41 | The delineation could be based on two algorithms:
42 |
43 | (1) Pour points are snapped to the chosen flow accumulation pixel value which most approximates the area of the respective station at 'bufferSearch';
44 |
45 | (2) Pour points are snapped to the chosen biggest flow accumulation value within a 'bufferSearch' radius.
46 |
47 | To choose which algorithm is implemented, the user must configure the input shapefile:
48 |
49 | (1) If the first method is desired, the station shapefile MUST INCLUDE an 'are_km2' column containing area values for station basins in km².
50 | If the area is not known for a specific station, leave the 'are_km2' column of this specific station as 'NA', and the function will use the second algorithm to delineate watershed boundaries.
51 |
52 | (2) If you're interested in the second algorithm, just make sure that 'are_km2' is not provided ou set 'NA' to all station value at 'are_km2' column.
53 | }
54 | \examples{
55 |
56 | \dontrun{
57 | #stations in area of interest
58 |
59 | stations = inventory(
60 | stationType = "flu",
61 | as_sf = T,
62 | aoi = sf::st_read("./example/data/aoi_example.shp")
63 | )
64 |
65 | # omit station with area equal NA, reproject to epsg of dem and export it
66 |
67 | sf::st_write(
68 | na.omit(stations) \%>\% sf::st_transform(crs = "epsg:32723"),
69 | dsn = "./example/results/stations_aoi.shp",
70 | delete_dsn = TRUE, delete_layer = TRUE
71 | )
72 |
73 | #run watersheDelimit
74 | watershedDelineation(
75 | stationsPath = "./example/results/stations_aoi.shp",
76 | flowAcumPath = "./example/results/demproducts/03flowAccumulation.tif",
77 | flowDir8Path = "./example/results/demproducts/03flowDirection.tif",
78 | bufferSearch = 1000,
79 | outputDirPath = "./example/results/watershedsDelimit"
80 | )
81 |
82 | }
83 |
84 | }
85 | \references{
86 | whitetoolbox package (https://cran.r-project.org/web/packages/whitebox/index.html)
87 | }
88 |
--------------------------------------------------------------------------------
/man/downloadTerraClimateParallel.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/downloadTerraClimateParallel.R
3 | \name{downloadTerraClimateParallel}
4 | \alias{downloadTerraClimateParallel}
5 | \title{Download terraClimate monthly data}
6 | \usage{
7 | downloadTerraClimateParallel(
8 | aoi,
9 | dir_out,
10 | variable,
11 | years,
12 | ncores = 1,
13 | retry = 10,
14 | timeout = 600
15 | )
16 | }
17 | \arguments{
18 | \item{aoi}{spatVector object. Provides the boundaries where chirps data should be limited to (datum = WGS84).}
19 |
20 | \item{dir_out}{character. Directory where you want to save the raster images that you are going to download.}
21 |
22 | \item{variable}{character. Variable to download. See details for more information.}
23 |
24 | \item{years}{numeric. The period in years that the function should download images.}
25 |
26 | \item{ncores}{numeric. numeric. The number of processor cores to use for parallelizing the download operation. Default is 1 (no parallelization).}
27 |
28 | \item{retry}{numeric. numeric. The number of retry attempts for failed downloads. Default is 100.}
29 |
30 | \item{timeout}{numeric.numeric. The timeout in seconds for each download attempt. Default is 600.}
31 | }
32 | \value{
33 | raster files of each year containing 12 layers each (1 for each month of given year).
34 | }
35 | \description{
36 | Download TerraClimate monthly data based on area of interest
37 | }
38 | \details{
39 | \itemize{
40 | \item Variable descriptions:
41 | }
42 |
43 | aet (Actual Evapotranspiration, monthly total), units = mm
44 |
45 | def (Climate Water Deficit, monthly total), units = mm
46 |
47 | pet (Potential evapotranspiration, monthly total), units = mm
48 |
49 | ppt (Precipitation, monthly total), units = mm
50 |
51 | q (Runoff, monthly total), units = mm
52 |
53 | soil (Soil Moisture, total column - at end of month), units = mm
54 |
55 | srad (Downward surface shortwave radiation), units = W/m2
56 |
57 | swe (Snow water equivalent - at end of month), units = mm
58 |
59 | tmax (Max Temperature, average for month), units = C
60 |
61 | tmin (Min Temperature, average for month), units = C
62 |
63 | vap (Vapor pressure, average for month), units = kPa
64 |
65 | ws (Wind speed, average for month), units = m/s
66 |
67 | vpd (Vapor Pressure Deficit, average for month), units = kpa
68 |
69 | PDSI (Palmer Drought Severity Index, at end of month), units = unitless
70 | }
71 | \examples{
72 |
73 | \dontrun{
74 |
75 | require(terra)
76 |
77 | area_of_interest = vect("./paracatu.shp")
78 |
79 |
80 | pptAoi = downloadTerraClimateParallel(dir_out = "./temp/terraClimate",
81 | variable = "ppt",
82 | years = c(1990:2000),
83 | ncores = 5,
84 | aoi = area_of_interest)
85 |
86 |
87 |
88 | #set sequential plan
89 | future::plan(future::sequential)
90 |
91 | }
92 |
93 | }
94 | \references{
95 | adapted from download_terraclimate function of cropDemand package.
96 |
97 | https://search.r-project.org/CRAN/refmans/cropDemand/html/00Index.html
98 |
99 | Abatzoglou, J.T., S.Z. Dobrowski, S.A. Parks, K.C. Hegewisch, 2018, Terraclimate, a high-resolution global dataset of monthly climate and climatic water balance from 1958-2015, Scientific Data,
100 | }
101 |
--------------------------------------------------------------------------------
/R/downloadChirpsRainfall.R:
--------------------------------------------------------------------------------
1 | #' Download Chirps Rainfall daily data by year
2 | #'
3 | #' @description
4 | #' Download Chirps Rainfall daily data by year based on area of interest
5 | #'
6 | #'
7 | #' @param dir_out character. Directory where you want to save the raster images that you are going to download.
8 | #' @param years numeric. The period in years that the function should download images.
9 | #' @param aoi spatVector object. Provides the boundaries where chirps data should be limited to (datum = WGS84).
10 | #'
11 | #' @returns raster files of each year containing daily layers for each (1 for each day of given year).
12 | #'
13 | #' @details
14 | #' Simple application of get_chirps function of chirps package
15 | #'
16 | #'
17 | #' @references
18 | #'
19 | #' https://cran.r-project.org/web/packages/chirps/chirps.pdf
20 | #'
21 | #'
22 | #' @examples
23 | #'
24 | #'
25 | #'\dontrun{
26 | #'
27 | #'require(terra)
28 | #'
29 | #'area_of_interest = vect("./paracatu.shp")
30 | #'
31 | #'
32 | #'downloadChirpsRainfall(dir_out = "./temp/chirpsRainfall",
33 | #' years = c(1990:1991),
34 | #' aoi = area_of_interest)
35 | #'
36 | #'}
37 | #'
38 | #'
39 | #'@export
40 | #'
41 | downloadChirpsRainfall = function(dir_out, years, aoi){
42 |
43 |
44 | stopifnot(
45 | "`dir_out` parameter must be character indicating output folder path (i.e `c:/temp`)" = is.character(dir_out),
46 | "`years` must be numeric vector containing years to be downloaded" = is.numeric(years),
47 | "`aoi` must be a polygon of class `SpatVector` (terra package)" = class(aoi) == "SpatVector")
48 |
49 |
50 |
51 | dir.create(dir_out, showWarnings = FALSE)
52 |
53 |
54 | for (i in 1:length(years)){
55 |
56 | print(paste0(years[i], " Downloading"))
57 |
58 | inicial = paste0(years[i], "-01","-01")
59 |
60 | final = paste0(years[i], "-12","-31")
61 |
62 | if(years[i] == 1981){
63 |
64 | inicial = paste0(years[i], "-01", "-02")
65 |
66 | }
67 |
68 |
69 | dates = c(inicial, final)
70 |
71 | chirpsData <- chirps::get_chirps(aoi, dates, server = "CHC", as.raster = TRUE)
72 |
73 | print(paste0(years[i], " Saving"))
74 |
75 | terra::writeRaster(chirpsData, filename = paste0(dir_out,
76 | "/chirps_rainfall", years[i], ".tif"),
77 | filetype = "GTiff", overwrite = TRUE)
78 | }
79 | }
80 |
81 |
82 |
83 | # if(variable %in% c("tmax", "tmin")){
84 | #
85 | # i = 1
86 | # for (i in 1:length(years)){
87 | #
88 | # print(paste0(years[i], " Downloading"))
89 | #
90 | # inicial = paste0(years[i], "-01","-01")
91 | #
92 | # final = paste0(years[i], "-12","-31")
93 | #
94 | # dates = c(inicial, final)
95 | #
96 | # chirpsData <- chirps::get_chirts(aoi, var = stringr::str_to_title(variable), dates, server = "CHC", as.raster = TRUE)
97 | #
98 | # print(paste0(years[i], " Saving"))
99 | #
100 | # terra::writeRaster(chirpsData, filename = paste0(dir_out,
101 | # "/chirps_", "variable", years[i], ".tif"),
102 | # filetype = "GTiff", overwrite = TRUE)
103 | # }
104 | # }
105 |
106 |
107 |
108 |
109 |
110 |
--------------------------------------------------------------------------------
/man/selectStationsAllMonths.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/selectStationsAllMonths.R
3 | \name{selectStationsAllMonths}
4 | \alias{selectStationsAllMonths}
5 | \title{Select stations loop for all months}
6 | \usage{
7 | selectStationsAllMonths(
8 | organizeResult,
9 | mode = "yearly",
10 | maxMissing = 10,
11 | minYears = 15,
12 | iniYear = NULL,
13 | finYear = NULL,
14 | consistedOnly = FALSE,
15 | folderPathWithNameDescription,
16 | plot = TRUE
17 | )
18 | }
19 | \arguments{
20 | \item{organizeResult}{list, tibble data frame; provides a list containing
21 | the data frames of raw records for each station downloaded from ANA web API
22 | (output from \code{\link[=stationsData]{stationsData()}} function).}
23 |
24 | \item{mode}{character; indicates in which scale to check missing data, 'monthly'
25 | or 'yearly'. The default is 'yearly'.}
26 |
27 | \item{maxMissing}{numeric; indicates the maximum threshold of missing data allowed.
28 | The default is 10 percent.}
29 |
30 | \item{minYears}{numeric; indicates the minimum years of complete data allowed. The
31 | default is 15 years.}
32 |
33 | \item{iniYear}{numeric; filters the time series to begin on this year (inclusive).
34 | If you choose to use water year instead of civil year, e.g., month = 6,
35 | the first observation used is from the date "01-06-\code{iniYear}".
36 | The default is NULL (use entire period).}
37 |
38 | \item{finYear}{numeric; filters the time series to end on this year (inclusive).
39 | If you choose to use water year instead of civil year, e.g., month = 6,
40 | the last observation used is from the date "31-05-\code{finYear}".
41 | The default is NULL (use entire period).}
42 |
43 | \item{consistedOnly}{logical; should only consisted data be considered?
44 | The default is FALSE.}
45 |
46 | \item{folderPathWithNameDescription}{character. folder path and description of selectStations parameters.}
47 |
48 | \item{plot}{logical; plot the figure? The default is TRUE. The figure is saved
49 | regardless.}
50 | }
51 | \value{
52 | 12 Rdata files. Each one contain selectStation result considering inicial hydrological month.
53 | }
54 | \description{
55 | Execute selectStation function for all months (1:12)
56 | }
57 | \examples{
58 |
59 | \dontrun{
60 | # Fech a inventory of fluviometric stations for the state of Minas Gerais
61 |
62 | inv <- inventory(
63 | states = "MINAS GERAIS",
64 | stationType = "flu",
65 | as_sf = TRUE,
66 | aoi = NULL
67 | )
68 |
69 | # Download the first 10 stations from the inventory
70 |
71 | s_data <- stationsData(
72 | inventoryResult = inv[1:10,],
73 | deleteNAstations = TRUE
74 | )
75 |
76 | # Organize the data for the stations
77 |
78 | org_data <- organize(stationsDataResult = s_data)
79 |
80 | # Filter the data for desired period and quality contorl
81 |
82 | selectStationsAllMonths(
83 | organizeResult = org_data,
84 | mode = "yearly",
85 | maxMissing = 10,
86 | minYears = 15,
87 | iniYear = NULL,
88 | finYear = NULL,
89 | consistedOnly = FALSE,
90 | folderPathWithNameDescription = "./loop/selecStation_15years_5porc",
91 | plot = TRUE
92 | )
93 |
94 | #'
95 | files = list.files("./loop", full.names = TRUE) \%>\% gtools::mixedsort()
96 |
97 | selectStationsMonth1 = readRDS(files[1])
98 |
99 | }
100 | }
101 |
--------------------------------------------------------------------------------
/R/lag1AutoCorrelationAll.R:
--------------------------------------------------------------------------------
1 | #' Lag 1 AutoCorrelation considering all hydrological years months begin
2 | #'
3 | #' @description
4 | #' Same processing done at [hydrobr::lag1AutoCorrelation] but considering all 12 months possible to start hydrological year
5 | #' Function idealized to assistant hydrological year definition.
6 | #'
7 | #' @param selectStationsAllmonthsRDSfolder character. folder path with 12 Rdata files generated with [hydrobr::selectStationsAllMonths].
8 | #'
9 | #' @param statistics character; indicates statistics.
10 | #' * The supported statistics for streamflow are:
11 | #' (1) mean stream flow (Qmean); (2) minimum of seven-day moving average of daily stream flow (Q7);
12 | #' (3) stream flow associated with a percentage of time (Qperm); (4) maximum stream flow (Qmax);
13 | #' and (5) minimum stream flow (Qmin).
14 | #' * The supported statistics are: (1) total rainfall (Rtotal); (2) maximum rainfall (Rmax);
15 | #' (3) rainy days (Rdays).
16 | #' * The default value is "Qmean".
17 | #'
18 | #' @param permanence numeric; percentage of time if "Qperm" is choose as statistic parameter.
19 | #' The default is 95 percent.
20 | #'
21 | #' @return
22 | #'
23 | #' list with 12 tibble objects. Each tibble contatin autocorrelation for all stations for respective hydrological month begin.
24 | #'
25 | #' @export
26 | #'
27 | #' @examples
28 | #'
29 | #'
30 | #' \dontrun{
31 | #'
32 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais.
33 | #'
34 | #' inv <- inventory(
35 | #' states = "MINAS GERAIS",
36 | #' stationType = "flu",
37 | #' as_sf = TRUE,
38 | #' aoi = NULL
39 | #' )
40 | #'
41 | #' # Download the first 10 stations from the inventory
42 | #'
43 | #' s_data <- stationsData(
44 | #' inventoryResult = inv[1:10,],
45 | #' deleteNAstations = TRUE
46 | #' )
47 | #'
48 | #' # Organize the data for the stations
49 | #'
50 | #' org_data <- organize(
51 | #' stationsDataResult = s_data
52 | #' )
53 | #'
54 | #' # Filter the data for desired period and quality contorl
55 | #'
56 | #' selectStationsAllMonths(
57 | #' organizeResult = org_data,
58 | #' mode = "yearly",
59 | #' maxMissing = 10,
60 | #' minYears = 15,
61 | #' iniYear = NULL,
62 | #' finYear = NULL,
63 | #' consistedOnly = FALSE,
64 | #' folderPathWithNameDescription = "./loop/selecStation_15years_5porc",
65 | #' plot = TRUE
66 | #' )
67 | #'
68 | #' #autocorrelation for Qmean series for all hydrological year month begin
69 | #'
70 | #' autoCorQmld = autocorrelationAll(selectStationsAllmonthsRDSfolder = "./loop", statistics = "Qmean")
71 | #'
72 | #'}
73 | lag1AutocorrelationAll = function(selectStationsAllmonthsRDSfolder,
74 | statistics = "Qmean",
75 | permanence = 95){
76 |
77 |
78 | lista1 = list.files(selectStationsAllmonthsRDSfolder, full.names = T) %>%
79 | gtools::mixedsort()
80 |
81 | listaCor = list()
82 |
83 | for (i in 1:length(lista1)){
84 |
85 | dados = base::readRDS(lista1[i])
86 |
87 | dados1 = dados$series %>%
88 | hydrobr::seriesStatistics(statistics = statistics, permanence = permanence)
89 |
90 | listaCor[[i]] = hydrobr::lag1AutoCorrelation(dados1$series) %>%
91 | dplyr::mutate(month = i) %>%
92 | dplyr::as_tibble()
93 |
94 | print(paste0("starting hydrological year at month ", i))
95 |
96 | }
97 |
98 | return(listaCor)
99 |
100 | }
101 |
102 |
103 |
--------------------------------------------------------------------------------
/man/seriesStatistics.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/seriesStatistics.R
3 | \encoding{UTF-8}
4 | \name{seriesStatistics}
5 | \alias{seriesStatistics}
6 | \title{Compute streamflow or rainfall statistics by month or year}
7 | \usage{
8 | seriesStatistics(
9 | selectStationsResultSeries,
10 | statistics = "Qmean",
11 | permanence = 95,
12 | rainyDays = 1,
13 | byMonth = FALSE
14 | )
15 | }
16 | \arguments{
17 | \item{selectStationsResultSeries}{list, tibble data frame; provides a list containing
18 | the data frames of filtered records for each station
19 | (series output from \code{\link[=selectStations]{selectStations()}} function).}
20 |
21 | \item{statistics}{character; indicates statistics.
22 | \itemize{
23 | \item The supported statistics for streamflow are:
24 | (1) mean stream flow (Qmean); (2) minimum of seven-day moving average of daily stream flow (Q7);
25 | (3) stream flow associated with a percentage of time (Qperm); (4) maximum stream flow (Qmax);
26 | and (5) minimum stream flow (Qmin).
27 | \item The supported statistics are: (1) total rainfall (Rtotal); (2) maximum rainfall (Rmax);
28 | (3) rainy days (Rdays).
29 | \item The default value is "Qmean".
30 | }}
31 |
32 | \item{permanence}{numeric; percentage of time if "Qperm" is choose as statistic parameter
33 | The default is 95 percent.}
34 |
35 | \item{rainyDays}{numeric; number of day to be consider if "Rmax" is choose as statistic parameters.
36 | For example, if rainyDays = 2, seriesStatistics will compute max value considering 2 day of raining for each wateryear (or monthWaterYear).
37 | Default is 1 day.}
38 |
39 | \item{byMonth}{logical; if byMounth = TRUE, seriesStatistics is performed for by month. default = FALSE.}
40 | }
41 | \value{
42 | A list containing 3 objects:
43 | \itemize{
44 | \item a list containing statistic a data frame \code{\link[tibble:tibble]{tibble::tibble()}} object for each station.
45 | \item a data frame \code{\link[tibble:tibble]{tibble::tibble()}} with statistic of all stations in wide format
46 | \item a data frame \code{\link[tibble:tibble]{tibble::tibble()}} with statistic of all stations in longer format
47 | }
48 | }
49 | \description{
50 | Takes as input a list containing data frames of organized and filtered records
51 | for each station (output from \code{\link[=selectStations]{selectStations()}}) and compute streamflow or rainfall
52 | statistics by month or year.
53 | }
54 | \examples{
55 | \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
56 | # Fech a inventory of fluviometric stations for the state of Minas Gerais
57 |
58 | inv <- inventory(
59 | states = "MINAS GERAIS",
60 | stationType = "flu",
61 | as_sf = TRUE,
62 | aoi = NULL
63 | )
64 |
65 | # Download the first 10 stations from the inventory
66 |
67 | s_data <- stationsData(
68 | inventoryResult = inv[1:10,],
69 | deleteNAstations = TRUE
70 | )
71 |
72 | # Organize the data for the stations
73 |
74 | org_data <- organize(
75 | stationsDataResult = s_data
76 | )
77 |
78 | # Filter the data for desired period and quality contorl
79 |
80 | final_data <- selectStations(
81 | stationsDataResult = org_data,
82 | mode = "yearly",
83 | maxMissing = 10,
84 | minYears = 15,
85 | month = 1,
86 | iniYear = NULL,
87 | finYear = NULL,
88 | consistedOnly = FALSE,
89 | plot = TRUE
90 | )
91 |
92 | # annual mean stream flow serie for each station
93 | Qmean_years = seriesStatistics(final_data$series, statistics = "Qmean")
94 | \dontshow{\}) # examplesIf}
95 | }
96 |
--------------------------------------------------------------------------------
/R/mMonthlyStat.R:
--------------------------------------------------------------------------------
1 | #' Mean and Median Monthly Statistics
2 | #'
3 | #'@description Evaluate Mean and Median monthly statistics based [hydrobr::selectStations] function series result
4 |
5 | #'
6 | #' @param selectionResultSeries list of tibble; lista de tibbles obtidos com a função [hydrobr::selectStations] contendo a série de dados diários.
7 | #'
8 | #' @return dataframe contendo o início do mês úmido e seco.
9 | #'
10 | #' @details Computa estatística mensal (média ou mediana) nos meses do ano e, posteriormente, e realiza uma média movel de 6 meses para identificar período seco e úmido no ano.
11 | #'
12 | #' @examplesIf interactive()
13 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
14 | #'
15 | #' inv <- inventory(
16 | #' states = "MINAS GERAIS",
17 | #' stationType = "flu",
18 | #' as_sf = TRUE,
19 | #' aoi = NULL
20 | #' )
21 | #'
22 | #' # Download the first 10 stations from the inventory
23 | #'
24 | #' s_data <- stationsData(
25 | #' inventoryResult = inv[1:10,],
26 | #' deleteNAstations = TRUE
27 | #' )
28 | #'
29 | #' # Organize the data for the stations
30 | #'
31 | #' org_data <- organize(stationsDataResult = s_data)
32 | #'
33 | #' # Filter the data for desired period and quality contorl
34 | #'
35 | #' final_data <- selectStations(
36 | #' organizeResult = org_data,
37 | #' mode = "yearly",
38 | #' maxMissing = 10,
39 | #' minYears = 15,
40 | #' month = 1,
41 | #' iniYear = NULL,
42 | #' finYear = NULL,
43 | #' consistedOnly = FALSE,
44 | #' plot = TRUE
45 | #' )
46 | #'
47 | #'mStats = mMonthlyStat(final_data)
48 | #'
49 | #'
50 | #' @export
51 |
52 |
53 |
54 | mMonthlyStat = function(selectionResultSeries){
55 |
56 | stopifnot(
57 | "`selectionsResultSerie` parameter must be a list of tibble resulted from `selectStation` function" = is.list(selectionResultSeries),
58 | "`selectionsResultSerie` parameter must be a list of tibble resulted from `selectStation` function" = identical(names(selectionResultSeries[[1]]), c(
59 | "station_code", "consistency_level", "date", "stream_flow_m3_s",
60 | "civilYear", "monthCivilYear", "waterYear", "monthWaterYear",
61 | "maxMissing"
62 | )) | identical(names(selectionResultSeries[[1]]), c(
63 | "station_code", "consistency_level", "date", "rainfall_mm",
64 | "civilYear", "monthCivilYear", "waterYear", "monthWaterYear",
65 | "maxMissing"
66 | ))
67 | )
68 |
69 | MonthlyMR = lapply(selectionResultSeries, FUN = function(y) y %>%
70 | dplyr::ungroup() %>%
71 | dplyr::mutate(month = lubridate::month(monthCivilYear)) %>%
72 | dplyr::group_by_at(c("station_code", "month")) %>%
73 | dplyr::summarise(monthlyMean = base::mean(stream_flow_m3_s,
74 | na.rm = TRUE),
75 | monthlyMedian = stats::median(stream_flow_m3_s,
76 | na.rm = TRUE)) %>%
77 | dplyr::ungroup() %>%
78 | base::suppressMessages()) %>%
79 | stats::setNames(names(selectionResultSeries))
80 |
81 | return(MonthlyMR)
82 | }
83 |
84 | if(getRversion() >= "2.15.1") utils::globalVariables(c("monthCivilYear",
85 | 'selectionResultSeries',
86 | 'MonthlyM',
87 | 'medianRoll6Mean',
88 | 'meanRoll6Mean'))
89 |
--------------------------------------------------------------------------------
/man/historicalStatistics.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/historicalStatistics.R
3 | \encoding{UTF-8}
4 | \name{historicalStatistics}
5 | \alias{historicalStatistics}
6 | \title{Compute flow statistics by month or year}
7 | \usage{
8 | historicalStatistics(
9 | selectStationsResultSeries,
10 | statistics = "Qmean",
11 | basedOn = "waterYear",
12 | permanence = 95,
13 | pReturn = 10
14 | )
15 | }
16 | \arguments{
17 | \item{selectStationsResultSeries}{list, tibble data frame; provides a list containing
18 | the data frames of filtered records for each station
19 | (series output from \code{\link[=selectStations]{selectStations()}} function).}
20 |
21 | \item{statistics}{character; indicates statistics.
22 | \itemize{
23 | \item The supported statistics for streamflow are:
24 | (1) mean stream flow (Qmean);
25 | (2) minimum of seven-day moving average of daily stream flow associated with return period (Q7T);
26 | (3) stream flow associated with a percentage of time (Qperm);
27 | (4) maximum stream flow (Qmax);
28 | (5) minimum stream flow (Qmin).
29 | \item The supported statistics are:
30 | (1) total rainfall (Rtotal);
31 | (2) maximum rainfall (Rmax);
32 | (3) rainy days (Rdays).
33 | \item The default value is "Qmean".
34 | }}
35 |
36 | \item{basedOn}{character; indicate if statistics must evaluated considering year ("wateryear") or month ("monthwateryear"). Default is "wateryear".}
37 |
38 | \item{permanence}{numeric; percentage of time if "Qperm" is choose as statistic parameter.
39 | The default is 95 percent.}
40 |
41 | \item{pReturn}{numeric; return period if "Q7T" is choose as statistic parameter.
42 | The default is 10 year.}
43 | }
44 | \value{
45 | A list containing 3 objects:
46 | \itemize{
47 | \item a list containing statistic a data frame \code{\link[tibble:tibble]{tibble::tibble()}} object for each station.
48 | \item a data frame \code{\link[tibble:tibble]{tibble::tibble()}} with statistic of all stations in wide format.
49 | \item a data frame \code{\link[tibble:tibble]{tibble::tibble()}} with statistic of all stations in longer format.
50 | }
51 | }
52 | \description{
53 | Takes as input a list containing data frames of organized and filtered records
54 | for each station (output from \code{\link[=selectStations]{selectStations()}}) and compute historical
55 | streamflow or rainfall statistics
56 | }
57 | \details{
58 | Q7T is evaluated based on empirical distribution using Kimbal method.
59 | }
60 | \examples{
61 | \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
62 | # Fech a inventory of fluviometric stations for the state of Minas Gerais.
63 |
64 | inv <- inventory(
65 | states = "MINAS GERAIS",
66 | stationType = "flu",
67 | as_sf = TRUE,
68 | aoi = NULL
69 | )
70 |
71 | # Download the first 10 stations from the inventory
72 |
73 | s_data <- stationsData(
74 | inventoryResult = inv[1:10,],
75 | deleteNAstations = TRUE
76 | )
77 |
78 | # Organize the data for the stations
79 |
80 | org_data <- organize(
81 | stationsDataResult = s_data
82 | )
83 |
84 | # Filter the data for desired period and quality contorl
85 |
86 | final_data <- selectStations(
87 | stationsDataResult = org_data,
88 | mode = "yearly",
89 | maxMissing = 10,
90 | minYears = 15,
91 | month = 1,
92 | iniYear = NULL,
93 | finYear = NULL,
94 | consistedOnly = FALSE,
95 | plot = TRUE
96 | )
97 |
98 | # annual mean stream flow serie for each station
99 | Qmean_years = historicalStatistics(final_data$series, statistics = "Qmean")
100 | \dontshow{\}) # examplesIf}
101 | }
102 |
--------------------------------------------------------------------------------
/R/lag1AutoCorrelation.R:
--------------------------------------------------------------------------------
1 | #' Lag 1 AutoCorrelation
2 | #'
3 | #' @description
4 | #' Evaluate serial correlation (or autocorrelation) with 1 lag.
5 | #'
6 | #'
7 | #'
8 | #' @param seriesStatisticsResultSeries list of tibbles containing annual or monthly series of all stations;
9 | #' (series output from [hydrobr::seriesStatistics()] function).
10 | #'
11 | #' @return
12 | #' tibble with autocorrelation based on lag1 (CorrelationLag1 column), absolute confidente interval and logical column indicating if station series is autocorrelated
13 | #'
14 | #'
15 | #' @references
16 | #' Based on acf function
17 | #' (https://www.rdocumentation.org/packages/forecast/versions/8.21.1/topics/Acf)
18 | #'
19 | #' Fundamentals of Statistical Hydrology
20 | #' (https://link.springer.com/book/10.1007/978-3-319-43561-9)
21 | #'
22 | #' The Mann-Kendall Test Modified by Effective Sample Size to Detect Trend in Serially Correlated Hydrological Series
23 | #' (https://link.springer.com/article/10.1023/B:WARM.0000043140.61082.60)
24 | #'
25 | #'
26 | #' @export
27 | #'
28 | #'
29 | #'
30 | #' @examples
31 | #'
32 | #' \dontrun{
33 | #'
34 | #'
35 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
36 | #'
37 | #' inv <- inventory(
38 | #' states = "MINAS GERAIS",
39 | #' stationType = "flu",
40 | #' as_sf = TRUE,
41 | #' aoi = NULL)
42 | #'
43 | #' # Download the first 10 stations from the inventory
44 | #'
45 | #' s_data <- stationsData(
46 | #' inventoryResult = inv[1:10,],
47 | #' deleteNAstations = TRUE)
48 | #'
49 | #' # Organize the data for the stations
50 | #'
51 | #' org_data <- organize(
52 | #' stationsDataResult = s_data
53 | #' )
54 | #'
55 | #' # Filter the data for desired period and quality contorl
56 | #'
57 | #' final_data <- selectStations(
58 | #' stationsDataResult = org_data,
59 | #' mode = "yearly",
60 | #' maxMissing = 10,
61 | #' minYears = 15,
62 | #' month = 1,
63 | #' iniYear = NULL,
64 | #' finYear = NULL,
65 | #' consistedOnly = FALSE,
66 | #' plot = TRUE
67 | #' )
68 | #'
69 | #' # Annual mean stream flow serie for each station
70 | #' Qmean_years = seriesStatistics(final_data, statistics = "Qmean")
71 | #'
72 | #'
73 | #' #lag1Autocorrelation
74 | #'
75 | #' autoCorr = lag1AutoCorrelation(Qmean_years$series)
76 | #'
77 | #' }
78 | #'
79 | #'
80 | #'
81 | #'
82 | lag1AutoCorrelation = function(seriesStatisticsResultSeries){
83 |
84 | funcao = function(y){
85 |
86 | dados2 = y %>%
87 | dplyr::pull(3) %>%
88 | stats::acf(plot = F)
89 |
90 | intervalConf = stats::qnorm((1 + 0.95)/2)/sqrt(dados2$n.used)
91 |
92 | p = data.frame(CorrelationLag1 = dados2$acf %>%
93 | as.data.frame() %>%
94 | dplyr::slice(2),
95 | confidenceInterval = intervalConf) %>%
96 | stats::setNames(c("CorrelationLag1", "confidenceInterval")) %>%
97 | dplyr::mutate(autocorrelated =dplyr:: if_else(abs(CorrelationLag1)
%
107 | dplyr::bind_rows() %>%
108 | dplyr::mutate(station_code = seriesStatisticsResultSeries %>%
109 | dplyr::bind_rows() %>%
110 | {base::unique(.$station_code)}) %>%
111 | dplyr::select(4,dplyr::everything()) %>%
112 | dplyr::as_tibble()
113 |
114 | return(t)
115 |
116 | }
117 |
118 | if(getRversion() >= "2.15.1") utils::globalVariables(c("consistency_level",
119 | "CorrelationLag1",
120 | "confidenceInterval"))
121 |
122 |
123 |
--------------------------------------------------------------------------------
/R/exportStationsData.R:
--------------------------------------------------------------------------------
1 | #' Export Stations Data
2 | #'
3 | #'@description Export station data from [hydrobr::stationsData], [hydrobr::organize], [hydrobr::selectStations]
4 |
5 | #'
6 | #' @param stationsTimeSerieList list of tibble; lista de tibbles contendo série de dados temporal de cada estação.
7 | #' Aceita resultado das funções [hydrobr::stationsData], [hydrobr::organize], [hydrobr::selectStations]. Para função [hydrobr::selectStations],
8 | #' utlizar elemento da lista contendo série de dados temporais.
9 | #'
10 | #'@param directory character; diretório para o qual tabelas .xlsx de cada estação serão exportadas.
11 | #'
12 | #' @return dataframe contendo o início do mês úmido e seco.
13 | #'
14 | #' @details Exporta uma tabela .xlsx para cada estação na série
15 | #'
16 | #' @export
17 | #'
18 | #' @import openxlsx
19 |
20 |
21 |
22 |
23 |
24 | exportStationsData = function(stationsTimeSerieList, directory){
25 |
26 |
27 | namesStationDataFlu <- c(
28 | "estacaocodigo", "nivelconsistencia", "data", "mediadiaria", "metodoobtencaovazoes", "maxima",
29 | "minima", "media", "diamaxima", "diaminima", "maximastatus", "minimastatus", "mediastatus", "mediaanual",
30 | "mediaanualstatus", "vazao01", "vazao02", "vazao03", "vazao04", "vazao05", "vazao06", "vazao07", "vazao08",
31 | "vazao09", "vazao10", "vazao11", "vazao12", "vazao13", "vazao14", "vazao15", "vazao16", "vazao17", "vazao18",
32 | "vazao19", "vazao20", "vazao21", "vazao22", "vazao23", "vazao24", "vazao25", "vazao26", "vazao27", "vazao28", "vazao29",
33 | "vazao30", "vazao31", "vazao01status", "vazao02status", "vazao03status", "vazao04status", "vazao05status", "vazao06status",
34 | "vazao07status", "vazao08status", "vazao09status", "vazao10status", "vazao11status", "vazao12status", "vazao13status",
35 | "vazao14status", "vazao15status", "vazao16status", "vazao17status", "vazao18status", "vazao19status", "vazao20status",
36 | "vazao21status", "vazao22status", "vazao23status", "vazao24status", "vazao25status", "vazao26status", "vazao27status",
37 | "vazao28status", "vazao29status", "vazao30status", "vazao31status", "datains"
38 | )
39 |
40 | namesOrganizeFlu = c("station_code","consistency_level","date","streamflow_m3_s")
41 | namesOrganizePlu = c("station_code","consistency_level","date","rainfall_mm")
42 |
43 | namesSelectStationPlu= c("station_code", "consistency_level", "date", "rainfall_mm",
44 | "civilYear", "monthCivilYear", "waterYear", "monthWaterYear","maxMissing"
45 | )
46 |
47 | namesSelectStationFlu=c(
48 | "station_code", "consistency_level", "date", "stream_flow_m3_s",
49 | "civilYear", "monthCivilYear", "waterYear", "monthWaterYear",
50 | "maxMissing"
51 | )
52 |
53 |
54 | stopifnot(
55 | "`stationsTimeSerieList` parameter must be a list of tibble resulted from `stationsData`, `selectStation`, `organize` function" = is.list(stationsTimeSerieList),
56 | "`selectionsResultSerie` parameter must be a list of tibble resulted from `selectStation` function" =
57 | identical(names(stationsTimeSerieList[[1]]), namesStationDataFlu) |
58 | identical(names(stationsTimeSerieList[[1]]), namesOrganizePlu) |
59 | identical(names(stationsTimeSerieList[[1]]), namesOrganizeFlu) |
60 | identical(names(stationsTimeSerieList[[1]]), namesSelectStationPlu) |
61 | identical(names(stationsTimeSerieList[[1]]), namesSelectStationFlu),
62 | "directroy must be a filepath in which stationData will be exported to (i.e., `./stationDataXLSX`)" = is.character(directory)
63 | )
64 |
65 |
66 | if (dir.exists(directory) == FALSE){
67 | dir.create(directory, recursive = TRUE)
68 | }
69 |
70 | a = lapply(1:length(stationsTimeSerieList), FUN = function(i)
71 | openxlsx::write.xlsx(stationsTimeSerieList[[i]],
72 | paste0(directory,
73 | "/",
74 | names(stationsTimeSerieList[i]),
75 | ".xlsx"))
76 | ) %>%
77 | suppressMessages() %>%
78 | suppressWarnings()
79 |
80 | }
81 |
82 |
--------------------------------------------------------------------------------
/man/selectStations.Rd:
--------------------------------------------------------------------------------
1 | % Generated by roxygen2: do not edit by hand
2 | % Please edit documentation in R/selectStations.R
3 | \encoding{UTF-8}
4 | \name{selectStations}
5 | \alias{selectStations}
6 | \title{Summarizes and filter the stations (organized) data by month or year}
7 | \usage{
8 | selectStations(
9 | organizeResult,
10 | mode = "yearly",
11 | maxMissing = 10,
12 | minYears = 15,
13 | month = 1,
14 | iniYear = NULL,
15 | finYear = NULL,
16 | consistedOnly = FALSE,
17 | plot = TRUE
18 | )
19 | }
20 | \arguments{
21 | \item{organizeResult}{list, tibble data frame; provides a list containing
22 | the data frames of raw records for each station downloaded from ANA web API
23 | (output from \code{\link[=stationsData]{stationsData()}} function).}
24 |
25 | \item{mode}{character; indicates in which scale to check missing data, 'monthly'
26 | or 'yearly'. The default is 'yearly'.}
27 |
28 | \item{maxMissing}{numeric; indicates the maximum threshold of missing data allowed.
29 | The default is 10 percent.}
30 |
31 | \item{minYears}{numeric; indicates the minimum years of complete data allowed. The
32 | default is 15 years.}
33 |
34 | \item{month}{numeric; indicates the month when the water year begins. The default is
35 | 1 (use civil year).}
36 |
37 | \item{iniYear}{numeric; filters the time series to begin on this year (inclusive).
38 | If you choose to use water year instead of civil year, e.g., month = 6,
39 | the first observation used is from the date "01-06-\code{iniYear}".
40 | The default is NULL (use entire period).}
41 |
42 | \item{finYear}{numeric; filters the time series to end on this year (inclusive).
43 | If you choose to use water year instead of civil year, e.g., month = 6,
44 | the last observation used is from the date "31-05-\code{finYear}".
45 | The default is NULL (use entire period).}
46 |
47 | \item{consistedOnly}{logical; should only consisted data be considered?
48 | The default is FALSE.}
49 |
50 | \item{plot}{logical; plot the figure? The default is TRUE. The figure is saved
51 | regardless.}
52 | }
53 | \value{
54 | A list containing 4 objects:
55 | \itemize{
56 | \item a list containing the data frames \code{\link[tibble:tibble]{tibble::tibble()}} for each station after
57 | removing periods exceeding \code{maxMissing} and filtering out stations which
58 | observational period is shorter than \code{minYears}.
59 | \item a failureMatrix indicating if the period exceeds the threshold of \code{maxMissing}
60 | data and columns only for stations with at least \code{minYears} of complete
61 | observational data
62 | \item a missingMatrix indicating the percentage of missing data and columns only
63 | for stations with at least \code{minYears} of complete observational data
64 | \item the saved plot.
65 | }
66 | }
67 | \description{
68 | Takes as input a list containing data frames of organized records
69 | for each station (output from \code{\link[=organize]{organize()}}) and (i) filters the time
70 | series within a range of years, (ii) filters out months or years exceeding
71 | the maximum threshold of missing data, and (iii) filters out stations
72 | with less than a minimum years of complete observations.
73 | }
74 | \examples{
75 | \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
76 | # Fech a inventory of fluviometric stations for the state of Minas Gerais
77 |
78 | inv <- inventory(
79 | states = "MINAS GERAIS",
80 | stationType = "flu",
81 | as_sf = TRUE,
82 | aoi = NULL
83 | )
84 |
85 | # Download the first 10 stations from the inventory
86 |
87 | s_data <- stationsData(
88 | inventoryResult = inv[1:10,],
89 | deleteNAstations = TRUE
90 | )
91 |
92 | # Organize the data for the stations
93 |
94 | org_data <- organize(stationsDataResult = s_data)
95 |
96 | # Filter the data for desired period and quality contorl
97 |
98 | final_data <- selectStations(
99 | organizeResult = org_data,
100 | mode = "yearly",
101 | maxMissing = 10,
102 | minYears = 15,
103 | month = 1,
104 | iniYear = NULL,
105 | finYear = NULL,
106 | consistedOnly = FALSE,
107 | plot = TRUE
108 | )
109 | \dontshow{\}) # examplesIf}
110 | }
111 |
--------------------------------------------------------------------------------
/R/selectStationsAllMonths.R:
--------------------------------------------------------------------------------
1 | #' Select stations loop for all months
2 | #'
3 | #' @description
4 | #' Execute selectStation function for all months (1:12)
5 | #'
6 | #'
7 | #'@param organizeResult list, tibble data frame; provides a list containing
8 | #' the data frames of raw records for each station downloaded from ANA web API
9 | #' (output from [hydrobr::stationsData()] function).
10 | #' @param mode character; indicates in which scale to check missing data, 'monthly'
11 | #' or 'yearly'. The default is 'yearly'.
12 | #' @param maxMissing numeric; indicates the maximum threshold of missing data allowed.
13 | #' The default is 10 percent.
14 | #' @param minYears numeric; indicates the minimum years of complete data allowed. The
15 | #' default is 15 years.
16 | #' @param iniYear numeric; filters the time series to begin on this year (inclusive).
17 | #' If you choose to use water year instead of civil year, e.g., month = 6,
18 | #' the first observation used is from the date "01-06-`iniYear`".
19 | #' The default is NULL (use entire period).
20 | #' @param finYear numeric; filters the time series to end on this year (inclusive).
21 | #' If you choose to use water year instead of civil year, e.g., month = 6,
22 | #' the last observation used is from the date "31-05-`finYear`".
23 | #' The default is NULL (use entire period).
24 | #' @param consistedOnly logical; should only consisted data be considered?
25 | #' The default is FALSE.
26 | #' @param folderPathWithNameDescription character. folder path and description of selectStations parameters.
27 | #' @param plot logical; plot the figure? The default is TRUE. The figure is saved
28 | #' regardless.
29 | #'
30 | #' @return
31 | #' 12 Rdata files. Each one contain selectStation result considering inicial hydrological month.
32 | #'
33 | #' @export
34 | #'
35 | #' @importFrom gtools mixedsort
36 | #'
37 | #' @examples
38 | #'
39 | #' \dontrun{
40 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
41 | #'
42 | #' inv <- inventory(
43 | #' states = "MINAS GERAIS",
44 | #' stationType = "flu",
45 | #' as_sf = TRUE,
46 | #' aoi = NULL
47 | #' )
48 | #'
49 | #' # Download the first 10 stations from the inventory
50 | #'
51 | #' s_data <- stationsData(
52 | #' inventoryResult = inv[1:10,],
53 | #' deleteNAstations = TRUE
54 | #' )
55 | #'
56 | #' # Organize the data for the stations
57 | #'
58 | #' org_data <- organize(stationsDataResult = s_data)
59 | #'
60 | #' # Filter the data for desired period and quality contorl
61 | #'
62 | #' selectStationsAllMonths(
63 | #' organizeResult = org_data,
64 | #' mode = "yearly",
65 | #' maxMissing = 10,
66 | #' minYears = 15,
67 | #' iniYear = NULL,
68 | #' finYear = NULL,
69 | #' consistedOnly = FALSE,
70 | #' folderPathWithNameDescription = "./loop/selecStation_15years_5porc",
71 | #' plot = TRUE
72 | #' )
73 | #'
74 | #'#'
75 | #' files = list.files("./loop", full.names = TRUE) %>% gtools::mixedsort()
76 | #'
77 | #' selectStationsMonth1 = readRDS(files[1])
78 | #'
79 | #'}
80 |
81 |
82 |
83 | selectStationsAllMonths = function(organizeResult,
84 | mode = "yearly",
85 | maxMissing = 10,
86 | minYears = 15,
87 | iniYear = NULL,
88 | finYear = NULL,
89 | consistedOnly = FALSE,
90 | folderPathWithNameDescription,
91 | plot = TRUE){
92 |
93 | dir.create(folderPathWithNameDescription, recursive = T, showWarnings = F)
94 |
95 | for (i in 1:12){
96 |
97 | estSelec1 = hydrobr::selectStations(organizeResult = organizeResult,
98 | maxMissing = maxMissing,
99 | month = i,
100 | mode = "yearly",
101 | minYears = minYears,
102 | iniYear = iniYear,
103 | finYear = finYear,
104 | consistedOnly = consistedOnly,
105 | plot = plot
106 | )
107 |
108 | saveRDS(estSelec1, file = paste0(folderPathWithNameDescription, "_month", i,".Rdata"))
109 |
110 | print(paste0("month ", i, " Done"))
111 |
112 | }
113 |
114 |
115 |
116 | }
117 |
--------------------------------------------------------------------------------
/R/terraClimateExtOrg.R:
--------------------------------------------------------------------------------
1 | #' Extract and organize terraClimate data
2 | #'
3 | #' @description
4 | #' Extract TerraClimate spatial data based on a polygon and organize it into a time series which can be used at [hydrobr::selectStations()]
5 | #'
6 | #' @param terraClimateRast rast object contain result from downloadterra
7 | #' @param aoi object of class \code{sf} or \code{terra} (polygon); Provides the boundaries
8 | #' where extraction should be done.
9 | #' @param fun character; function which should be use on extraction. Available functions are:
10 | #' min, max, sum, mean, median, mode, majority, minority.
11 | #' @param colname chracter; colname of aoi which should be used for display results.
12 | #'
13 | #' @return A list containing an organized data frame [tibble::tibble()] object
14 | #' for each station. The data frames will contain the following columns:
15 | #' station_code: station unique identifier (chr).
16 | #' consistency_level: data consistency level (1 = raw, 2 = consisted) (chr).
17 | #' date: date format YYYY-MM-DD (Date).
18 | #' rainfall_mm/streamflow_m3_s: rain/streamflow gauge measurement (dbl).
19 | #'
20 | #' @export
21 | #'
22 | #' @examples
23 | #'
24 | #' \dontrun{
25 | #'
26 | #'es = geobr::read_municipality(code_muni = "ES")
27 | #'
28 | #'terraClimate = downloadTerraClimate("./temp3",
29 | #' variable = "ppt",
30 | #' years = c(2019:2021),
31 | #' aoi = es)
32 | #'
33 | #'ppt_es = terraClimateExtOrg(terraClimateRast = terraClimate,
34 | #' aoi = es,
35 | #' fun = "mean",
36 | #' colname = "name_muni")
37 | #'
38 | #'
39 | #'}
40 |
41 |
42 | terraClimateExtOrg = function(terraClimateRast, aoi, fun, colname){
43 |
44 | # Verificações iniciais
45 | stopifnot(
46 | "`terraClimateRast` must be a raster of class `rast` (terra package)" = "SpatRaster" %in% class(terraClimateRast),
47 | "`aoi` must be a polygon of class `sf` (sf package) or `SpatVector` (terra package)" = sum(class(aoi) %in% c("sf", "SpatVector"))==1,
48 | "`fun` must be a character indicating function to be use in zonal statistics" = is.character(fun),
49 | "`fun` must be a character indicating function to be use in zonal statistics" = fun %in% c("min", "max", "sum", "mean", "median", "mode", "majority", "minority"),
50 | "`colname` must be a character indicating column of `aoi` to summarise zonal statistics" = colname %in% names(aoi)
51 |
52 | )
53 |
54 | #if aoi is SpatVector convert to sf
55 |
56 | if(unique(class(aoi)%in%"SpatVector")==TRUE){
57 |
58 | aoi = aoi %>%
59 | sf::st_as_sf(aoi)
60 |
61 | }
62 |
63 | #convert aoi to wgs84
64 | aoi = aoi %>%
65 | sf::st_transform(crs = 4326)
66 |
67 |
68 | #variaveis e unidades
69 | variaveis = data.frame(variavel_real = c("aet", "def", "pet", "ppt", "q", "soil", "srad", "swe", "tmax", "tmin", "vap", "ws", "vpd", "PDSI"),
70 | unidade = c("_mm", "_mm", "_mm", "_mm", "_mm", "_mm", "_w_m2", "_mm", "_c", "_c", "_kpa", "_m_s", "kpa", "adimensional"))
71 |
72 | #variavel do dado de entrada
73 | variable = substr(names(terraClimateRast)[1],1,nchar(names(terraClimateRast)[1])-11)
74 |
75 | #variavel e unidade do dado de entrada
76 | variavel_unidade = variaveis %>%
77 | dplyr::filter(variavel_real == variable) %>%
78 | dplyr::mutate(nome = paste0(variavel_real, unidade)) %>%
79 | dplyr::pull(nome)
80 |
81 | #extracao
82 | zonal = exactextractr::exact_extract(terraClimateRast,
83 | aoi,
84 | fun = fun,
85 | append_cols = colname)
86 |
87 | #organizacao dos dados em série temporal
88 | lista = zonal %>%
89 | tidyr::pivot_longer(cols = 2:ncol(.)) %>%
90 | dplyr::mutate(name = substr(.$name, nchar(.$name)-9,nchar(.$name)),
91 | data = as.Date(name),
92 | month = lubridate::month(data),
93 | consistency_level = 2,
94 | !!variavel_unidade := value) %>%
95 | dplyr::select(station_code = dplyr::any_of(colname),
96 | consistency_level,
97 | date = data,
98 | dplyr::contains(variavel_unidade)) %>%
99 | split(.$station_code)
100 |
101 |
102 | return(lista)
103 |
104 |
105 | }
106 |
107 |
108 | if(getRversion() >= "2.15.1") utils::globalVariables(c("variable",
109 | "variavel_real",
110 | "unidade",
111 | "nome",
112 | "name",
113 | "data",
114 | "value"))
115 |
--------------------------------------------------------------------------------
/R/downloadTerraClimate.R:
--------------------------------------------------------------------------------
1 | #' Download terraClimate monthly data
2 | #'
3 | #' @description
4 | #' Download TerraClimate monthly data based on area of interest
5 | #'
6 | #'
7 | #' @param dir_out character. Directory where you want to save the raster images that you are going to download.
8 | #' @param variable character. Variable to download. See details for more information
9 | #' @param years numeric. The period in years that the function should download images.
10 | #' @param aoi spatVector or sf object. Provides the boundaries where terraClimate data should be limited to.
11 |
12 | #' @details
13 | #'
14 | #' - Variable descriptions:
15 | #'
16 | #' aet (Actual Evapotranspiration, monthly total), units = mm
17 | #'
18 | #' def (Climate Water Deficit, monthly total), units = mm
19 | #'
20 | #' pet (Potential evapotranspiration, monthly total), units = mm
21 | #'
22 | #' ppt (Precipitation, monthly total), units = mm
23 | #'
24 | #' q (Runoff, monthly total), units = mm
25 | #'
26 | #' soil (Soil Moisture, total column - at end of month), units = mm
27 | #'
28 | #' srad (Downward surface shortwave radiation), units = W/m2
29 | #'
30 | #' swe (Snow water equivalent - at end of month), units = mm
31 | #'
32 | #' tmax (Max Temperature, average for month), units = C
33 | #'
34 | #' tmin (Min Temperature, average for month), units = C
35 | #'
36 | #' vap (Vapor pressure, average for month), units = kPa
37 | #'
38 | #' ws (Wind speed, average for month), units = m/s
39 | #'
40 | #' vpd (Vapor Pressure Deficit, average for month), units = kpa
41 | #'
42 | #' PDSI (Palmer Drought Severity Index, at end of month), units = unitless
43 | #'
44 | #' @returns raster files of each year containing 12 layers each (1 for each month of given year).
45 | #'
46 | #' @references adapted from download_terraclimate function of cropDemand package.
47 | #'
48 | #' https://search.r-project.org/CRAN/refmans/cropDemand/html/00Index.html
49 | #'
50 | #' Abatzoglou, J.T., S.Z. Dobrowski, S.A. Parks, K.C. Hegewisch, 2018, Terraclimate, a high-resolution global dataset of monthly climate and climatic water balance from 1958-2015, Scientific Data,
51 | #'
52 | #' @export
53 | #' @examples
54 | #'
55 | #'\dontrun{
56 | #'
57 | #'require(terra)
58 | #'
59 | #'area_of_interest = vect("./paracatu.shp")
60 | #'
61 | #'
62 | #'downloadTerraClimate(dir_out = "./temp/terraClimate",
63 | #' variable = "ppt",
64 | #' years = c(1990:2000),
65 | #' aoi = area_of_interest)
66 | #'
67 | #'}
68 | #'
69 | #'
70 | #'
71 |
72 |
73 | downloadTerraClimate = function (dir_out, variable, years, aoi) {
74 |
75 | stopifnot(
76 | "`dir_out` parameter must be character indicating output folder path (i.e `c:/temp`)" = is.character(dir_out),
77 | "`variable` must be 'aet`, `def`, `pet`, `ppt`, `q`, `soil`, `srad`, `swe`, `tmax`, `tmin`, `vap`, `ws`, `vpd`or `PSDI` (see function description for information"= variable %in% c("ppt", "aet", "def", "pet", "q", "soil", 'srad', "swe", "tmax", "tmin", "vap", "ws", "vpd", "PDSI"),
78 | "`years` must be numeric vector containing years to be downloaded" = is.numeric(years),
79 | "`aoi` must be a polygon of class `sf` (sf package) or `SpatVector` (terra package)" = sum(class(aoi) %in% c("sf", "SpatVector"))==1)
80 |
81 |
82 | if(sum(class(aoi) %in% "sf")==1){
83 |
84 | aoi = terra::vect(aoi)
85 |
86 | }
87 |
88 |
89 | #create output dir if do not exist
90 |
91 | dir.create(dir_out, recursive = F, showWarnings = FALSE)
92 |
93 | #projet to wgs84 epsg
94 | aoi = terra::project(aoi, y = "epsg:4326")
95 | i = 1
96 | for (i in 1:length(years)) {
97 |
98 | baseurl <- paste0("http://thredds.northwestknowledge.net:8080/thredds/fileServer/TERRACLIMATE_ALL/data/TerraClimate_",
99 | variable, "_", years[i], ".nc")
100 |
101 | name_img <- paste0("TerraClimate_", variable, "_",
102 | years[i], ".nc")
103 |
104 | outfile <- paste0(dir_out, "/", name_img)
105 |
106 | utils::download.file(url = baseurl, method = "libcurl", destfile = outfile,
107 | mode = "wb", quiet = FALSE)
108 |
109 | img <- terra::rast(list.files(dir_out, pattern = name_img,
110 | full.names = T))
111 |
112 | crs <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"
113 |
114 | terra::crs(img) <- crs
115 |
116 | img <- terra::crop(img, aoi)
117 |
118 | img <- terra::mask(img, aoi)
119 |
120 | names(img) = paste0(variable, "_", seq(as.Date(paste0(years[i], "-01-01")), as.Date(paste0(years[i], "-12-01")), by = "month"))
121 |
122 | unlink(outfile)
123 |
124 | terra::writeRaster(img, filename = paste0(dir_out,
125 | "/", paste0(substr(name_img, 1, nchar(name_img)-3), ".tif")),
126 | filetype = "GTiff", overwrite = TRUE)
127 |
128 | print(paste0(years[i], " Done"))
129 |
130 | }
131 |
132 |
133 | unlink(list.files(dir_out, pattern = ".json",
134 | full.names = T))
135 |
136 | list_img <- lapply(list.files(dir_out, pattern = ".tif$",
137 | full.names = T), terra::rast)
138 |
139 | s <- terra::rast(list_img)
140 |
141 | return(s)
142 | }
143 |
144 |
145 | if(getRversion() >= "2.15.1") utils::globalVariables(c("variable"))
146 |
--------------------------------------------------------------------------------
/R/historicalStatisticsSazonal.R:
--------------------------------------------------------------------------------
1 | #' Historical Statistics for sazonal period (underdevelopment. available for streamdflow and annual series)
2 | #'
3 | #' @description
4 | #' Historical series is splitted in two (six months each) and [hydrobr::historicalStatistics] is computed for both period.
5 | #'
6 | #'
7 | #' @param selectStationsResultSeries list, tibble data frame; provides a list containing
8 | #' the data frames of filtered records for each station
9 | #' (series output from [hydrobr::selectStations()] function).
10 | #'
11 | #' @param statistics character; indicates statistics.
12 | #'
13 | #' * The supported statistics for streamflow are:
14 | #' (1) mean stream flow (Qmean);
15 | #' (2) minimum of seven-day moving average of daily stream flow associated with return period (Q7T);
16 | #' (3) stream flow associated with a percentage of time (Qperm);
17 | #' (4) maximum stream flow (Qmax);
18 | #' (5) minimum stream flow (Qmin).
19 | #'
20 | #' * The supported statistics are:
21 | #' (1) total rainfall (Rtotal);
22 | #' (2) maximum rainfall (Rmax);
23 | #' (3) rainy days (Rdays).
24 | #'
25 | #' * The default value is "Qmean".
26 | #'
27 | #' @param pReturn numeric; return period if "Q7T" is choose as statistic parameter.
28 | #' The default is 10 year.
29 | #'
30 | #' @param permanence numeric; percentage of time if "Qperm" is choose as statistic parameter.
31 | #' The default is 95 percent.
32 | #'
33 | #' @return
34 | #'
35 | #' tibble object containing desired statistics for boths period and the ratio (porcentage) between
36 | #' historicalStatistics and sazonal historic statistics
37 | #'
38 | #'
39 | #' @examples
40 | #'
41 | #'
42 | #' \dontrun{
43 | #'
44 | #' #' # Fech a inventory of fluviometric stations for the state of Minas Gerais.
45 | #'
46 | #' inv <- inventory(
47 | #' states = "MINAS GERAIS",
48 | #' stationType = "flu",
49 | #' as_sf = TRUE,
50 | #' aoi = NULL
51 | #' )
52 | #'
53 | #' # Download the first 10 stations from the inventory
54 | #'
55 | #' s_data <- stationsData(
56 | #' inventoryResult = inv[1:10,],
57 | #' deleteNAstations = TRUE
58 | #' )
59 | #'
60 | #' # Organize the data for the stations
61 | #'
62 | #' org_data <- organize(
63 | #' stationsDataResult = s_data
64 | #' )
65 | #'
66 | #' # Filter the data for desired period and quality contorl
67 | #'
68 | #' final_data <- selectStations(
69 | #' stationsDataResult = org_data,
70 | #' mode = "yearly",
71 | #' maxMissing = 10,
72 | #' minYears = 15,
73 | #' month = 1,
74 | #' iniYear = NULL,
75 | #' finYear = NULL,
76 | #' consistedOnly = FALSE,
77 | #' plot = TRUE
78 | #' )
79 | #'
80 | #' # annual mean stream flow serie for each station
81 | #' QmeanS = historicalStatisticsSazonal(final_data$series, statistics = "Qmean")
82 | #'
83 | #'
84 | #'
85 | #'}
86 |
87 | #' @export
88 |
89 | historicalStatisticsSazonal = function(selectStationsResultSeries,
90 | statistics = "Qmean",
91 | permanence = 95,
92 | pReturn = 10
93 | ){
94 |
95 | startMonth = selectStationsResultSeries %>%
96 | dplyr::bind_rows() %>%
97 | dplyr::ungroup() %>%
98 | dplyr::arrange(date) %>%
99 | dplyr::slice(1) %>%
100 | dplyr::pull(date) %>%
101 | lubridate::month()
102 |
103 | d = rep(1:12, 2)
104 |
105 | months = d[startMonth:(startMonth+11)]
106 |
107 | months1 = months[1:6]
108 |
109 | ####################### Calcular vazão de interesse para série Anual
110 |
111 | a = hydrobr::historicalStatistics(selectStationsResultSeries, statistics = statistics, permanence = permanence, pReturn = pReturn)
112 |
113 |
114 | #selecionar 6 primeiros meses e computar vazao de permanencia
115 |
116 | b = selectStationsResultSeries %>%
117 | dplyr::bind_rows() %>%
118 | dplyr::mutate(month = lubridate::month(date)) %>%
119 | dplyr::filter(month %in% months1) %>%
120 | list() %>%
121 | hydrobr::historicalStatistics(statistics = statistics, permanence = permanence, pReturn = pReturn)
122 |
123 |
124 |
125 | c = selectStationsResultSeries %>%
126 | dplyr::bind_rows() %>%
127 | dplyr::mutate(month = lubridate::month(date)) %>%
128 | dplyr::filter(!month %in% months1) %>%
129 | list() %>%
130 | hydrobr::historicalStatistics(statistics = statistics, permanence = permanence, pReturn = pReturn)
131 |
132 |
133 | if(statistics == "Qperm"){
134 |
135 | lista = a %>%
136 | dplyr::mutate("Q{permanence}_m3_s_first6_months" := b[2] %>% dplyr::pull(),
137 | "Q{permanence}_m3_s_last6_months" := c[2] %>% dplyr::pull(),
138 | "Q{permanence}_first6m_ratio_Q{permanence}_hist_porcent" := round(b[2]/a[2]*100,1) %>% dplyr::pull(),
139 | "Q{permanence}_last6m_ratio_Q{permanence}_hist_porcent" := round(c[2]/a[2]*100,1) %>% dplyr::pull(),
140 | InicialMonth = startMonth)
141 | } else {
142 |
143 | lista = a %>%
144 | dplyr::mutate("{statistics}_m3_s_first6_months" := b[2] %>% dplyr::pull(),
145 | "{statistics}_m3_s_last6_months" := c[2] %>% dplyr::pull(),
146 | "{statistics}_first6m_ratio_{statistics}_hist_porcent" := round(b[2]/a[2]*100,1) %>% dplyr::pull(),
147 | "{statistics}_last6m_ratio_{statistics}_hist_porcent" := round(c[2]/a[2]*100,1) %>% dplyr::pull(),
148 | InicialMonth = startMonth)
149 |
150 |
151 | }
152 |
153 |
154 |
155 | return(lista)
156 |
157 | }
158 |
--------------------------------------------------------------------------------
/R/aggregateChirpsTS.R:
--------------------------------------------------------------------------------
1 | #' Aggregate Chirps Time Series by year, month
2 | #'
3 | #' @description
4 | #' Aggregate Chirps Rainfall Times Series by year, month or yearmonth
5 | #'
6 | #'
7 | #' @param chirpsStack spatRaster. spatRaster stack with chirps daily chirps data (output from [hydrobr::downloadChirpsRainfall()])
8 | #' @param month numeric; indicates the month when the water year begins. The default is
9 | #' 1 (use civil year).
10 | #' @param inicialYear numeric; filters the time series to begin on this year (inclusive).
11 | #' If you choose to use water year instead of civil year, e.g., month = 6,
12 | #' the first observation used is from the date "01-06-`inicialYear`".
13 | #' @param finalYear numeric; filters the time series to end on this year (inclusive).
14 | #' If you choose to use water year instead of civil year, e.g., month = 6,
15 | #' the last observation used is from the date "31-05-`finalYear`".
16 | #' @param fun function to be applied. The following functions have been are implemented "sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first".
17 | #' @param group_by character. One of the following values: "years", "months", "yearmonths" which daily data will be grouped.
18 | #' @param cores positive integer. cores to be used for a 'parallel' processing.
19 | #'
20 | #' @return
21 | #' spatRaster object with aggregated rainfall data.
22 | #'
23 | #'
24 | #' @export
25 | #'
26 | #' @examples
27 | #'
28 | #'\dontrun{
29 | #'
30 | #'require(terra)
31 | #'
32 | #'area_of_interest = vect("./paracatu.shp")
33 | #'
34 | #'
35 | #'downloadChirpsRainfall(dir_out = "./temp/chirpsRainfall",
36 | #' years = c(1990:2019),
37 | #' aoi = area_of_interest)
38 | #'
39 | #'
40 | #'chirpsStackAoi= list.files("./temp/chirpsRainfall", full.names = T) %>%
41 | #'terra::rast()
42 | #'
43 | #'
44 | #'#Annual mean rainfall
45 | #'chirpsYear = aggregateChirpsTS(chirpsStack = chirpsStackAoi,
46 | #'month = 11,
47 | #'inicialYear = 1990,
48 | #'finalYear = 2019,
49 | #' fun = "sum",
50 | #' group_by = "years",
51 | #' cores = 23)
52 | #'
53 | #'
54 | #'}
55 | #'
56 | #'
57 | aggregateChirpsTS = function(chirpsStack, month, inicialYear, finalYear, fun, group_by, cores = NULL){
58 |
59 | stopifnot(
60 | "`chirpsStack` parameter must be SpatRaster object (output of downloadChirpsRainfall)" = class(chirpsStack)[1]=="SpatRaster",
61 | "`fun` must be `sum`, `mean`, `median`, `modal`, `which`, `which.min`, `which.max`, `min`, `max`, `prod`, `any`, `all`, `sd`, `std`, `first`" = fun %in% c("sum", "mean", "median", "modal", "which", "which.min", "which.max", "min", "max", "prod", "any", "all", "sd", "std", "first"),
62 | "`group_by` must be character (`years`, `months`, `yearmonths`" = group_by %in% c("years", "months", "yearmonths"),
63 | "`cores` must be numeric" = is.numeric(cores) | is.null(cores))
64 |
65 | print("Processing time dependes of area size and time series length. Consider to take a small sample size to get experience and/or use parallel processing (cores input). To detect number of cores use available `parallel::detectCores()")
66 |
67 | #renomear tempo nas camadas para datas
68 | terra::time(chirpsStack) = gsub(pattern = "chirps-v2.0.", "", names(chirpsStack)) %>%
69 | as.Date("%Y.%m.%d")
70 |
71 | #filtrar chirpsStack pelos anos final e inicial
72 | chirpsStack = terra::subset(chirpsStack, terra::time(chirpsStack) >= paste0(inicialYear, "-01-01"))
73 | chirpsStack = terra::subset(chirpsStack, terra::time(chirpsStack) <= paste0(finalYear, "-12-31"))
74 |
75 |
76 | #anohidrológico
77 | hidrologicalYear <- gsub(pattern = "chirps-v2.0.", "",names(chirpsStack)) %>%
78 | base::as.Date("%Y.%m.%d") %>%
79 | dplyr::as_tibble() %>%
80 | dplyr::rename(date = 1) %>%
81 | dplyr::mutate(
82 | # Retrieve year from date
83 | civilYear = lubridate::year(.data$date),
84 | # Retrieve year-month from date
85 | monthCivilYear = .data$date - (lubridate::day(.data$date) - 1),
86 | # Calculate water year
87 | waterYear = lubridate::year(.data$date %>%
88 | lubridate::add_with_rollback(months(-(month - 1)))),
89 | # same as monthCivilYear but replace civilYear by waterYear
90 | monthWaterYear = as.Date(paste0(.data$waterYear, substr(.data$monthCivilYear, 5, 10)))
91 | )
92 |
93 |
94 | #verificar anos que possuem 12 monthwateryear. Ou seja, wateryears completos
95 | anoCompletos = hidrologicalYear$monthWaterYear %>%
96 | base::unique() %>%
97 | lubridate::year() %>%
98 | base::table() %>%
99 | dplyr::as_tibble() %>%
100 | dplyr::filter(n == 12) %>%
101 | dplyr::pull(1) %>%
102 | base::sort()
103 |
104 |
105 | #filtrar dados com awateryear completos
106 | finalData = hidrologicalYear %>%
107 | dplyr::filter(waterYear >=anoCompletos[1]) %>%
108 | dplyr::filter(waterYear <= dplyr::last(anoCompletos))
109 |
110 |
111 | #filtrar chirpsStack pelos anos final e inicial
112 | chirpsStack = subset(chirpsStack, terra::time(chirpsStack) >= dplyr::first(finalData)$date)
113 | chirpsStack = subset(chirpsStack, terra::time(chirpsStack) <= dplyr::last(finalData)$date)
114 |
115 |
116 | terra::time(chirpsStack) = finalData$monthWaterYear
117 |
118 | names(chirpsStack) = finalData$monthWaterYear %>%
119 | as.Date("%Y.%m.%d")
120 |
121 | terra::time(chirpsStack) = names(chirpsStack) %>%
122 | as.Date()
123 |
124 | newTS = terra::tapp(chirpsStack, index = group_by, fun = fun, cores = cores)
125 |
126 | return(newTS)
127 |
128 |
129 | }
130 |
--------------------------------------------------------------------------------
/R/historicalStatisticsSazonalAll.R:
--------------------------------------------------------------------------------
1 | #' Historical Statistics for sazonal period considering all hydrological years months begin (underdevelopment. available for streamdflow and annual series)
2 | #'
3 | #' @description
4 | #' Same processing done at [hydrobr::historicalStatisticsSazonal] but considering all 12 months possible to start hydrological year
5 | #'
6 | #'
7 | #' @param selectStationsAllmonthsRDSfolder character. folder path with 12 Rdata files generated with [hydrobr::selectStationsAllMonths].
8 | #' @param statistics character; indicates statistics.
9 | #'
10 | #' * The supported statistics for streamflow are:
11 | #' (1) mean stream flow (Qmean);
12 | #' (2) minimum of seven-day moving average of daily stream flow associated with return period (Q7T);
13 | #' (3) stream flow associated with a percentage of time (Qperm);
14 | #' (4) maximum stream flow (Qmax);
15 | #' (5) minimum stream flow (Qmin).
16 | #'
17 | #' * The supported statistics are:
18 | #' (1) total rainfall (Rtotal);
19 | #' (2) maximum rainfall (Rmax);
20 | #' (3) rainy days (Rdays).
21 | #'
22 | #' * The default value is "Qmean".
23 | #'
24 | #' @param pReturn numeric; return period if "Q7T" is choose as statistic parameter.
25 | #' The default is 10 year.
26 | #'
27 | #' @param permanence numeric; percentage of time if "Qperm" is choose as statistic parameter.
28 | #' The default is 95 percent.
29 | #'
30 | #' @return
31 | #' list with 12 tibble objects. Each one containing desired statistics for boths period and the ratio (porcentage) between
32 | #' historicalStatistics and sazonal historic statistics
33 | #'
34 | #' @export
35 | #'
36 | #' @examples
37 | #'#'
38 | #' \dontrun{
39 | #'
40 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais.
41 | #'
42 | #' inv <- inventory(
43 | #' states = "MINAS GERAIS",
44 | #' stationType = "flu",
45 | #' as_sf = TRUE,
46 | #' aoi = NULL
47 | #' )
48 | #'
49 | #' # Download the first 10 stations from the inventory
50 | #'
51 | #' s_data <- stationsData(
52 | #' inventoryResult = inv[1:10,],
53 | #' deleteNAstations = TRUE
54 | #' )
55 | #'
56 | #' # Organize the data for the stations
57 | #'
58 | #' org_data <- organize(
59 | #' stationsDataResult = s_data
60 | #' )
61 | #'
62 | #' # Filter the data for desired period and quality contorl
63 | #'
64 | #' selectStationsAllMonths(
65 | #' organizeResult = org_data,
66 | #' mode = "yearly",
67 | #' maxMissing = 10,
68 | #' minYears = 15,
69 | #' iniYear = NULL,
70 | #' finYear = NULL,
71 | #' consistedOnly = FALSE,
72 | #' folderPathWithNameDescription = "./loop/selecStation_15years_5porc",
73 | #' plot = TRUE
74 | #' )
75 | #'
76 | #' # annual mean stream flow serie for each station
77 | #'
78 | #' hsQmean = historicalStatisticsSazonalAll("./loop", statistics = "Qmean")
79 | #'
80 | #'
81 | #'}
82 | #'
83 | #'
84 |
85 |
86 |
87 | historicalStatisticsSazonalAll = function(selectStationsAllmonthsRDSfolder,
88 | statistics = "Qmean",
89 | permanence = 95,
90 | pReturn = 10
91 | ){
92 |
93 |
94 | lista = list()
95 | lista1 = list.files(selectStationsAllmonthsRDSfolder, full.names = T) %>%
96 | gtools::mixedsort()
97 |
98 | for (i in 1:length(lista1)){
99 |
100 | estSelec1 = readRDS(lista1[i])
101 |
102 | startMonth = i
103 |
104 | d = rep(1:12, 2)
105 |
106 | months = d[startMonth:(startMonth+11)]
107 |
108 | months1 = months[1:6]
109 | print("first 6 months:")
110 | print(months1)
111 |
112 | ####################### Calcular vazão de interesse para série Anual
113 |
114 | a = hydrobr::historicalStatistics(estSelec1$series, statistics = statistics, permanence = permanence, pReturn = pReturn)
115 |
116 |
117 | #selecionar 6 primeiros meses e computar vazao de permanencia
118 |
119 | b = estSelec1$series %>%
120 | dplyr::bind_rows() %>%
121 | dplyr::mutate(month = lubridate::month(date)) %>%
122 | dplyr::filter(month %in% months1) %>%
123 | list() %>%
124 | hydrobr::historicalStatistics(statistics = statistics, permanence = permanence, pReturn = pReturn)
125 |
126 |
127 |
128 | c = estSelec1$series %>%
129 | dplyr::bind_rows() %>%
130 | dplyr::mutate(month = lubridate::month(date)) %>%
131 | dplyr::filter(!month %in% months1) %>%
132 | list() %>%
133 | hydrobr::historicalStatistics(statistics = statistics, permanence = permanence, pReturn = pReturn)
134 |
135 |
136 |
137 | if(statistics == "Qperm"){
138 |
139 | lista[[i]] = a %>%
140 | dplyr::mutate("Q{permanence}_m3_s_first6_months" := b[2] %>% dplyr::pull(),
141 | "Q{permanence}_m3_s_last6_months" := c[2] %>% dplyr::pull(),
142 | "Q{permanence}_first6m_ratio_Q{permanence}_hist_porcent" := round(b[2]/a[2]*100,1) %>% dplyr::pull(),
143 | "Q{permanence}_last6m_ratio_Q{permanence}_hist_porcent" := round(c[2]/a[2]*100,1) %>% dplyr::pull(),
144 | InicialMonth = startMonth)
145 | } else {
146 |
147 | lista[[i]] = a %>%
148 | dplyr::mutate("{statistics}_m3_s_first6_months" := b[2] %>% dplyr::pull(),
149 | "{statistics}_m3_s_last6_months" := c[2] %>% dplyr::pull(),
150 | "{statistics}_first6m_ratio_{statistics}_hist_porcent" := round(b[2]/a[2]*100,1) %>% dplyr::pull(),
151 | "{statistics}_last6m_ratio_{statistics}_hist_porcent" := round(c[2]/a[2]*100,1) %>% dplyr::pull(),
152 | InicialMonth = startMonth)
153 |
154 | }
155 |
156 |
157 |
158 |
159 |
160 | }
161 |
162 | names(lista) = paste0("month", c(1:12))
163 |
164 | return(lista)
165 |
166 | }
167 |
--------------------------------------------------------------------------------
/R/sazonality.R:
--------------------------------------------------------------------------------
1 | #' Sazonality
2 | #'
3 | #'@description Identifica os 6 meses secos e úmidos nas estações em análise.
4 | #'
5 | #' @param selectionResultSeries list of tibble; lista de tibbles obtidos com a função [hydrobr::selectStations] contendo a série de dados diários.
6 | #'
7 | #' @param statistic character; "mean" or "median" monthly statistics.
8 | #'
9 | #' @return dataframe contendo o início do mês úmido e seco.
10 | #'
11 | #' @details Computa estatística mensal (média ou mediana) nos meses do ano e, posteriormente, e realiza uma média movel de 6 meses para identificar período seco e úmido no ano.
12 | #'
13 | #'
14 | #' @examples
15 | #'
16 | #' \dontrun{
17 | #'
18 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
19 | #'
20 | #' inv <- inventory(
21 | #' states = "MINAS GERAIS",
22 | #' stationType = "flu",
23 | #' as_sf = TRUE,
24 | #' aoi = NULL
25 | #' )
26 | #'
27 | #' # Download stations from the inventory
28 | #'
29 | #' s_data <- stationsData(
30 | #' inventoryResult = inv[1:10,],
31 | #' deleteNAstations = TRUE
32 | #' )
33 | #'
34 | #' # Organize the data for the stations
35 | #'
36 | #' org_data <- organize(stationsDataResult = s_data)
37 | #'
38 | #' # Filter the data for desired period and quality contorl
39 | #'
40 | #' final_data <- selectStations(
41 | #' organizeResult = org_data,
42 | #' mode = "yearly",
43 | #' maxMissing = 10,
44 | #' minYears = 15,
45 | #' month = 1,
46 | #' iniYear = NULL,
47 | #' finYear = NULL,
48 | #' consistedOnly = FALSE,
49 | #' plot = TRUE
50 | #' )
51 | #'
52 | #'sazon = sazonality(final_data$series, statistic = "median")
53 | #'
54 | #'
55 | #'}
56 | #'
57 |
58 |
59 |
60 |
61 | sazonality = function(selectionResultSeries, statistic = "median"){
62 |
63 | stopifnot(
64 | "`statistic` parameter must be `median` or `mean`" = statistic %in% c("median", "mean"),
65 | "`selectionsResultSerie` parameter must be a list of tibble resulted from `selectStation` function" = is.list(selectionResultSeries),
66 | "`selectionsResultSerie` parameter must be a list of tibble resulted from `selectStation` function" = identical(names(selectionResultSeries[[1]]), c(
67 | "station_code", "consistency_level", "date", "stream_flow_m3_s",
68 | "civilYear", "monthCivilYear", "waterYear", "monthWaterYear",
69 | "maxMissing"
70 | )) | identical(names(selectionResultSeries[[1]]), c(
71 | "station_code", "consistency_level", "date", "rainfall_mm",
72 | "civilYear", "monthCivilYear", "waterYear", "monthWaterYear",
73 | "maxMissing"
74 | ))
75 | )
76 |
77 |
78 |
79 |
80 | mMensal = hydrobr::mMonthlyStat(selectionResultSeries)
81 |
82 |
83 |
84 |
85 | sazon = mMensal %>%
86 | dplyr::bind_rows() %>%
87 | dplyr::group_by(station_code) %>%
88 | dplyr::slice(rep(1:dplyr::n(), 2)) %>%
89 | dplyr::mutate(meanRoll6Mean = zoo::rollapply(.data$monthlyMean,
90 | width = 6,
91 | FUN = base::mean,
92 | partial = T,
93 | align = "left"),
94 | medianRoll6Mean = zoo::rollapply(.data$monthlyMedian,
95 | width = 6,
96 | FUN = base::mean,
97 | partial = T,
98 | align = "left"),
99 | months = zoo::rollapply(.data$month,
100 | width = 6,
101 | FUN = function(y) {
102 | paste(dplyr::first(y),
103 | dplyr::last(y),
104 | sep = "-")},
105 | partial = T,
106 | align = "left")) %>%
107 | dplyr::slice(1:12)
108 |
109 |
110 |
111 | if (statistic == "median") {
112 | AnoHS <- sazon %>%
113 | dplyr::filter(medianRoll6Mean == min(medianRoll6Mean)) %>%
114 | dplyr::select(1, 2, 7) %>% stats::setNames(c("station_code",
115 | "FirstDryMonth", "DryMonths"))%>%
116 | dplyr::ungroup()
117 | AnoHU <- sazon %>%
118 | dplyr::filter(medianRoll6Mean == max(medianRoll6Mean))%>%
119 | dplyr::select(1, 2, 7) %>% stats::setNames(c("station_code",
120 | "FirstwetMonth", "WetMonths"))%>%
121 | dplyr::ungroup()
122 | } else {
123 |
124 | AnoHS <- sazon %>%
125 | dplyr::filter(meanRoll6Mean == min(meanRoll6Mean)) %>%
126 | dplyr::select(1, 2, 7) %>% stats::setNames(c("station_code",
127 | "FirstDryMonth", "DryMonths")) %>%
128 | dplyr::ungroup()
129 | AnoHU <- sazon %>%
130 | dplyr::filter(meanRoll6Mean == max(meanRoll6Mean))%>%
131 | dplyr::select(1, 2, 7) %>% stats::setNames(c("station_code",
132 | "FirstwetMonth", "WetMonths"))%>%
133 | dplyr::ungroup()
134 |
135 |
136 | }
137 |
138 | sazon <- dplyr::left_join(AnoHU, AnoHS, by = "station_code") %>%
139 | dplyr::select(c(1, 4, 2, 5, 3))
140 |
141 | return(sazon)
142 |
143 | }
144 |
145 | if(getRversion() >= "2.15.1") utils::globalVariables(c("MonthlyMResult",
146 | 'selectionResultSeries',
147 | 'MonthlyM',
148 | 'medianRoll6Mean',
149 | 'meanRoll6Mean'))
150 |
151 |
152 |
153 |
--------------------------------------------------------------------------------
/R/identifyQ7dates.R:
--------------------------------------------------------------------------------
1 | #' Retorna a série de Q7 anual e respectivas datas
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description A partir da série histórica de vazões nas estações (output from [hydrobr::selectStations()]), retorna os valores de Q7 anual com respectivas datasTakes as input a list containing data frames of organized records
6 | #'
7 | #' @param selectStationsResultSeries list of tibble data frame;
8 | #' @param order character; quando há valores mínimos de Q7 num ano, escolher o primeiro (firstDate) ou último (lastDate).
9 | #'
10 | #' @return A list containing 2 objects:
11 | #' * a list of data frames [tibble::tibble()] for each station containing Q7 dates, value and month of ocorrence for each wateryear
12 | #' * a dataframe containing Q7 month frequency for each station
13 | #'
14 | #'
15 | #' @examplesIf interactive()
16 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
17 | #'
18 | #' inv <- inventory(
19 | #' states = "MINAS GERAIS",
20 | #' stationType = "flu",
21 | #' as_sf = TRUE,
22 | #' aoi = NULL
23 | #' )
24 | #'
25 | #' # Download the first 10 stations from the inventory
26 | #'
27 | #' s_data <- stationsData(
28 | #' inventoryResult = inv[1:10,],
29 | #' deleteNAstations = TRUE
30 | #' )
31 | #'
32 | #' # Organize the data for the stations
33 | #'
34 | #' org_data <- organize(stationsDataResult = s_data)
35 | #'
36 | #' # Filter the data for desired period and quality contorl
37 | #'
38 | #' final_data <- selectStations(
39 | #' organizeResult = org_data,
40 | #' mode = "yearly",
41 | #' maxMissing = 10,
42 | #' minYears = 15,
43 | #' month = 1,
44 | #' iniYear = NULL,
45 | #' finYear = NULL,
46 | #' consistedOnly = FALSE,
47 | #' plot = TRUE
48 | #' )
49 | #'
50 | #'
51 | #' Q7stats = identifyQ7dates( final_data$series)
52 | #'
53 | #' @export
54 | #'
55 | #' @importFrom rlang .data
56 |
57 | identifyQ7dates = function(selectStationsResultSeries, order = "lastDate"){
58 |
59 |
60 |
61 | series1 = lapply(selectStationsResultSeries, function(x) {x %>%
62 | dplyr::arrange(date) %>%
63 | dplyr::group_by_at(c("waterYear")) %>%
64 | dplyr::mutate(Q7_m3_s = zoo::rollapply(.data$stream_flow_m3_s,
65 | 7, FUN = mean,
66 | partial = TRUE,
67 | align = "left"),
68 | dataQ7 = zoo::rollapply(.data$date,
69 | 7, FUN = function(x) paste(min(x), max(x), sep = "//"),
70 | partial = TRUE,
71 | align = "left")) %>%
72 |
73 | dplyr::slice(-(dplyr::n()-5):-dplyr::n()) %>%
74 | dplyr::filter(Q7_m3_s==min(Q7_m3_s, na.rm = T)) %>%
75 | {if(order == "lastDate") dplyr::arrange(., dplyr::desc(date)) else dplyr::arrange(., date)} %>%
76 | dplyr::slice(1) %>%
77 | dplyr::mutate(firstDateQ7 = as.Date(substr(dataQ7, 0,10)),
78 | lastDateQ7 = as.Date(substr(dataQ7, 13,23)),
79 | doisMeses = dplyr::if_else(lubridate::month(firstDateQ7)==lubridate::month(lastDateQ7), "sim", "nao"),
80 | daysMonth1 = dplyr::if_else(doisMeses == "nao",
81 | lubridate::days_in_month(lubridate::month(firstDateQ7)) - lubridate::mday(firstDateQ7)+1,
82 | NA),
83 | daysMonth2 = dplyr::if_else(doisMeses == "nao",
84 | lubridate::mday(lastDateQ7),
85 | NA),
86 | monthQ7 = dplyr::if_else(daysMonth2>=daysMonth1, lubridate::month(lastDateQ7), lubridate::month(firstDateQ7)),
87 | monthQ7 = dplyr::if_else(is.na(monthQ7), lubridate::month(lastDateQ7), monthQ7)) %>%
88 | dplyr::select(dplyr::everything(), -dataQ7, -doisMeses, -daysMonth1, -daysMonth2) %>%
89 | dplyr::ungroup() %>%
90 | dplyr::select(station_code, civilYear, waterYear, Q7_m3_s, firstDateQ7, lastDateQ7, monthQ7)}
91 |
92 | )
93 |
94 | series1_freq = lapply(series1, function(y) y %>%
95 | dplyr::pull(monthQ7) %>%
96 | plyr::count() %>%
97 | dplyr::right_join(tibble::tibble(x = 1:12, by = "x")) %>%
98 | base::suppressMessages() %>%
99 | dplyr::select(c(1,2)) %>%
100 | dplyr::arrange(x) %>%
101 | dplyr::mutate(station_code = unique(y$station_code),
102 | freq = dplyr::if_else(is.na(freq), 0, freq),
103 | month = as.factor(x)) %>%
104 | dplyr::select(station_code, month, freq)) %>%
105 | dplyr::bind_rows() %>%
106 | dplyr::as_tibble() %>%
107 | tidyr::pivot_wider(id_cols = station_code, names_from = month, values_from = freq)
108 |
109 |
110 | listResult = list(series1, series1_freq)
111 | names(listResult) = c("Q7stats", "Q7monthFreq")
112 | return(listResult)
113 |
114 |
115 | }
116 |
117 |
118 | if(getRversion() >= "2.15.1") utils::globalVariables(c("n",
119 | 'dataQ7',
120 | 'firstDateQ7',
121 | 'lastDateQ7',
122 | 'waterYear',
123 | 'doisMeses',
124 | 'daysMonth1',
125 | 'daysMonth2',
126 | 'monthQ7',
127 | 'civilYear',
128 | 'x',
129 | 'freq'))
130 |
--------------------------------------------------------------------------------
/R/MKTest.R:
--------------------------------------------------------------------------------
1 | #' Mann-Kendall trend test
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Performs the Mann-Kendall trend test for annual or monthly rainfall (or streamflow) times series
6 | #'
7 | #'
8 | #' @param dfSeriesFromFillorSerieStatisticsFunc tibble containing annual or monthly series of all stations;
9 | #' @param byMonth logical. if byMounth = TRUE, MannKendall test is performed for each month.
10 | #'
11 | #' @return p-value for each continuous stations data
12 | #'
13 | #' @references
14 | #' Kendall package (https://cran.r-project.org/web/packages/Kendall/Kendall.pdf)
15 | #'
16 | #' @examplesIf interactive()
17 | #'
18 | #' inv <- inventory(
19 | #' states = "MINAS GERAIS",
20 | #' stationType = "flu",
21 | #' as_sf = TRUE,
22 | #' aoi = NULL)
23 | #'
24 | #' # Download the first 10 stations from the inventory
25 | #'
26 | #' s_data <- stationsData(
27 | #' inventoryResult = inv[1:10,],
28 | #' deleteNAstations = TRUE)
29 | #'
30 | #' # Organize the data for the stations
31 | #'
32 | #' org_data <- organize(
33 | #' stationsDataResult = s_data)
34 | #'
35 | #' # Filter the data for desired period and quality contorl
36 | #'
37 | #' final_data <- selectStations(
38 | #' stationsDataResult = org_data,
39 | #' mode = "yearly",
40 | #' maxMissing = 10,
41 | #' minYears = 15,
42 | #' month = 1,
43 | #' iniYear = NULL,
44 | #' finYear = NULL,
45 | #' consistedOnly = FALSE,
46 | #' plot = TRUE)
47 | #'
48 | #' # Annual mean stream flow serie for each station
49 | #' Qmean_years = seriesStatistics(final_data, statistics = "Qmean")
50 | #'
51 | #' #MannKendall test
52 | #' MKTest(dfSeriesFromFillorSerieStatisticsFunc = Qmean_years$df_series, byMonth = FALSE)
53 | #'
54 | #'
55 | #' @export
56 |
57 | MKTest <- function(dfSeriesFromFillorSerieStatisticsFunc, byMonth = FALSE) { # se byMonth for igual a TRUE, faz o RunTest por mÊs da série mensal. Caso contrário na série mensal ou anual
58 |
59 | ## Verification if arguments are in the desired format
60 | # is StatisticsResult an outcome from rainStatistics or flowStatistics function?
61 |
62 | # if (!attributes(dfSeriesFromFillorSerieStatisticsFunc)$class[2] %in% c('flowStatistics','rainStatistics', 'fillGaps')) {
63 | # stop(
64 | # call. = FALSE,
65 | # '`StatisticsResult` does not inherit attribute "flowStatistics" or "rainStatistics".
66 | # The outcome from the flowStatistics() or rainStatistics() function should be passed as argument'
67 | # )
68 | # }
69 |
70 | ## verify byMonth parameter
71 |
72 | dfSeriesFromFillorSerieStatisticsFunc = dfSeriesFromFillorSerieStatisticsFunc %>%
73 | split(dfSeriesFromFillorSerieStatisticsFunc$station_code)
74 |
75 | #identify type of serie (annual or monthly)
76 |
77 | ## verify byMonth parameter
78 |
79 | #identify type of serie (annual or monthly)
80 |
81 | if (names(dfSeriesFromFillorSerieStatisticsFunc[[1]])[2] == "waterYear"){
82 | period = "waterYear"
83 | } else {period = "monthWaterYear"}
84 |
85 | if (byMonth == TRUE & period == "waterYear" | !is.logical(byMonth) | !length(byMonth) == 1) {
86 | stop(
87 | call. = FALSE,
88 | '`byMonth` should be a logical vector of length == 1 (TRUE or FALSE).
89 | if `dfSeriesFromFillorSerieStatisticsFunc` is an annual series list, byMonth is necessarily `FALSE`.
90 | See arguments details for more information'
91 | )
92 | }
93 |
94 | dfSeriesFromFillorSerieStatisticsFunc2 <- lapply(dfSeriesFromFillorSerieStatisticsFunc, function(x) { # nome da coluna modificado para que a função funcione para vazao e precipitacao
95 | names(x) <- c("station_code", "period", "value")
96 | x
97 | })
98 |
99 |
100 |
101 | if (byMonth == FALSE) { # se os a estatística for anual
102 |
103 |
104 | pvalueMK <- as.numeric()
105 | station <- as.numeric()
106 |
107 | for (i in 1:length(dfSeriesFromFillorSerieStatisticsFunc2)) {
108 | testMK <- dfSeriesFromFillorSerieStatisticsFunc2[[i]] %>%
109 | dplyr::pull(3) %>%
110 | Kendall::MannKendall()
111 | pvalueMK[i] <- round(testMK$sl[1], 3)
112 | station[i] <- names(dfSeriesFromFillorSerieStatisticsFunc2)[i]
113 | }
114 |
115 | testMK <- tibble::as_tibble(apply(cbind(station, pvalueMK), 2, as.numeric))
116 | testMK # valores menores que 0.05 rejeita hipótese nula (não há tendência)
117 | names(testMK) = c("station_code", "pvaluePT", "dateChange")
118 |
119 | } else { # fazer teste de Run por mês
120 |
121 | pvalueMK <- as.numeric()
122 | estacao <- as.numeric()
123 | testMK <- list()
124 |
125 | for (i in 1:length(dfSeriesFromFillorSerieStatisticsFunc2)) {
126 | testMK[[i]] <- dfSeriesFromFillorSerieStatisticsFunc2[[i]] %>%
127 | stats::setNames(c("station_code", "monthWaterYear", "value")) %>%
128 | dplyr::mutate(month = lubridate::month(monthWaterYear)) %>% # criar mês
129 | dplyr::group_by(month) %>% # agrupar por mÊs
130 | dplyr::group_map(~ Kendall::MannKendall(.x$value)) %>% # realziar teste de Run no mÊs
131 | lapply(FUN = function(x) x$sl[1]) %>% # pegar p-value
132 | unlist() %>% # converter para vetor
133 | base::round(3) %>% # arredondar
134 | dplyr::bind_cols(dfSeriesFromFillorSerieStatisticsFunc[[i]] %>% # concatenar vetor de pvalue com mês associado
135 | dplyr::mutate(month = lubridate::month(monthWaterYear)) %>%
136 | dplyr::pull(month) %>%
137 | base::unique()) %>%
138 | stats::setNames(c(paste("pval_MKtest_", names(dfSeriesFromFillorSerieStatisticsFunc)[i], sep = ""), "month")) %>% # renomear colunas
139 | dplyr::arrange(month) %>% # ordenar por mês
140 | dplyr::mutate(month = as.character(lubridate::month(month, label = TRUE))) %>% # converter número do mês em nome do mÊs
141 | dplyr::select(month, dplyr::everything()) %>% # ordenar colunas %>%
142 | suppressMessages()
143 | }
144 |
145 | testMK <- Reduce(function(x, y) dplyr::full_join(x, y, by = "month"), testMK) # criar data.frame com todas as estações
146 | testMK
147 |
148 | }
149 |
150 | names(testMK) = c("station_code", "pvalueMK")
151 | testMK$station_code = as.character(testMK$station_code)
152 | return(testMK)
153 | }
154 |
155 | if(getRversion() >= "2.15.1") utils::globalVariables(c("month"))
156 |
--------------------------------------------------------------------------------
/R/organize.R:
--------------------------------------------------------------------------------
1 | #' Organizes the raw data provided by ANA for its stations
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Takes as input a list containing data frames of raw records
6 | #' for each station (output from [hydrobr::stationsData()]) and organizes
7 | #' them into tidy data frames. As some dates may be provided with different
8 | #' consistency levels, priority is given to consisted data (consistency level = 2)
9 | #'
10 | #' @param stationsDataResult list, tibble data frame; provides a list containing
11 | #' the data frames of raw records for each station downloaded from ANA web API
12 | #' (output from [hydrobr::stationsData()] function).
13 | #'
14 | #' @return A list containing an organized data frame [tibble::tibble()] object
15 | #' for each station. The data frames will contain the following columns:
16 | #' station_code: station unique identifier (chr).
17 | #' consistency_level: data consistency level (1 = raw, 2 = consisted) (chr).
18 | #' date: date format YYYY-MM-DD (Date).
19 | #' rainfall_mm/streamflow_m3_s: rain/streamflow gauge measurement (dbl).
20 | #'
21 | #' @examplesIf interactive()
22 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
23 | #'
24 | #' inv <- inventory(
25 | #' states = "MINAS GERAIS",
26 | #' stationType = "flu",
27 | #' as_sf = TRUE,
28 | #' aoi = NULL
29 | #' )
30 | #'
31 | #' # Download the first 10 stations from the inventory
32 | #'
33 | #' s_data <- stationsData(
34 | #' inventoryResult = inv[1:10,],
35 | #' deleteNAstations = TRUE
36 | #' )
37 | #'
38 | #' # Organize the data for the stations
39 | #'
40 | #' org_data <- organize(
41 | #' stationsDataResult = s_data
42 | #' )
43 | #'
44 | #' @export
45 | #'
46 | #' @importFrom rlang .data
47 | #'
48 | #'
49 | #'
50 | #'
51 |
52 | organize <- function(stationsDataResult) {
53 |
54 | # ## Verification if arguments are in the desired format
55 | # # is stationsDataResult an outcome from stationsData function?
56 | # if (!attributes(stationsDataResult)$hydrobr_class %in% 'stationsData') {
57 | # stop(
58 | # call. = FALSE,
59 | # '`stationsDataResult` does not inherit attribute "stationsData".
60 | # The outcome from the stationsData() function should be passed as argument'
61 | # )
62 | # }
63 |
64 | ##
65 | # Single workflow regardless of station type
66 | stationsDataResult <- stationsDataResult[stationsDataResult != 'No Data'] %>%
67 | # Join all stations into single df
68 | do.call(what = dplyr::bind_rows) %>%
69 | # Select desired columns
70 | dplyr::select(
71 | dplyr::contains('estacaocodigo'),
72 | dplyr::contains('nivelconsistencia'),
73 | dplyr::matches('data$'),
74 | dplyr::matches("vazao..$"),
75 | dplyr::matches("chuva..$"),
76 | dplyr::matches("cota..$")
77 | ) %>%
78 | # Rename from pt to en
79 | dplyr::rename(
80 | 'station_code' = 1,
81 | 'consistency_level' = 2
82 | ) %>%
83 | # Group by station id
84 | dplyr::group_by_at('station_code') %>%
85 | # Make single column for flow/precipitation data
86 | tidyr::pivot_longer(cols = 4:34) %>%
87 | # Fix date columns
88 | dplyr::mutate(date = .data$data + as.numeric(stringr::str_extract(.data$name, pattern = "[0-9]+")) - 1) %>%
89 | # Remove duplicates by selecting highest consistency level
90 | dplyr::group_by_at(c('station_code', 'date')) %>%
91 | stats::na.omit() %>%
92 | dplyr::filter(
93 | .data$consistency_level == max(.data$consistency_level),
94 | # Other duplicates may appear because more columns than days for certain months
95 | lubridate::month(.data$date) == lubridate::month(.data$data)
96 | ) %>%
97 | # If there is still a duplicate row, we select the first one
98 | dplyr::filter(dplyr::row_number() == 1) %>%
99 | dplyr::ungroup() %>%
100 | # Select desired columns
101 | dplyr::select(
102 | dplyr::matches('station_code$'),
103 | dplyr::matches('consistency_level$'),
104 | dplyr::matches('date$'),
105 | dplyr::matches('name$'),
106 | dplyr::matches('value$')
107 | ) %>%
108 | # Organize by station code and date
109 | dplyr::arrange(dplyr::across(c('station_code', 'date')))
110 |
111 | # Rename column for rainfall or streamflow
112 | if (stringr::str_remove(stationsDataResult$name[1], pattern = "[0-9]+") == "chuva") {
113 | stationsDataResult <- stationsDataResult %>%
114 | dplyr::rename(rainfall_mm = 5)
115 | } else {if (stringr::str_remove(stationsDataResult$name[1], pattern = "[0-9]+") == "vazao") {
116 | stationsDataResult <- stationsDataResult %>%
117 | dplyr::rename(stream_flow_m3_s = 5)
118 | } else {
119 | stationsDataResult <- stationsDataResult %>%
120 | dplyr::rename(level_cm = 5)
121 | }
122 |
123 | }
124 |
125 | # Output format
126 | organizedResult <- stationsDataResult %>%
127 | # Remove name column
128 | dplyr::select(-'name') %>%
129 | # Filter stations with data
130 | dplyr::group_by_at('station_code') %>%
131 | dplyr::filter(dplyr::n() > 0) %>%
132 | # Transform into lists with tibble for each station
133 | dplyr::ungroup()
134 |
135 | # Split into lists
136 | organizedResult <- split(organizedResult, organizedResult$station_code)
137 |
138 | #Pad data to complete dates. Set consistency level = 2 to missing data. Will be computed as NA in selectStation
139 |
140 | organizedResult <- lapply(organizedResult, FUN = function(x) padr::pad(x,
141 | start_val = as.Date(paste(lubridate::year(dplyr::first(x$date)),
142 | 01, 01, sep = "-")),
143 | end_val = as.Date(paste(lubridate::year(dplyr::last(x$date)),
144 | 12, 31, sep = "-"))) %>% dplyr::mutate(station_code = unique(x$station_code)) %>%
145 | dplyr::mutate(consistency_level = ifelse(is.na(consistency_level),
146 | 2, consistency_level))) %>%
147 | suppressMessages()
148 |
149 | # attr(organizedResult, "hydrobr_class") <- "organize"
150 | return(organizedResult)
151 | }
152 |
153 | if(getRversion() >= "2.15.1") utils::globalVariables("consistency_level")
154 |
--------------------------------------------------------------------------------
/R/RunTest.R:
--------------------------------------------------------------------------------
1 | #' Wald-Wolfowitz runs trend test
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Performs the Wald-Wolfowitz runs trend test for annual or monthly rainfall (or streamflow) times series
6 | #'
7 | #'
8 | #' @param dfSeriesFromFillorSerieStatisticsFunc tibble containing annual or monthly series of all stations;
9 | #' @param byMonth logical. if byMounth = TRUE, MannKendall test is performed for each month.
10 | #'
11 | #' @return p-value for each continuous stations data
12 | #'
13 | #' @references
14 | #' randtest package (https://cran.r-project.org/web/packages/randtests/index.html)
15 | #'
16 | #' @examplesIf interactive()
17 | #'
18 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
19 | #'
20 | #' inv <- inventory(
21 | #' states = "MINAS GERAIS",
22 | #' stationType = "flu",
23 | #' as_sf = TRUE,
24 | #' aoi = NULL)
25 | #'
26 | #' # Download the first 10 stations from the inventory
27 | #'
28 | #' s_data <- stationsData(
29 | #' inventoryResult = inv[1:10,],
30 | #' deleteNAstations = TRUE)
31 | #'
32 | #' # Organize the data for the stations
33 | #'
34 | #' org_data <- organize(
35 | #' stationsDataResult = s_data
36 | #' )
37 | #'
38 | #' # Filter the data for desired period and quality contorl
39 | #'
40 | #' final_data <- selectStations(
41 | #' stationsDataResult = org_data,
42 | #' mode = "yearly",
43 | #' maxMissing = 10,
44 | #' minYears = 15,
45 | #' month = 1,
46 | #' iniYear = NULL,
47 | #' finYear = NULL,
48 | #' consistedOnly = FALSE,
49 | #' plot = TRUE
50 | #' )
51 | #'
52 | #' # Annual mean stream flow serie for each station
53 | #' Qmean_years = seriesStatistics(final_data, statistics = "Qmean")
54 | #'
55 | #' #MannKendall test
56 | #' RunTest(dfSeriesFromFillorSerieStatisticsFunc = Qmean_years$df_series, byMonth = FALSE)
57 | #'
58 | #'
59 | #' @export
60 | #'
61 | RunTest <- function(dfSeriesFromFillorSerieStatisticsFunc, byMonth = FALSE) { # se byMonth for igual a TRUE, faz o RunTest por mÊs da série mensal. Caso contrário na série mensal ou anual
62 |
63 | # ## Verification if arguments are in the desired format
64 | # # is StatisticsResult an outcome from rainStatistics or flowStatistics function?
65 | #
66 | # if (!attributes(dfSeriesFromFillorSerieStatisticsFunc)$class[2] %in% c('flowStatistics','rainStatistics', 'fillGaps')) {
67 | # stop(
68 | # call. = FALSE,
69 | # '`StatisticsResult` does not inherit attribute "flowStatistics" or "rainStatistics".
70 | # The outcome from the flowStatistics() or rainStatistics() function should be passed as argument'
71 | # )
72 | # }
73 | ## verify byMonth parameter
74 |
75 | dfSeriesFromFillorSerieStatisticsFunc = dfSeriesFromFillorSerieStatisticsFunc %>%
76 | split(dfSeriesFromFillorSerieStatisticsFunc$station_code)
77 |
78 | #identify type of serie (annual or monthly)
79 |
80 | ## verify byMonth parameter
81 |
82 | #identify type of serie (annual or monthly)
83 |
84 | if (names(dfSeriesFromFillorSerieStatisticsFunc[[1]])[2] == "waterYear"){
85 | period = "waterYear"
86 | } else {period = "monthWaterYear"}
87 |
88 | if (byMonth == TRUE & period == "waterYear" | !is.logical(byMonth) | !length(byMonth) == 1) {
89 | stop(
90 | call. = FALSE,
91 | '`byMonth` should be a logical vector of length == 1 (TRUE or FALSE).
92 | if `dfSeriesFromFillorSerieStatisticsFunc` is an annual series list, byMonth is necessarily `FALSE`.
93 | See arguments details for more information'
94 | )
95 | }
96 |
97 | dfSeriesFromFillorSerieStatisticsFunc2 <- lapply(dfSeriesFromFillorSerieStatisticsFunc, function(x) { # nome da coluna modificado para que a função funcione para vazao e precipitacao
98 | names(x) <- c("station_code", "period", "value")
99 | x
100 | })
101 |
102 | if (byMonth == FALSE) { # for annual and monthly series compute trendness
103 |
104 |
105 | pvalueRun <- as.numeric()
106 | station <- as.numeric()
107 |
108 | for (i in 1:length(dfSeriesFromFillorSerieStatisticsFunc)) {
109 | testRun <- dfSeriesFromFillorSerieStatisticsFunc[[i]] %>%
110 | dplyr::pull(3) %>%
111 | randtests::runs.test(plot = FALSE)
112 | pvalueRun[i] <- round(testRun$p.value, 3)
113 | station[i] <- names(dfSeriesFromFillorSerieStatisticsFunc)[i]
114 | }
115 |
116 | testRun <- tibble::as_tibble(apply(cbind(station, pvalueRun), 2, as.numeric))
117 | testRun # valores menores que 0.05 rejeita hipótese nula (não há tendência)
118 | names(testRun) = c("station_code", "pvalueRun")
119 |
120 | } else { # fazer teste de Run por mês
121 |
122 | pvalueRun <- as.numeric()
123 | estacao <- as.numeric()
124 | testRun <- list()
125 |
126 | for (i in 1:length(dfSeriesFromFillorSerieStatisticsFunc)) {
127 | testRun[[i]] <- dfSeriesFromFillorSerieStatisticsFunc[[i]] %>%
128 | stats::setNames(c("station_code", "monthWaterYear", "value")) %>%
129 | dplyr::mutate(month = lubridate::month(monthWaterYear)) %>% # criar mês
130 | dplyr::group_by(month) %>% # agrupar por mÊs
131 | dplyr::group_map(~ randtests::runs.test(.x$value, plot = FALSE)) %>% # realziar teste de Run no mÊs
132 | lapply(FUN = function(x) x$p.value) %>% # pegar p-value
133 | unlist() %>% # converter para vetor
134 | base::round(3) %>% # arredondar
135 | dplyr::bind_cols(dfSeriesFromFillorSerieStatisticsFunc[[i]] %>% # concatenar vetor de pvalue com mês associado
136 | dplyr::mutate(month = lubridate::month(monthWaterYear)) %>%
137 | dplyr::pull(month) %>%
138 | base::unique()) %>%
139 | stats::setNames(c(paste("pval_Rtest_", names(dfSeriesFromFillorSerieStatisticsFunc)[i], sep = ""), "month")) %>% # renomear colunas
140 | dplyr::arrange(month) %>% # ordenar por mês
141 | dplyr::mutate(month = as.character(lubridate::month(month, label = TRUE))) %>% # converter número do mês em nome do mÊs
142 | dplyr::select(month, dplyr::everything()) %>% # ordenar colunas %>%
143 | suppressMessages()
144 | }
145 |
146 | testRun <- Reduce(function(x, y) dplyr::full_join(x, y, by = "month"), testRun) # criar data.frame com todas as estações
147 | testRun
148 |
149 | }
150 |
151 | names(testRun) = c("station_code", "pvalueRun")
152 | testRun$station_code = as.character(testRun$station_code)
153 | return(testRun)
154 | }
155 |
156 | if(getRversion() >= "2.15.1") utils::globalVariables(c("month"))
157 |
--------------------------------------------------------------------------------
/R/stationsData.R:
--------------------------------------------------------------------------------
1 | #' Retrieves raw data for the stations inventory from ANA web API
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Takes as input an inventory of stations (output from
6 | #' [hydrobr::inventory()]) or data.frame/tibble object with station_code and stationType
7 | #' columns and downloads raw stations data from the Brazilian
8 | #' National Water Agency (ANA). The user can choose wether to maintain
9 | #' stations with missing data.
10 | #'
11 | #' @param inventoryResult tibble data frame; provides the station inventory (output
12 | #' from [hydrobr::inventory()] function) for which to download data for.
13 | #' @param deleteNAstations logical; should stations with no data be removed?
14 | #' The default is TRUE.
15 | #' @param waterLevel logical. if param "station_type" in [hydrobr::inventory()], get waterLevel data of fluviometric stations?
16 | #' Use FALSE for streamflow data. TRUE for water level data. Default is FALSE.
17 | #'
18 | #' @return A list containing a data frame [tibble::tibble()] object for each station.
19 | #' The data frame format is identical to the format provided by ANA.
20 | #'
21 | #' @details Improvement of the code developed by Artur Lourenço
22 | #' (https://github.com/ArturLourenco/HidroWebFix)
23 | #'
24 | #' @references
25 | #' Dados Abertos da Agência Nacional de Águas e Saneamento Básico.
26 | #'
27 | #'
28 | #'
29 | #' HIDRO - Inventário pluviométrico/fluviométrico atualizado.
30 | #'
31 | #'
32 | #'
33 | #' @examplesIf interactive()
34 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
35 | #'
36 | #'\dontrun{
37 | #' inv <- inventory(
38 | #' states = "MINAS GERAIS",
39 | #' stationType = "flu",
40 | #' as_sf = TRUE,
41 | #' aoi = NULL
42 | #' )
43 | #'
44 | #' # Download the first 10 stations from the inventory
45 | #'
46 | #' s_data <- stationsData(
47 | #' inventoryResult = inv[1:10,],
48 | #' deleteNAstations = TRUE
49 | #' )
50 | #'
51 | #' #######
52 | #'
53 | #' #create data.frame with station_code and stationType columns
54 | #'
55 | #' stations_code = data.frame(station_code = c("42600000","42690001"),
56 | #' stationType = "fluviometric")
57 | #'
58 | #' s_data = stationsData(stations_code)
59 | #'
60 | #'}
61 | #'
62 | #'
63 | #'
64 | #'
65 | #' @export
66 |
67 | # inventoryResult = inv
68 | # waterLevel = TRUE
69 |
70 | stationsData <- function(inventoryResult, deleteNAstations = TRUE, waterLevel = FALSE) {
71 |
72 | ## Verification if arguments are in the desired format
73 |
74 | # is deleteNAstations logical?
75 | if (!is.logical(deleteNAstations) | length(deleteNAstations) != 1) {
76 | stop(
77 | call. = FALSE,
78 | "`deleteNAstations` should be logical and have length == 1 (either TRUE or FALSE)."
79 | )
80 | }
81 |
82 | if (!any(names(inventoryResult) == "station_code")) {
83 | stop(
84 | call. = FALSE,
85 | '`inventoryResults` does not have a "station_code" column.
86 | Use inventory() function to retrieve stations inventory
87 | or create a column "station_code" with desired stations'
88 | )
89 | }
90 |
91 | if (!any(names(inventoryResult) == "stationType")) {
92 | stop(
93 | call. = FALSE,
94 | '`inventoryResults` does not have a "station_code" column.
95 | Use inventory() function to retrieve stations inventory
96 | or create a column "stationType" in your data
97 | ("fluviometric" or "pluviometric" allowed)'
98 | )
99 | }
100 |
101 | ## Query
102 | # Create list to receive results
103 | serie <- list()
104 |
105 | # Assert stationType for query
106 | if (inventoryResult$stationType[1] == "fluviometric") {
107 | stationType <- 3
108 | } else if (inventoryResult$stationType[1] == "pluviometric") {
109 | stationType <- 2
110 | } else {
111 | stop('Inventory missing stationType column/parameter
112 | ("fluviometric" or "pluviometric" allowed)')
113 | }
114 |
115 | #waterLevel or streamFlow for fluviometric stations
116 | if(waterLevel == TRUE & stationType ==3){
117 |
118 | stationType = 1
119 |
120 | }
121 |
122 |
123 | # Begin loop to retrieve data
124 | for (i in 1:nrow(inventoryResult)) {
125 | # Subset station_code
126 | station_number <- inventoryResult$station_code[i]
127 |
128 | # Query for station
129 | html_raw <- xml2::read_html(
130 | paste("http://telemetriaws1.ana.gov.br/ServiceANA.asmx/HidroSerieHistorica?codEstacao=",
131 | station_number,
132 | "&dataInicio=&dataFim=&tipoDados=",
133 | stationType,
134 | "&nivelConsistencia=",
135 | sep = ""
136 | )
137 | )
138 |
139 | station_df <- html_raw %>%
140 | # Retrieve station data
141 | xml2::xml_find_all(".//documentelement") %>%
142 | xml2::xml_children() %>%
143 | xml2::as_list()
144 |
145 | # Convert list to rows
146 | station_df<- lapply(station_df, function(row) {
147 | # Fill empty arguments with NA so columns are preserved
148 | row[sapply(row, function(x) { length(x) == 0})] <- NA
149 | row %>%
150 | unlist() %>%
151 | t() %>%
152 | dplyr::as_tibble()
153 | }) %>%
154 | # Binding rows
155 | do.call(what = dplyr::bind_rows)
156 |
157 |
158 | # Is there data for this station?
159 | if (ncol(station_df) == 1) {
160 | serie[[i]] <- "No Data"
161 | } else {
162 | station_df <- station_df %>%
163 | # Convert flow/precipitation columns to numeric and datahora to date format
164 | dplyr::mutate(
165 | dplyr::across(dplyr::matches("vazao..$"), as.numeric),
166 | dplyr::across(dplyr::matches("chuva..$"), as.numeric),
167 | dplyr::across(dplyr::matches("cota..$"), as.numeric),
168 | dplyr::across(dplyr::matches("data"), as.Date)
169 | ) %>%
170 | dplyr::rename(data = dplyr::any_of("datahora")) %>%
171 | dplyr::arrange(dplyr::across('data'))
172 |
173 | serie[[i]] <- station_df
174 | }
175 |
176 | print(paste(i, "/", length(inventoryResult$station_code), " (station ", station_number, " done)", sep = ""))
177 | }
178 |
179 | # Name list objects according to station codes
180 | names(serie) <- inventoryResult$station_code
181 |
182 | # Remove stations with missing data?
183 | if (deleteNAstations == TRUE) {
184 | serie <- serie[serie != "No Data"]
185 | }
186 |
187 | # # Create attribute to facilitate input/output check
188 | # attr(serie, 'hydrobr_class') <- 'stationsData'
189 | return(serie)
190 | }
191 |
--------------------------------------------------------------------------------
/R/mMonthlyPlot.R:
--------------------------------------------------------------------------------
1 | #' Plot streamflow or rainfall monthly average graph
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Plot streamflow or rainfall monthly average to help users identify hydrological year
6 | #'
7 | #' @param organizeResult list, tibble data frame; provides a list containing
8 | #' the data frames of raw records for each station downloaded from ANA web API
9 | #' (output from [hydrobr::organize()] function).
10 | #' @param maxMissing numeric; indicates the maximum threshold of missing data allowed at each year.
11 | #' The default is 10 percent.
12 | #' @param minYears numeric; indicates the minimum years of complete data allowed. The
13 | #' default is 15 years.
14 | #' @param consistedOnly logical; should only consisted data be considered?
15 | #' The default is TRUE.
16 | #'
17 | #' @return Saved plot.
18 | #'
19 | #' @examplesIf interactive()
20 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
21 | #'
22 | #' inv <- inventory(
23 | #' states = "MINAS GERAIS",
24 | #' stationType = "flu",
25 | #' as_sf = TRUE,
26 | #' aoi = NULL
27 | #' )
28 | #'
29 | #' # Download the first 10 stations from the inventory
30 | #'
31 | #' s_data <- stationsData(
32 | #' inventoryResult = inv[1:10,],
33 | #' deleteNAstations = TRUE
34 | #' )
35 | #'
36 | #' # Organize the data for the stations
37 | #'
38 | #' org_data <- organize(
39 | #' stationsDataResult = s_data
40 | #' )
41 | #'
42 | #' # Filter the data for desired period and quality control
43 | #'
44 | #' mMonthlyPlot(
45 | #' stationsDataResult = org_data,
46 | #' maxMissing = 10,
47 | #' minYears = 15,
48 | #' consistedOnly = FALSE
49 | #' )
50 | #'
51 | #' @export
52 | #' @importFrom rlang .data
53 | mMonthlyPlot = function(organizeResult,
54 | maxMissing = 10,
55 | minYears = 15,
56 | consistedOnly = TRUE){
57 |
58 |
59 | # ## Verification if arguments are in the desired format
60 | # # is stationsDataResult an outcome from stationsData function?
61 | # if (!attributes(organizeResult)$hydrobr_class %in% 'organize') {
62 | # stop(
63 | # call. = FALSE,
64 | # '`organizeResult` does not inherit attribute "organize".
65 | # The outcome from the organize() function should be passed as argument'
66 | # )
67 | # }
68 |
69 | # Is maxMissing numeric
70 | if (!is.numeric(maxMissing) | length(maxMissing) != 1) {
71 | stop(
72 | call. = FALSE,
73 | '`maxMissing` should be a numeric vector of length == 1 (ex: 10).
74 | See arguments details for more information.'
75 | )
76 | }
77 |
78 | # Is minYears numeric
79 | if (!is.numeric(minYears) | length(minYears) != 1) {
80 | stop(
81 | call. = FALSE,
82 | '`minYears` should be a numeric vector of length == 1 (ex: 15).
83 | See arguments details for more information.'
84 | )
85 | }
86 |
87 | # is consistedOnly logical?
88 | if (!is.logical(consistedOnly) | length(consistedOnly) != 1) {
89 | stop(
90 | call. = FALSE,
91 | "`consistedOnly` should be logical and have length == 1 (either TRUE or FALSE)."
92 | )
93 | }
94 |
95 | #################
96 |
97 |
98 | # Type of station?
99 | if (any(names(organizeResult[[1]]) %in% "streamflow_m3_s")) {
100 | stationType <- "flu"
101 | } else {
102 | stationType <- "plu"
103 | }
104 |
105 | varName <- switch (stationType, plu = 'rainfall_mm', flu = 'streamflow_m3_s')
106 |
107 | ##
108 | # Single workflow regardless of station type
109 | organizeResultDF <- organizeResult %>%
110 | # Join all stations into single df
111 | dplyr::bind_rows() %>%
112 | # Rename streamflow/precipitation variable
113 | dplyr::rename('value' = varName)
114 |
115 |
116 | # Create civil and water year columns
117 | organizeResultDF <- organizeResultDF %>%
118 | dplyr::mutate(
119 | # Retrieve year from date
120 | civilYear = lubridate::year(.data$date)
121 | )
122 |
123 | # Are only consisted data to be considered?
124 | if (consistedOnly == TRUE) {
125 | organizeResultDF <- organizeResultDF %>%
126 | # Instead of filtering, we change them to NA, so we know where there was inconsistent data
127 | dplyr::mutate(value = dplyr::if_else(.data$consistency_level == 2, .data$value, NA_real_))
128 | }
129 |
130 | # Identify civil years with less than `maxMissing` years
131 | failuredf <- organizeResultDF %>%
132 | # Group by station and civilYear
133 | dplyr::group_by_at(c('station_code', 'civilYear')) %>%
134 | # Number of observations in each group
135 | dplyr::summarise(
136 | N = dplyr::if_else(
137 | length(.data$value) < 365,
138 | 365,
139 | length(.data$value) %>% as.double()),
140 | # Percentage of missing data
141 | missing = 100*sum(is.na(.data$value))/.data$N,
142 | .groups = "drop_last") %>%
143 | # Adjust missing to logical based on `maxMissing`
144 | dplyr::mutate(missing = .data$missing <= maxMissing)
145 |
146 | # Organize plot data
147 | plotData <- organizeResultDF %>%
148 | dplyr::ungroup() %>%
149 | # Join with failure matrix
150 | dplyr::left_join(failuredf, by = c("station_code", "civilYear")) %>%
151 | #filter year with less that "minporc"
152 | dplyr::filter(missing == TRUE) %>%
153 | dplyr::group_by_at('station_code') %>%
154 | #count number of years of each station and verify if there is all months (1:12)
155 | dplyr::mutate(lengthYears = length(unique(.data$civilYear)),
156 | lengthMonths = length(unique(lubridate::month(.data$date)))) %>%
157 | #stations with minimal year and all months
158 | dplyr::filter(.data$lengthYears >= minYears & .data$lengthMonths >= 12)
159 |
160 | plot <- plotData %>%
161 | # Compute civil month
162 | dplyr::mutate(monthCY = factor(lubridate::month(date), levels = 1:12)) %>%
163 | # Group by station and month
164 | dplyr::group_by_at(c("station_code", "monthCY")) %>%
165 | # Calc average for streamflow, sum for monthly precipitation
166 | dplyr::summarise(
167 | value = if (varName == "streamflow_m3_s")
168 | {mean(.data$value, na.rm = TRUE)} else
169 | {sum(.data$value, na.rm = TRUE)/length(unique(.data$civilYear))}, .groups = 'drop') %>%
170 | # Plot
171 | ggplot2::ggplot()+
172 | ggplot2::aes(x = .data$monthCY,
173 | y = .data$value) +
174 | ggplot2::geom_col() +
175 | ggplot2::facet_wrap(ggplot2::vars(station_code), scale = "free")+
176 | ggplot2::theme_bw(base_size = 12)+
177 | ggplot2::labs(x = "Month",
178 | y = if (varName == "streamflow_m3_s")
179 | {expression(paste("Average streamflow (m"^3," s"^-1,")"))} else
180 | {expression(paste("Average rainfall (mm month"^-1,")"))})
181 |
182 | # Plot!
183 | return(plot)
184 | }
185 |
186 |
187 | # if(getRversion() >= "2.15.1") utils::globalVariables(c("value", "monthCY"))
188 |
--------------------------------------------------------------------------------
/vignettes/intro_to_hydrobr.Rmd:
--------------------------------------------------------------------------------
1 | ---
2 | title: "hydrobr package: Introduction"
3 | subtitle: "Accessing the Brazilian National Water Agency (ANA) database"
4 | date: "2022-07-02"
5 | output: rmarkdown::html_vignette
6 | vignette: >
7 | %\VignetteEncoding{UTF-8}
8 | %\VignetteIndexEntry{hydrobr package: Introduction}
9 | %\VignetteEngine{knitr::rmarkdown}
10 | editor_options:
11 | chunk_output_type: console
12 | ---
13 |
14 | ```{r, include = FALSE}
15 | knitr::opts_chunk$set(
16 | collapse = TRUE,
17 | comment = "#>"
18 | )
19 | ```
20 |
21 | # Introduction
22 |
23 | The objective of this vignette is to present the first and main functions developed for `hydrobr` package. This vignette will show how to access the inventory, download, pre-process and filter fluviometric/pluviometric stations from the Brazilian National Water Agency (ANA) database for an arae of interest. The first step is to load the package in your session. Here we'll also load the `ggplot2`, `sf`, and `dplyr` packages which will be used for illustrations/examples.
24 |
25 | ```{r setup}
26 | library(hydrobr)
27 | library(ggplot2)
28 | library(sf)
29 | library(dplyr)
30 | ```
31 |
32 | ## 1 Stations inventory
33 |
34 | First of all you need to know the stations that you want to download. You can do it searching manually on ANA inventory and provide this data to R in a data.frame (or tibble) format. In this example, we create a inventory data.frame for two desired fluviometric stations.
35 |
36 | ```{r manual_inventory, warning=F}
37 | ## Generating manual inventory
38 | inv_manual = data.frame(station_code = c("42600000","42690001"),
39 | stationType = "fluviometric")
40 |
41 | inv_manual
42 |
43 | ```
44 |
45 | Another way to do so, is using the `hydrobr::inventory()` function, you access the list of gauge stations for an area of interest. You can either provide the list of states for argument `states` or a object (polygon) of class `sf` to argument `aoi`. You must also specify the type of stations that you are interested on to argument `stationType` ("plu" = pluviometric, "flu" = fluviometric). Finally, you can also choose if you want the output to be returned as a `sf` object or `tibble` through argument `as_sf`. Check function description for more details ("?inventory")
46 |
47 | In this example, we'll access the list of fluviometric stations both by providing a state ("ACRE") and by providing a sf object (Pantanal biome). The sf file will be accessed using the `geobr` package.
48 |
49 | ```{r pantanal, results='hide', warning=F}
50 | ## Downloading Cerrado biome boundaries
51 | pantanal <- geobr::read_biomes()[6,]
52 | ```
53 |
54 | ```{r inventory, warning=F}
55 | ## Visualize the sf object
56 | ggplot(pantanal) + geom_sf()
57 |
58 | ## Access inventory
59 | ## By listing state(s)
60 | inv_flu_acre <- inventory(
61 | states = 'ACRE',
62 | stationType = 'flu',
63 | as_sf = F
64 | )
65 | ## Check first lines
66 | head(inv_flu_acre)
67 |
68 | ## By providing sf object
69 | inv_flu_pantanal <- inventory(
70 | stationType = 'flu',
71 | as_sf = T,
72 | aoi = pantanal
73 | )
74 | ## Check first lines
75 | head(inv_flu_pantanal)
76 |
77 | ```
78 |
79 | The same workflow applies if you choose `stationType = 'plu'`. Note that by passing the argument `as_sf = T`, it returns a simple feature collection which may be used directly in spatial analysis/illustrations.
80 |
81 | ```{r inventoryplot, warning=F}
82 | ## inventory: Acre state
83 | ggplot(inv_flu_acre) +
84 | geom_point(aes(x = long, y = lat)) +
85 | coord_sf(crs = 4326) +
86 | theme(axis.title = element_blank())
87 |
88 | ## inventory: Pantanal
89 | ggplot() +
90 | geom_sf(data = pantanal) +
91 | geom_sf(data = inv_flu_pantanal)
92 | ```
93 |
94 | ## 2 Data download
95 |
96 | The next step is to download the time series for each station. We'll use the function `hydrobr::stationsData` which returns raw data from the Brazilian National Water Agency database for the stations inventory. The user can choose wether to maintain stations with missing data through the argument `deleteNAstations`. Check function description for more details ("?stationsData")
97 |
98 | This step might take a while depending on how many stations is in your inventory. For brevity, we'll only download the first 10 stations from the inventory list for ACRE.
99 |
100 | ```{r downloaddata, warning=F}
101 | ## Data download
102 | data_flu_acre <- stationsData(
103 | # [1:10,] specifics that you are interest only in the first 10 rows (stations)
104 | inventoryResult = inv_flu_acre[1:10,],
105 | deleteNAstations = T
106 | )
107 |
108 | ## How many stations have data available?
109 | str(data_flu_acre, max.level = 1)
110 | ```
111 |
112 | The output structure is a "List of 6", meaning that only 6 out of the 10 first stations in the inventory list have data available. Note that this stations are in the exact same format as provided by ANA. Example for first station downloaded:
113 |
114 | ```{r dataformat}
115 | ## Check first station downloaded
116 | data_flu_acre[[1]]
117 | ```
118 |
119 | ## 3 Organizing data
120 |
121 | Because the downloaded data is not in a format easy to work with, we can use the function `hydrobr::organize()` to organize the data into tidy data frames. The output will contain only columns for station code, data consistency level, date, and either rainfall or streamflow data. Check function description for more details ("?organize").
122 |
123 | ```{r organize}
124 | ## Organize stations data
125 | tidy_data_acre <- organize(stationsDataResult = data_flu_acre)
126 | str(tidy_data_acre, max.level = 1)
127 |
128 | ## Check first station
129 | ## First rows
130 | tidy_data_acre[[1]]
131 | ## summary
132 | summary(tidy_data_acre[[1]])
133 |
134 | ## Instead of working with a list of stations data, the user can also combine all data frames into a single data.frame
135 | bind_rows(tidy_data_acre)
136 | ```
137 |
138 | ## 4 Pre-process and filter data
139 |
140 | Next, we can use the `hydrobr::selectStations()` function to (i) filter the time series within a range of years, (ii) filters out months or years exceeding the maximum threshold of missing data, and (iii) filters out stations with less than a minimum years of complete observations. This function also provides a plot summarising the data availability by default. Check function description for more details on arguments ("?selectStations").
141 |
142 | ```{r filterdata, fig.width=6}
143 | flu_acre <- selectStations(
144 | # Pass on output from organize() function
145 | organizeResult = tidy_data_acre,
146 | # Decide by either yearly or monthly filter
147 | mode = "yearly",
148 | # Filter years with a maximum % of missing data
149 | maxMissing = 10,
150 | # Filter stations with a minimum of years available
151 | minYears = 15,
152 | # use civil year (month = 1) or define month for water year
153 | month = 1,
154 | # filter from initial to final years (or NULL to use entire time series)
155 | iniYear = 1980,
156 | finYear = 2020,
157 | # Use only consisted or raw data as well?
158 | consistedOnly = FALSE,
159 | # Plot figure? TRUE by default
160 | plot = TRUE
161 | )
162 |
163 | ## It returns a list of 4 objects as output
164 | str(flu_acre, max.level = 1)
165 |
166 | ## The station data are in the first object of the list = a list of data frames for the stations data
167 | ## Acessing the first one
168 | flu_acre$series[[1]]
169 |
170 | # Bind them all together
171 | bind_rows(flu_acre$series)
172 | ```
173 |
174 | ### Session info
175 | ```{r sessioninfo, echo=F}
176 | version
177 | sessionInfo()
178 | ```
179 |
--------------------------------------------------------------------------------
/R/inventory.R:
--------------------------------------------------------------------------------
1 | #' Retrieves stations inventory from ANA web API.
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Downloads pluviometric and fluviometric stations inventory from
6 | #' the Brazilian National Water Agency (ANA) and returns a tidy
7 | #' data frame [tibble::tibble()] object. The inventory is optionally
8 | #' returned as simple features [sf::st_as_sf()] object (CRS: WGS84).
9 | #' The user can alternatively provide an area of interest to download all
10 | #' stations within its boundaries.
11 | #'
12 | #' @param states character vector; state(s) name(s) that you wish to download
13 | #' data for. Example: \dQuote{MINAS GERAIS}, \dQuote{DISTRITO FEDERAL},
14 | #' \dQuote{GOIÁS}, etc. Ignored if argument \code{aoi} is passed.
15 | #' @param stationType character; indicates what type of stations
16 | #' to download. Supported values are \dQuote{flu} (fluviometric)
17 | #' and \dQuote{plu} (pluviometric). The default is \dQuote{plu}.
18 | #' @param as_sf logical; should inventory be returned as \code{sf} object?
19 | #' The default is FALSE
20 | #' @param aoi object of class \code{sf} (polygon). Provides the boundaries
21 | #' where stations should be limited to (optional). Overrides `states` argument.
22 | #'
23 | #' @return A data frame (either a \code{tibble} or a \code{sf}) containing the
24 | #' following columns:
25 | #' state: state name (chr).
26 | #' station_code: station unique identifier (chr).
27 | #' lat: latitude (dbl).
28 | #' long: longitude (dbl).
29 | #' stationType: station type (chr).
30 | #'
31 | #' @references
32 | #' Dados Abertos da Agência Nacional de Águas e Saneamento Básico.
33 | #'
34 | #'
35 | #'
36 | #' HIDRO - Inventário pluviométrico/fluviométrico atualizado.
37 | #'
38 | #'
39 | #'
40 | #' @examplesIf interactive()
41 | #' # Fetch pluviometric "plu" stations for the states of "GOIÁS" and "MINAS GERAIS"
42 | #'
43 | #'\dontrun{
44 | #' inventory(
45 | #' states = c("GOIÁS", "MINAS GERAIS"),
46 | #' stationType = "plu",
47 | #' as_sf = TRUE,
48 | #' aoi = NULL
49 | #' )
50 | #'
51 | #'}
52 | #' @export
53 | inventory <- function(states, stationType = "plu", as_sf = F, aoi = NULL) {
54 |
55 |
56 | # Retrieve Brazilian states list
57 | br_states <- xml2::read_html("http://telemetriaws1.ana.gov.br//ServiceANA.asmx/HidroEstado?codUf=") %>%
58 | xml2::xml_find_all(".//nome") %>%
59 | xml2::xml_contents() %>%
60 | xml2::xml_text()
61 | br_states <- br_states[1:27]
62 |
63 | ## Verification if arguments are in the desired format
64 | suppressMessages(sf::sf_use_s2(FALSE))
65 | # Was a sf passed as aoi?
66 | if (!is.null(aoi)) {
67 | if (!any(class(aoi) == "sf")) {
68 | stop(
69 | call. = FALSE,
70 | "Provided `aoi` is not a polygon/multipolygon sf object"
71 | )
72 | } else if (!sf::st_is(aoi, c("MULTIPOLYGON", "POLYGON"))) {
73 | stop(
74 | call. = FALSE,
75 | "Provided `aoi` is not a polygon/multipolygon sf object"
76 | )
77 | } else {
78 | cat("Subsetting states in AOI... \n")
79 |
80 | # So it can use WGS84 for intersection
81 | aoi <- aoi %>% sf::st_transform(crs = "WGS84")
82 |
83 | # Update states character vector
84 | states <- suppressMessages(
85 | geobr::read_state(
86 | code_state = "all",
87 | year = 2017,
88 | simplified = TRUE,
89 | showProgress = FALSE
90 | ) %>%
91 | sf::st_transform(crs = "WGS84") %>%
92 | # Get intersection with area of interest
93 | sf::st_intersection(aoi) %>%
94 | dplyr::as_tibble() %>%
95 | # Select states name and convert to character vector
96 | dplyr::select(dplyr::all_of('name_state')) %>%
97 | apply(2, toupper) %>%
98 | as.vector()
99 | )
100 | }
101 | }
102 |
103 | # Is states a character vector?
104 | if (!is.character(states)) {
105 | stop(
106 | call. = FALSE,
107 | "`states` should be a character vector. See arguments details."
108 | )
109 | }
110 |
111 | # States in states list?
112 | if (!all(states %in% br_states)) {
113 | stop(
114 | call. = FALSE,
115 | paste0(
116 | "From `states`: ",
117 | paste(states[which(!states %in% br_states)], collapse = ", "),
118 | " not in Brazilian states list. See arguments details."
119 | )
120 | )
121 | }
122 |
123 | # stationType lenght
124 | if (length(stationType) != 1) {
125 | stop(
126 | call. = FALSE,
127 | '`stationType` should have length == 1 (either "plu" or "flu").'
128 | )
129 | }
130 |
131 | # stationType argument
132 | if (!any(stationType %in% c("plu", "flu"))) {
133 | stop(
134 | call. = FALSE,
135 | '`stationType` should be either "plu" or "flu".'
136 | )
137 | }
138 |
139 | # is as_sf logical?
140 | if (!is.logical(as_sf) | length(as_sf) != 1) {
141 | stop(
142 | call. = FALSE,
143 | "`as_sf` should be logical and have length == 1 (either TRUE or FALSE)."
144 | )
145 | }
146 |
147 | ## Query
148 | # Create empty list to receive stations info
149 | serief <- list()
150 |
151 | # Define type of station to download
152 | if (stationType == "flu") {
153 | stationType <- 1
154 | } else {
155 | stationType <- 2
156 | }
157 |
158 | # Loop to download inventory using ANA's API by state
159 | cat("Downloading... \n")
160 | for (i in 1:length(states)) {
161 | # Adjusting string for API query
162 | estadoG <- gsub(" ", "%20", states[i])
163 |
164 | # Raw HTML to retrieve stations inventory
165 | html_raw1 <- xml2::read_html(paste("http://telemetriaws1.ana.gov.br/ServiceANA.asmx/HidroInventario?codEstDE=&codEstATE=&tpEst=", stationType, "&nmEst=&nmRio=&codSubBacia=&codBacia=&nmMunicipio=&nmEstado=", estadoG, "&sgResp=&sgOper=&telemetrica=", sep = ""))
166 |
167 | # Scrapping info for each station
168 | estac <- as.data.frame(cbind(
169 | xml2::xml_text(xml2::xml_contents(xml2::xml_find_all(html_raw1, ".//nmestado"))),
170 | xml2::xml_double(xml2::xml_contents(xml2::xml_find_all(html_raw1, ".//codigo"))),
171 | xml2::xml_text(xml2::xml_contents(xml2::xml_find_all(html_raw1, ".//nome"))),
172 | xml2::xml_double(xml2::xml_contents(xml2::xml_find_all(html_raw1, ".//latitude"))),
173 | xml2::xml_double(xml2::xml_contents(xml2::xml_find_all(html_raw1, ".//longitude"))),
174 | xml2::xml_double(xml2::xml_find_all(html_raw1, ".//areadrenagem"))
175 | ))
176 |
177 | # Filtering
178 | estac <- estac %>%
179 | # Convert to tibble format
180 | dplyr::as_tibble() %>%
181 | # Reassure stations are from the desired state
182 | dplyr::filter(estac$V1 == states[i]) %>%
183 | # Eliminate duplicate rows by station_code
184 | dplyr::distinct_at(2, .keep_all = TRUE) %>%
185 | # Rename columns
186 | rlang::set_names(c("state", "station_code", "name", "lat", "long", "area_km2")) %>%
187 | # Change area_km2 class to numeric
188 | dplyr::mutate(dplyr::across('area_km2', .fns = as.numeric))
189 |
190 | # Save stations by state in list format
191 | serief[[i]] <- estac
192 | cat(states[i], " finished. \n")
193 | }
194 |
195 | # Bind all states inventory together in single data frame
196 | serief <- do.call(rbind, serief)
197 |
198 | # Create additional column to inform type of station
199 | if (stationType == 2) {
200 | serief <- serief %>%
201 | dplyr::mutate(stationType = "pluviometric") %>%
202 | # If stationType == 'pluviometric', remove drainage area column
203 | dplyr::select(-'area_km2')
204 | } else {
205 | serief <- serief %>%
206 | dplyr::mutate(stationType = "fluviometric")
207 | }
208 |
209 | # Return final object
210 | columns_to_select <- c('state', 'station_code', 'name', 'lat', 'long', 'stationType', 'area_km2', 'geometry')
211 | serief <- serief %>% sf::st_as_sf(coords = c("long", "lat"), crs = 'WGS84')
212 | serief <- serief %>%
213 | dplyr::mutate(
214 | lat = sf::st_coordinates(serief$geometry)[, 2],
215 | long = sf::st_coordinates(serief$geometry)[, 1]
216 | ) %>%
217 | dplyr::select(dplyr::any_of(columns_to_select))
218 |
219 | # If aoi is provided, subset the stations
220 | if (!is.null(aoi)) {
221 | serief <- suppressMessages(serief[aoi, ])
222 | }
223 |
224 | # Return object either as tibble or sf
225 | if (as_sf == F) {
226 | serief <- serief %>% dplyr::as_tibble() %>% dplyr::select(-'geometry')
227 | }
228 |
229 | # Create attribute to facilitate input/output check
230 | # attr(serief, 'hydrobr_class') <- 'inventory'
231 | return(serief)
232 | }
233 |
234 |
235 |
--------------------------------------------------------------------------------
/R/downloadTerraClimateParallel.R:
--------------------------------------------------------------------------------
1 | #' Download terraClimate monthly data
2 | #'
3 | #' @description
4 | #' Download TerraClimate monthly data based on area of interest
5 | #'
6 | #' @param aoi spatVector object. Provides the boundaries where chirps data should be limited to (datum = WGS84).
7 | #' @param dir_out character. Directory where you want to save the raster images that you are going to download.
8 | #' @param variable character. Variable to download. See details for more information.
9 | #' @param years numeric. The period in years that the function should download images.
10 | #' @param ncores numeric. numeric. The number of processor cores to use for parallelizing the download operation. Default is 1 (no parallelization).
11 | #' @param retry numeric. numeric. The number of retry attempts for failed downloads. Default is 100.
12 | #' @param timeout numeric.numeric. The timeout in seconds for each download attempt. Default is 600.
13 | #'
14 | #' @details
15 | #'
16 | #' - Variable descriptions:
17 | #'
18 | #' aet (Actual Evapotranspiration, monthly total), units = mm
19 | #'
20 | #' def (Climate Water Deficit, monthly total), units = mm
21 | #'
22 | #' pet (Potential evapotranspiration, monthly total), units = mm
23 | #'
24 | #' ppt (Precipitation, monthly total), units = mm
25 | #'
26 | #' q (Runoff, monthly total), units = mm
27 | #'
28 | #' soil (Soil Moisture, total column - at end of month), units = mm
29 | #'
30 | #' srad (Downward surface shortwave radiation), units = W/m2
31 | #'
32 | #' swe (Snow water equivalent - at end of month), units = mm
33 | #'
34 | #' tmax (Max Temperature, average for month), units = C
35 | #'
36 | #' tmin (Min Temperature, average for month), units = C
37 | #'
38 | #' vap (Vapor pressure, average for month), units = kPa
39 | #'
40 | #' ws (Wind speed, average for month), units = m/s
41 | #'
42 | #' vpd (Vapor Pressure Deficit, average for month), units = kpa
43 | #'
44 | #' PDSI (Palmer Drought Severity Index, at end of month), units = unitless
45 | #'
46 | #' @returns raster files of each year containing 12 layers each (1 for each month of given year).
47 | #'
48 | #' @references adapted from download_terraclimate function of cropDemand package.
49 | #'
50 | #' https://search.r-project.org/CRAN/refmans/cropDemand/html/00Index.html
51 | #'
52 | #' Abatzoglou, J.T., S.Z. Dobrowski, S.A. Parks, K.C. Hegewisch, 2018, Terraclimate, a high-resolution global dataset of monthly climate and climatic water balance from 1958-2015, Scientific Data,
53 | #'
54 | #' @export
55 | #' @examples
56 | #'
57 | #'\dontrun{
58 | #'
59 | #'require(terra)
60 | #'
61 | #'area_of_interest = vect("./paracatu.shp")
62 | #'
63 | #'
64 | #'pptAoi = downloadTerraClimateParallel(dir_out = "./temp/terraClimate",
65 | #' variable = "ppt",
66 | #' years = c(1990:2000),
67 | #' ncores = 5,
68 | #' aoi = area_of_interest)
69 | #'
70 | #'
71 | #'
72 | #'#set sequential plan
73 | #'future::plan(future::sequential)
74 | #'
75 | #'}
76 | #'
77 |
78 | downloadTerraClimateParallel = function (aoi,
79 | dir_out,
80 | variable,
81 | years,
82 | ncores = 1,
83 | retry = 10,
84 | timeout = 600)
85 |
86 | {
87 |
88 | stopifnot(`\`dir_out\` parameter must be character indicating output folder path (i.e \`c:/temp\`)` = is.character(dir_out),
89 | `\`variable\` must be \`ppt\` or \`eto\`` = variable %in%
90 | c("ppt", "aet", "def", "pet", "q", "soil", "srad",
91 | "swe", "tmax", "tmin", "vap", "ws", "vpd", "PDSI"),
92 | `\`years\` must be numeric vector containing years to be downloaded` = is.numeric(years),
93 | `\`aoi\` must be a polygon of class \`SpatVector\` (terra package)` = class(aoi) ==
94 | "SpatVector")
95 |
96 | #criar diretório de saída
97 | dir.create(dir_out, recursive = F, showWarnings = FALSE)
98 |
99 | #converster sistema de coordenadas da área de interesse para wgs84
100 | aoi = terra::project(aoi, y = "epsg:4326")
101 |
102 | #links para download----
103 |
104 | links = sapply(years, function(year) {
105 |
106 | baseurl <- paste0("http://thredds.northwestknowledge.net:8080/thredds/fileServer/TERRACLIMATE_ALL/data/TerraClimate_",
107 | variable, "_", year, ".nc")
108 | })
109 |
110 | #nomes dos arquivos de saída----
111 |
112 | names = sapply(years, function(year) {
113 |
114 | name_img <- paste0("terraclimate_", variable, "_",
115 | year, ".nc")
116 |
117 | outfile <- paste0(dir_out, "/", name_img)
118 | })
119 |
120 |
121 | #combinando url e diretorios de saida
122 |
123 | info = tibble::tibble(url = links,
124 | outdir = names)
125 |
126 |
127 | #funcao para baixar 1 imagem
128 |
129 | download_tile <- function(url, destfile, timeout) {
130 |
131 | options(timeout = timeout)
132 |
133 | flag <- tryCatch(
134 | {
135 | utils::download.file(
136 | url = url, method = "libcurl",
137 | destfile = destfile, mode = "wb", quiet = FALSE
138 | )
139 |
140 | "sucesso"
141 | },
142 | error = function(e) {
143 | "download_failed"
144 | },
145 | warning = function(w) {
146 | "download_failed"
147 | }
148 | )
149 |
150 | return(flag)
151 |
152 | }
153 |
154 | # download_tile(url = links[1], destfile = names[1], timeout = 5)
155 |
156 | #funcao para baixar tiles em paralelo com retry
157 |
158 | # url = links
159 | # destfile = names
160 | # timeout = 60
161 |
162 | download_tile_with_retry <- function(url, destfile, retry, timeout) {
163 |
164 | failed_downloads <- which(rep(TRUE, length(url)))
165 |
166 | results = rep("download_failed", length(url))
167 | attempt = 1
168 | for (attempt in 1:retry) {
169 |
170 | # print(attempt)
171 |
172 | if (length(failed_downloads) > 0) {
173 |
174 | p <- progressr::progressor(along = 1:length(failed_downloads))
175 |
176 | results[failed_downloads] <- future.apply::future_lapply(failed_downloads,
177 |
178 | FUN = function(i) {
179 |
180 | p()
181 |
182 | download_tile(
183 | url = url[i],
184 | destfile = destfile[i],
185 | timeout = timeout
186 | )
187 |
188 |
189 |
190 | }
191 | )
192 |
193 | failed_downloads <- which(sapply(results, function(w) {
194 | unique(as.character(w) == "download_failed")
195 |
196 | }))
197 | }
198 |
199 | if (length(failed_downloads) == 0) {
200 |
201 | print(paste0("Download Complete"))
202 |
203 | break}
204 |
205 | }
206 |
207 | return(failed_downloads)
208 |
209 | }
210 |
211 |
212 |
213 | progressr::handlers("txtprogressbar")
214 |
215 | future::plan(future::multisession, workers = ncores)
216 |
217 | progressr::handlers(global = TRUE)
218 |
219 | teste = suppressWarnings(download_tile_with_retry(url = links,
220 | destfile = names,
221 | retry = retry,
222 | timeout = timeout))
223 |
224 |
225 |
226 | future::plan(future::sequential)
227 |
228 | #funcao para ler rasters baixados, cortar e exportar como tif
229 |
230 | lerRasters = function(imagens){
231 |
232 | img <- terra::rast(imagens)
233 |
234 | terra::crs(img) <- "EPSG:4326"
235 |
236 | img <- terra::crop(img, aoi)
237 |
238 | img <- terra::mask(img, aoi)
239 |
240 | unlink(imagens)
241 |
242 | ano = substr(imagens, nchar(imagens) - 7 + 1, nchar(imagens)-3)
243 |
244 | names(img) = paste0(variable, "_", seq(as.Date(paste0(ano, "-01-01")), as.Date(paste0(ano, "-12-01")), by = "month"))
245 |
246 | terra::writeRaster(img, filename = gsub(imagens, replacement = ".tif", pattern = ".nc"),
247 | filetype = "GTiff", overwrite = TRUE)
248 |
249 | }
250 |
251 | #
252 |
253 | finalRaster = terra::rast(lapply(names, FUN = lerRasters))
254 |
255 | unlink(list.files(dir_out, pattern = ".json", full.names = T))
256 |
257 | return(finalRaster)
258 |
259 | }
260 |
261 |
262 |
263 |
264 |
265 |
266 | if(getRversion() >= "2.15.1") utils::globalVariables(c("variable"))
267 |
--------------------------------------------------------------------------------
/R/fillGaps.R:
--------------------------------------------------------------------------------
1 | #' (UNDER DEVELOPMENT) Fill gaps at monthly or annual time series
2 | #'
3 | #' @encoding UTF-8
4 | #'
5 | #' @description Takes as input a list containing annual or monthly time series statistic
6 | #' for each station (output from [hydrobr::seriesStatistics()])
7 | #' and try to fill gaps based on linear regression among them.
8 | #'
9 | #' @param StatisticsResult list, tibble data frame; A list containing statistic data frame [tibble::tibble()] object
10 | #' for each station (output from [hydrobr::seriesStatistics()]).
11 | #' @param minimumCor value; minimum correlation between stations. default = 0.84
12 | #' @param minimunObsPairs value; minimum of observation pairwise between stations to be filled with.
13 | #' If 'StatisticsResult' is annual time series, minimunObsPairs is equal to number of commom years.
14 | #' If 'StatisticsResult' is monthly time series, minimunObsPairs is equal to number of common months.
15 | #'
16 | #' @return A list containing 4 objects:
17 | #' * a list containing statistic a data frame [tibble::tibble()] object for each station.
18 | #' gap filled.
19 | #' * a data frame [tibble::tibble()] with statistic of all stations in wide format
20 | #' * a data frame [tibble::tibble()] with statistic of all stations in longer format
21 | #' * a failureMatrix indicating if the gap was filled (TRUE) or not (FALSE)
22 | #' * the saved plot.
23 |
24 | #' @examplesIf interactive()
25 | #' # Fech a inventory of fluviometric stations for the state of Minas Gerais
26 | #'
27 | #' inv <- inventory(
28 | #' states = "MINAS GERAIS",
29 | #' stationType = "flu",
30 | #' as_sf = TRUE,
31 | #' aoi = NULL
32 | #' )
33 | #'
34 | #' # Download the first 10 stations from the inventory
35 | #'
36 | #' s_data <- stationsData(
37 | #' inventoryResult = inv[1:10,],
38 | #' deleteNAstations = TRUE
39 | #' )
40 | #'
41 | #' # Organize the data for the stations
42 | #'
43 | #' org_data <- organize(
44 | #' stationsDataResult = s_data
45 | #' )
46 | #'
47 | #' # Filter the data for desired period and quality contorl
48 | #'
49 | #' final_data <- selectStations(
50 | #' stationsDataResult = org_data,
51 | #' mode = "yearly",
52 | #' maxMissing = 10,
53 | #' minYears = 15,
54 | #' month = 1,
55 | #' iniYear = NULL,
56 | #' finYear = NULL,
57 | #' consistedOnly = FALSE,
58 | #' plot = TRUE
59 | #' )
60 | #'
61 | #' # Annual mean stream flow serie for each station
62 | #' Qmean_years = flowStatistics(final_data, statistics = "Qmean")
63 | #'
64 | #' #fill Gaps of Annual time series
65 | #'
66 | #' Qmean_years_filled = fillGaps(StatisticsResult = Qmean_years,
67 | #' minimumCor = 0.84,
68 | #' minimunObsPairs = 10)
69 | #'
70 | #' @export
71 | #' @importFrom rlang :=
72 |
73 | fillGaps = function(StatisticsResult, minimumCor = 0.84, minimunObsPairs = 10){
74 |
75 |
76 | ## Verification if arguments are in the desired format
77 | # is StatisticsResult an outcome from rainStatistics or flowStatistics function?
78 | # if (!attributes(StatisticsResult)$class[2] %in% c('flowStatistics','rainStatistics')) {
79 | # stop(
80 | # call. = FALSE,
81 | # '`StatisticsResult` does not inherit attribute "flowStatistics" or "rainStatistics".
82 | # The outcome from the flowStatistics() or rainStatistics() function should be passed as argument'
83 | # )
84 | # }
85 |
86 | # Is mode a character vector?
87 | if (!is.numeric(minimumCor) | length(minimumCor) != 1) {
88 | stop(
89 | call. = FALSE,
90 | '`minimumCor` should be a numeric vector of length == 1 (bigger then 0 and lesse then 1).
91 | See arguments details for more information.'
92 | )
93 | }
94 |
95 | # Is mode a character vector?
96 | if (!is.numeric(minimunObsPairs) | length(minimunObsPairs) != 1 | !minimunObsPairs >= 5) {
97 | stop(
98 | call. = FALSE,
99 | '`minimunObsPairs` should be a numeric vector of length == 1 (bigger or equal to 5).
100 | See arguments details for more information.'
101 | )
102 | }
103 |
104 | #identify type of serie (annual or monthly)
105 | #if monthly: minimunObsPairs = minimunObsPairs*12
106 |
107 | if (names(StatisticsResult$series[[1]])[2]=="waterYear"){
108 |
109 | period = "waterYear"
110 |
111 | } else if(names(StatisticsResult$series[[1]])[2]=="monthWaterYear"){
112 |
113 | period = "monthWaterYear"
114 |
115 | minimunObsPairs = minimunObsPairs*12
116 |
117 | } else {stop ("Please choose \"selectStations\" output result \"Anual\" or \"Monthly\".")}
118 |
119 |
120 | resultados = list()
121 |
122 | #convert list of station serie to tibble and rename columns
123 | df = StatisticsResult$series_matrix %>%
124 | dplyr::select(dplyr::all_of(period), sort(colnames(.))[-ncol(.)])
125 |
126 |
127 |
128 | #correlation between stations
129 | corN = tibble::as_tibble(stats::cor(df[,-1], use = "pairwise.complete.obs"))
130 |
131 | preenchidos = list()
132 |
133 | for (i in 1:ncol(corN)){
134 |
135 | #identify station that will be filled
136 | estPrencher = names(corN)[i]
137 | estPrencher
138 |
139 | #identify correlation order and get stations name
140 |
141 | ordem = corN[i,] %>%
142 | t() %>%
143 | as.data.frame() %>%
144 | dplyr::arrange(-V1) %>%
145 | t() %>%
146 | tibble::as_tibble() %>%
147 | dplyr::select(-dplyr::all_of(estPrencher))
148 |
149 |
150 | ordem = names(ordem)[ordem>=abs(minimumCor)]
151 | ordem
152 |
153 |
154 | if (length(stats::na.omit(ordem))>0){ #caso exista estação com r > 0.84 #na.omit existe pois pode haver situações que não existe dados pareados gerando NA na correlão entre estações
155 |
156 | for (j in 1:length(stats::na.omit(ordem))){ #para todas estações com r > 0.84
157 |
158 | if (nrow(stats::na.omit(df[,c(period, estPrencher, ordem[j])]))>=minimunObsPairs){ #se o número de observações pareadas forem maior ou igual a "minimunObsPairs"
159 |
160 | regrdf = df[,c(period, estPrencher, ordem[j])] #df com estação a ser preenchida e estação que vai preencher
161 |
162 | names(regrdf) = c(period, "y", "x") #renomear para regressão
163 |
164 | df2 <- regrdf %>% dplyr::filter(!is.na(y)) #retirar NAs da estação que será preenchida
165 |
166 | fit <- stats::lm(y~x, data = df2) #regressão
167 |
168 | if (!exists("df3")){ #df3 é o df com dados preenchidos, mas pode ser que em uma rodada não preencha todos.
169 |
170 | df3 <- regrdf %>%
171 | dplyr::mutate(pred = stats::predict(fit, .)) %>%
172 | # Replace NA with pred in var1
173 | dplyr::mutate(preenchido = ifelse(is.na(y), pred, y)) %>%
174 | dplyr::select(dplyr::all_of(period), preenchido)
175 |
176 | } else {
177 |
178 | df3 = regrdf %>%
179 | dplyr::mutate(pred = stats::predict(fit, .)) %>%
180 | dplyr::mutate(preenchido = ifelse(is.na(df3$preenchido), pred, df3$preenchido)) %>%
181 | dplyr::select(dplyr::all_of(period), preenchido)
182 |
183 | }
184 |
185 |
186 | if(sum(is.na(df3)[,2])==0) break
187 |
188 | }
189 | }
190 |
191 | if (exists("df3")){
192 |
193 | preenchidos[[i]] = df3
194 |
195 | remove(df3) #remover df3 para próxima rodada (estação)
196 |
197 | } else {preenchidos[[i]] = df[,c(period, estPrencher)]}
198 |
199 |
200 | } else {preenchidos[[i]] = df[,c(period, estPrencher)]}
201 |
202 | names(preenchidos[[i]]) = c(period, names(StatisticsResult$df_series)[3])
203 |
204 | preenchidos[[i]] = dplyr::arrange(preenchidos[[i]], dplyr::across(dplyr::starts_with(period))) %>%
205 | dplyr::mutate(station_code = estPrencher) %>%
206 | dplyr::select(c(3,1,2))
207 | }
208 |
209 | names(preenchidos) = names(df[,-1])
210 |
211 | #reorder preenchidos based on date if its a montlhy series
212 | if(names(preenchidos[[1]])[2] == "monthWaterYear"){
213 |
214 | preenchidos = preenchidos %>%
215 | lapply(function(x) x %>%
216 | dplyr::arrange(monthWaterYear))
217 |
218 | }
219 |
220 | #list of df with filling results of each station
221 | resultados[[1]] = preenchidos
222 |
223 | #convert list to df
224 | resultados[[2]] = preenchidos %>%
225 | dplyr::bind_rows()
226 |
227 | #convert list to df wider format
228 | resultados[[3]] = resultados[[2]] %>%
229 | tidyr::pivot_wider(names_from = station_code, values_from = 3)
230 |
231 | #failureMatrix
232 | resultados[[4]] = resultados[[3]] %>%
233 | dplyr::mutate_at(c(2:ncol(.)), ~ dplyr::if_else(is.na(.), TRUE, FALSE))
234 |
235 |
236 | #plot
237 | g = reshape2::melt(resultados[[4]], id.vars = period) %>%
238 | dplyr::rename(!!period := dplyr::contains("Year"),
239 | station_code = "variable") %>%
240 | dplyr::as_tibble() %>%
241 | ggplot2::ggplot(ggplot2::aes(x = .data[[period]],
242 | y = .data$station_code,
243 | fill = .data$value)) +
244 | ggplot2::geom_tile(color = "black") +
245 | ggplot2::scale_fill_manual(name = paste(names(StatisticsResult$df_series)[3] %>%
246 | stringr::str_extract(pattern = "[^_]+"), "Data", sep = " "),
247 | values=c("FALSE"="#00b0f6", "TRUE"="#f8766d"),
248 | labels = c("complete", "missing"))+
249 | ggplot2::theme_bw()
250 |
251 | resultados[[5]] = g
252 |
253 | names(resultados) = c("series", "df_series", "df_serie_wider", "failure_matrix", "plot")
254 |
255 | print(g)
256 | #
257 | # class(resultados) <- c(class(resultados), 'fillGaps')
258 |
259 | return(resultados)
260 | }
261 |
262 | if(getRversion() >= "2.15.1") utils::globalVariables(c("V1", "y", "pred", "preenchido"))
263 |
264 |
--------------------------------------------------------------------------------