Commit 35270330 authored by Dorchies David's avatar Dorchies David
Browse files

feat: function for getting objective storage for the current day

Fix #22
parent 09faca41
#' Interpolate objective reservoir storage for a given date
#'
#' @param date [Date] (default current date)
#'
#' @return Named [numeric] vector with objective storage for each reservoir
#' @export
#'
#' @examples
#' getObjectiveStorage()
getObjectiveStorage <- function(date = Sys.Date()) {
pivots <- list(
data.frame(mmdd = c('1101', '0201', '0301', '0701'),
S = c(24.5, 84., 130., 170.)),
data.frame(mmdd = c('1108', '1208', '0208', '0408', '0708'),
S = c(18.7, 40., 95., 175., 207.8)),
data.frame(mmdd = c('1101', '1231', '0131', '0701'),
S = c(12.3, 34., 50., 80.)),
data.frame(mmdd = c('1101', '0101', '0201', '0301', '0701'),
S = c(25, 100, 170, 260, 350))
)
names(pivots) <- c("AUBE", "SEINE", "YONNE","MARNE")
caldays <- format(seq(as.Date("2001-01-01"), as.Date("2001-12-31"), 1), "%m%d")
pivots <- lapply(pivots, function(x) {
# sort array by date
x <- x[order(x$mmdd),]
# add count for before and after year
x <- rbind(x[nrow(x),], x, x[1,])
# Julian day count
x$julian <- match(x$mmdd, caldays)
x$julian[1] <- x$julian[1] - 365
x$julian[nrow(x)] <- x$julian[nrow(x)] + 365
x
})
date_julian <- which(format(date, "%m%d") == caldays)
unlist(lapply(pivots, function(x) {
approx(x$julian, x$S, date_julian)$y
}))
}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment