diff --git a/DESCRIPTION b/DESCRIPTION index 0836476559fe9d6b9012a51e39f57853b459a7e1..1a14feec5c05118112b8889f8cb8ff44c9cd0870 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.0.5.30 -Date: 2017-03-30 +Version: 1.0.6.0 +Date: 2017-03-31 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl")), person("Charles", "Perrin", role = c("aut", "ths")), diff --git a/R/plot.OutputsModel.R b/R/plot.OutputsModel.R index 7d8f03fa3b5ab7ca3c6ad00ecb6f83d29de2f13c..462903b61f1158905c6415d0cf05acd5c7dc8277 100644 --- a/R/plot.OutputsModel.R +++ b/R/plot.OutputsModel.R @@ -51,6 +51,9 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = return(filter(x, rep(1/n, n), sides = 2)); } MyRollMean2 <- function(x, n){ return(filter(c(tail(x, n%/%2), x, x[1:(n%/%2)]), rep(1/n, n), sides = 2)[(n%/%2+1):(length(x)+n%/%2)]); } + MyRollMean3 <- function(x, n){ + return(filter(x, filter = rep(1/n, n), sides = 2, circular = TRUE)) + } BOOL_TS <- FALSE; TimeStep <- difftime(tail(OutputsModel$DatesR, 1), tail(OutputsModel$DatesR, 2), units = "secs")[[1]]; if(inherits(OutputsModel, "hourly" ) & TimeStep %in% ( 60*60)){ BOOL_TS <- TRUE; NameTS <- "hour" ; plotunit <- "[mm/h]"; formatAxis <- "%m/%Y"; } @@ -308,19 +311,27 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = colnames(DataMonthly) <- c("Dates", "Precip", "Psol", "Qobs", "Qsim"); TxtDatesDataMonthly <- formatC(DataMonthly$Dates, format = "d", width = 6, flag = "0"); ##Computation_of_interannual_mean_series - if(!is.null(DataDaily)){ - DataDailyInterAn <- as.data.frame(aggregate(DataDaily[, 2:5], by = list(as.numeric(substr(TxtDatesDataDaily , 5, 8))), FUN = mean, na.rm = T)); - colnames(DataDailyInterAn) <- c("Dates", "Precip", "Psol", "Qobs", "Qsim"); } + if (!is.null(DataDaily)) { + SeqY <- data.frame(Dates = as.numeric(format(seq(as.Date("1970-01-01", tz = "UTC"), + as.Date("1970-12-31", tz = "UTC"), "day"), + format = "%m%d"))) + DataDailyInterAn <- as.data.frame(aggregate(DataDaily[, 2:5], by = list(as.numeric(substr(TxtDatesDataDaily , 5, 8))), FUN = mean, na.rm = T)); + colnames(DataDailyInterAn) <- c("Dates", "Precip", "Psol", "Qobs", "Qsim") + DataDailyInterAn <- merge(SeqY, DataDailyInterAn, by = "Dates", all.x = TRUE, all.y = FALSE) + } if(!is.null(DataMonthly)){ - DataMonthlyInterAn <- as.data.frame(aggregate(DataMonthly[, 2:5], by = list(as.numeric(substr(TxtDatesDataMonthly, 5, 6))), FUN = mean, na.rm = T)); - colnames(DataMonthlyInterAn) <- c("Dates", "Precip", "Psol", "Qobs", "Qsim"); } + SeqM <- data.frame(Dates = 1:12) + DataMonthlyInterAn <- as.data.frame(aggregate(DataMonthly[, 2:5], by = list(as.numeric(substr(TxtDatesDataMonthly, 5, 6))), FUN = mean, na.rm = T)); + colnames(DataMonthlyInterAn) <- c("Dates", "Precip", "Psol", "Qobs", "Qsim") + DataMonthlyInterAn <- merge(SeqM, DataMonthlyInterAn, by = "Dates", all.x = TRUE, all.y = FALSE) + } ##Smoothing_of_daily_series_and_scale_conversion_to_make_them_become_a_monthly_regime if(!is.null(DataDaily)){ ##Smoothing NDaysWindow <- 30; DataDailyInterAn <- as.data.frame(cbind(DataDailyInterAn$Dates, - MyRollMean2(DataDailyInterAn$Precip, NDaysWindow), MyRollMean2(DataDailyInterAn$Psol, NDaysWindow), - MyRollMean2(DataDailyInterAn$Qobs , NDaysWindow), MyRollMean2(DataDailyInterAn$Qsim, NDaysWindow))); + MyRollMean3(DataDailyInterAn$Precip, NDaysWindow), MyRollMean3(DataDailyInterAn$Psol, NDaysWindow), + MyRollMean3(DataDailyInterAn$Qobs , NDaysWindow), MyRollMean3(DataDailyInterAn$Qsim, NDaysWindow))); colnames(DataDailyInterAn) <- c("Dates", "Precip", "Psol", "Qobs", "Qsim"); ##Scale_conversion_to_make_them_become_a_monthly_regime if(plotunitregime != "[mm/month]"){ stop(paste("incorrect unit for regime plot \n", sep = "")); return(NULL); } @@ -346,12 +357,12 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = txtleg <- NULL; colleg <- NULL; lwdleg <- NULL; lwdP = 10; ##Plot_forcings if(BOOL_Pobs){ - plot(SeqX2, DataPlotP$Precip[seq_along(SeqX2)], type = "h", xlim = range(SeqX1), ylim = c(3*ylimP[1], ylimP[2]), lwd = lwdP, lend = 1, lty = 1, col = "royalblue", xlab = "", ylab = "", xaxt = "n", yaxt = "n", yaxs = "i", bty = "n", ...) + plot(SeqX2[DataMonthlyInterAn$Dates], DataPlotP$Precip, type = "h", xlim = range(SeqX1), ylim = c(3*ylimP[1], ylimP[2]), lwd = lwdP, lend = 1, lty = 1, col = "royalblue", xlab = "", ylab = "", xaxt = "n", yaxt = "n", yaxs = "i", bty = "n", ...) txtleg <- c(txtleg, "Ptot" ); colleg <- c(colleg, "royalblue"); lwdleg <- c(lwdleg, lwdP/3); axis(side = 2, at = pretty(0.8*ylimP, n = 3), labels = pretty(0.8*ylimP, n = 3), cex.axis = cexaxis, col.axis = "royalblue", col.ticks = "royalblue"); par(new = TRUE); } if(BOOL_Psol){ - plot(SeqX2, DataPlotP$Psol[seq_along(SeqX2)], type = "h", xlim = range(SeqX1), ylim = c(3*ylimP[1], ylimP[2]), lwd = lwdP, lend = 1, lty = 1, col = "lightblue", xlab = "", ylab = "", xaxt = "n", yaxt = "n", yaxs = "i", bty = "n", ...); + plot(SeqX2, DataPlotP$Psol[DataMonthlyInterAn$Dates], type = "h", xlim = range(SeqX1), ylim = c(3*ylimP[1], ylimP[2]), lwd = lwdP, lend = 1, lty = 1, col = "lightblue", xlab = "", ylab = "", xaxt = "n", yaxt = "n", yaxs = "i", bty = "n", ...); txtleg <- c(txtleg, "Psol" ); colleg <- c(colleg, "lightblue"); lwdleg <- c(lwdleg, lwdP/3); par(new = TRUE); } ##Plot_flows