From d682e1c9c82ca725643fdfd9cb4a7e4295e19d1a Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Fri, 4 Aug 2023 06:31:45 +0200 Subject: [PATCH 01/19] Corrected wrong assignment of water year for the months of Jan and Feb if the desired start of the water year is earlier than March (wyMonth < 3) --- R/get_waterYear.R | 37 ++++++++++++++++++++++++++++++++++--- 1 file changed, 34 insertions(+), 3 deletions(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 4eb29f5..1cc9f6b 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -17,11 +17,42 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { ## 2012Aug11 DLLorenz Integer fixes ## 2013Feb15 DLLorenz Prep for gitHub ## 2016Aug12 Joe Mills copied this from smwrBase + ## 2023Aug04 Jens Kiesel added different calculation if wyMonth < 3 + ## (see explanation below) x <- as.POSIXlt(x) yr <- x$year + 1900L - mn <- x$mon + 1L - ## adjust for water year - yr <- yr + ifelse(mn < wyMonth, 0L, 1L) + mn <- x$mon + 1L # x$mon starts at 0 for Jan! + if (wyMonth < 3){ + # Jan must be associated to the previous year if wyMonth < 3 + # because of leap years. If an assigned water year includes the + # 29th of Feb, it must be associated to a leap year: + # + # If the water year starts in January (equal to the calendar year): + # yr for all months must be equal to the current yr. + # function "yr<-yr-ifelse(mn=2 == wyMonth=2: + # yr <- yr - 0 (ifelse condition is false) + # The first of February of a time series initiates a new + # water year and if the time series contains a leap year, + # the year for February must be kept as the current year + # (with the function, February 2000 would be assigned + # water year 2001) + yr <- yr - ifelse(mn < wyMonth, 1L, 0L) + }else{ + # If the water year starts in March (or later): + # yr for Jan and Feb must be the current year (as it can be a + # leap year) + # function "yr<-yr+ifelse(mn Date: Fri, 4 Aug 2023 06:31:45 +0200 Subject: [PATCH 02/19] Corrected wrong assignment of water year for the months of Jan and Feb if the desired start of the water year is earlier than March (wyMonth < 3) --- R/get_waterYear.R | 37 ++++++++++++++++++++++++++++++++++--- 1 file changed, 34 insertions(+), 3 deletions(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 4eb29f5..1cc9f6b 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -17,11 +17,42 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { ## 2012Aug11 DLLorenz Integer fixes ## 2013Feb15 DLLorenz Prep for gitHub ## 2016Aug12 Joe Mills copied this from smwrBase + ## 2023Aug04 Jens Kiesel added different calculation if wyMonth < 3 + ## (see explanation below) x <- as.POSIXlt(x) yr <- x$year + 1900L - mn <- x$mon + 1L - ## adjust for water year - yr <- yr + ifelse(mn < wyMonth, 0L, 1L) + mn <- x$mon + 1L # x$mon starts at 0 for Jan! + if (wyMonth < 3){ + # Jan must be associated to the previous year if wyMonth < 3 + # because of leap years. If an assigned water year includes the + # 29th of Feb, it must be associated to a leap year: + # + # If the water year starts in January (equal to the calendar year): + # yr for all months must be equal to the current yr. + # function "yr<-yr-ifelse(mn=2 == wyMonth=2: + # yr <- yr - 0 (ifelse condition is false) + # The first of February of a time series initiates a new + # water year and if the time series contains a leap year, + # the year for February must be kept as the current year + # (with the function, February 2000 would be assigned + # water year 2001) + yr <- yr - ifelse(mn < wyMonth, 1L, 0L) + }else{ + # If the water year starts in March (or later): + # yr for Jan and Feb must be the current year (as it can be a + # leap year) + # function "yr<-yr+ifelse(mn Date: Wed, 6 Sep 2023 09:04:50 +0200 Subject: [PATCH 03/19] Corrected the calculation of the water year to a more intuitive convention: the water year value should be the calendar year with the most dates in the water year. Therefore, a cutoff is assigned at wyMonth=7. See this issue for further information: https://github.com/DOI-USGS/EflowStats/issues/196 --- R/get_waterYear.R | 77 +++++++++++++++++++---------------------------- 1 file changed, 31 insertions(+), 46 deletions(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 1ab6a31..47a64af 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -10,50 +10,35 @@ #' get_waterYear(sampleData$date) #' get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { - ## Coding history: - ## 2005Jul14 DLLorenz Initial dated verion - ## 2010Feb17 DLLorenz Added option to return numerics - ## 2011Jun07 DLLorenz Conversion to R - ## 2012Aug11 DLLorenz Integer fixes - ## 2013Feb15 DLLorenz Prep for gitHub - ## 2016Aug12 Joe Mills copied this from smwrBase - ## 2023Aug04 Jens Kiesel added different calculation if wyMonth < 3 - ## (see explanation below) - x <- as.POSIXlt(x) - yr <- x$year + 1900L - mn <- x$mon + 1L # x$mon starts at 0 for Jan! - if (wyMonth < 3){ - # Jan must be associated to the previous year if wyMonth < 3 - # because of leap years. If an assigned water year includes the - # 29th of Feb, it must be associated to a leap year: - # - # If the water year starts in January (equal to the calendar year): - # yr for all months must be equal to the current yr. - # function "yr<-yr-ifelse(mn=2 == wyMonth=2: - # yr <- yr - 0 (ifelse condition is false) - # The first of February of a time series initiates a new - # water year and if the time series contains a leap year, - # the year for February must be kept as the current year - # (with the original function yr<-yr+ifelse(mn Date: Wed, 6 Sep 2023 09:06:40 +0200 Subject: [PATCH 04/19] Adjusted the validate_data and isleapYear functions to work with the new assignment of the water year (cutoff at wyMonth=7). See this issue for details: https://github.com/DOI-USGS/EflowStats/issues/196 --- R/isleapYear.R | 23 ++++++++++++++++++++--- R/validate_data.R | 3 ++- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/R/isleapYear.R b/R/isleapYear.R index 8313aca..46fe922 100644 --- a/R/isleapYear.R +++ b/R/isleapYear.R @@ -1,5 +1,22 @@ #courtesy of R bloggers for is.leapyear -is.leapyear <- function(year){ - #http://en.wikipedia.org/wiki/Leap_year - return(((year %% 4 == 0) & (year %% 100 != 0)) | (year %% 400 == 0)) +is.leapyear <- function(year, yearType='calendar', wyMonth=10L){ + if (yearType=='calendar' || wyMonth<3 || wyMonth>6) { + #http://en.wikipedia.org/wiki/Leap_year + return(((year %% 4 == 0) & (year %% 100 != 0)) | (year %% 400 == 0)) + }else if ((yearType=='water') && (wyMonth>=3 && wyMonth <=6)) { + # + # add 1 year if water year is supposed to start in Mar, Apr, May, Jun. + # For these cases, the water year is assigned the previous + # year value but contains the leap day. + # + # Example: + # Time series: 01Apr1999 - 31Mar2000 + # wyMonth = 4 + # Assigned water year: 1999 + # Number of days: 366 (because it contains 29Feb2000) + # -> Function must return true for 1999 (and any other year that + # precedes a leap year) + # + return((((year+1) %% 4 == 0) & ((year+1) %% 100 != 0)) | ((year+1) %% 400 == 0)) + } } \ No newline at end of file diff --git a/R/validate_data.R b/R/validate_data.R index 5448906..bb6de13 100644 --- a/R/validate_data.R +++ b/R/validate_data.R @@ -73,7 +73,8 @@ validate_data <- function(x,yearType,wyMonth=10L) { } #check for complete years - x$leapYear <- is.leapyear(as.numeric(as.character(x$year_val))) + x$leapYear <- is.leapyear(as.numeric(as.character(x$year_val)), + yearType, wyMonth) fullYearCheck <- dplyr::summarize(dplyr::group_by(x,year_val), completeYear = From bbf58e0bbe2a5919f9feed419f5307007cc31b6a Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Thu, 7 Sep 2023 08:31:47 +0200 Subject: [PATCH 05/19] clarify description in comment Co-authored-by: Jared D. Smith --- R/get_waterYear.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 47a64af..2c57f28 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -26,7 +26,8 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { # it is most intuitive that the water year value should be the calendar # year with the most dates in the water year. Jan.-Jun. would be assigned # the previous year as the water year value and Jul.-Dec. would be assigned - # the current year as the water year value. + # the current calendar year as the water year value. + # If the water year is supposed to start in Jan-Jun (e.g. April): # yr for Jan-Mar must be the previous year, From d6e8b16f593dc57b9c5951bfc03f9323d843799c Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Thu, 7 Sep 2023 08:32:17 +0200 Subject: [PATCH 06/19] clarify description in comment Co-authored-by: Jared D. Smith --- R/get_waterYear.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 2c57f28..45a6619 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -25,7 +25,8 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { if (wyMonth < 7){ # it is most intuitive that the water year value should be the calendar # year with the most dates in the water year. Jan.-Jun. would be assigned - # the previous year as the water year value and Jul.-Dec. would be assigned + # the previous calendar year as the water year value and Jul.-Dec. would be assigned + # the current calendar year as the water year value. From 4ddd0f121207b5fc40dbba6a56e9af6eac33a1e8 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Thu, 7 Sep 2023 08:32:29 +0200 Subject: [PATCH 07/19] clarify description in comment Co-authored-by: Jared D. Smith --- R/get_waterYear.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 45a6619..a57f8db 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -31,7 +31,8 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { # If the water year is supposed to start in Jan-Jun (e.g. April): - # yr for Jan-Mar must be the previous year, + # yr for Jan-Mar must be the previous calendar year, + # yr for Apr-Dec must be the current year yr <- yr - ifelse(mn < wyMonth, 1L, 0L) }else{ From fe6fcb5ee1a587a659fef2c19d47faf955cd5196 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Thu, 7 Sep 2023 08:32:38 +0200 Subject: [PATCH 08/19] clarify description in comment Co-authored-by: Jared D. Smith --- R/get_waterYear.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index a57f8db..9dabdfa 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -33,7 +33,8 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { # If the water year is supposed to start in Jan-Jun (e.g. April): # yr for Jan-Mar must be the previous calendar year, - # yr for Apr-Dec must be the current year + # yr for Apr-Dec must be the current calendar year + yr <- yr - ifelse(mn < wyMonth, 1L, 0L) }else{ # If the water year is supposed to start in Jul-Dec (e.g. September): From e401c6e3c15b9d25fc194f270f93c3ffc07f07f1 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Thu, 7 Sep 2023 08:32:47 +0200 Subject: [PATCH 09/19] clarify description in comment Co-authored-by: Jared D. Smith --- R/get_waterYear.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 9dabdfa..8a73870 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -38,7 +38,8 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { yr <- yr - ifelse(mn < wyMonth, 1L, 0L) }else{ # If the water year is supposed to start in Jul-Dec (e.g. September): - # yr for Jan-August must be the current year, + # yr for Jan-August must be the current calendar year, + # yr for Sep-Dec must be the next year yr <- yr + ifelse(mn < wyMonth, 0L, 1L) } From bc1b45866ce9de540483c5ae114689d35d854199 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Thu, 7 Sep 2023 08:32:55 +0200 Subject: [PATCH 10/19] clarify description in comment Co-authored-by: Jared D. Smith --- R/get_waterYear.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_waterYear.R b/R/get_waterYear.R index 8a73870..243e67e 100644 --- a/R/get_waterYear.R +++ b/R/get_waterYear.R @@ -40,7 +40,8 @@ get_waterYear <- function(x, wyMonth=10L, numeric=TRUE) { # If the water year is supposed to start in Jul-Dec (e.g. September): # yr for Jan-August must be the current calendar year, - # yr for Sep-Dec must be the next year + # yr for Sep-Dec must be the next calendar year + yr <- yr + ifelse(mn < wyMonth, 0L, 1L) } if(numeric) From 18d1886336e18428169f24fbccaab1a9b875a5c4 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Thu, 7 Sep 2023 09:36:09 +0200 Subject: [PATCH 11/19] suggestion for updating the calc_timingAverage.R function to work with the dynamic assignment of the water year and leap-year issue --- R/calc_timingAverage.R | 24 +++++++++++++++++++----- test_water_year_calculation.R | 30 ++++++++++++++++++++++++++++++ 2 files changed, 49 insertions(+), 5 deletions(-) create mode 100644 test_water_year_calculation.R diff --git a/R/calc_timingAverage.R b/R/calc_timingAverage.R index f9e6bfe..3c400e7 100644 --- a/R/calc_timingAverage.R +++ b/R/calc_timingAverage.R @@ -57,17 +57,31 @@ calc_timingAverage <- function(x,yearType = "water",wyMonth=10L,digits=3,pref="m #calculate some stuff for use later x$month_val <- lubridate::month(x$date) + x$dayom_val <- lubridate::mday(x$date) meanFlow <- mean(x$discharge) ###Remove leap year data to calculate Colwell matrix #Remove feb29th for Colwell matrix - x <- x[!(x$month_val == 2 & - yday(x$date) == 29),] + #x <- x[!(x$month_val == 2 & + # yday(x$date) == 29),] + # I think the lubridate yday function is wrong here - it does not + # return the day of the month, but the day of the year. + + # remove all February 29th from the time series + x <- x[!((x$month_val == 2) & (x$dayom_val == 29)),] + #Get a new julian day value that does not count leap years - x$day[is.leapyear(x$year_val) & - x$day > 152] <- x$day[is.leapyear(x$year_val) & - x$day > 152] - 1 + #x$day[is.leapyear(x$year_val) & + # x$day > 152] <- x$day[is.leapyear(x$year_val) & + # x$day > 152] - 1 + + # after removing the 29th of Feb, we can count the rows sequentially + # for each unique water year + # https://stackoverflow.com/a/46613159 + x$day <- sequence(rle(x$year_val)$lengths) + + #Calculate the colwell matrix... log_meanFlow = log10(meanFlow) x$log_discharge = log10(x$discharge) diff --git a/test_water_year_calculation.R b/test_water_year_calculation.R new file mode 100644 index 0000000..154a388 --- /dev/null +++ b/test_water_year_calculation.R @@ -0,0 +1,30 @@ +## finds all .R and .r files within a folder and sources them +sourceFolder <- function(folder, recursive = FALSE, ...) +{ + files <- list.files(folder, pattern = "[.][rR]$", + full.names = TRUE, recursive = recursive) + if (!length(files)) + stop(simpleError(sprintf('No R files in folder "%s"', folder))) + src <- invisible(lapply(files, source, ...)) + message(sprintf('%s files sourced from folder "%s"', length(src), folder)) +} +sourceFolder("c:\\Users\\jensk\\Work\\01_Projects\\210301bsu_DFG_RESIST\\01_Definition\\Lehre\\SEWAMM\\TrainTheTrainers_2022\\iha_software\\EflowStats\\R") + +x <- data.frame( + date = seq.Date(from = as.Date('1999-01-01'), to = as.Date('2003-12-31'), by = 'days'), + discharge = seq.int(1,length(seq.Date(from = as.Date('1999-01-01'), to = as.Date('2003-12-31'), by = 'days'))) +) + +yearType <- 'water' +for (wy_month in 1:12){ + x_cut <- cut_dataToWaterYear(x, wy_month) + cat("wyMonth =", wy_month, ":\n") + print(as.data.frame(table(get_waterYear(x_cut$date, wy_month)))) + cat("----------------\n") + if (length(validate_data(x_cut, yearType, wy_month))>1){ + cat("Data is valid\n\n\n") + }else{ + cat("Data is NOT valid\n\n\n") + } +} + From eb4af3fb73e8ff65a911fa9205f435b741197f31 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Fri, 8 Sep 2023 05:15:51 +0200 Subject: [PATCH 12/19] removed the original calculation and clenaed up commenting --- R/calc_timingAverage.R | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/R/calc_timingAverage.R b/R/calc_timingAverage.R index 3c400e7..4acfb46 100644 --- a/R/calc_timingAverage.R +++ b/R/calc_timingAverage.R @@ -60,28 +60,15 @@ calc_timingAverage <- function(x,yearType = "water",wyMonth=10L,digits=3,pref="m x$dayom_val <- lubridate::mday(x$date) meanFlow <- mean(x$discharge) - ###Remove leap year data to calculate Colwell matrix - #Remove feb29th for Colwell matrix - #x <- x[!(x$month_val == 2 & - # yday(x$date) == 29),] - # I think the lubridate yday function is wrong here - it does not - # return the day of the month, but the day of the year. - - # remove all February 29th from the time series + # remove all February 29th from the time series to calculate + # Colwell matrix x <- x[!((x$month_val == 2) & (x$dayom_val == 29)),] - - #Get a new julian day value that does not count leap years - #x$day[is.leapyear(x$year_val) & - # x$day > 152] <- x$day[is.leapyear(x$year_val) & - # x$day > 152] - 1 - + # #Get a new julian day value that does not count leap years # after removing the 29th of Feb, we can count the rows sequentially - # for each unique water year - # https://stackoverflow.com/a/46613159 + # for each unique water year; https://stackoverflow.com/a/46613159 x$day <- sequence(rle(x$year_val)$lengths) - #Calculate the colwell matrix... log_meanFlow = log10(meanFlow) x$log_discharge = log10(x$discharge) From 8aef94d28a51d1d3838cd6eb929ba92552de9eba Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Tue, 19 Sep 2023 07:54:41 +0200 Subject: [PATCH 13/19] The calculation of the leap year must also be updated in the cut_dataToWaterYear function as otherwise data is cut even though it is complete --- R/cut_dataToWaterYear.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/R/cut_dataToWaterYear.R b/R/cut_dataToWaterYear.R index a162a14..a0b88d4 100644 --- a/R/cut_dataToWaterYear.R +++ b/R/cut_dataToWaterYear.R @@ -1,6 +1,8 @@ #' Cuts the discharge time series to full water years #' @param x data.frame containing a vector of date values in the first #' column and vector of numeric flow values in the second column. +#' @param yearType A character of either "water" or "calendar" indicating +#' whether to use water years or calendar years, respectively. #' @param wyMonth A numeric. The month of the year in which the water year starts #' (1=January, 12=December). The water year begins on the first day of wyMonth. #' @return data.frame in original structure, but cut to full water years @@ -16,7 +18,7 @@ #' cut_dataToWaterYear(x,10L) #' @export #' -cut_dataToWaterYear <- function(x,wyMonth=10L) { +cut_dataToWaterYear <- function(x, yearType, wyMonth=10L) { ###rename dataframe for convenient use inside function old_names <- colnames(x) names(x) <- c("date","discharge") @@ -34,8 +36,8 @@ cut_dataToWaterYear <- function(x,wyMonth=10L) { ndays_last_year <- nrow(x[x$year_val == last_year,]) # get the target number of days (depends if water year is in a leap year or not) - ndays_first_year_target <- ifelse(lubridate::leap_year(first_year), 366, 365) - ndays_last_year_target <- ifelse(lubridate::leap_year(last_year), 366, 365) + ndays_first_year_target <- ifelse(is.leapyear(first_year, yearType, wyMonth), 366, 365) + ndays_last_year_target <- ifelse(is.leapyear(last_year, yearType, wyMonth), 366, 365) # remove the first and last year if number of days is less than target number if(ndays_first_year < ndays_first_year_target){ From 090382a5ef7bd2561722852747206e93d7e52814 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Tue, 19 Sep 2023 09:00:28 +0200 Subject: [PATCH 14/19] NA need to be removed after calculating rolling means (see also function calc_durationHigh.R where na.rm=TRUE when calculating rolling means) --- R/calc_durationLow.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/calc_durationLow.R b/R/calc_durationLow.R index d348c9f..8267fb4 100644 --- a/R/calc_durationLow.R +++ b/R/calc_durationLow.R @@ -93,10 +93,10 @@ calc_durationLow <- function(x,yearType = "water",wyMonth=10L,digits=3,pref="mea meanFlow = mean(discharge), totalFlow = sum(discharge)) minRollingMean <- dplyr::summarize(dplyr::group_by(x,year_val), - minRoll3Mean = min(roll3Mean), - minRoll7Mean = min(roll7Mean), - minRoll30Mean = min(roll30Mean), - minRoll90Mean = min(roll90Mean) + minRoll3Mean = min(roll3Mean,na.rm=TRUE), + minRoll7Mean = min(roll7Mean,na.rm=TRUE), + minRoll30Mean = min(roll30Mean,na.rm=TRUE), + minRoll90Mean = min(roll90Mean,na.rm=TRUE) ) medFlow <- median(x$discharge) From 7a362d546fc6e9b0a31891421d353ac67b4d3852 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Wed, 20 Sep 2023 04:48:06 +0200 Subject: [PATCH 15/19] Added yearType to \item --- R/cut_dataToWaterYear.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/cut_dataToWaterYear.R b/R/cut_dataToWaterYear.R index a0b88d4..bc5c1ec 100644 --- a/R/cut_dataToWaterYear.R +++ b/R/cut_dataToWaterYear.R @@ -11,6 +11,7 @@ #' #' \enumerate{ #' \item First column must be of class `Date`. #' \item Second must be of class `numeric`. +#' \item `yearType` input must be either "water" or "calendar". #' \item `wyMonth`input must be of class `integer`. #' } #' @examples From cd61438b7b48e83478a7e7a0f2083bcd6e7d452d Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Wed, 20 Sep 2023 04:49:09 +0200 Subject: [PATCH 16/19] added "water" (=yearType) to the test function so that cut_dataToWaterYear does not fail --- tests/testthat/tests_cut_dataToWaterYear.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/tests_cut_dataToWaterYear.R b/tests/testthat/tests_cut_dataToWaterYear.R index cb88179..edf722f 100644 --- a/tests/testthat/tests_cut_dataToWaterYear.R +++ b/tests/testthat/tests_cut_dataToWaterYear.R @@ -1,7 +1,7 @@ test_that("cut water year", { x <- sampleData[, c('date', 'discharge')] - cut <- cut_dataToWaterYear(x, 8) + cut <- cut_dataToWaterYear(x, 'water', 8) expect_equal(cut$date[1], structure(15187, class = "Date")) @@ -13,7 +13,7 @@ test_that("cut water year", { expect_equal(nrow(cut), 366) - cut <- cut_dataToWaterYear(x, 11) + cut <- cut_dataToWaterYear(x, 'water', 11) expect_equal(cut$date[1], structure(14914, class = "Date")) From 1f041371578afca36afca97774df81580bdfae49 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Fri, 22 Sep 2023 05:29:54 +0200 Subject: [PATCH 17/19] Needed to change test functions to "expect_equal_to_reference" as the target test files are not created with "expect_equal"; readRDS functions do not work when .rds files don't exist. --- tests/testthat/tests_calc_durationLow.R | 17 ++++++++--------- tests/testthat/tests_calc_timingAverage.R | 7 +++---- 2 files changed, 11 insertions(+), 13 deletions(-) diff --git a/tests/testthat/tests_calc_durationLow.R b/tests/testthat/tests_calc_durationLow.R index 5e8191a..ddbdee4 100644 --- a/tests/testthat/tests_calc_durationLow.R +++ b/tests/testthat/tests_calc_durationLow.R @@ -5,14 +5,14 @@ test_that("duration low pref mean", { x<-sampleData[c("date","discharge")] calc_durationLowTest <- calc_durationLow(x=x,yearType="water",pref = "mean") - calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow.rds") + #calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow.rds") - expect_equal(calc_durationLowTest,calc_durationLowTestCheck) + expect_equal_to_reference(calc_durationLowTest,"data/tests_calc_durationLow.rds") x <- readRDS("data/sample_nwis_data.rds") calc_durationLowTest <- calc_durationLow(x=x,yearType="water",pref = "mean") - calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow_nwis_mean.rds") - expect_equal(calc_durationLowTest,calc_durationLowTestCheck) + #calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow_nwis_mean.rds") + expect_equal_to_reference(calc_durationLowTest,"data/tests_calc_durationLow_nwis_mean.rds") }) @@ -21,12 +21,11 @@ test_that("duration low pref median", { x<-sampleData[c("date","discharge")] calc_durationLowTest <- calc_durationLow(x=x,yearType="water", pref = "median") - calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow.rds") - - expect_equal(calc_durationLowTest,calc_durationLowTestCheck) + #calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow.rds") + expect_equal_to_reference(calc_durationLowTest,"data/tests_calc_durationLow.rds") x <- readRDS("data/sample_nwis_data.rds") calc_durationLowTest <- calc_durationLow(x=x,yearType="water", pref = "median") - calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow_nwis_median.rds") - expect_equal(calc_durationLowTest,calc_durationLowTestCheck) + #calc_durationLowTestCheck <- readRDS("data/tests_calc_durationLow_nwis_median.rds") + expect_equal_to_reference(calc_durationLowTest,"data/tests_calc_durationLow_nwis_median.rds") }) diff --git a/tests/testthat/tests_calc_timingAverage.R b/tests/testthat/tests_calc_timingAverage.R index a3bd14a..281d738 100644 --- a/tests/testthat/tests_calc_timingAverage.R +++ b/tests/testthat/tests_calc_timingAverage.R @@ -5,9 +5,8 @@ test_that("timing average", { x<-sampleData[c("date","discharge")] calc_timingAverageOutTest <- calc_timingAverage(x, floodThreshold = 1158) - calc_timingAverageOut <- readRDS("data/tests_calc_timingAverage_1158Thresh.rds") - - expect_equal(calc_timingAverageOutTest,calc_timingAverageOut) + #calc_timingAverageOut <- readRDS("data/tests_calc_timingAverage_1158Thresh.rds") + expect_equal_to_reference(calc_timingAverageOutTest,"data/tests_calc_timingAverage_1158Thresh.rds") }) test_that("timing average works with very low flows", { @@ -17,7 +16,7 @@ test_that("timing average works with very low flows", { x$discharge <- x$discharge/1000 calc_timingAverageOutTest <- calc_timingAverage(x, floodThreshold = 1) - expect_equal(calc_timingAverageOutTest$statistic,c(0.306,80.386, 0.5)) + expect_equal(calc_timingAverageOutTest$statistic,c(0.305,80.359, 0.5)) }) From 35a5b8ef188f19e15f4aee0891cb9cf3cf79bda5 Mon Sep 17 00:00:00 2001 From: jenskiesel Date: Fri, 22 Sep 2023 05:31:35 +0200 Subject: [PATCH 18/19] New .rds files after the changes made to the water year calculation and fixing bug that prevented the calculation of somme duration_low indicators. --- tests/testthat/data/tests_calc_allHIT.rds | Bin 1411 -> 1451 bytes tests/testthat/data/tests_calc_allHIT_bug.rds | Bin 1510 -> 1497 bytes tests/testthat/data/tests_calc_allHIT_med.rds | Bin 1372 -> 1412 bytes .../testthat/data/tests_calc_durationLow.rds | Bin 265 -> 333 bytes .../data/tests_calc_durationLow_nwis_mean.rds | Bin 331 -> 331 bytes .../tests_calc_durationLow_nwis_median.rds | Bin 324 -> 329 bytes .../tests_calc_timingAverage_1158Thresh.rds | Bin 167 -> 167 bytes 7 files changed, 0 insertions(+), 0 deletions(-) diff --git a/tests/testthat/data/tests_calc_allHIT.rds b/tests/testthat/data/tests_calc_allHIT.rds index e21fcaabb3b551dd753ae3d277428a0f6cf2573b..208fd975e4fc3f379404aa0ef8efb5eaeae01c08 100644 GIT binary patch delta 1421 zcmZ|KeLNEg9LI4YhOL=r&6*TDKI7d(%v zO@GpuGJCxYF`W;7Ji-GnUTUB8x-hfbw?3jApr4#Ro#0&&_Wi(m3P4WT7Np|2i+VLT z2d-=?o2wOc!kB)7;aRVuD+}yS4k+`@buT2L+eK|gZxV;t`FGGFcB?S7GDMPO(`_^= z6m80=$kE6oVlk_Ii?|XhZtz?XL_qA6O0rN4R3?gEuXR?T=adXu|5-FW1JDd;R@ej4 zF*sruZTwhYR@Faa*_Xl9>(H2O0H0(JK`8yeOn9VjRu&@`2J?B;Z^Oq+W+;0g4 znNj|iqS~V_fJVkq^>6Bq4y)`k-2aspM7qB014bTLdM~Y~=NP79$jPW;$e5D76z5tT zEY=xacm#4ASvW}fe-QM%Uw$vsJ5mjBL(nS`ddl_-Plqwa@ovDTtdeG9H#vs#Wr%~a z9+UvJCk7vz)FMCw=|}(jwA$eVb(pZHW0{ZcLU3pv!NKokdX09>*ZMUA@vy)ulzo~u zg6(nkvLf2^c1aIVJ**0KKoQOJcbFQ;o0W#q7H5((iZPnDaY*WWzs4&W>(RTllQT-5 zBME}i=L#V%x@Yv9|Cyq3;K!f55%$?z#FRED7n!a;k9x9zN0HXLa;UUKOSP_qx`esU zL6!KKeKRczWR}*pI1VpwAI;6IUll}MiwO;XCYHHW0M8e$CDu&M>s;^buA}h=XV&C> zi-Z{Yu=i0`ckyPLA1*Pa-|6m*WRD!0<_AW?F^C7C*Pk{epGieoPqO4k(Ilh3f`6bHD+LHs;ilGCVThZ_O-L!r-YPm&IL5vSb z>bpEfFmx=xMcv`>i?gR4X@Ra1(xBXz%+3wJzEFkcpL)S@&SuPU5TU zwrnxDD5sjHq*zNN1+cc2$v@m-6(tMGY_T@2MHG0-)^1fQHRdP%4JvS7GWxMj>fu%m~LeWi-N2GY*{1<9J7jZ_e#H0$?Aj|Y$NxI2_ ze|C?=S*Fnog8P@R;pUd+8Z{2d%*0P*zMXL0ronI~Nzu(3XJuPRHy>Zzh|OP6^Y*s`iF-3#F zayTwQrPOX1XD4=joJ_JT2CjbCQ_;M*_6cz^&D?=%&Y_h7SNlJXXcbyN?5q64bQ2rS zz3edVVLRH`aCfR|a(K>+Q~470(wR*nN5t;b5_V3J_yWOwr|+sYUsW7*YCz{7pI#jH Uwi~=voBxM&m|C6vAV^B;PYH0i;s5{u literal 1411 zcmZ|LeLNEg9LI4?XFKa`l!sg%3+G|TdDcdrDyBU2veT>(wODE!36tB6)0yXljfuiM z+%0*It!or9*3MITERV@~e%g%O>*`*wyZ*S}AD=(oe|=v+^<<#Lrvs3DWy5@&4~#A< zj#!)&qQ0Nj*1)aEtg}aP1{O=J*igY~=xGUPGZ9r9;&*QW00nF4@0Ty8Y^P;-JL50uUTIzT}302laoaT!;gf45l+iCpT|5oVIMcrAI>1b)646X{aVpIsA6Nj~MP zr<=SQ4;9Cfrotl-2*{D*pb&-uXU`PuIIi5 zK692 z>(-@wQ&Q?2!M$+O!s=9E*1GlorX1*@PtN+~?L#fAav-B3$sSyw;5gg%%G$KgB5~-2 zl?vp9vWv1qQWz5lu1kU9f|$5?kkprt@b05F(xAR(6IWf(-AR=yH_Wwv3u){BjKqle zA};t~2-CzdK}DZ;HX!k9GoRcdE>(}06r*y(SbH(JjZJOLfo>g}z_^TbeSt+W09f1% zdWY8}%p(ZYU_-43FG;`>4>dEZlMm^p8~qq|NAI77D9R({fIDFJbhrVJ9k)S7*+OT8 zEwZKIulL5n!x!SoIX(TU=e?(hox?wgEggG?K*oq(GdXheETy3Ab^^7lxzkT>F@l5R z43Agh8wjY)kB=F)Vn4Zh#BjJIPgM}9)lAgv+wcbHIK*!BWU7#6xLirRPoV9iRz zYE1tbN#;VeGfukHzse>W+hxvNksDGpG>oq}hu^Rch>G2nsDtp-E4F?ZD!vz^e0tDO zG_yVJe-@+LU^x+^7n;2#02DRG7}CwJs8U%utre*bw`L9NG^h)mu#|>^_z$qUQ5~k; zxTey3={VE1`u&S#Cc&%$?I2OMcWYWcAr5URsztwS%4D@8X{@zTL*L`kb0lDNnv5;l zBQ8*cm=j!vMICTQmrn-iq~+d%53djA3#x}|D|s!Qk%x6@n}CopcLjrMd{PX5!nk0P zUDoBKXzhAeKbY>dz{&=@?#0KxJA7osvb&dWtu#1$SIM(o&^{OC?;mdOjb=4puSxAj z%s0-^QbDbBtNW8)y&XDSU-}>CXC2 z`kDKKYzD-HS7lazAf9$3X|z&%+hl61`usdHH@((B>iGBc5ipjwEQ-H zETx!$78{W`giV8p!+1_s|Df=LO^0pye8~i#kI6s2%DTjOxl-P80V`NZm}H!}*iWdi z`}tY%o8XE}&5tYJlza=mjZ}%=H??&R50}aSG2$Tb2N=i&`;&#LRGw$B)uC-VY2EJr zJlwu{Gke%odJkhGrHXTnfekiq@@(L|{FUWKr)Q&c9LF_cPF`YXdC8OsNv6EsRNlsV%AuI@wpPu%ro7L~ymdHlQ+bJvBAq!* z%?MeABg8Im!=f1THgCt8uw2*ObAMg;`{VOG-_Kv)@AHGC14X``I5uB85QG4AGMnp1 z#FYVV_W*mGD`M)KBU%8jqEgH2k#Z_PD;*CUo}A|ww1Sdyu~hGnv$4v!gUpSWL!|l< z)#U-1iSi&Zwy$z&j5Saj@`uiF)5(yCmCGiL?+Ai$?(PI3j#gAeo?MH3UJRnLIQ+(b zmTO70dCNG{*x_d_PtPjpnTK_bW7j=Ymjh;rej|rLz_)Bf2QA_>> zgoQdRFP}q9O}2qTm3~4ZZLGfJbGc%YXNkmbLecnWZLDR@)olP9Ji>VSac{kTZEOM- z*w0X3lKLi|YKV>QPvikD!;{tFR?vuK{lsY-A_;g$;Z>kUL68kmW#{YMQWbBNF9ym6 zdM|SBAf?JP`?F8PpMYTHuzR{68EH9(Sp6sLDq~d@xCOAzWV0i03@}-eA?FLOwSG}h z%#U+3$zJ~lB$fG!MM|QYNuWbyrY6Qi2!U1dW%@DN5)3Q}63HX5+9; zB|){da|dZj&8t)w)}?HMlcQ zq9ejmCdB^-;W2pV;-V4Otl{!v0^hwaZvq=F9!P-UMl>txhpUU@ZULNwuv8%fWfA-0 zsj2|w%Tr|&+8DOJrpA8Q;DrcBns2SLxIG#Lq!^!v06YEj_CQR{3ndew0ABKVm&Ga;65QS_>njQ$mWFnf$(N#|iIcs_*hni0kB$)W91Nzkw!LD6UsDiz;1jKEG@9lPtk zWO>nU0Df+nd;qVSH|~7NTsEBsrU2AYPMpuH2L|irE zfUW0Mom?c>{DO-QZAi0hMqeQhxO@;D)vJ-Z9k+KYMc81^>)Ns%QevFI>sp*~$Gdhe zUz3R;V#ZCY0guS?;(^V-|aEU6h*C|a)2=T^q7tVY(H$d&7_ zgJG4ut2yjPmREh;dKu<$m)SRc^Z>OH%{CQyiJz&m(rh4R%?-S9C=IU=1zkiN^i03l zF`*sr@i)|8^{@1j4Ne~2<(;Et@s=R(I6(97ja5OUlVNO=-qYQw+XBZy=CZU`OYGjo zjFl1(7-L{e8p5F##*&6AW*vreU7%0>csO;{X5v literal 1510 zcmaLLc{mdc0LO7hLhQkKSvnl`3gxJTcbJ(od5v79*_<;mgvQpq6rnuHZ7(B{!n|#A zrb6s>QboIM4icCIaKPlCw)}CS@EBQoeY*o6>KxR%?A_Es=;ATT36CGljttmHjAJ1dxPMW(8nB=Cm}x7mo*>vg$>puG7a6G~&v zt-QZKP1=H~^d$Dj;1X3$VCl!yy3%C*ZBwSx!jm(|`kC@J5p5(as0JVvk)Tv26QE`v z)gIDL!jk-tbcB3D0D~UaIuo3CofJzpN~Mb(JR@NjPPzUkPndmYebOW&9Y}s{N98#r z{m#T+GLo$!|M9^-HjB67?l$QqI!UH}hkBmQTmoUgM<0wu3r% zLNiofzD*rYej!_?5+F1aGkf~|&SJdv&!a4MPM+iitnN+dPQ5nQHDXI<}VyS3wYXLAYsN9#=bJnO1Lkq`pw^RSyrq+JV09 z>TwFLt17%fP#*~iqzamm(5cq@M`ztJ%gRQW_qWj)Fa%#0$24+kh#@IUJ}$2~ab?j( zRJB&Mz9n=VrP{_pJk>ShUTG`gU5e<-j`pF0&$G*O?1^IX-1C9YAOgef8r!2SwAG8N z1V!+{f%w?<4jw;m!Kb&{$u-9UoBQIH94z)GjpkiYv5s$$51y5A8V_Bj zGRHP&i%N84SuuNFK2R1Bl>V&3@#4IwVvfY)5!x>jb*eL#aw?qcQI&fW&h3>=knkW z)zCg7Kw{)JM_4%l9D`woHDa1DoI<8A!^8{DJ}~bnZ@C5OY(kf}CetPmN{2*6casyM z9TvNHI}AY0=XSNA=2w67=v?sKT0R2VP1?+O&3bc5XYNFLPFT$8d@?7BymVh>HNB%k z|bXDSQm1{ki5Cgc#=N}3wf8q-*O)rm>1U~@DDM5Vw>-H6Q4zcAR37Cd}GShfk#!8VyjBA_=*7VpjDAs z%Xpaunw`7E;HJ;XEDVrVB$HkhO?m&8+TB23XKyM~Dj(Fs=5EyJw!=xYRx>_(rans( zQC~x9nuwSa6QDR`_CVp(nGlmP%MF6@3Sd*E!b6b34U%AZ*m`l`F7^UnPpl{v;MO@X zTw3j2WvEO6Y=R1o;~(Qge2J(FNF8i+bTl5Gl`d@~uW>K+uqj9?4PZ-N>mN7&CZc7# KWj6{C68a01C-pf1 diff --git a/tests/testthat/data/tests_calc_allHIT_med.rds b/tests/testthat/data/tests_calc_allHIT_med.rds index ae56ce2691f5c6853fbda4b5cc900f0e032d9845..28a7b7e7bdb01264c3c8abd458c90b2d10340a15 100644 GIT binary patch delta 1401 zcmV-<1%~?E3WN)PABzY80000000v!G3v3ic7~bAhyf&49ST*HgL1?Qe(A~Rh5u5#i zwos+g0wqNr;o9MxnxT~IRuK*0E2I)s0zQe6LR1tr4MAdvF~tZX5mJlQ2q9p27D4VHjZqVH9Br!cv5j4a}4jlL#&**e2K^I81Pa;3&Z*1eX#_cx}RK6JDF}+Jx68 zyf)#r39n6fZNh64UWf2Hgx4Xw4&ikOuS0kp!s`%ThwwUtH%xfLgf~oh!-O|Xc*FQ? z1x7+(Bm_o(LSQ5WnTC-N7zu%q5V%!AA|Xg51c`(okq{&jf{|ZFhhqKI?T{vh7L1yn4!ZA9cIK~M$*fZ-vJ+g4AUF*@Mq4$pE(bI<~)pthw<

ubBA@cDB~r?!{4ee&zxgF7L2!}J#(A2bd^`<6u9$9{o~OM5Fi4)1rrUOzsNQ?<`M zDtmu_-o)Jl9f!M~ynY45%z6!`@_b#JPwU!f`WLU$wSJqfb4nu}aow}B7 znOr}l;XWv9U-i|MOM9WRQEqSSNvPA)0r|A=>CT9X`BeGDr5WGhq*Q~I;Z zT6TN`HT`P4tx$FTf?S{v_z#&kZ}vWd+Wp#pkBl{!PmJk4=bqU(`;=VCy(bMYMr`L{>9Tuy#)&EM(OG8Zf~`(J4EEjE6{&HY8Dzs~qmW7^ebUX}5q+_Yz! zc?(RPaZBFoA3yZD+dFu^6w>B)D_1JEr`lgC8+v|+0^vVMxNDy8pLz>AKpqS+}m9(a~g{>y|xcosiL)^|mq^ z3VSX}upEXT>p%MKjq4$x9$(%zw|}nRcKcR;H{<;q9$ovJS^w_yadknV-I@RC);A$n z*?jo~WGC}!^yK;Rodsi8)&BVOs1G53=T6@U7;VBq1^PB*XjL~Z&k4jK~+cvWGz%b>*p-#Ka4%OTkRAI221th1CU?r z`{Z^Ps{megdrjVY&G|d7YW@qMnO@zq zK1~hObtxO>CG|l|i>|f^N#`DaNuLMPCh7Y%4gUKq)gLkQo7=RG5vHA(tKV-&biUjJ zOMTt$dlUV02MfCNxLZrr!K;+N8|pt&hI!>)(;QpAtku$gngXVCP*XE&YFuVoS*>2o zYijkH8q?-xC00BvNM~-yx4?zLe7^At*ie5?6&Qg H&J6$ne2udp delta 1339 zcmV-B1;qM<3)~8SABzY80000000V_r3v3ic7~bC1dTo$^ST*HgLE7Sr(%rl3Rc!XB zw3I4H0U<>S;o9MxGt*M8TSYV!Uug;S!im7jG zwN}MCyEAwHPYH38yZ@Wnnfd1X_M5$2O_pI8KEv<#89u*%g#K|}+c3t+&mJS)$aFg! zqD2Tzgciae!VtnR!eWFGge4lLONto;7ZGd{Y!MtJI7D!m;9`O!1QTA9@S23zB)lf! zH3_dtcum4<5?+(=nuOOPycXfL2(LwWEy8ONUW@Qrgx4ax7U2yN-XP%(65b%;4HDiU zK3jp25Euy-fsqgx2|=b|Bm_o6U?c=?Rgg#s5($$H0UCdVi9$Kb=cE_qbCl0fK1cZ+ z<#UwJaT}b-=R`gy@;Q;uiF{7vb0VJ;`JBk-L_R0-Ig!uFiQwc!aB?CzIT4(k2%b6- z{um}FhRKOxa$@Lh484tUG9ZXBgfNT{+0fegXQq4%J8A&xGsb(bAjHH^8R5MJqpP|DH9cJh-Lx&kU%+O(m4l{I^ zp~H+g%#+{&AAgLbmtlJS4*twJ_%r9=&zytta4;T@AOmnQ^w>d<9rQSXYzbsbM9F|4 z!VtnR!eWFGge9_!mY+RPcj52v#O88XX?Pbb-FD=)UtZn^1yA>`n$=!x56G{(j_ii) z&9k3*G$RiJ2UmvdM}CI1{sR>|jvcZ;Z@a}es_LM9LVx!Dw3XY3cO2_{{OUCj)$7&i z%5zn1Jfmv8?q9J{)tc?9F4FCVovO|SRp;p%-K%P8M@h|?y1SvYecfjl`VYXIdbz!+ zUqi(X`CT|3BEvJ;y%XMqvbY>J|0K*AkgY%w%pA-rZQAt(R1dn_ZHB6IeR6>T;NPcT zzs-3M7JnX6exz*}IyI%M*Zy|Pg41#(dnjLxyYoJ!ceh-%`}`Xa@NQ4Extx6ehQCHu zLtn65?|-@0w?g|7)Awt2{}Sy_wQkSX^QyET<+?pr&s(Nz#4 z<+@U_Gu8gowW0er$QRy&gxl}&{Ih$d8Cj)kA%8D?bieGe`(ALb7ooXHt-E%&s%<~2 z+WwEK3C){0s_J^(W?iZ}T1Q+z*N**qoq*Pv`MPT~6m*}LpaI6896a&mwQb;YA79RP zdvLMWwg=XKQ~CBa54ZlR*T3Uj%)Ow%+?)I1ORqw&fxrI}fI=TlmA1 zlYicYQMY+Uz+}Bn?k<<$y43TzRoALnDnH3~V8s0#UDHSOPtsMdr}lg0PAI>)eYu+S z|Nq9>Jt}XP^q>92y^h;o$P+!n}_=E9*f0^kmK* zEbCO`Zj87GZ;t%kaQ`Ev=~wO*jnRhH&4&8ZK%Ohe%@BP@YF%o?8Fw!2muF`yPI_R!dM*C_-=}|Ycn}07_R*NJg3|K zf}z^WiYx!@ulnD&PKlDWzxsKb>%vn9?Qd;RI5KW|T3_{IPQ^* E0GaT5P5=M^ delta 186 zcmV;r07d`J0*L|?ABzY80000000WEQVqjokVqj)wkrY{fp#BGb+CkOq#1_j4f%*?1 z9{VC(wEb28`_?H@vgrElpPT`Kv-Yf3o6=ciIOUX=5h4MIyOA<>mi%T+-(e!c_<(KQh^z(xBHvozM o|Np;1w%$s32QrUP@+iDwM}rT#{IlSzMBtjHZ{f zD8F0}rk@w2zX3@6|Ns9Dx+TduiN!EWV1isJi6x18X+=Q&K;Az9!}?VtMFIc-iMDW> delta 249 zcmV@@d2?qJ{|F}Y+Am(BU$@Hb2z+CI&D6f;?ZgcGM?lk0Y_YVzQM5tf$n0ef%8M>MO>pdVFj+e> zqiBO70~FL;|6o7^ETE`igu0zIFEKZ@7#dehP(ilLyp+u3R49+LxFoS8v$!NP8BH%| zQGU4|Og}G3e*=*C|Ns9RbW4(R5{qG$zy!Hc5=#>G(u#okfxLeJq}8dMMFIc-&RBG& diff --git a/tests/testthat/data/tests_calc_durationLow_nwis_median.rds b/tests/testthat/data/tests_calc_durationLow_nwis_median.rds index 165a91fc759b80cfc11107e808834f8b335e2f04..35a0d9a9dfde1b636b166d64ea3ad8691a1a05f9 100644 GIT binary patch delta 224 zcmV<603ZLv0?7gtABzY80000000xWTVqjokVqjrnkrZ=(6lD2c`nd9sgN?}F&)ZxV zIoQaRo!DX-;b6V|{oGBud=6GCihvsDI5;@EuM??yXn*NIvryjjUi%9mW9oj{U%9I< zHGf~Z{iFH&KpO3D6hZ7!UUcDUf@7zH$=Zn-MH>_uprHN-0~%lfMGYg=?W}o;xv9m_ zxMG3|vSsE&rDP_jLV29UC5a`O#U+`^XnHw|^2_yL`guY6L0lCoABzY80000000WEQVqjokVqj)wkrZ=(qzPseZBRJsU?cMP^ETH- z4tfh5JI%e1I~ce~fD}4de1V8tcsoyRWK*@jbf8%%Z+fr&1(0mrFZ(NZ^`++TE4P0% ze_z>&Etd8-iXiqVFS_tF!Lif9WbH(t1&Rz%Q2&Dg4X}Wsh7sy^*1W{r)M98{F+l~{ zGV@Y0lT)ESJkH{h#FEV7lFVc@y_`k)<$5svydeD`umAu5{|&k&$vKI|FiT*9Tq%hq ViF#>8K>a}8KLAP-6c0rL008vZW6b~n diff --git a/tests/testthat/data/tests_calc_timingAverage_1158Thresh.rds b/tests/testthat/data/tests_calc_timingAverage_1158Thresh.rds index ff7ec865d0c26b93fe327b5f44cd7d00680f73ba..52077400055172a3dc1b83100d5e723467626498 100644 GIT binary patch delta 133 zcmZ3^xSUZ$zMF#q4A{CKBqbyyBqby!O%&12C`kEs>A2!Ie`S_QHTtzl46}Hqq_<=x zp7lQCtJ^l~9E)hm=`-FZef(NKS#)~~c^h?m8%@6WrAX}Q^w$T!d~W(;&d~WE2wb Date: Fri, 22 Sep 2023 09:28:34 -0500 Subject: [PATCH 19/19] check --- .Rbuildignore | 6 +++++- man/cut_dataToWaterYear.Rd | 6 +++++- test_water_year_calculation.R | 30 ------------------------------ 3 files changed, 10 insertions(+), 32 deletions(-) delete mode 100644 test_water_year_calculation.R diff --git a/.Rbuildignore b/.Rbuildignore index da248cd..2862990 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -18,4 +18,8 @@ test_stats_huc12_modeled_performance.R appveyor.yml EflowStats.bbl ^appveyor\.yml$ -CONDUCT.md \ No newline at end of file +CONDUCT.md +code.json +DISCLAIMER.md +LICENSE.md +README.Rmd \ No newline at end of file diff --git a/man/cut_dataToWaterYear.Rd b/man/cut_dataToWaterYear.Rd index e8197aa..9cbd390 100644 --- a/man/cut_dataToWaterYear.Rd +++ b/man/cut_dataToWaterYear.Rd @@ -4,12 +4,15 @@ \alias{cut_dataToWaterYear} \title{Cuts the discharge time series to full water years} \usage{ -cut_dataToWaterYear(x, wyMonth = 10L) +cut_dataToWaterYear(x, yearType, wyMonth = 10L) } \arguments{ \item{x}{data.frame containing a vector of date values in the first column and vector of numeric flow values in the second column.} +\item{yearType}{A character of either "water" or "calendar" indicating +whether to use water years or calendar years, respectively.} + \item{wyMonth}{A numeric. The month of the year in which the water year starts (1=January, 12=December). The water year begins on the first day of wyMonth.} } @@ -25,6 +28,7 @@ EflowStats functions. #' \enumerate{ \item First column must be of class `Date`. \item Second must be of class `numeric`. + \item `yearType` input must be either "water" or "calendar". \item `wyMonth`input must be of class `integer`. } } diff --git a/test_water_year_calculation.R b/test_water_year_calculation.R deleted file mode 100644 index 154a388..0000000 --- a/test_water_year_calculation.R +++ /dev/null @@ -1,30 +0,0 @@ -## finds all .R and .r files within a folder and sources them -sourceFolder <- function(folder, recursive = FALSE, ...) -{ - files <- list.files(folder, pattern = "[.][rR]$", - full.names = TRUE, recursive = recursive) - if (!length(files)) - stop(simpleError(sprintf('No R files in folder "%s"', folder))) - src <- invisible(lapply(files, source, ...)) - message(sprintf('%s files sourced from folder "%s"', length(src), folder)) -} -sourceFolder("c:\\Users\\jensk\\Work\\01_Projects\\210301bsu_DFG_RESIST\\01_Definition\\Lehre\\SEWAMM\\TrainTheTrainers_2022\\iha_software\\EflowStats\\R") - -x <- data.frame( - date = seq.Date(from = as.Date('1999-01-01'), to = as.Date('2003-12-31'), by = 'days'), - discharge = seq.int(1,length(seq.Date(from = as.Date('1999-01-01'), to = as.Date('2003-12-31'), by = 'days'))) -) - -yearType <- 'water' -for (wy_month in 1:12){ - x_cut <- cut_dataToWaterYear(x, wy_month) - cat("wyMonth =", wy_month, ":\n") - print(as.data.frame(table(get_waterYear(x_cut$date, wy_month)))) - cat("----------------\n") - if (length(validate_data(x_cut, yearType, wy_month))>1){ - cat("Data is valid\n\n\n") - }else{ - cat("Data is NOT valid\n\n\n") - } -} -