Demostration of the Weather model
Andreas Angourakis
07 April, 2021
Load source file
source("source/weatherModel.R")Base generic functions
Sinusoidal curve with fluctuations
Generic function for geting points in sinusoidal curves depending on minValue, maxValue, length of year in days, and a normal stochastic fluctuation. See extended explanation at HTML with R walkthrough.
knitr::include_graphics("annualSinusoidCurve_full.png")
Annual cumulative daily precipitation using escalonated double logistic curve
Generic function for geting an year of daily precipitation. First, it generates a double logistic curve of range 0-1 depending on start and end days of year, a plateau value (intermediate value), and two sets of point of inflection and growth rate. See extended explanation at HTML with R walkthrough. Then, the curve is broken down stochastically into steps, controlled by nSample and maxSampleSize, which better represents the discretionality of precipitation events. Finally, the cumulative daily value is transformed into daily increments, which is multiplied by the annualSum, returning daily precipitation values.
knitr::include_graphics("annualDoubleLogisticCurve_full.png")
Reference evapotranspiration
TO-DO
estimateETr## function (R_s, temperature, temperature_max, temperature_min,
## temperature_dew = temperature_min, windSpeed = 2, albedo = 0.23,
## z = 200, lambda = 2.45, c_p = 1.013 * 10^-3, epsilon = 0.622,
## method = "PM", C_n = 900, C_d = 0.34, alpha = 1.26)
## {
## ETr <- NULL
## netSolarRadiation <- (1 - albedo) * R_s
## e_o <- function(temperature) {
## return(0.6108 * exp(17.27 * temperature/(temperature +
## 237.3)))
## }
## e_s = (e_o(temperature_max) + e_o(temperature_min))/2
## e_a = e_o(temperature_dew)
## DELTA = 4098 * e_o(temperature)/(temperature + 237.3)^2
## P = 101.3 * ((293 - 0.0065 * z)/293)^5.26
## gamma = c_p * P/(epsilon * lambda)
## if (method == "PM") {
## ETr <- (0.408 * DELTA * netSolarRadiation + gamma * (C_n/(temperature +
## 273)) * windSpeed * (e_s - e_a))/(DELTA + gamma *
## (1 + C_d * windSpeed))
## }
## if (method == "PT") {
## ETr <- (alpha/lambda) * (DELTA/(DELTA + gamma)) * netSolarRadiation
## }
## return(ETr)
## }#knitr::include_graphics("XXXXXX.png")Auxiliar functions
An auxiliar function to simplify code with long variable names:
getLastItemInVector## function (x)
## {
## return(x[length(x)])
## }Function for marking the end of each year:
markEndYears## function (lengthOfData, offset = 1, yearLengthInDays = 365, lty = 3)
## {
## for (i in 1:lengthOfData) {
## if (i%%(yearLengthInDays * offset) == 0) {
## abline(v = i, lty = lty)
## }
## }
## }The model main procedures
weatherModel.init## function (yearLengthInDays = 365, seed = 0, albedo = 0.4, southHemisphere = FALSE,
## temperature_annualMaxAt2m = 40, temperature_annualMinAt2m = 15,
## temperature_meanDailyFluctuation = 5, temperature_dailyLowerDeviation = 5,
## temperature_dailyUpperDeviation = 5, solar_annualMax = 7,
## solar_annualMin = 3, solar_meanDailyFluctuation = 1, precip_yearlyMean = 400,
## precip_yearlySd = 130, precip_nSamples = 200, precip_maxSampleSize = 10,
## precip_plateauValue_yearlyMean = 0.1, precip_plateauValue_yearlySd = 0.05,
## precip_inflection1_yearlyMean = 40, precip_inflection1_yearlySd = 20,
## precip_rate1_yearlyMean = 0.15, precip_rate1_yearlySd = 0.02,
## precip_inflection2_yearlyMean = 200, precip_inflection2_yearlySd = 20,
## precip_rate2_yearlyMean = 0.05, precip_rate2_yearlySd = 0.01)
## {
## set.seed(seed)
## weatherModel <- list()
## weatherModel$PARS <- list(seed = seed, yearLengthInDays = yearLengthInDays,
## albedo = albedo, southHemisphere = southHemisphere, temperature = list(annualMaxAt2m = temperature_annualMaxAt2m,
## annualMinAt2m = temperature_annualMinAt2m, meanDailyFluctuation = temperature_meanDailyFluctuation,
## dailyLowerDeviation = temperature_dailyLowerDeviation,
## dailyUpperDeviation = temperature_dailyUpperDeviation),
## solar = list(annualMax = solar_annualMax, annualMin = solar_annualMin,
## meanDailyFluctuation = solar_meanDailyFluctuation),
## precipitation = list(yearlyMean = precip_yearlyMean,
## yearlySd = precip_yearlySd, nSamples = precip_nSamples,
## maxSampleSize = precip_maxSampleSize, plateauValue_yearlyMean = precip_plateauValue_yearlyMean,
## plateauValue_yearlySd = precip_plateauValue_yearlySd,
## inflection1_yearlyMean = precip_inflection1_yearlyMean,
## inflection1_yearlySd = precip_inflection1_yearlySd,
## rate1_yearlyMean = precip_rate1_yearlyMean, rate1_yearlySd = precip_rate1_yearlySd,
## inflection2_yearlyMean = precip_inflection2_yearlyMean,
## inflection2_yearlySd = precip_inflection2_yearlySd,
## rate2_yearlyMean = precip_rate2_yearlyMean, rate2_yearlySd = precip_rate2_yearlySd))
## weatherModel$annualPrecipitationPars <- list(annualSum = c(),
## plateauValue = c(), inflection1 = c(), rate1 = c(), inflection2 = c(),
## rate2 = c())
## weatherModel$daily <- list(currentYear = c(), currentDayOfYear = c(),
## temperature = c(), temperature_max = c(), temperature_min = c(),
## solarRadiation = c(), ETr = c(), precipitation = c())
## return(weatherModel)
## }weatherModel.run## function (weatherModel, numberOfYears)
## {
## for (year in 1:numberOfYears) {
## weatherModel$annualPrecipitationPars$annualSum <- c(weatherModel$annualPrecipitationPars$annualSum,
## max(0, rnorm(1, weatherModel$PARS$precipitation$yearlyMean,
## weatherModel$PARS$precipitation$yearlySd)))
## weatherModel$annualPrecipitationPars$plateauValue <- c(weatherModel$annualPrecipitationPars$plateauValue,
## min(1, max(0, rnorm(1, weatherModel$PARS$precipitation$plateauValue_yearlyMean,
## weatherModel$PARS$precipitation$plateauValue_yearlySd))))
## weatherModel$annualPrecipitationPars$inflection1 <- c(weatherModel$annualPrecipitationPars$inflection1,
## min(weatherModel$PARS$yearLengthInDays, max(1, rnorm(1,
## weatherModel$PARS$precipitation$inflection1_yearlyMean,
## weatherModel$PARS$precipitation$inflection1_yearlySd))))
## weatherModel$annualPrecipitationPars$rate1 <- c(weatherModel$annualPrecipitationPars$rate1,
## max(0, rnorm(1, weatherModel$PARS$precipitation$rate1_yearlyMean,
## weatherModel$PARS$precipitation$rate1_yearlySd)))
## weatherModel$annualPrecipitationPars$inflection2 <- c(weatherModel$annualPrecipitationPars$inflection2,
## min(weatherModel$PARS$yearLengthInDays, max(1, rnorm(1,
## weatherModel$PARS$precipitation$inflection2_yearlyMean,
## weatherModel$PARS$precipitation$inflection2_yearlySd))))
## weatherModel$annualPrecipitationPars$rate2 <- c(weatherModel$annualPrecipitationPars$rate2,
## max(0, rnorm(1, weatherModel$PARS$precipitation$rate2_yearlyMean,
## weatherModel$PARS$precipitation$rate2_yearlySd)))
## weatherModel$daily$precipitation <- c(weatherModel$daily$precipitation,
## getPrecipitationOfYear(plateauValue = getLastItemInVector(weatherModel$annualPrecipitationPars$plateauValue),
## inflection1 = getLastItemInVector(weatherModel$annualPrecipitationPars$inflection1),
## rate1 = getLastItemInVector(weatherModel$annualPrecipitationPars$rate1),
## inflection2 = getLastItemInVector(weatherModel$annualPrecipitationPars$inflection2),
## rate2 = getLastItemInVector(weatherModel$annualPrecipitationPars$rate2),
## yearLengthInDays = weatherModel$PARS$yearLengthInDays,
## nSamples = weatherModel$PARS$precipitation$nSamples,
## maxSampleSize = weatherModel$PARS$precipitation$maxSampleSize,
## annualSum = getLastItemInVector(weatherModel$annualPrecipitationPars$annualSum),
## seed = runif(1, 0, 2147483647)))
## for (day in 1:weatherModel$PARS$yearLengthInDays) {
## weatherModel$daily$currentYear <- c(weatherModel$daily$currentYear,
## year)
## weatherModel$daily$currentDayOfYear <- c(weatherModel$daily$currentDayOfYear,
## day)
## weatherModel$daily$temperature <- c(weatherModel$daily$temperature,
## getDayValueInAnnualSinusoidWithFluctuation(minValue = weatherModel$PARS$temperature$annualMinAt2m,
## maxValue = weatherModel$PARS$temperature$annualMaxAt2m,
## fluctuation = weatherModel$PARS$temperature$meanDailyFluctuation,
## dayOfYear = day, yearLengthInDays = weatherModel$PARS$yearLengthInDays,
## southHemisphere = weatherModel$PARS$southHemisphere,
## seed = runif(1, 0, 2147483647)))
## weatherModel$daily$temperature_min <- c(weatherModel$daily$temperature_min,
## getLastItemInVector(weatherModel$daily$temperature) -
## weatherModel$PARS$temperature$dailyLowerDeviation)
## weatherModel$daily$temperature_max <- c(weatherModel$daily$temperature_max,
## getLastItemInVector(weatherModel$daily$temperature) +
## weatherModel$PARS$temperature$dailyUpperDeviation)
## weatherModel$daily$solarRadiation <- c(weatherModel$daily$solarRadiation,
## max(0, getDayValueInAnnualSinusoidWithFluctuation(minValue = weatherModel$PARS$solar$annualMin,
## maxValue = weatherModel$PARS$solar$annualMax,
## fluctuation = weatherModel$PARS$solar$meanDailyFluctuation,
## dayOfYear = day, yearLengthInDays = weatherModel$PARS$yearLengthInDays,
## southHemisphere = weatherModel$PARS$southHemisphere,
## seed = runif(1, 0, 2147483647))))
## weatherModel$daily$ETr <- c(weatherModel$daily$ETr,
## estimateETr(R_s = getLastItemInVector(weatherModel$daily$solarRadiation),
## temperature = getLastItemInVector(weatherModel$daily$temperature),
## temperature_max = getLastItemInVector(weatherModel$daily$temperature_max),
## temperature_min = getLastItemInVector(weatherModel$daily$temperature_min)))
## }
## }
## return(weatherModel)
## }Running the model
Initialise
weatherModel <- weatherModel.init()Show table with parameter values:
parvalues <- c(
weatherModel$PARS[[1]],
weatherModel$PARS[[2]],
weatherModel$PARS[[3]],
weatherModel$PARS[[4]]
)
parNames <- c("seed", "yearLengthInDays", "albedo", "southHemisphere")
for (j in 5:length(weatherModel$PARS))
{
parGroupName <- names(weatherModel$PARS)[j]
for (i in 1:length(weatherModel$PARS[[j]]))
{
parvalues <- c(
parvalues,
weatherModel$PARS[[j]][[i]]
)
parName <- paste(parGroupName, names(weatherModel$PARS[[j]])[i], sep = " - ")
parNames <- c(parNames, parName)
}
}
parvalues <- cbind(parNames, parvalues)
knitr::kable(parvalues,
format = "html",
col.names = c("parameter", "values"),
align = c("l", "r"))| parameter | values |
|---|---|
| seed | 0 |
| yearLengthInDays | 365 |
| albedo | 0.4 |
| southHemisphere | 0 |
| temperature - annualMaxAt2m | 40 |
| temperature - annualMinAt2m | 15 |
| temperature - meanDailyFluctuation | 5 |
| temperature - dailyLowerDeviation | 5 |
| temperature - dailyUpperDeviation | 5 |
| solar - annualMax | 7 |
| solar - annualMin | 3 |
| solar - meanDailyFluctuation | 1 |
| precipitation - yearlyMean | 400 |
| precipitation - yearlySd | 130 |
| precipitation - nSamples | 200 |
| precipitation - maxSampleSize | 10 |
| precipitation - plateauValue_yearlyMean | 0.1 |
| precipitation - plateauValue_yearlySd | 0.05 |
| precipitation - inflection1_yearlyMean | 40 |
| precipitation - inflection1_yearlySd | 20 |
| precipitation - rate1_yearlyMean | 0.15 |
| precipitation - rate1_yearlySd | 0.02 |
| precipitation - inflection2_yearlyMean | 200 |
| precipitation - inflection2_yearlySd | 20 |
| precipitation - rate2_yearlyMean | 0.05 |
| precipitation - rate2_yearlySd | 0.01 |
Run
Run for 5 years:
set.seed(0)
weatherModel <- weatherModel.run(weatherModel, numberOfYears = 5)0.1 Plot results
Set colours for maximum and minimum temperature:
maxTemperatureColour = hsv(7.3/360, 74.6/100, 70/100)
minTemperatureColour = hsv(232/360, 64.6/100, 73/100)Plot time-series:
lengthOfSimulation = length(weatherModel$daily$currentYear)
#--------
plotName = "weatherModelExample.png"
grScale = 2
fontRescale = 0
fontRescaleDay = 0
png(plotName, width = grScale * 600, height = grScale * 700)
#---------
# alternatively, to create eps file:
#---------
# plotName = "FigX-weatherModelExample.eps"
#
# grScale = 1.2
# fontRescale = 0.1
# fontRescaleDay = -0.5 # to adjust unexpected scale behaviour in mtext
#
# extrafont::loadfonts(device = "postscript")
# grDevices::cairo_ps(file = plotName,
# pointsize = 12,
# width = grScale * 6,
# height = grScale * 7,
# onefile = FALSE,
# family = "sans")
#---------
layout(matrix(c(1:10),
nrow = 5, ncol = 2, byrow = FALSE),
widths = c(1, 10),
heights = c(10, 10, 10, 12, 2))
yLabs <- c(expression(paste(" Solar\nRadiation (", MJ/m^-2, ")")),
"Temperature (C)",
"ETr (mm)",
"Precipitation (mm)")
par(cex = grScale)
# First column
par(mar = c(0, 0, 0, 0))
plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
text(x = 0.5, y = 0.5, font = 4,
cex = grScale * (0.6 + fontRescale),
srt = 90,
labels = yLabs[1])
plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
text(x = 0.5, y = 0.5, font = 4,
cex = grScale * (0.7 + fontRescale),
srt = 90,
labels = yLabs[2])
plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
text(x = 0.5, y = 0.6, font = 4,
cex = grScale * (0.7 + fontRescale),
srt = 90,
labels = yLabs[3])
plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
text(x = 0.5, y = 0.6, font = 4,
cex = grScale * (0.7 + fontRescale),
srt = 90,
labels = yLabs[4])
plot(c(0, 1), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
# Second column
par(mar = c(0.2, 1, 0.5, 0.1),
cex.axis = grScale * (0.6 + fontRescale))
# 1: Solar radiation
plot(1:lengthOfSimulation, weatherModel$daily$solarRadiation, type = "l",
xlab = "", xaxt = 'n',
ylab = "")
markEndYears(lengthOfSimulation)
# 2: Temperature
plot(1:lengthOfSimulation, weatherModel$daily$temperature, type = "l",
xlab = "", xaxt = 'n',
ylab = "")
lines(1:lengthOfSimulation, weatherModel$daily$temperature_max,
col = adjustcolor(maxTemperatureColour, alpha.f = 0.8))
lines(1:lengthOfSimulation, weatherModel$daily$temperature_min,
col = adjustcolor(minTemperatureColour, alpha.f = 0.8))
markEndYears(lengthOfSimulation)
# 3: Reference evapotranspiration
plot(1:lengthOfSimulation, weatherModel$daily$ETr, type = "l",
ylab = "",
xlab = "", xaxt = 'n')
markEndYears(lengthOfSimulation)
# 4: Precipitation
par(mar = c(2, 1, 0.1, 0.1))
barplot(weatherModel$daily$precipitation,
ylab = "",
#names.arg = 1:lengthOfSimulation,
xlab = "", xaxt = 'n')
markEndYears(lengthOfSimulation
, offset = 1.2)
abline(v = lengthOfSimulation * 1.2, lty = 3)
# not sure why, but barplot() x coordinates do not behave as in plot()
# 5: x-axis title
par(mar = c(1, 1, 0, 0.1))
plot(c(1, lengthOfSimulation), c(0, 1), ann = F, bty = 'n', type = 'n', xaxt = 'n', yaxt = 'n')
axis(3,
at = 1:lengthOfSimulation,
tck = 0, lwd = 0)
mtext("day", side = 1, line = -1,
font = 4, cex = grScale * (1.7 + fontRescale + fontRescaleDay))
dev.off()## png
## 2knitr::include_graphics(plotName)